Remainder Graphs

Adam Rumpf, 10/10/2017

Introduction

This Notebook defines a variety of functions for calculating and displaying remainder graphs. The remainder graph for any positive integer n is defined with vertex set 0,1,...,(n-1) and with two types of directed edge. For each vertex i, there is a black directed edge i->(i+1) mod n and a green directed edge i->10i mod n. The functions in this Module generate graphs of this form.

The purpose of a remainder graph is to provide a graphical method for evaluating the remainder of a large number (Subscript[b, 1])(Subscript[b, 2])...(Subscript[b, m]) after division by a small number n. Specifically, we begin at node 0 and then read the digits of the large number from left to right. For each digit (Subscript[b, j]), we advance (Subscript[b, j]) steps around the black arrows and then (except for the final step) follow the green arrow. The final node represents the remainder after dividing (Subscript[b, 1])(Subscript[b, 2])...(Subscript[b, m]) by n. Because a remainder of 0 indicates that the large number is divisible by n, this graph can also be used to gain insight into the tests for divisibility by n.

The main functions to be used in this Notebook are graphgen[], graphgendoz[], graphgenoct[], and graphgenhex[], which correspond to base 10, base 12, base 8, and base 16 number systems, respectively. Each accepts a single integer argument, and produces a graphic of the remainder graph for the given input in the given base.

Code

Initialization

(* Generates the described graph for a given value n. *)
graphgen[n_]:=Module[{e1,e2},
e1=Table[{k,Mod[k+1,n]},{k,0,n-1}];e2=Table[{k,Mod[10k,n]},{k,0,n-1}];
graphdraw[n,e1,e2]
]

