FixRules[rlist_]:=Map[(#+1)&,rlist,{-1}]
Note: Needs DiagramInit first....
Hairs[g_]:=Complement[Flatten[Last/@g],First/@g]
General::spell1:Possible spelling error: new symbol name "Hairs is similar to existing symbol Pairs.
HairDests[g_]:=Module[{h=Hairs[g]},g[[Position[g,#,{3}][[1,1]],1]]&/@h]
RulePicture0[g_]:=Module[{h=Hairs[g]},hdests=g[[Position[g,#,{3}][[1,1]],1]]&/@h;hdests=MapThread[(#1->{#2,#2,#2})&,{h,hdests}];NeighborsPictureRX[Join[hdests,g],h]]
RulePicture[urule_]:=GraphicsRow[GraphicsRow[{RulePicture0[First[#]],Graphics[Arrow[{{0,0},{1,0}},.35],PlotRange->{{-.3,1.3},{-.6,.6}}],RulePicture0[Last[#]]},.1]&/@urule,.5]
NeighborsPictureRX[g_,init_]:=Module[{gp=g,already=init,next,xv=0,gbag={},last,lastp},last=init;While[(nextp=last/.gp;next=Complement[Flatten[nextp],already])=!={},wts=(First/@Position[nextp,#])&/@next;wts=(Apply[Plus,#]/Length[#])&/@wts;wts=Transpose[{wts,next}];next=Last/@Sort[wts];AppendTo[gbag,Table[If[MemberQ[next,nextp〚i,j〛],Line[{{If[xv==0,0.8,xv],i},{xv+1,Position[next,nextp〚i,j〛]〚1,1〛}}],{}],{i,Length[last]},{j,3}]];already=Flatten[{already,next}];nextp=next/.gp;AppendTo[gbag,Table[If[MemberQ[next,nextp[[i,j]]],p=Position[next,nextp[[i,j]]][[1,1]];Circle[{xv+1,(i+p)/2},N[{ArcTan[#]/2,#}]&[Abs[p-i]/2],{-π/2,π/2}],{}],{i,Length[next]},{j,3}]];xv++;last=next];Graphics[Flatten[gbag],PlotRangeAll]]
rule36={{4{1,5,6},5{2,4,6},6{3,4,5}}{4{5,6,7},5{1,4,8},6{2,4,8},7{3,4,8},8{5,6,7}},{6{1,7,8},7{4,6,9},8{5,6,10},9{3,7,10},10{2,8,9}}{6{1,7,8},7{2,6,9},8{3,6,10},9{4,7,10},10{5,8,9}}};