Home > Logic
| If....Then... (Posted on 2010-09-21) |
 |
|
No Solution Yet
|
Submitted by brianjn
|
|
No Rating
|
|
computer solution (no diagnals)
|
 | Comment 1 of 4
|
not entirely certain if diagnal movement is allowed
the following solution assumes it is not, I will post another solution assuming that it is.
analysis with Mathematica gives the only path as
84,105,576,200,2990,45,420,72,133,1190,140,546,120
to get this solution, I first created a list of the tests (1 thru 5) which pass for each number in the grid. I then use this to determine the possible moves for each number. Finally, I used this to create a graphics which showed all of these possible moves. This made it quite obvious what the path was.
here is a link to a picture of the resulting graphics showing the possible moves
http://www.flickr.com/photos/15704053@N04/5012692783/
mathematica code is:
row={3,11,13,5,9,7};
col={4,12,10,2,6,8};
grd={{84,108,91,10,60,40},{105,576,2310,198,30,264},{52,200,2990,286,52,40},{108,420,45,156,330,120},{180,72,140,126,18,153},
{33,133,1190,140,546,120}};
tst1[x_,y_,n_]:=Xor[Mod[n,x] ƒú0,Mod[n,y]ƒú0];
tst2[x_,y_,n_]:=If[Mod[n,x+y] ƒú0,Return[True],Return[False]];
tst3[x_,y_,n_]:=If[Mod[n,Abs[x-y]] ƒú0 && Abs[x-y]>1,Return[True],Return[False]];
tst4[x_,y_,n_]:=If[Mod[n,x*y] ƒú0,Return[True],Return[False]];
tst5[x_,y_,n_]:=If[Mod[n,x*y] ƒú0,Return[False],Return[True]];
glst=Table[{},{i,1,6},{j,1,6}];
For[i=1,i „T6,++i,
For[j=1,j „T6,++j,
num=grd[[i,j]];
lst={};
x=row[[i]];
y=col[[j]];
If[tst1[x,y,num],AppendTo[lst,1]];
If[tst2[x,y,num],AppendTo[lst,2]];
If[tst3[x,y,num],AppendTo[lst,3]];
If[tst4[x,y,num],AppendTo[lst,4]];
If[tst5[x,y,num],AppendTo[lst,5]];
glst[[i,j]]=lst;
];
];
lines={};
points={};
lbls={};
moves={{0,1},{0,-1},{1,0},{-1,0}};
For[i=1,i „T6,++i,
For[j=1,j „T6,++j,
AppendTo[points,{j,6-i}];
AppendTo[lbls,Text[ToString[grd[[i,j]]],{j,6-i},BaseStyle „_{Large,Bold}]];
lst=glst[[i,j]];
For[mi=1,mi „T4,++mi,
move=moves[[mi]];
di=move[[1]];
dj=move[[2]];
x=i+di;
y=j+dj;
If[1 „Tx„T6 && 1„Ty„T6,
lst2=glst[[x,y]];
If[Length[Intersection[lst,lst2]] ƒú1,
lne=Line[{{j,6-i},{y,6-x}}];
AppendTo[lines,lne];
];
];
];
];
];
Show[Graphics[lines],Graphics[Point[points]],Graphics[lbls]]
|
|
Posted by Daniel
on 2010-09-21 21:58:47 |
|
|
Please log in:
Forums (1)
Newest Problems
Random Problem
FAQ |
About This Site
Site Statistics
New Comments (17)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On
Chatterbox:
|
