PROBLEME DES CUBES
PROBLEME DES CUBES
  PL_FILE CUBES
    DOC
      On a table there are N cubes, which can be stacked as columns
      The table has a square shape and can accomodate at most S x S = S² columns max of cubes.
      A configuration C is a given arrangement of the cubes on the table
      A hand/robot can move one cube from one place (on the table/on top of a column) to another.
      Problem :
          produce an efficient programm to find a sequence of moves needed to change from configuration C1 to configuration C2
          practically :
            solve for N > 3 and P = infinity
            minimum performance : solve for N > 50 and 9 <= S² <= N/2
      code
      Implementation notes
        a configuration is defined as an ordeed list of colums
          C = [[1, [a, d, g]], [2, [b, e, h]], [3, [c, f]]
    *exec
      print (0)
    *standard prolog sans macros
      *exec
        print (0.5)
        test du nil
          foo (X . nil)
    *exec
      print (1)
    SEP fonctions de base
      fabrication de positions
        DOC
          structure
            random_position
              range
              board
              random_merge
        random_position ( N, K, L) :-
          range (1, N, Range)
          random_permutation (Range, Range2)
          board (K, Board)
          random_merge (Board, Range2, L)
        DEF_IO range , (I, N, L)
          DOC
            génere la liste [I, ... N ]
          in
            I, N
              []
                out
              I > N
                goals
                !
            I , N
              I .. L
                out
              I1 is I +1
                goals
                range (I1, N, L)
        board (K, B) :-
          2 D
            findall (
              (I, J)
              (
                range (1, K, L)
                member (I, L)
                member (J, L)
              B
          one dimension
            range (1, K, B)
        random_merge (Board, Range, L) :-
          echo Board
            echo Range
          positionnement des cubes sur le board
            findall (
              (Pos, N)
              (
                member (N, Range)
                  random_select (Pos, Board, _)
              Pairs
          echo Pairs
            ALL
              member (Pair, Pairs)
                echo (Pair)
            ALL
              member (Pos, Board)
                member ((Pos, K1), Pairs)
                  echo (Pos, K1)
          rassemblement par colonnes
            findall (
              (Npos, Stack)
              (
                member (Npos, Board)
                  echo Npos
                  findall (
                    K
                    (
                      echo Npos
                        member ((Npos, K), Pairs)
                          echo foo(Npos,K)
                    Stack
                  echo Stack
              L
          echo L
      move cubes between columns
        MOVE
          move_cube (J, K, C1, C2) :-
            DOC
              moves top of column J to top of column K
                changes C1 to C2
              H is the name of the cube which is moved
            c_remove (J, C1, H, Cx)
            c_remove (K, C2, H, Cx)
          c_remove (J, (J, H .. U) .. L , H, (J, U) .. L) .
          c_remove (J, X .. L, H, X .. L2) :-
            c_remove (J, L, H, L2)
          move_seq (C, C, [])
          move_seq (C, C2, Move .. L) :-
            Move = (J, K)
              move_cube (J, K, C, C1)
                move_seq (C1, C2, L)
      impression de positions
        board display
          show_board (Message, C) :-
            show_message (Message)
              show_board (C)
          show_board (C) :-
            writeln ('-------------')
              show_board_aux (C)
                nl
                show_board_aux ( X .. L) :-
                  show_line (X)
                    show_board_aux (L)
                show_board_aux ([])
                show_line ( (Pos, L)) :-
                  write (Pos)
                    write ('=')
                      ALL
                        reverse (L, L1)
                          member (X, L1)
                            write (X)
                              write ('.')
                      nl
        show_message (Message) :-
          writeln (Message)
        show_path (C, []) :-
          show_board (C)
        show_path (C, Move .. L) :-
          show_board (C)
            Move = (J, K)
              move_cube (J,K, C, C2)
                show_path (C2, L)
        show_path (C1, C2, Path) :-
          show_path (C1, Path)
            show_board (C2)
      misc for tests
        example (N, K) :-
          random_position (N, K, C1)
            random_position (N, K, C2)
          show_board ('before :', C1)
            nl
          show_board (' after :', C2)
        tests
          random_position(10, 5, L).
          random_position(10, 5, L), show_board(L).
          random_position(10, 5, L), show_board(L), move_cube(1, 2, L, L2), nl, show_board(L2),fail.
          example(5, 3).
    SEP board algebra
      boards algebra
        DOC
          add_board (C1, C2, C3)
          les cubes de C3 sont les cubes de C1 avec ceux de C2 en dessous
        sum of boards
          if same_number of columns
            add_board ([], [], [])
            add_board (X .. Lx, Y .. Ly, Z .. Lz) :-
              add_columns (X, Y, Z)
                add_columns ((N, Cx), (N, Cy), (N, Cz)) :-
                  append (Cx, Cy, Cz)
                add_board (Lx, Ly, Lz)
          if not same number
            add_board_2 ([], C, C) :-
              !
            add_board_2 (C, [], C) :-
              !
            add_board_2 ((N, Cx) .. Lx, (M, Cy) .. Ly, (K, Cz) .. Lz) :-
              IF N = M
                append (Cx, Cy, Cz)
                  add_board (Lx, Ly, Lz)
                IF N < M
                  K = N
                    Cz = Cx
                      add_board_2 (Lx, (M, Cy) .. Ly, Lz)
                  K = M
                    Cz = Cy
                      add_board_2 ((N, Cx) .. Lx, Ly, Lz) :-
        difference of boards
          DOC
            diff_board (B1, B2, C, B3, B4)
            where
              C is the common part of B1 and B2
              B4 is the B1 = C + B3
              B4 is C + B2
            structure
              diff_board
                diff_column
                  diff_stack
          P_DEBUG diff_board (B1, B2, C, B3, B4)
          diff_board ([], [], [], [], []):-
            !
          diff_board (X .. Lx, Y .. Ly, M .. Lz, Rx .. Lx2, Ry .. Ly2) :-
            !
              diff_column (X, Y, M, Rx, Ry)
                diff_board (Lx, Ly, Lz, Lx2, Ly2)
          P_DEBUG diff_column (A, B, C, D, E)
          diff_column ((N, Lx), (N, Ly), (N, C), (N, Rx), (N, Ry) ) :-
            reverse (Lx, Lx1)
              reverse (Ly, Ly1)
                diff_stack (Lx1, Ly1, C1, Rx1, Ry1)
                reverse (C, C1)
                  reverse (Rx, Rx1)
                    reverse (Ry, Ry1)
          P_DEBUG diff_stack (A, B, C, D, E)
          diff_stack (X, [], [], X, []):-
            !
          diff_stack ([], X, [], [], X):-
            !
          diff_stack (X .. Lx, X .. Ly, X .. C, Rx, Ry) :-
            !
              diff_stack (Lx, Ly, C, Rx, Ry)
          diff_stack (X .. Lx, Y .. Ly, [], X .. Lx, Y .. Ly) :-
            !
        empty board
          is_empty_board ([])
          is_empty_board ((N, []) .. L) :-
            is_empty_board (L)
          is_empty-col ([])
          is_empty_col ((_, []))
        misc for tests
          test_algebra (N, K) :-
            random_position (N, K, C1)
              random_position (N, K, C2)
            show_board ('Board 1 :', C1)
              show_board ('Board 2 :', C2)
                add_board (C1, C2, C)
                show_board ('Sum :', C)
            diff_board (C1, C2, Cd, B3, B4)
              show_board ('Common', Cd)
                show_board ('B3', B3)
                show_board ('B4', B4)
          test_show_path (N, K) :-
            random_position (N, K, C1)
              C1 = C2
            show_path (C1, C2, [])
          tests
            test_algebra(5, 3).
    SEP solvers
      solvers
        DOC
          main solver
          PARAMETERS
            steps = Path = list of (J, K) moves
              top of column J to top of column K
            C1, C2, etc :
              configurations
          many possible strategies
          structure
            solve (+C1, +C2, -Steps)
              solve_s (+C1, + C2, -Steps)
        main functions
          solve (+C1, +C2, -Steps)
            solve (C, C, []) :-
              !
            solve (C1, C2, Steps) :-
              simplify
                diff_board (C1, C2, C, Co, Cg)
                  solve_s (Co, Cg, Steps)
          solve_s (+C1, + C2, -Steps)
            DOC
            solve_s (Co, Cg, []) :-
              is_empty_board (Co)
                !
            solve_s (Co, Cg, Steps) :-
              choose_columns (Co, Cg, J, K)
                moves (Co, Cg, J, K, Moves, Con, Cgn)
              solve (Con, Cgn, Steps_n)
              append (Moves, Steps_n, Steps)
        auxiliaries
          size of each column
            d_vector ([], []).
            d_vector ((N, C) .. L, (N, M, Last) .. L2) :-
              length (C, M)
                last (C, Last)
                  d_vector ( L, L2)
          invers position Cube -> Colnum
            P_DEBUG inverse_columns (A, B)
            inverse_columns ([], []) :-
            inverse_columns ((N, Stack) .. L, L1 ) :-
              inverse_c_stack (N, Stack, L2)
                inverse_columns ( L, L3)
                  append (L2, L3, L1)
            P_DEBUG inverse_c_stack (A, B, C)
            inverse_c_stack (N, [], [])
            inverse_c_stack (N, X .. L, (X, N) .. L2) :-
              inverse_c_stack (N, L, L2)
          find columns and heights of cubes
            find_column (N_Cube, (K, Stack) .. L, Cnum, Hnum) :-
              !
          move the cubes above a certain height afor columnK to other places
            DEF_IO dispatch , (+C, +N, +K, +L, -Moves, -C_final)
              DOC
                dispatch (+C, +N, +K, +L, -Moves, -C_final)
                removes K cubes
                  from column N
                add these cubes to othe other columns
              in
                C, N, K, L
                  Moves, C_final
                    out
                  !
                    goals
                    dispatch_build (C)
            etc
            dispatch_cubes (L, Places, Conf) :-
              DOC
                dispatch the K cubes of column N to other columns not indicated in L, answer is Moves
              dispatch_cubes_1 (L, Places, Result1)
                echo Result1
              findall (
                (P, L_cubes)
                (
                  (member (P, Places)
                    findall (
                      Cube
                      member ( (P, Cube), Result1 )
                      L_cubes
                Conf
              findall ((P, L_cubes),((member (P, Places),findall (Cube,member ( (P, Cube), Result1 ),L_cubes))),Conf)
                DEF_IO dispatch_cubes_1 ,(L, Places, Result)
                  DOC
                    dispatches regularly the cubes of L into places
                  in
                    [], Places
                      []
                        out
                      !
                        goals
                    L, Places
                      Lf
                        out
                      dispatch_1 (L, Places, L2, Reste)
                        goals
                        DEF_IO dispatch_1 ,(L, Places, Result, reste)
                          in
                            [], Places
                              [], []
                                out
                              !
                                goals
                            L, []
                              [], L
                                out
                              !
                                goals
                            X .. L, Y .. Places
                              (Y, X) .. L2, Reste
                                out
                              dispatch_1 (L, Places, L2, Reste)
                                goals
                      IF Reste = []
                        goals
                        !
                          L2 = Lf
                        dispatch_cubes_1 (Reste, Places, L3)
                          append (L2, L3, Lf)
                  test
                    dispatch_cubes_1( [a, b, c, d, e, f, g, h], [1, 2,3] , R) .
                      R = [(1, a), (2, b), (3, c), (1, d), (2, e), (3, f), (1, g), (2, h)].
                    dispatch_cubes( [a, b, c, d, e, f, g, h], [1, 2,3] , C) .
                      C = [[1, [a, d, g]], [2, [b, e, h]], [3, [c, f]]].
            liste des placeslibres, sauf K et N
              free_places ([], K, N, []) :-
                !
              free_places (X .. L, K, N, L2) :-
                IF
                  OR
                    X = K
                    X = N
                  free_places (L, K, N, L2)
                  L2 = X .. L3
                    free_places (L, K, N, L3)
              test
                free_places( [1, 2, 3, 4, 5], 2, 4, L).
                  L = [1, 3, 5].
        tests
          show_solver_1 (N, K) :-
            N = number of cubes; K number of places
            random_position (N, K, C1)
              C1 = C2
                show_board (C1)
              random_position (N, K, C1)
            d_vector (C1, D)
              writeln (D)
                inverse_columns (C1, Inv1)
                  writeln (Inv1)
            Path = []
              solve (C1, C2, Path)
            show_path (C1, C2, Path)
          show_solver (N, K) :-
            N = number of cubes; K number of places
            random_position (N, K, C1)
              d_vector (C1, D1)
                writeln (D1)
                  inverse_columns (C1, Inv1)
                    writeln (Inv1)
            random_position (N, K, C2)
              d_vector (C2, D2)
                writeln (D2)
                  inverse_columns (C2, Inv2)
                    writeln (Inv2)
            solve (C1, C2, Path)
              Path = []
            show_path (C1, C2, Path)
          tests
            show_solver_1 (5, 3).
            show_solver (5, 3).
    SEP CUBE SOLVER
    SEP some utilities
      les N premiers d'une liste L, reste Reste
        n_first (N, L, L1, Reste) :-
          n_first_1 (1, L, N, L1, Reste)
            n_first_1 (Max, X .. L, Max, [X], L) :-
              !
            n_first_1 (K, X .. L, Max, X .. L1 , Reste) :-
              !
                K1 is K +1
                  n_first_1 (K1, L, Max, L1 , Reste)
          test
            n_first( 2, [1, 2, 3, 4], L, Reste).
    THE END ...