All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Logic
If....Then... (Posted on 2010-09-21) Difficulty: 4 of 5

No Solution Yet Submitted by brianjn    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
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,iT6,++i,

For[j=1,jT6,++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,iT6,++i,

For[j=1,jT6,++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,miT4,++mi,

move=moves[[mi]];

di=move[[1]];

dj=move[[2]];

x=i+di;

y=j+dj;

If[1TxT6 && 1TyT6,

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:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (0)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information