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