QUEENS
QUEENS
  PL_FILE QUEENS
    HTM_FILE QUEENS
      *standard texte html
        MON_TEXTE
          TEXT
            GOSUB DOC//start
          TITLE
            N-QUEEN'S PROBLEM
          STYLE
            STYLES_2
          HEADER
            page de garde
              BR
                BR
                  QUEENS : N = 11
                BR
                  CENTER
                    BR
                      BOLD
                        2 avril 2022
                        *exec
                          r = 'C:\\ANACONDA\\Library'
                            if r not in sys.path and os.path.exists (r) :
                              sys.path.append (r)
                          r = 'C:\\ANACONDA\\sip'
                            if r not in sys.path and os.path.exists (r) :
                              sys.path.append (r)
                          print ('----------------------------------------- importing librairies and date')
                        SMALL
                          MAJ_DATE_EN
                    BR 1
                    BR 2
    DOC
      start
        DESCRIPTION OF THE PROBLEM
          Problem of N independant queens
            question
              solve (N)
                --> should print correctly all solutions
            difficulties
            il faut trouver sur un échiquier carré de taille N coment positionner N dames sans prise mutuelle
        DIFFICULTIES
          2COLUMNS
            model the solving process
            print a solution
              example
        MODEL OF THE PROBLEM
          if Ln = [1, 2, ..., N]
            a queen in row i is in row Ln [i]
              find a permutation of Ln such that queens can not catch each other.
          constraints
              not same line
                from the model in Ln
              not same column
                from the model in Ln
                  all different numbers
              not same diagonal
                should check 2 directions
          solve by trying first 2, 3, ... N queens
            while respecting constraints
        USER'S MANUAL
          queries
            q1 ( N )
              find first solution for N
            qf (N)
              Find all solutions for N
            ql(N)
              finds a solution for N if N is prime
          examples of solutions
          BOLD
            2COLUMNS
              N = 29
                algorithm in linear time for K not multiple of 2 nor 3
        structure
          solve_queens
            tree
            list_range
            solve_queens_2
              member_reste
              diagonal_ok
            display_board
              display_line
                display_queen_1
        Code in prolog
          BR
            PRE
              CODE
                *insert
    :- use_module(library(pce)).
    utilitaires
      *standard prolog sans macros
      SEP FOR USER INTERACTION
        DOC
          a few predicates and macros to have more readable code
            for demo for Laurent chaudron
          GOSUB say ::=
        notation
          say ::=
            *vars
              {say_}
                say_ = a0 [4:]
            write_info ([{say_}])
            {L}
          [say ::=
            *vars
              {say_}
                say_ = a0 [4:]
            {a0}
            [{a0}
            write_info ([{say_}])
            {L}
        write_info (L) :-
          write (L)
            nl
          write_info_1 (L)
            !
              nl
        DEF write_info_1, +Info
          args
            []
              !
                goals
            X .. L
              !
                goals
                write_info_1 (X)
                  write(" ")
                    write_info_1 (L)
            found (X)
              write (found)
                goals
                !
                  write(" ")
                    write_info_1 (X)
            board (B)
              !
                goals
                length (B, N)
                  nl
                    display_board (B, N)
            board (B, N)
              !
                goals
                display_board (B, N)
            (X .. L)
              !
                goals
                write_info_1 (X .. L)
            Any
              write (Any)
                goals
    probleme des N QUEENS
      affichage
        display_queen_1 :-
          write ("♛")
        display_line (K, N, M) :-
          IF M > N
            !
              write ('|')
                nl
                  fail
            IF K = M
              display_queen_1
              write (" ")
          echo display_line (K, N, M)
          M1 is M +1
            !
              display_line (K, N, M1)
        display_board (Sol, N) :-
          ALL
            iteritems (Sol, Elt, K)
              write ('|')
                display_line (Elt, N, 1)
        affichage
          DOC
            display _queens
            INPUT
              L = liste of positions in rows
              N = number of queens
          DEF display_queens, (L, N)
            args
              L, _, 0
                Sous-sujet 2
                  notes
              [X | L ], Compteur
                C2 is Compteur + 1
                  goals
                display_queens (L, N, C2)
                  goals
      solution du problème
        fabrication d'une liste [8, 7, 6, 5 .... 1]
          DEF liste_range ,(N, L)
            args
              0,[]
                !
                  goals
                nothing
                  notes
              K, [K | L]
                K > 0
                  goals
                K1 is K-1
                  goals
                  liste_range (K1, L)
        solver
          solver 1 : simple backtrack et colonnes dans l'ordre 1 2 .. N
            DOC
              solve for
                just print 1 st case
                print all solutions
                count all solutions
            solve_queens (N) :-
              1° solution
                solve_queens (N, _, true)
            solve_queens (N, S) :-
              solve_queens (N, S, true)
            solve_queens (N, S, true) :-
              solving queens for ...
                write (N)
                  nl
                    echo solve_queen (N, S)
                liste_range (N, L1)
                  reverse (L1, L)
                    solve_queens_2 (L, N, [], S)
                      say for . N . found (board (S))
                        !
            solve_queens (N, S, first) :-
              solving queens for ...
                liste_range (N, L1)
                  reverse (L1, L)
                    solve_queens_2 (L, N, [], S)
                      !
            solve_queens (N, S, all, D) :-
              print all queens solutions for ...
                write (N)
                  nl
                    echo solve_queen (N, S)
                  init_counter (counter)
                liste_range (N, L1)
                  reverse (L1, L)
                    !
                      ALL
                        solve_queens_2 (L, N, [], S)
                          incr_counter (counter)
                          display_board (S, N)
                            nl
                prints result
                  val_counter (counter, D)
                    !
                      say found ([D, solutions])
            solve_queens (N, S, count, D) :-
              counts the number of cases for
                write (N)
                  nl
                    echo solve_queen (N, S)
                  init_counter (counter)
                liste_range (N, L1)
                  reverse (L1, L)
                    !
                      ALL
                        solve_queens_2 (L, N, [], S)
                          incr_counter (counter)
                            write('.')
                prints result
                  val_counter(counter, D)
                    !
                      say found (D . solutions . for . N . queens)
            solves by backtracking
              DOC
                L ::= x1 . x2 . .... : Xi : numbers of columns
                called initially with (L = [1, 2, ... N]
              DEF_IO solve_queens_2, (+L, +N, +K, -Solution)
                in
                  [], N, S
                    !
                      goals
                      terminal
                    last line
                      notes
                    S
                      out
                  L, N, S
                    trace
                      goals
                      recursif solve_queens_2
                        echo solve_queens_2 (L, N, S, S2)
                    prendre un élément
                      goals
                      member_reste (L, X, Reste),
                    vérifier les diagonales
                      goals
                      K1 is X + 1
                        K2 is X -1
                          diagonal_ok (S, K1, K2)
                    continue la récursion
                      goals
                      solve_queens_2 (Reste, N, [X | S] , S2)
                    any line
                      notes
                    S2
                      out
          vérifier les diagonales
            DEF diagonal_ok, (Liste, X1, X2)
              args
                [], _, _
                  !
                    goals
                X .. L , K, K1
                  IF
                    goals
                    OR
                      X = K
                      X = K1
                    !
                      fail
                    K2 is K + 1
                      K3 is K1 -1
                        echo diagonal_ok (X .. L, K, K1)
                          diagonal_ok (L, K2, K3)
          linear solver for N
            solve in linear time for N not multiple of od nor 3
              solve_queens_l (N):-
                solve_queens_l (N, _, true)
                  !
                    solve_queens_l (N, S):-
                      solve_queens_l (N, S, true)
                        !
                    solve_queens_l (N, S, true) :-
                      solve_queens_l (N, S, P, 1)
                      write (S)
                        nl
                      check_sol (S)
                      display_board (S, N)
                        nl
              solve_queens_l (N, S , P, K) :-
                IF K > N
                  S = []
                  !
                  X is 1 + (3 * K) mod N
                    K1 is K + 1
                      S = X .. S1
                        solve_queens_l (N, S1, P, K1)
              check of solutions
                check_sol (S) :-
                  check_sol (S, S1, S2, 0)
                    sort (S, So)
                      echo So
                        nl
                          check_sol ([], [], [], K):-
                          check_sol (A .. L, X .. L1 , Y .. L2, K) :-
                            X is A -K
                              Y is A + K
                                K1 is K +1
                                  check_sol (L, L1 , L2, K1)
                      echo S
                    sort (S1, So1)
                      echo So1
                        echo S1
                          length (S1, N1)
                            length (So1, No1)
                              IF N1 = No1
                                !
                                write ('ascending diagonal error')
                                  nl
                    sort (S2, So2)
                      echo So2
                        echo S2
                          length (S2, N2)
                            length (So2, No2)
                              IF N2 = No2
                                !
                                write ('descending diagonal error')
                                  nl
          solver 2 : simple backtrack et colonnes dans l'ordre N/2, N/2 +-1 ..... N 1 (ou un autre ordre)
        prelever un élement et garder le reste
          member_reste (X .. L , X, L) :-
            true
          member_reste (X .. L , Y, X .. U ) :-
            !
              member_reste (L, Y, U)
      tests
        SEP
        q11 :-
          display_board ([1, 2, 3], 3)
          display_board( [2, 4, 1, 3], 4).
        SEP tests for only first solution
          t4 :-
            ALL
              solve_queens (4, S, true)
                echo solution (4, S)
          q2 :-
            ALL
              member (K, [3, 4, 8])
                echo K
                  solve_queens (K, S)
          q13 :-
            L = [100, 200, 300]
              ALL
                member_reste (L, X, U)
                  echo q3 (L, X, U)
          qs3 :-
            ALL
              solve_queens (3, S)
          qs4 :-
            ALL
              solve_queens (4, S)
          qs5 :-
            ALL
              solve_queens (5, S)
          qs6 :-
            ALL
              solve_queens (6, S)
        SEP 8 queens
          qs8 :-
            ALL
              solve_queens (8, S, all, D)
          qc8 :-
            ALL
              solve_queens (8, S, count, N)
                echo N
          fs8 :-
            solve_queens (8, S)
          compte le nombre de solutions
            qf8 :-
              K = 8
                qf(8)
        SEP 20 queens
          qf20 :-
            K = 20
              qf(20)
        SEP Counting solutions
          compte le nombre de solutions
            qf (N) :-
              ALL
                solve_queens (N, S, count, N_sol)
                  say found (N_sol . solutions . for . N . queens)
            q1 (N) :-
              FIRST
                solve_queens (N, S, true)
              prints result
                say for . N . found (board (S))
                  !
            q2 (N) :-
              init_counter (counter)
              ALL
                P = true
                solve_queens (N, S, true)
                  incr_counter_v (counter, C)
                    echo C
            solution avec algorithme linéaire
              ql (N) :-
                solve_queens_l (N)
    tests unitaires prolog
      SEP
      q1 :-
        liste_range (4, L)
          write (L)
        liste_range (8, L8)
          write (L8)
      q21 :-
        ALL
          L = [1, 2, 3]
            echo L
          iteritems (L, X, N)
            echo iter (X, N)
    interface xpce
      queens :-
        fabrication d'un formulaire de saisie
          Drawing as an array
            *setf DRAWING
              OBJECT
                object name
                  one line stuff
                    create
                  what to do to display the object
                    display
                  description
                    note
                  once all objects are created, add functionalities
                    prepare
                  Sous-sujet 5
                    tipe
                  Sous-sujet 6
                    name
                  juste après create
                    after
                Dialog
                  dialog ('Define employee')
                    create
                  Dialog /> open
                    display
                  main window
                    note
                  Dialog /> default_button, Calc
                    prepare
                  window
                    tipe
                  send_list (
                    prepare
                    Dialog
                    append
                    [
                      Number
                        Results
                      Calc, All, Count, Quit
                Number
                  get number
                    note
                  int_item (number, low := 4, high := 30)
                    create
                  get
                    tipe
                Results
                  number of results
                    note
                  text_item('Result')
                    create
                  results
                    name
                  show
                    tipe
                Calc
                  launches the calculation
                    note
                  button
                    tipe
                  message(@prolog,calc_gui, Number?selection, Dialog)
                    create
                  first
                    name
                All
                  launches the calculation
                    note
                  button
                    tipe
                  message(@prolog,calc_gui_2, Number?selection, Dialog)
                    create
                  show_all
                    name
                Count
                  count
                    name
                  launches the calculation
                    note
                  button
                    tipe
                  message(@prolog,calc_gui_count, Number?selection, Dialog)
                    create
                Quit
                  cancels and close the window
                    note
                  button
                    tipe
                  message (Dialog, destroy)
                    create
                  quit
                    name
            EXTRACT TABLE OBJECT, create, after, note, tipe, name
              by_item
              TABLE
                {DRAWING}
              FORMAT
                  *exec
                    var_high = False
                      if "{OBJECT}" [0] in "AZERTYUIOPQSDFGHJKLMWXCVBN_"
                        var_high = True
                  =====> description of {OBJECT} :
                    {note}
                  ..............................creation of {OBJECT}
                    *if '{tipe}' = 'button'
                      new(
                        {OBJECT}
                        button (
                          {name}
                          {create}
                      *else
                        *if var_high
                          display {OBJECT}
                            new (
                              {OBJECT}
                              {create}
                          *else
                            chk(@{OBJECT})
                            display {OBJECT}
                              new (
                                @{OBJECT}
                                {create}
                  *if after and after != []
                    *exec
                      safe_print (after)
                    stuff to do after creation (parameters)
                      {after}
          STEP 2 : prepare
            EXTRACT TABLE OBJECT, prepare
              by_item
              TABLE
                {DRAWING}
              FORMAT
                *if prepare and prepare != []
                  *exec
                    safe_print (prepare)
                  prepare {OBJECT}
                    {prepare}
          finally
            display
              show_var (Dialog, 'Number', 4)
              send (Number, 4)
              Dialog /> open
              writeln("... >>> creation ok 3")
          creation ok
      pce_pl (X, Y) :-
        ouverture du stream pce --> prolog
          pce_open(X, read, In)
            read(In, Y)
              close(In)
      calc_gui (N, DIalog) :-
        préparation du terme
          string_concat(N,'.',E2)
            pce_open(E2, read, In)
              read(In, Term),
              close(In),
        Calculer
          le calcul
            N1 is eval (Term)
              solve_queens (N1, S, true)
                write ([E2, '-->', Res])
                  nl
        écrire le résultat
          get(Dialog,member('Result'),A_1),
            send(A_1,selection(ok)).
      calc_gui_2 (N, Dialog) :-
        préparation du terme
          string_concat(N,'.',E2)
            pce_open(E2, read, In)
              read(In, Term),
              close(In),
        Calculer
          le calcul
            N1 is eval (Term)
              solve_queens (N1,_, all, C)
        écrire le résultat
          get(Dialog,member('Result'),A_1),
            send(A_1,selection(C)).
      calc_gui_count (N, Dialog) :-
        préparation du terme
          string_concat(N,'.',E2)
            pce_open(E2, read, In)
              read(In, Term)
              close(In)
        Calculer
          le calcul
            N1 is eval (Term)
              solve_queens (N1,_, count, C)
        écrire le résultat
          show_var (Dialog, 'Result', C)
      show_var (Dialog, Field, Value) :-
        get(Dialog,member(Field),A_1),
          send(A_1,selection(Value)).
  ici
    QUEENS.bat
    QUEENS.htm