(* Draws the given graph information with black edges e1 and green edges e2 (both lists of ordered pairs {a,b} representing an edge a->b).  We use a custom graph drawing function since it's difficult to color multiedges different colors with the built-in Graph and GraphPlot functions. *)
graphdraw[n_,e1_,e2_]:=Module[{coord,coordmid,v,eb,eg,label},
coord=Table[{Cos[Pi/2-2Pi k/n],Sin[Pi/2-2Pi k/n]},{k,0,n-1}];
coordmid=1.25Table[{Cos[Pi/2-2Pi k/n-Pi/n],Sin[Pi/2-2Pi k/n-Pi/n]},{k,0,n-1}];
v=Graphics[{Black,PointSize[Large],Point[Table[coord[[k]],{k,1,n}]]}];
label=Graphics[Join[{Black},Table[Text[Style[ToString[k-1],Medium],1.1coord[[k]]],{k,1,n}]]];
eb=Graphics[Join[{Black},Table[Arrow[{coord[[e1[[k,1]]+1]],coord[[e1[[k,2]]+1]]}],{k,1,Length[e1]}]]];
eg=Graphics[Join[{Green},Table[Arrow[greenline[k,n,e2,coord,coordmid]],{k,1,Length[e2]}]]];
Show[eb,eg,v,label]
]

(* Generates a spline function approximating a circle with n points, with the first point at the bottom (specified by x) and moving CW, and radius r, and rotation offset θ. *)
splinecircle[n_,x_,r_,θ_]:=BSplineCurve[Table[x+{r Cos[θ],r Sin[θ]}+{r Cos[θ-Pi-2Pi k/10],r Sin[θ-Pi-2Pi k/10]},{k,0,10}]]

(* Piecewise: Use a circle if it maps to itself, a Bezier curve through the midpoint if it maps to the next element or the previous element, or a straight line otherwise.  This will act as the argument for the Arrow function. *)
greenline[k_,n_,e2_,coord_,coordmid_]:=Piecewise[{{splinecircle[5,coord[[k]],0.25,Pi/2-2Pi (k-1)/n],e2[[k,1]]==e2[[k,2]]},{BezierCurve[{coord[[e2[[k,1]]+1]],coordmid[[e2[[k,1]]+1]],coord[[e2[[k,2]]+1]]}],Mod[e2[[k,1]]+1,n]==e2[[k,2]]},{BezierCurve[{coord[[e2[[k,1]]+1]],coordmid[[e2[[k,2]]+1]],coord[[e2[[k,2]]+1]]}],Mod[e2[[k,1]]-1,n]==e2[[k,2]]}},{coord[[e2[[k,1]]+1]],coord[[e2[[k,2]]+1]]}]

graphgendoz[n_]:=Module[{e1,e2},
e1=Table[{k,Mod[k+1,n]},{k,0,n-1}];e2=Table[{k,Mod[12k,n]},{k,0,n-1}];
graphdrawdoz[n,e1,e2]
]

graphdrawdoz[n_,e1_,e2_]:=Module[{coord,coordmid,v,eb,eg,label},
coord=Table[{Cos[Pi/2-2Pi k/n],Sin[Pi/2-2Pi k/n]},{k,0,n-1}];
coordmid=1.25Table[{Cos[Pi/2-2Pi k/n-Pi/n],Sin[Pi/2-2Pi k/n-Pi/n]},{k,0,n-1}];
v=Graphics[{Black,PointSize[Large],Point[Table[coord[[k]],{k,1,n}]]}];
label=Graphics[Join[{Black},Table[Text[Style[ToString[Piecewise[{{"χ",k-1==10},{"ϵ",k-1==11}},k-1]],Medium],1.1coord[[k]]],{k,1,n}]]];
eb=Graphics[Join[{Black},Table[Arrow[{coord[[e1[[k,1]]+1]],coord[[e1[[k,2]]+1]]}],{k,1,Length[e1]}]]];
eg=Graphics[Join[{Green},Table[Arrow[greenline[k,n,e2,coord,coordmid]],{k,1,Length[e2]}]]];
Show[eb,eg,v,label]
]

graphgenoct[n_]:=Module[{e1,e2},
e1=Table[{k,Mod[k+1,n]},{k,0,n-1}];e2=Table[{k,Mod[8k,n]},{k,0,n-1}];
graphdrawoct[n,e1,e2]
]

graphdrawoct[n_,e1_,e2_]:=Module[{coord,coordmid,v,eb,eg,label},
coord=Table[{Cos[Pi/2-2Pi k/n],Sin[Pi/2-2Pi k/n]},{k,0,n-1}];
coordmid=1.25Table[{Cos[Pi/2-2Pi k/n-Pi/n],Sin[Pi/2-2Pi k/n-Pi/n]},{k,0,n-1}];
v=Graphics[{Black,PointSize[Large],Point[Table[coord[[k]],{k,1,n}]]}];
label=Graphics[Join[{Black},Table[Text[Style[ToString[k-1],Medium],1.1coord[[k]]],{k,1,n}]]];
eb=Graphics[Join[{Black},Table[Arrow[{coord[[e1[[k,1]]+1]],coord[[e1[[k,2]]+1]]}],{k,1,Length[e1]}]]];
eg=Graphics[Join[{Green},Table[Arrow[greenline[k,n,e2,coord,coordmid]],{k,1,Length[e2]}]]];
Show[eb,eg,v,label]
]

graphgenhex[n_]:=Module[{e1,e2},
e1=Table[{k,Mod[k+1,n]},{k,0,n-1}];e2=Table[{k,Mod[16k,n]},{k,0,n-1}];
graphdrawhex[n,e1,e2]
]

graphdrawhex[n_,e1_,e2_]:=Module[{coord,coordmid,v,eb,eg,label},
coord=Table[{Cos[Pi/2-2Pi k/n],Sin[Pi/2-2Pi k/n]},{k,0,n-1}];
coordmid=1.25Table[{Cos[Pi/2-2Pi k/n-Pi/n],Sin[Pi/2-2Pi k/n-Pi/n]},{k,0,n-1}];
v=Graphics[{Black,PointSize[Large],Point[Table[coord[[k]],{k,1,n}]]}];
label=Graphics[Join[{Black},Table[Text[Style[ToString[Piecewise[{{"A",k-1==10},{"B",k-1==11},{"C",k-1==12},{"D",k-1==13},{"E",k-1==14},{"F",k-1==15}},k-1]],Medium],1.1coord[[k]]],{k,1,n}]]];
eb=Graphics[Join[{Black},Table[Arrow[{coord[[e1[[k,1]]+1]],coord[[e1[[k,2]]+1]]}],{k,1,Length[e1]}]]];
eg=Graphics[Join[{Green},Table[Arrow[greenline[k,n,e2,coord,coordmid]],{k,1,Length[e2]}]]];
Show[eb,eg,v,label]
]

Demonstration

(* Remainder graph for 7 (base 10). *)
graphgen[7]

(* Remainder graph for 11 (base 10). *)
graphgen[11]

(* Selectable remainder graph (base 10). *)
Manipulate[graphgen[n],{{n,7},1,20,1}]

(* Table of bases 0,...,10 (base 10). *)
TableForm[{Table[graphgen[n],{n,1,5}],Table[graphgen[n],{n,6,10}]}]

(* Table of bases 0,...,12 (base 12). *)
TableForm[{Table[graphgendoz[n],{n,1,5}],Table[graphgen[n],{n,6,10}]}]

(* Table of bases 0,...,8 (base 8). *)
TableForm[{Table[graphgenoct[n],{n,1,5}],Table[graphgen[n],{n,6,10}]}]

(* Table of bases 0,...,16 (base 16). *)
TableForm[{Table[graphgenhex[n],{n,1,5}],Table[graphgen[n],{n,6,10}]}]