All the code
hintstyle=Sequence[11,Red];
candstyle=Sequence[8,Gray];
fixedstyle=Sequence[22,Black];
linestyle=Sequence[Thickness[0.01],JoinForm["Round"],CapForm["Round"]];
thinlinestyle=Sequence[GrayLevel[0.85],Thickness[0.005],JoinForm["Round"],CapForm["Round"]];
opchars={Plus->"+",Minus->"-",Times->"*",Divide->"/"};
ClearAll[SquareSides,ClueText,DrawGrid]
SquareSides[n_,m_]:={{{n,-m},{n+1,-m}},{{n,-m},{n,-m-1}},{{n+1,-m},{n+1,-m-1}},{{n,-m-1},{n+1,-m-1}}}
ClueText[cands_,{x_,y_}]:=Module[{center,r=0.2,cp},
center={x+0.5,-y-0.5};
If[Length[cands]==1,
Text[Style[First[cands],fixedstyle],center]
,
cp=CirclePoints[center,{r,\[Pi]/2},n];
cp=MapThread[Text[Style[#1,candstyle],#2]&,{Range[n],cp}][[cands]];
cp
]
]
DrawGrid[cands_List,hints_List]:=Module[{hor,ver,all,rem,boxborders,topleft,hinttext,candpos,candtext},
hor=Flatten[Outer[List,Range[n],Range[n+1]],1];
ver=Flatten[Outer[List,Range[n+1],Range[n]],1];
all=Join[{#,#+{1,0}}&/@hor,{#,#+{0,1}}&/@ver];
all[[All,All,2]]*=-1;
topleft=First[TakeSmallestBy[#,Total,1]]&/@hints[[All,3]];
topleft+=0.08;
topleft[[All,2]]*=-1;
hinttext=ToString[#1]<>(#2/.opchars)&@@@hints;
hinttext=MapThread[Text[Style[#1,hintstyle],#2,{-1,1}]&,{hinttext,topleft}];
boxborders=Apply[SquareSides,hints[[All,3]],{2}];
boxborders=Flatten[#,1]&/@boxborders;
boxborders=Select[Tally[#],Last[#]==1&][[All,1]]&/@boxborders;
boxborders=Flatten[boxborders,1];
rem=Complement[all,boxborders];
candpos=Tuples[Range[n],2];
candtext=MapThread[ClueText,{Flatten[cands,1],candpos}];
Graphics[{{thinlinestyle,Line/@rem},
hinttext,
{linestyle,Line[boxborders]},
candtext
},ImageSize->65n
]
]
ClearAll[ConvertHint,CandAssassin,CandAssassinHelper,ApplyHint]
ConvertHint[ans_,Divide,cells_]:={Log[ans],Abs[Log[#1/#2]]&,cells}
ConvertHint[ans_,Minus,cells_]:={ans,Abs[#1-#2]&,cells}
ConvertHint[ans_,op_,cells_]:={ans,op,cells}
ApplyHint[ans_Integer,op_,cells_List]:=ApplyHint[ConvertHint[ans,op, cells]]
ApplyHint[{ans_,op_,cells_List}]:=Module[{cns},
cns=Extract[cands,cells];
cns=Select[Tuples[cns],op@@#==ans&];
cns=CandAssassin[cns,cells];
cns=Union/@(cns\[Transpose]);
MapThread[(Part[cands,Sequence@@#2]=#1)&,{cns,cells}]
]
CandAssassinHelper[cn_List,icell_List]:=AllTrue[icell,Unequal@@cn[[#]]&]
CandAssassin[cns_List,cells_List]:=Module[{icell,newcans},
icell={Range[Length[cells]],cells}\[Transpose];
icell=GatherBy[icell,#[[2,1]]&][[All,All,1]];
newcans=Select[cns,CandAssassinHelper[#,icell]&];
icell={Range[Length[cells]],cells}\[Transpose];
icell=GatherBy[icell,#[[2,2]]&][[All,All,1]];
Select[newcans,CandAssassinHelper[#,icell]&]
]
ClearAll[DeleteCands,NakedSubset,NakedSubsetCheck,NakedDelete]
DeleteCands[{n_,m_},del_]:=(Part[cands,n,m]=Complement[Part[cands,n,m],del])
NakedDelete[cells_List,samesubs_List]:=Module[{other,digits},
other=Complement[cells,samesubs];
digits=First[Extract[cands,samesubs[[{1}]]]];
Do[DeleteCands[o,digits],{o,other}]
]
NakedSubsetCheck[cells_List]:=Module[{celldata,n=Length[cells]},
celldata=Extract[cands,cells];
If[AllTrue[celldata,Length[#]<=n&],
Length[Union@@celldata]==n
,
False
]
]
NakedSubset[m_Integer]:=Module[{cellgroups},
cellgroups=Join[Outer[List,Range[n],Range[n]],Outer[List,Range[n],Range[n]]\[Transpose]];
Do[NakedSubset[m,cg],{cg,cellgroups}]
]
NakedSubset[m_Integer,cells_List]:=Module[{subsets},
subsets=Subsets[cells,{m}];
subsets=Select[subsets,NakedSubsetCheck];
Do[NakedDelete[cells,ss],{ss,subsets}];
]
ClearAll[BoxBoxInteraction]
BoxBoxInteraction[]:=BoxBoxInteraction/@Apply[ConvertHint,Subsets[hints,{2}],{2}]
BoxBoxInteraction[hints_List]:=Module[{ans,ops,cellss,cns},
{ans,ops,cellss}=Transpose[hints];
cns=Extract[cands,#]&/@cellss;
cns=Tuples/@cns;
cns=Table[Select[cns[[\[Iota]]],ops[[\[Iota]]]@@#==ans[[\[Iota]]]&],{\[Iota],Length[hints]}];
cns=MapThread[CandAssassin,{cns,cellss}];
cns=Tuples[cns];
cns=Flatten[cns,{{1},{2,3}}];
cellss=Flatten[cellss,1];
cns=CandAssassin[cns,cellss];
cns=Union/@Transpose[cns];
MapThread[(Part[cands,Sequence@@#2]=#1)&,{cns,cellss}];
]
Example 1
n=4;
hints={
{12,Times,{{1,1},{2,1},{2,2}}},
{2,Divide,{{3,1},{4,1}}},
{11,Plus,{{1,2},{1,3},{1,4},{2,3}}},
{2,Minus,{{3,2},{3,3}}},
{2,Plus,{{4,2}}},
{4,Plus,{{4,3},{4,4}}},
{3,Minus,{{2,4},{3,4}}}
};
AbsoluteTiming[
cands=ConstantArray[Range[n],{n,n}];
old=False;
While[old=!=cands,
old=cands;
ApplyHint@@@hints;
NakedSubset/@Range[n];
If[old==cands,
BoxBoxInteraction[];
];
];
]
DrawGrid[cands,hints]
Example 2
n=6;
hints={{13,Plus,{{1,1},{1,2},{2,1},{2,2}}},
{180,Times,{{3,1},{4,1},{5,1},{4,2}}},
{9,Plus,{{6,1},{6,2},{6,3}}},
{2,Plus,{{3,2}}},
{20,Times,{{5,2},{5,3}}},
{15,Plus,{{1,3},{1,4},{1,5}}},
{6,Times,{{2,3},{3,3}}},
{11,Plus,{{4,3},{4,4},{3,4}}},
{3,Plus,{{2,4}}},
{9,Plus,{{5,4},{6,4},{5,5},{4,5}}},
{2,Divide,{{2,5},{3,5}}},
{8,Plus,{{1,6},{2,6},{3,6}}},
{18,Plus,{{4,6},{5,6},{6,6},{6,5}}}
};
AbsoluteTiming[
cands=ConstantArray[Range[n],{n,n}];
old=False;
While[old=!=cands,
old=cands;
ApplyHint@@@hints;
NakedSubset/@Range[n];
If[old==cands,
BoxBoxInteraction[];
];
];
]
DrawGrid[cands,hints]