edges number system

labeled edges


connect as line endpoints

In[]:=
ClearAll[yearGraphicEndpts]​​yearGraphicEndpts[year_Integer /; 1000 <= year <= 9999] := Module[{o, t, h, th},​​ {o, t, h, th} = IntegerDigits[year];​​ Graphics[​​ GrayLevel[0.8],​​ Line[{{9, o}, {t, 9}, {0, h}, {th, 0}, {9, o}}],​​ Line[{{9, o}, {9-t, 9}, {0, 9-h}, {th, 0}, {9, o}}]​​ ,​​ PlotRange -> {{0, 9}, {0, 9}},​​ PlotRangePadding -> 0.1​​ ]​​];
In[]:=
yearGraphicEndpts/@{1957,1965,1995,1997}
Out[]=

,
,
,

(*AnimatedoesnotworkintheCloud*)​​(*Animate[img,{img,yearGraphicEndpts/@Range[1995,2024]}]*)

connect as ends of folds

In[]:=
ClearAll[foldLine]​​foldLine[pt1_, pt2_] := Module[{normalSlope, midPt, secondX, secondPt},​​ ​​ normalSlope = -1 * First[Quiet[Divide @@ (Differences /@ Transpose[{pt1, pt2}]), Divide::infy]];​​ midPt = Midpoint[{pt1, pt2}];​​ ​​ If[MatchQ[normalSlope, ComplexInfinity],​​ secondPt = midPt + {0, 1},​​ ​​ secondX = First[midPt] + 1;​​ secondPt = {secondX, normalSlope * (secondX - First[midPt]) + Last[midPt]}​​ ];​​ ​​ InfiniteLine[{midPt, secondPt}]​​];
In[]:=
ClearAll[yearGraphicFolds]​​yearGraphicFolds[year_Integer /; 1000 <= year <= 9999] := Module[{o, t, h, th, pts},​​ {th, h, t, o} = IntegerDigits[year];​​ pts = {{9, th}, {9-h, 9}, {0, 9-t}, {o, 0}};​​ Graphics[​​ (*Point /@ pts,*)​​ GrayLevel[0.8],​​ foldLine @@@ Partition[pts, 2, 1]​​ ,​​ PlotRange -> {{0, 9}, {0, 9}},​​ PlotRangePadding -> 0.1​​ ]​​];
In[]:=
yearGraphicFolds/@{1957,1965,1995,1997}
Out[]=

,
,
,

(*AnimatedoesnotworkintheCloud*)​​(*Animate[img,{img,yearGraphicFolds/@Range[1995,2024]}]*)