graph, cograph, endograph examples for real functions

This Mathematica notebook is licensed under a MouseOver .
It provides software for producing graphs, cographs and endographs for a given function. This notebook is discussed at the blog post Demos for graph and cograph of calculus functions.  I hope anyone interested will feel free to improve this work and to use it in their own publications and coursework.

Code for real cograph

Remove[Env]

Tikk[x_,y_]:=Line[{{x,y-.05},{x,y+.05}}];
Tixx[a_,b_,c_,n_]:=Table[Tikk[a+k n,c],{k,0,(b-a)/n}]

Options[RealCograph]={ArrowSource->2,ArrowTarget->0,SampleIncrement->1/2,ArrowHeadSize->.02,TikkIncrement->1/4,LabelIncrement->1,ArrowColor->Blue}

RealCograph[x_,DisplayLeft_,DisplayRight_,DomainLeft_,DomainRight_,Expr_,OptionsPattern[]] :=(LabelOffset:=(1/10)(OptionValue[ArrowSource]-OptionValue[ArrowTarget]);
Show[Graphics[Line[{{DomainLeft,OptionValue[ArrowSource]},{DomainRight,OptionValue[ArrowSource]}}]],Graphics[Line[{{DisplayLeft,OptionValue[ArrowTarget]},{DisplayRight,OptionValue[ArrowTarget]}}]],Graphics[Tixx[DisplayLeft,DisplayRight,OptionValue[ArrowTarget],OptionValue[TikkIncrement]]],Graphics[Tixx[DomainLeft,DomainRight,OptionValue[ArrowSource],OptionValue[TikkIncrement]]],Graphics[Text[#,{#,OptionValue[ArrowSource]+LabelOffset}]&/@Table[n,{n,DomainLeft,DomainRight,OptionValue[LabelIncrement]}]],Graphics[Text[#,{#,OptionValue[ArrowTarget]-LabelOffset}]&/@Table[n,{n,DisplayLeft,DisplayRight,OptionValue[LabelIncrement]}]],Graphics[{OptionValue[ArrowColor],Arrowheads[OptionValue[ArrowHeadSize]],Table[Arrow[{{x,OptionValue[ArrowSource]},{Expr,OptionValue[ArrowTarget]}}],(*????*){x,DomainLeft,DomainRight,OptionValue[SampleIncrement]}]}],ImageSize->Medium,ImagePadding->.3])

Code for real endograph

Real Endograph

Tikk[x_,y_]:=Line[{{x,y-.05},{x,y+.05}}];
Tixx[a_,b_,c_,n_]:=Table[Tikk[a+k n,c],{k,0,(b-a)/n}]

Arr[a_,c_,Envelope_:0]:=(jump:=c-a;adjust:=.25;htadj:=3;Arrow[BezierCurve[{{a,0},{a+ adjust jump,2+Envelope},
{c- adjust jump,2+Envelope},{c,0}}]])

Show[Graphics[{Arr[3,3],Arr[1,1.2,1],Arr[-1,-3,2],Arr[-3,-1],Arr[-3,-2]}],ImageSize->Tiny]

Options[RealEndograph]={SampleIncrement->1/2,ArrowHeadSize->.015,TikkIncrement->1/4,LabelIncrement->1,ArrowColor->Blue,Env->.2Abs[x],Loff->-0.4}

RealEndograph[DisplayLeft_,DisplayRight_,DomainLeft_,DomainRight_,Func_,OptionsPattern[]]:=Show[Graphics[Line[{{DisplayLeft,0},{DisplayRight,0}}]],Graphics[Tixx[DisplayLeft,DisplayRight,0,1/4]],Graphics[Text[#,{#,OptionValue[Loff]}]&/@Table[n,{n,DisplayLeft,DisplayRight}]],Graphics[{OptionValue[ArrowColor],Arrowheads[OptionValue[ArrowHeadSize]],Table[Arr[x,Func[x],OptionValue[Env]],{x,DomainLeft,DomainRight,OptionValue[SampleIncrement]}]}],ImageSize->Large]

RealEndograph[-4,4,-4,4,.5#&,Env->.2Abs[x]]

Examples

Linear functions

Manipulate[Row[{Plot[{a x+b},{x,-5,5},PlotRange->{{-5,5},{-5,5}},PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->Small],"    ",  Show[RealCograph[x,-12,12.3,-5,5,a x+b,SampleIncrement->1,ArrowSource->5,ArrowColor->Red],PlotRange->{{-12.1,12.3},{-1,6}},PlotRangeClipping->True,ImageSize->500],
Show[RealEndograph[-12,12,-5,5,a #+b&,Env->.4Abs[x]],ImageSize->500,PlotRange->{{-12.1,12.3},{-1,3}}]}
],
{{a,0.7},-2,2,.001,Appearance->"Open"},{{b,1.2},-2,2,.001,Appearance->"Open"},SaveDefinitions->True]

Two linear functions

Manipulate[Row[{Plot[{a x+b,a(x+b)},{x,-5,5},PlotRange->{{-5,5},{-5,5}},PlotStyle->Evaluate[{Thick,#}&/@ {Blue,Red}],AspectRatio->Automatic,ImageSize->Small],"   ",
Show[RealCograph[x,-14,14.3,-5,5,a (x+b),SampleIncrement->1,ArrowHeadSize->.01,ArrowSource->3],RealCograph[x,-14,14.3,-5,5,a x+b,SampleIncrement->1,ArrowSource->3,ArrowHeadSize->.01,ArrowColor->Red],ImageSize->900,PlotRange->{{-14.1,14.3},{-1,4}},ImageSize->Large,PlotRangeClipping->True],"    ",
Show[RealEndograph[-14,14.3,-5,5,a #+b&,Env->.4Abs[x],ArrowHeadSize->.01],
RealEndograph[-14,14.3,-5,5,a (#+b)&,Env->.4Abs[x],ArrowHeadSize->.01,ArrowColor->Red],ImageSize->900,PlotRange->{{-14.1,14.3},{-1,3}}]
}
],
{{a,2},-2,2,.001,Appearance->"Open"},{{b,1.7},-2,2,.001,Appearance->"Open"},SaveDefinitions->True]

Quadratic

Manipulate[
Row[{
Plot[{a x^2+b},{x,-1,1},
PlotRange->{{-1,1},{-2,2}},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->130],
"    ",
Show[RealCograph[x,-2,2,-1,1,a x^2+b,
SampleIncrement->.1,
ArrowSource->2.6,
ArrowColor->Blue],
PlotRange->{{-2,2},{-.4,3}},ImageSize->260],
"     ",
Show[RealEndograph[-2,2,-1,1,a #^2+b&,Env->.1Abs[x],ArrowHeadSize->.03,SampleIncrement->.13,Loff->-.2],ImageSize->260,PlotRange->{{-2,2},{-.4,2}}]}],
{{a,0.7},-1,1,.001,Appearance->"Open"},{{b,.3},-1,1,.001,Appearance->"Open"},
SaveDefinitions->True]

Quadratic and its derivative

Manipulate[Row[{Plot[{a x^2,2a x},{x,-2,2},PlotRange->{{-2,2},{-5,5}},PlotStyle->Evaluate[{Thick,#}&/@ {Blue,Red}],AspectRatio->Automatic,ImageSize->75],"\n",
Show[RealCograph[x,-8,8,-2,2,a x^2,SampleIncrement->.3,ArrowHeadSize->.015,ArrowSource->4],RealCograph[x,-8,8,-2,2,2a x,SampleIncrement->.3,ArrowSource->4,ArrowHeadSize->.015,ArrowColor->Red],ImageSize->350,PlotRange->{{-8,8},{-1,4.6}},ImageSize->400,PlotRangeClipping->True],"\n",
Show[RealEndograph[-8,8,-2,2,a #^2&,Env->1.3Abs[x],SampleIncrement->.3,ArrowColor->Blue],RealEndograph[-8,8,-2,2,2 a x&,Env->1.3Abs[x],SampleIncrement->.3,ArrowColor->Red],ImageSize->350,PlotRange->{{-8,8},{-1,4.6}}]
}
],
{{a,1},-2,2,.001,Appearance->"Open"},SaveDefinitions->True]

Cubic

Manipulate[
Row[{
Plot[{a x^3-b x},{x,-1,1},
PlotRange->{{-1,1},{-2,2}},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->150],
"    ",
Show[RealCograph[x,-2,2,-1,1,a x^3-b x,
SampleIncrement->.1,
ArrowSource->2.6,
ArrowColor->Blue],
PlotRange->{{-2,2},{-.4,3}},ImageSize->300],
"     ",
Show[RealEndograph[-2,2,-1,1,a #^3+b x& ,Env->.1Abs[x],ArrowHeadSize->.03,Loff->-.2,SampleIncrement->.13],ImageSize->300,PlotRange->{{-2,2},{-.4,2}}]
}],
{{a,0.7},-1,1,.001,Appearance->"Open"},{{b,.3},-1,1,.001,Appearance->"Open"},
SaveDefinitions->True]

Sine

Manipulate[
Row[{Plot[{Sin[a x]},{x,-Pi,Pi},
PlotRange->{{-3.2,3.2},{-1.1,1.1}},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->400],
"    ",
Show[RealCograph[x,-1,1,-3,3,Sin[a x],
ArrowHeadSize->.01,
SampleIncrement->.1,
ArrowSource->1.9,
ArrowColor->Blue],
PlotRange->{{-3,3},{-0.2,2.2}},ImageSize->400],
"    ",
Show[RealEndograph[-12,12,-5,5,Sin[a #]&,Env->.4Abs[x]],ImageSize->400,PlotRange->{{-5.1,5.3},{-1,3}}]}],
{{a,1},0,6,.001,Appearance->"Open"},
SaveDefinitions->True]

Sine with two parameters

Manipulate[
Row[{Plot[{a Sin[b  x]},{x,-Pi,Pi},
PlotRange->{{-3.2,3.2},{-2.1,2.1}},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->300],
"    ",
Show[RealCograph[x,-2,2,-3,3,a Sin[b x],
ArrowHeadSize->.02,
SampleIncrement->.1,
ArrowSource->1.9,
ArrowColor->Blue],
PlotRange->{{-3,3},{-0.2,2.2}},ImageSize->350],
"    ",
Show[RealEndograph[-12,12,-5,5,a Sin[b #]&,Env->.4Abs[x],ArrowHeadSize->.02],ImageSize->350,PlotRange->{{-5.1,5.3},{-1,3}}]}],
{{a,1},0,2,.001,Appearance->"Open"},{{b,1},0,6,.001,Appearance->"Open"},
SaveDefinitions->True]

Sine and its derivative

Manipulate[
Row[{Plot[{Sin[a x], a Cos[a x]},{x,-Pi,Pi},
PlotRange->{{-3.2,3.2},{-3.1,3.1}},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue,Red}],AspectRatio->Automatic,ImageSize->200],
"    ",
Show[{RealCograph[x,-3,3,-3,3,Sin[a x],
ArrowHeadSize->.01,
SampleIncrement->.25,
ArrowSource->1.9,
ArrowColor->Blue],
RealCograph[x,-3,3,-3,3,a  Cos[a x],
ArrowHeadSize->.01,
SampleIncrement->.25,
ArrowSource->1.9,
ArrowColor->Red]},
PlotRange->{{-3,3.3},{-0.3,2.2}},ImageSize->400],
"    ",
Show[{RealEndograph[-12,12,-3,3,Sin[a #]&,Env->.4Abs[x],ArrowHeadSize->.02,ArrowColor->Blue],
RealEndograph[-12,12,-3,3,a Cos[a #]&,Env->.4Abs[x],ArrowHeadSize->.02,ArrowColor->Red]},ImageSize->400,PlotRange->{{-3.3,3.3},{-1,3}}]}],
{{a,1},0,3,.001,Appearance->"Open"},
SaveDefinitions->True]

Quartic

Manipulate[Plot[(x-1)x(x+a)(x+1),{x,-2.2,2.2},PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],PlotRange->{{-3,3},{-2,2}},AspectRatio->Automatic,ImageSize->200],{{a,0},-2,2,.001,Appearance->"Open"},
SaveDefinitions->True]

Quintic

Plot[-.5+.5x+.2 x^2-.21 x^3-.015x^4+.01 x^5,{x,-4,4},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],AspectRatio->Automatic,ImageSize->600]

-c+.5 x+.2 x^2-.21 x^3-b x^4+a x^5//TraditionalFrom//TeXForm

Manipulate[
Row[{
Plot[-c+.5x+.2 x^2-.21x^3-b x^4+a  x^5,{x,-4,4},
PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],PlotRange->{{-4,4},{-5,5}},AspectRatio->Automatic,ImageSize->180],
"    ",
Show[RealCograph[x,-5,5,-4,4,-c+.5x+.2 x^2-.21 x^3-b x^4+a  x^5,
SampleIncrement->.15,
ArrowSource->2.6,
ArrowColor->Blue],
PlotRange->{{-4,4},{-.4,3.4}},ImageSize->360],
"     ",
Show[RealEndograph[-5,5,-4,4,-c+.5#+.2 #^2-.21#^3-b #^4+a  #^5& ,Env->.4Abs[x],ArrowHeadSize->.02,SampleIncrement->.15],ImageSize->360,PlotRange->{{-4,4},{-1,3}}]
}],
{{a,0.01},0.008,.012,.00025,Appearance->"Open"},{{b,.015},.007,.0175,.001,Appearance->"Open"},
{{c,.5},-1,2,.001,Appearance->"Open"},
SaveDefinitions->True]

Another quintic

Manipulate[Plot[.22(x-1.6)(x-.9)(x+a)(x+.6)(x+1.8),{x,-2,2},PlotStyle->Evaluate[{Thick,#}&/@ {Blue}],PlotRange->{{-2,2},{-2,2}},AspectRatio->Automatic,ImageSize->200],{{a,0},-2,2.4,.001,Appearance->"Open"},
SaveDefinitions->True]