C Count configurations of the M*N sliding block puzzle that require C a minimum of k moves to be reached. The initial position of the C empty square is read from input. C C Author: C Hugo Pfoertner http://www.pfoertner.org/ C C The program is only suitable to test a small number of moves, C because the backward comparison is a simple loop through C all previous visited configurations. C C Tested against the results in C Filip R.W. Karlemo, Patric R.J. Oestergard: On Sliding Block Puzzles C (Table I. Solution of small puzzles). See link in C http://www.research.att.com/projects/OEIS?Anum=A087725 C 0,6,31,80 C Maximum number of moves required for the m X n generalization of C Sam Loyd's Fifteen Puzzle. C C Used to generate the OEIS sequences A089473, A089474, A089484, C A089484. C C Version history: C Nov 14 2003 Arbitrary starting point C Nov 13 2003 Backtrace from final positions at maximum level C Nov 11 2003 Initial version C C For 2*2, 3*2, 4*2, 5*2, 3*3 the full solution is found, C Other parameters (e.g. 4*3, 6*2, 4*4, 5*4, 5*5, 6*6) will C not finish in a reasonable time. 4*3 and 6*2 might work, C but will require more memory mp_min=(m*n)!/2 C parameter ( m=4, n=2, mn=m*n, mp=10000000 ) C logical vequal external vequal C E: Position of empty block in m-th stored position integer*1 e(mp) C S: Stored positions reached by previous moves integer*1 s(mn,mp) integer*1 c(mn), t(mn) C LA, LE: First and last index of positions visited during C level L integer la(0:80), le(0:80) C Neighbor counts (dimension specific) integer nc(mn), nc2(n,m) equivalence (nc, nc2) C Index list of neighbors integer nb (4,mn), nbc(4,n,m) equivalence ( nb, nbc ) C Conversion 2d <-> 1d numbering integer nu2(n,m), num(mn) equivalence ( nu2, num ) C Parent position integer p(0:mp) C Preset possible move counts do 1 i = 1, mn 1 nc(i) = 4 do 2 i = 1, m, m-1 do 2 j = 2, n-1 nc2(j,i) = 3 2 continue do 3 i = 2, m-1 do 3 j = 1, n, n-1 nc2(j,i) = 3 3 continue nc2(1,1) = 2 nc2(n,1) = 2 nc2(1,m) = 2 nc2(n,m) = 2 C Conversion 2d <-> 1d numbering l = 0 do 4 i = 1, m do 4 j = 1, n l = l + 1 nu2(j,i) = l do 4 k = 1, 4 nbc (k,j,i) = 0 4 continue C 1d neighbors do 5 i = 1, m do 5 j = 1, n l = 0 if ( i-1 .ge. 1 ) then l = l + 1 nbc(l,j,i) = nu2(j,i-1) endif if ( i+1 .le. m ) then l = l + 1 nbc(l,j,i) = nu2(j,i+1) endif if ( j-1 .ge. 1 ) then l = l + 1 nbc(l,j,i) = nu2(j-1,i) endif if ( j+1 .le. n ) then l = l + 1 nbc(l,j,i) = nu2(j+1,i) endif 5 continue C Print setting of possible move counts and neighbor positions do 6 i=1,mn write (*,1001) i, nc(i), (nb(k,i),k=1,nc(i)) 1001 format ( i3, i4, 2x, 4I3 ) 6 continue C Number of possible positions ((m*n)!)/2 kfin = 1 if ( mn .le. 12 ) then do 7 i = 3, mn 7 kfin = kfin * i else C Proceed until storage is exhausted kfin = mp endif C write (*,*) ' Initial position (i,j) of blank:' read (*,*) iini, jini write (*,*) ' Init blank square: ', iini, jini nini = nu2(jini,iini) do 10 i = 1, nini-1 10 s(i,1) = i s(nini,1) = mn do 11 i = nini+1, mn 11 s(i,1) = i - 1 C Initial state C do 10 i = 1, mn C10 s(i,1) = i C Position of empty square C e(1) = mn e(1) = nini C Dummy previous position p(0) = 0 p(1) = 0 C Number of positions of level 1 la(1) = 1 le(1) = 1 C Start of loop over levels level = 1 C k: global count of visited configs k = 1 100 continue level = level + 1 C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. C write (*,*) ' level, la, le:', level, la(level-1), le(level-1) C Loop over all positions reached during previous level do 200 l = la(level-1), le(level-1) C Copy of previous config do 210 i = 1, mn 210 c(i) = s(i,l) C Number of potential successors nsucc = nc(e(l)) C write (*,*) ' nsucc, e(l):', nsucc, e(l) C Perform trial move and check if resulting config has occurred before, C including already visited configs of current level do 300 j = 1, nsucc do 310 i = 1, mn 310 t(i) = c(i) C Perform exchange i = e(l) ie = nb(j,i) C New position of empty square t(ie) = mn t(i) = c(ie) C Check against all existing configs do 400 kk = k, 1, -1 if ( ie .eq. e(kk) ) then if ( vequal ( mn, t, s(1,kk) ) ) goto 450 endif 400 continue C new config was different from all previously found, add to list k = k + 1 e(k) = ie do 410 i = 1, mn 410 s(i,k) = t(i) C Index of parent position p(k) = l 450 continue 300 continue 200 continue C Update limits for next level la(level) = le(level-1) le(level) = k C Output consistent with Karlemo/Oestergard paper write (*,*) level-1, k, le(level)-la(level) if ( k .eq. kfin ) then do 220 i = la(level)+1, le(level) write (*,1000) i, (s(j,i),j=1,mn) 1000 format ( i10, 25 I3 ) C search backwards ip = i 230 continue ip = p(ip) write (*,1000) ip, (s(j,ip),j=1,mn) if ( ip .gt. 1 ) goto 230 220 continue goto 999 endif C skip back to processing of next level C if ( level .gt. 20 ) stop goto 100 999 continue end C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. logical function vequal (n,a,b) integer*1 a(n), b(n) vequal = .false. do 10 i = 1, n if ( a(i) .eq. b(i) ) goto 10 return 10 continue vequal = .true. end