Introduction

This Mathematica notebook is licensed under a MouseOver .

It provides software for producing the endograph of finite functions.  MouseOver gives a definition of endograph.

The notebook is still rough and incomplete.  It will be revised from time to time.  I hope anyone interested will feel free to improve this work and to use it in their own publications and coursework.

Definitions

SetOptions[Plot, AspectRatio -> Automatic]; 
tf := TableForm; tx := TeXForm; hh := Hold; 
  ss := Simplify; 
tt[x_] :=TraditionalForm[x]; 
  mf := MatrixForm;

RuleGraph[r_]:=GraphPlot[r,VertexLabeling->True, DirectedEdges->True,EdgeRenderingFunction->(Arrow[#1,0.1]&),PlotStyle->{Directive[Arrowheads[0.02]],Thickness[0.003]},VertexRenderingFunction->(Text[Style[#2,16,Bold],#1]&),ImageSize->Large]

RuleGraph[r_,gstyle_,n_,arhs_]:=gstyle[r,VertexLabeling->True,DirectedEdges->True,EdgeRenderingFunction->(Arrow[#1,0.2]&),PlotStyle->{Directive[Arrowheads[arhs]],Thickness[0.005]},VertexRenderingFunction->(Text[Style[#2,16,Bold],#1]&),ImageSize->n]

ShowGraph[r_,coords_,n_,arhs_]:=GraphPlot[r,VertexCoordinateRules->coords,VertexLabeling->True,DirectedEdges->True,EdgeRenderingFunction->(Arrow[#1,0.2]&),PlotStyle->{Directive[Arrowheads[arhs]],Thickness[0.004]},VertexRenderingFunction->(Text[Style[#2,16,Bold],#1]&),ImageSize->n]

Endograph[f_,n_]:=GraphPlot[MakeFunctionRule[f,n],VertexLabeling->True,DirectedEdges->True,EdgeRenderingFunction->(Arrow[#1,0.1]&),PlotStyle->{Directive[Arrowheads[0.02]],Thickness[0.003]},VertexRenderingFunction->(Text[Style[#2,16,Bold],#1]&),ImageSize->Small]

LGraph[r_]:=LayeredGraphPlot[r,EdgeRenderingFunction->(Arrow[#1,0.1]&),PlotStyle->{Directive[Arrowheads[0.03]],Thickness[0.003]},VertexRenderingFunction->(Text[Style[#2,16,Bold],#1]&),ImageSize->Small]

MakeFunctionRule[f_,n_]:=#->f[#]&/@ Table[k,{k,0,n-1}]

FunctionGraph[x_,n_]:=RuleGraph[MakeFunctionRule[x,n]]

DFGraph[f_,n_]:=LGraph[MakeFunctionRule[f,n]]

Cograph

This produces cographs only for functions defined on intervals of the form {0, 1, ..., n}

rems[n_]:=Table[i,{i,0,n-1}]

rems[5]

{#,1}&/@rems[5]

Text[#,{#,1}]&/@rems[5]

Arrow[{{#,1},{#,0}},.2]&/@rems[5]

Show[Graphics[{Arrow[{{0,1},{0,0}},0.2],Arrow[{{1,1},{0,0}},0.2]}],ImageSize->Tiny]

Show[Graphics[{Arrow[{{#,1},{#,0}},.2]&/@rems[5]}],ImageSize->Small]

sqf[n_]:=Mod[n^2+1,5]

Show[Graphics[{Arrow[{{#,1},{sqf[#],0}},.2]&/@rems[5]}],ImageSize->Small]

Show[Graphics[{Arrow[{{#,1},{sqf[#],0}},.2]&/@rems[5]}],ImageSize->Small]

Show[Graphics[{Text[#,{#,1}]&/@rems[5],Text[#,{#,0}]&/@rems[5],Arrow[{{#,1},{sqf[#],0}},.2]&/@rems[5]}],ImageSize->Small]

cograph[f_,n_,sb_,is_,ahs_]:=Show[Graphics[{Arrowheads[ahs],Text[#,{#,1}]&/@rems[n],Text[#,{#,0}]&/@rems[n],Arrow[{{#,1},{f[#],0}},sb]&/@rems[n]}],ImageSize->is]

cograph[sqf,5,.15,Small,.04]

Examples

fm

fm[n_]:=Mod[n^(11)+n^9+n^7+1,13]

Show[cograph[fm,13,.15,400,.02],AspectRatio->.2]

MakeFunctionRule[fm,13]

Table[{n,fm[n]},{n,0,12}]

Table[{n,fm[n]},{n,0,12}]//TableForm

Table[{n,fm[n]},{n,0,12}]//TableForm//TeXForm

Table[{n,fm[n]},{n,0,12}]//Transpose//TableForm//TeXForm

FunctionGraph[fm,13]

Table[{n,fm[n]},{n,0,12}]//tf
({{0, 1}, {1, 4}, {2, 11}, {3, 1}, {4, 1}, {5, 9}, {6, 11}, {7, 4}, {8, 6}, {9, 1}, {10, 1}, {11, 4}, {12, 11}})

{{0,1},{1,4},{2,11},{3,1},{4,1},{5,9},{6,11},{7,4},{8,6},{9,1},{10,1},{11,4},{12,11}}//List//TraditionalForm

Symmetries

Square

Show[
Graphics[
{Thick,Point[{{0,0},{0,1},{1,0},{1,1}}]
}
],
ImageSize->50
]

labsty[ch_]=Style[ch,Bold,Larger,Red//Darker]

Manipulate[
Show[
Module[
{aa:={0,0},bb:={0,1},cc:={1,0},dd:={1,1}},
Graphics[
{Thick,Point[{aa,bb,cc,dd}],Text[labsty[A],bb+{-e1,e2}],Text[labsty[B],dd+{e1,e2}],Text[labsty[C],cc+{e1,-e2}],Text[labsty[D],aa+{-e1,-e2}]
}
]
],
ImageSize->100
],
{{e1,.1},0,1},{{e2,.1},0,1},AppearanceElements->All
]

Manipulate[
Show[
Module[
{aa:={0,0},bb:={0,1},cc:={1,0},dd:={1,1}},
Graphics[
{Thick,Point[{aa,bb,cc,dd}],Text[labsty[A],bb+{-e1,e2}],Text[labsty[B],dd+{e1,e2}],Text[labsty[C],cc+{e1,-e2}],Text[labsty[D],aa+{-e1,-e2}],Line[{aa,bb,dd,cc,aa}]
}
]
],
ImageSize->100
],
{{e1,.1},0,1},{{e2,.1},0,1},AppearanceElements->All
]

DiagFlip:=Show[
Module[
{aa:={0,0},bb:={0,1},cc:={1,0},dd:={1,1},aar:={2,0},bbr:={2,1},ccr:={3,0},ddr:={3,1}},
Graphics[
{Thick,Point[{aa,bb,cc,dd}],Text[labsty[A],bb+{-.1,.1}],Text[labsty[B],dd+{.1,.1}],Text[labsty[C],cc+{.1,-.1}],Text[labsty[D],aa+{-.1,-.1}],Line[{aa,bb,dd,cc,aa}],Blue//Darker,Arrowheads[0.05],Arrow[{{1.2,0.5},{1.8,0.5}}],
Black,Point[{aar,bbr,ccr,ddr}],Text[labsty[C],bbr+{-.1,.1}],Text[labsty[B],ddr+{.1,.1}],Text[labsty[A],ccr+{.1,-.1}],Text[labsty[D],aar+{-.1,-.1}],Line[{aar,bbr,ddr,ccr,aar}],Green,Dashed,Line[{aa,dd}]
}
]
],
ImageSize->200
]

DiagFlip

df["A"]="C";df["B"]="B";df["C"]="A";df["D"]="D";

dfgraph=ShowGraph[{"A"->"C","C"->"A","B"->"B","D"->"D"},{"A"->{0,0},"C"->{1,0},"B"->{2,0},"D"->{3,0}},200,.03]

gp[ch_,p_]:=Text[Style[ch,Bold],p]

Graphics[{gp["A",{0,1}],gp["A",{0,0}],gp["B",{1,1}],gp["B",{1,0}],gp["C",{2,1}],gp["C",{2,0}],gp["D",{3,1}],gp["D",{3,0}]}]

Show[Graphics[{Arrowheads[.05],gp["A",{0,1}],gp["A",{0,0}],gp["B",{1,1}],gp["B",{1,0}],gp["C",{2,1}],gp["C",{2,0}],gp["D",{3,1}],gp["D",{3,0}],Arrow[{{0,1},{2,0}},.1],Arrow[{{2,1},{0,0}},.1],Arrow[{{1,1},{1,0}},.1],Arrow[{{3,1},{3,0}},.1]}],ImageSize->Small]

HorizFlip:=Show[
Module[
{aa:={0,0},bb:={0,1},cc:={1,0},dd:={1,1},aar:={2,0},bbr:={2,1},ccr:={3,0},ddr:={3,1}},
Graphics[
{Thick,Point[{aa,bb,cc,dd}],Text[labsty[A],bb+{-.1,.1}],Text[labsty[B],dd+{.1,.1}],Text[labsty[C],cc+{.1,-.1}],Text[labsty[D],aa+{-.1,-.1}],Line[{aa,bb,dd,cc,aa}],Blue//Darker,Arrowheads[0.05],Arrow[{{1.2,0.5},{1.8,0.5}}],
Black,Point[{aar,bbr,ccr,ddr}],Text[labsty[D],bbr+{-.1,.1}],Text[labsty[C],ddr+{.1,.1}],Text[labsty[B],ccr+{.1,-.1}],Text[labsty[A],aar+{-.1,-.1}],Line[{aar,bbr,ddr,ccr,aar}],Green,Dashed,Line[{{0,.5},{1,.5}}]
}
]
],
ImageSize->200
]

HorizFlip

grn:=Green//Darker

hfgraph=ShowGraph[{"A"->"D","C"->"B","B"->"C","D"->"A"},{"A"->{0,0},"D"->{1,0},"B"->{2,0},"C"->{3,0}},200,.03]

Show[Graphics[{Arrowheads[.05],gp["A",{0,1}],gp["A",{0,0}],gp["B",{1,1}],gp["B",{1,0}],gp["C",{2,1}],gp["C",{2,0}],gp["D",{3,1}],gp["D",{3,0}],Arrow[{{0,1},{3,0}},.1],Arrow[{{1,1},{2,0}},.1],Arrow[{{2,1},{1,0}},.1],Arrow[{{3,1},{0,0}},.1]}],ImageSize->Small]

Turn:=Show[
Module[
{aa:={0,0},bb:={0,1},cc:={1,0},dd:={1,1},aar:={2,0},bbr:={2,1},ccr:={3,0},ddr:={3,1}},
Graphics[
{Thick,Point[{aa,bb,cc,dd}],Text[labsty[A],bb+{-.1,.1}],Text[labsty[B],dd+{.1,.1}],Text[labsty[C],cc+{.1,-.1}],Text[labsty[D],aa+{-.1,-.1}],Text[commutative,{0.5,0.5}],Line[{aa,bb,dd,cc,aa}],Blue//Darker,Arrowheads[0.05],Arrow[{{1.2,0.5},{1.8,0.5}}],
Black,Point[{aar,bbr,ccr,ddr}],Text[labsty[B],bbr+{-.1,.1}],Text[labsty[C],ddr+{.1,.1}],Text[labsty[D],ccr+{.1,-.1}],Text[labsty[A],aar+{-.1,-.1}],Line[{aar,bbr,ddr,ccr,aar}]
}
]
],
ImageSize->200
]

grn:=Green//Darker

commutative=Show[
{ParametricPlot[{Cos[θ],Sin[θ]},{θ,0.6,2 Pi-0.6},PlotRange->{{-1.2,1.4},{-1.3,1.3}},PlotStyle->{grn,Dashed,Thickness[.07]},Axes->False],Graphics[{grn,Thickness[.05],Line[{{.3,.44},{.83,.57},{.82,1.1}}]}]},ImageSize->30]

Turn

turngraph=ShowGraph[{"A"->"B","B"->"C","C"->"D","D"->"A"},{"A"->{0,1},"B"->{1,1},"D"->{0,0},"C"->{1,0}},66,.13]

Show[Graphics[{Arrowheads[.05],gp["A",{0,1}],gp["A",{0,0}],gp["B",{1,1}],gp["B",{1,0}],gp["C",{2,1}],gp["C",{2,0}],gp["D",{3,1}],gp["D",{3,0}],Arrow[{{0,1},{1,0}},.1],Arrow[{{1,1},{2,0}},.1],Arrow[{{2,1},{3,0}},.1],Arrow[{{3,1},{0,0}},.1]}],ImageSize->Small]