/* ARM assembly Raspberry PI  */
/*  program puzzle15solver.s   */
/* my first other program find à solution in 134 moves !!! */
/* this second program is a adaptation algorithme C++ and go rosetta code */
/* thanck for the creators */
/* 1 byte by box on game board */

/* create a file with nano  */
/*  15,  2,   3,   4
    5,   6,   7,   1
    9,   10,  8,   11
   13,  14,  12, 0     */

/*   Run this programm : puzzle15solver <file name> */
/*   wait several minutes for résult */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ STDIN,  0     @ Linux input console
.equ STDOUT, 1     @ Linux output console
.equ EXIT,   1     @ Linux syscall
.equ READ,   3     @ Linux syscall
.equ WRITE,  4     @ Linux syscall
.equ OPEN,   5     @ Linux syscall
.equ CLOSE,  6     @ Linux syscall

.equ TRUE, 1
.equ FALSE, 0

.equ O_RDWR,    0x0002        @ open for reading and writing

.equ SIZE,           4
.equ NBBOX,          SIZE * SIZE
.equ TAILLEBUFFER,   100
.equ NBMAXIELEMENTS, 100

.equ CONST_I,    1
.equ CONST_G,    8
.equ CONST_E,    2
.equ CONST_L,    4

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessTitre:            .asciz "Nom du fichier : "
sMessResult:           .ascii " "
sMessValeur:           .fill 11, 1, ' '             @ size => 11
szCarriageReturn:      .asciz "\n"
szMessCounterSolution: .asciz "Solution in @ moves : \n"

//szMessMoveError:       .asciz "Huh... Impossible move !!!!\n"
szMessErreur:          .asciz "Error detected.\n"
szMessImpossible:      .asciz "!!! Impossible solution !!!\n"
szMessErrBuffer:       .asciz "buffer size too less !!"
szMessSpaces:          .asciz "    "

iTabNr:  .int 3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3
iTabNc:  .int 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:      .skip 24
iAdrHeap:       .skip 4
ibox:           .skip SIZE * SIZE           @ game boxes
iAdrFicName:    .skip 4
iTabN0:         .skip 4 * NBMAXIELEMENTS    @ empty box
iTabN3:         .skip 4 * NBMAXIELEMENTS    @ moves
iTabN4:         .skip 4 * NBMAXIELEMENTS    @ ????
iTabN2:         .skip 4 * NBMAXIELEMENTS    @ table game address
sBuffer:        .skip TAILLEBUFFER
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                            @ INFO: main
    mov r0,sp                    @ stack address for load parameter
    bl traitFic                  @ read file and store value in array
    cmp r0,#-1
    beq 100f                     @ error ?

    ldr r0,iAdribox
    bl displayGame               @ display array game

    ldr r0,iAdribox              @ control if solution exists
    bl controlSolution
    cmp r0,#TRUE
    beq 1f
    ldr r0,iAdrszMessImpossible  @ no solution !!!
    bl affichageMess
    b 100f

1:
    ldr r0,iAdribox
    ldr r9,iAdriTabN2
    str r0,[r9]                  @ N2 address global

    mov r10,#0                   @ variable _n global
    mov r12,#0                   @ variable n global
    bl searchSolution
    cmp r0,#TRUE
    bne 100f                     @ no solution ?
    ldr r3,iAdriTabN2
    ldr r0,[r3,r12,lsl #2]       @ visual solution control
    bl displayGame
    mov r0,r12                   @ move counter
    ldr r1,iAdrsZoneConv
    bl conversion10              @ conversion counter
    mov r2,#0
    strb r2,[r1,r0]              @ and display
    ldr r0,iAdrszMessCounterSolution
    bl strInsertAtCharInc
    ldr r1,iAdrsZoneConv
    bl affichageMess
    ldr r5,iAdriTabN3
    ldr r3,iAdrsBuffer
    mov r2,#1
    mov r4,#0
2:                                @ loop solution display
    ldrb r1,[r5,r2,lsl #2]
    cmp r2,#TAILLEBUFFER
    bge 99f
    strb r1,[r3,r4]
    add r4,r4,#1
    add r2,r2,#1
    cmp r2,r12
    ble 2b
    mov r1,#0
    str r1,[r3,r4]                 @ zéro final
    mov r0,r3
    bl affichageMess
    ldr r0,iAdrszCarriageReturn
    bl affichageMess

    b 100f

99:
    ldr r0,iAdrszMessErrBuffer
    bl affichageMess
100:                                 @ standard end of the program
    mov r0, #0                       @ return code
    mov r7, #EXIT                    @ request to exit program
    svc #0                           @ perform the system call

iAdribox:                  .int ibox
iAdriTabN0:                .int iTabN0
iAdriTabN2:                .int iTabN2
iAdriTabN3:                .int iTabN3
iAdriTabN4:                .int iTabN4
iAdrszMessCounterSolution: .int szMessCounterSolution
iAdrszMessImpossible:      .int szMessImpossible
iAdrszMessErrBuffer:       .int szMessErrBuffer
iAdrsZoneConv:             .int sZoneConv
/******************************************************************/
/*      search    Solution                                        */
/******************************************************************/
searchSolution:                      @ INFO: searchSolution
    push {r1-r8,lr}                  @ save  registers
                                     @ address allocation place on the heap
    mov r0,#0                        @ allocation place heap
    mov r7,#0x2D                     @ call system 'brk'
    svc #0
    cmp r0,#-1                       @ allocation error
    beq 99f
    ldr r1,iAdriAdrHeap
    str r0,[r1]                      @ store heap address
    bl functionFN
    ldr r3,iAdriTabN2
    ldr r0,[r3,r12,lsl #2]           @ last current game
    bl gameOK                        @ it is Ok ?
    cmp r0,#TRUE
    beq 100f                         @ yes --> end

    ldr r1,iAdriAdrHeap              @ free up resources
    ldr r0,[r1]                      @ restaur start address heap
    mov r7,#0x2D                     @ call system 'brk'
    svc #0
    cmp r0,#-1                       @ allocation error
    beq 99f
    add r10,r10,#1                   @ _n
    mov r12,#0                       @ n
    bl searchSolution                @ next recursif call
    b 100f
99:
    ldr r0,iAdrszMessErreur
    bl affichageMess
100:
    pop {r1-r8,lr}                   @ restaur registers
    bx lr                            @return
iAdrszMessErreur:           .int szMessErreur
iAdriAdrHeap:               .int iAdrHeap
/******************************************************************/
/*     Fonction FN                                                */
/******************************************************************/
functionFN:                          @ INFO: functionFN
    push {lr}                        @ save  register
    ldr r4,iAdriTabN3
    ldr r3,[r4,r12,lsl #2]
    ldr r5,iAdriTabN0                @ load position empty box
    ldr r6,[r5,r12,lsl #2]
    cmp r6,#15                       @ last box
    bne 2f
    cmp r3,#'R'
    bne 11f
    mov r0,#CONST_G
    bl functionFZ
    b 100f
11:
    cmp r3,#'D'
    bne 12f
    mov r0,#CONST_L
    bl functionFZ
    b 100f
12:
    mov r0,#CONST_G + CONST_L
    bl functionFZ
    b 100f

2:
    cmp r6,#12
    bne 3f
    cmp r3,#'L'
    bne 21f
    mov r0,#CONST_G
    bl functionFZ
    b 100f
21:
    cmp r3,#'D'
    bne 22f
    mov r0,#CONST_E
    bl functionFZ
    b 100f
22:
    mov r0,#CONST_E + CONST_G
    bl functionFZ
    b 100f
3:
    cmp r6,#13
    beq 30f
    cmp r6,#14
    bne 4f
30:
    cmp r3,#'L'
    bne 31f
    mov r0,#CONST_G + CONST_L
    bl functionFZ
    b 100f
31:
    cmp r3,#'R'
    bne 32f
    mov r0,#CONST_G + CONST_E
    bl functionFZ
    b 100f
32:
    cmp r3,#'D'
    bne 33f
    mov r0,#CONST_E + CONST_L
    bl functionFZ
    b 100f
33:
    mov r0,#CONST_L + CONST_E + CONST_G
    bl functionFZ
    b 100f
4:
    cmp r6,#3
    bne 5f
    cmp r3,#'R'
    bne 41f
    mov r0,#CONST_I
    bl functionFZ
    b 100f
41:
    cmp r3,#'U'
    bne 42f
    mov r0,#CONST_L
    bl functionFZ
    b 100f
42:
    mov r0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
5:
    cmp r6,#0
    bne 6f
    cmp r3,#'L'
    bne 51f
    mov r0,#CONST_I
    bl functionFZ
    b 100f
51:
    cmp r3,#'U'
    bne 52f
    mov r0,#CONST_E
    bl functionFZ
    b 100f
52:
    mov r0,#CONST_I + CONST_E
    bl functionFZ
    b 100f
6:
    cmp r6,#1
    beq 60f
    cmp r6,#2
    bne 7f
60:
    cmp r3,#'L'
    bne 61f
    mov r0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
61:
    cmp r3,#'R'
    bne 62f
    mov r0,#CONST_E + CONST_I
    bl functionFZ
    b 100f
62:
    cmp r3,#'U'
    bne 63f
    mov r0,#CONST_E + CONST_L
    bl functionFZ
    b 100f
63:
    mov r0,#CONST_I + CONST_E + CONST_L
    bl functionFZ
    b 100f
7:
    cmp r6,#7
    beq 70f
    cmp r6,#11
    bne 8f
70:
    cmp r3,#'R'
    bne 71f
    mov r0,#CONST_I + CONST_G
    bl functionFZ
    b 100f
71:
    cmp r3,#'U'
    bne 72f
    mov r0,#CONST_G + CONST_L
    bl functionFZ
    b 100f
72:
    cmp r3,#'D'
    bne 73f
    mov r0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
73:
    mov r0,#CONST_I + CONST_G + CONST_L
    bl functionFZ
    b 100f
8:
    cmp r6,#4
    beq 80f
    cmp r6,#8
    bne 9f
80:
    cmp r3,#'D'
    bne 81f
    mov r0,#CONST_I + CONST_E
    bl functionFZ
    b 100f
81:
    cmp r3,#'U'
    bne 82f
    mov r0,#CONST_G + CONST_E
    bl functionFZ
    b 100f
82:
    cmp r3,#'L'
    bne 83f
    mov r0,#CONST_I + CONST_G
    bl functionFZ
    b 100f
83:
    mov r0,#CONST_G + CONST_E + CONST_I
    bl functionFZ
    b 100f
9:
    cmp r3,#'D'
    bne 91f
    mov r0,#CONST_I + CONST_E + CONST_L
    bl functionFZ
    b 100f
91:
    cmp r3,#'L'
    bne 92f
    mov r0,#CONST_I + CONST_G + CONST_L
    bl functionFZ
    b 100f
92:
    cmp r3,#'R'
    bne 93f
    mov r0,#CONST_I + CONST_G + CONST_E
    bl functionFZ
    b 100f
93:
    cmp r3,#'U'
    bne 94f
    mov r0,#CONST_G + CONST_E +  CONST_L
    bl functionFZ
    b 100f
94:
    mov r0,#CONST_G + CONST_L + CONST_I + CONST_E
    bl functionFZ
    b 100f

99:                                  @ error
    ldr r0,iAdrszMessErreur
    bl affichageMess
100:
    pop {lr}                         @ restaur registers
    bx lr                            @return

/******************************************************************/
/*     function FZ                           */
/*                                                 */
/***************************************************************/
/* r0 contains variable w           */
functionFZ:                    @ INFO: functionFZ
    push {r1,r2,lr}            @ save  registers
    mov r2,r0
    and r1,r2,#CONST_I
    cmp r1,#0
    ble 1f
    bl functionFI
    bl functionFY
    cmp r0,#TRUE
    beq 100f
    sub r12,r12,#1              @ variable n
1:
    ands r1,r2,#CONST_G
    ble 2f
    bl functionFG
    bl functionFY
    cmp r0,#TRUE
    beq 100f
    sub r12,r12,#1              @ variable n
2:
    ands r1,r2,#CONST_E
    ble 3f
    bl functionFE
    bl functionFY
    cmp r0,#TRUE
    beq 100f
    sub r12,r12,#1              @ variable n
3:
    ands r1,r2,#CONST_L
    ble 4f
    bl functionFL
    bl functionFY
    cmp r0,#TRUE
    beq 100f
    sub r12,r12,#1              @ variable n
4:
    mov r0,#FALSE
100:
    pop {r1,r2,lr}              @ restaur registers
    bx lr                       @return
/******************************************************************/
/*               function FY                                 */
/******************************************************************/
functionFY:                    @ INFO: functionFY
    push {lr}                  @ save  registers
    ldr r1,iAdriTabN2
    ldr r0,[r1,r12,lsl #2]
    bl gameOK                  @ game OK ?
    cmp r0,#TRUE
    beq 100f
    ldr r1,iAdriTabN4
    ldr r0,[r1,r12,lsl #2]
    cmp r0,r10
    bgt 1f
    bl functionFN
    b 100f
1:
    mov r0,#FALSE
100:
    pop {lr}                     @ restaur registers
    bx lr                        @return

/******************************************************************/
/*     the empty box is down                                     */
/******************************************************************/
functionFI:                       @ INFO: functionFI
    push {r0-r8,lr}               @ save  registers
    ldr r0,iAdriTabN0
    ldr r1,[r0,r12,lsl #2]        @ empty box
    add r2,r1,#4
    ldr r3,[r9,r12,lsl #2]        @ load game current
    ldrb r4,[r3,r2]               @ load box down empty box
    add r5,r12,#1                 @ n+1
    add r8,r1,#4                  @ new position empty case
    str r8,[r0,r5,lsl #2]         @ store new position empty case
    ldr r6,iAdriTabN3

    mov r7,#'D'                   @ down
    str r7,[r6,r5,lsl #2]         @ store move
    ldr r6,iAdriTabN4
    ldr r7,[r6,r12,lsl #2]
    str r7,[r6,r5,lsl #2]         @ N4 (n+1) = n4(n)
    mov r0,r3
    bl createGame                 @ create copy game
    ldrb r3,[r0,r1]               @ and inversion box
    ldrb r8,[r0,r2]
    strb r8,[r0,r1]
    strb r3,[r0,r2]
    str r0,[r9,r5,lsl #2]         @ store new game in table
    lsr r1,r1,#2                  @ line position empty case = N°/ 4
    ldr r0,iAdriTabNr
    ldr r2,[r0,r4,lsl #2]         @ load N° line box moved
    cmp r2,r1                     @ compare ????
    ble 1f
    add r7,r7,#1                  @ and increment ????
    str r7,[r6,r5,lsl #2]
1:
    add r12,r12,#1                @ increment N
    pop {r0-r8,lr}
    bx lr                         @return
iAdriTabNr:        .int iTabNr
iAdriTabNc:        .int iTabNc
/******************************************************************/
/*     empty case UP   see explain in english in function FI      */
/******************************************************************/
functionFG:                      @ INFO: functionFG
    push {r0-r8,lr}              @ save  registers
    ldr r0,iAdriTabN0
    ldr r1,[r0,r12,lsl #2]       @ case vide
    sub r2,r1,#4                 @ position case au dessus
    ldr r3,[r9,r12,lsl #2]       @ extrait jeu courant
    ldrb r4,[r3,r2]              @ extrait le contenu case au dessus
    add r5,r12,#1                @ N+1 = N
    sub r8,r1,#4                 @ nouvelle position case vide
    str r8,[r0,r5,lsl #2]        @ et on la stocke
    ldr r6,iAdriTabN3
    mov r7,#'U'                  @ puis on stocke le code mouvement
    str r7,[r6,r5,lsl #2]
    ldr r6,iAdriTabN4
    ldr r7,[r6,r12,lsl #2]
    str r7,[r6,r5,lsl #2]        @ N4 (N+1) = N4 (N)
    mov r0,r3                    @ jeu courant
    bl createGame                @ création nouveau jeu
    ldrb r3,[r0,r1]              @ et echange les 2 cases
    ldrb r8,[r0,r2]
    strb r8,[r0,r1]
    strb r3,[r0,r2]
    str r0,[r9,r5,lsl #2]        @ stocke la nouvelle situation
    lsr r1,r1,#2                 @ ligne case vide = position /4
    ldr r0,iAdriTabNr
    ldr r2,[r0,r4,lsl #2]        @ extrait table à la position case
    cmp r2,r1                    @ et comparaison ???
    bge 1f
    add r7,r7,#1                 @ puis increment N4 de 1  ???
    str r7,[r6,r5,lsl #2]
1:
    add r12,r12,#1               @ increment de N
    pop {r0-r8,lr}
    bx lr                        @return
/******************************************************************/
/*    empty case go right see explain finction FI ou FG en français */
/******************************************************************/
functionFE:                       @ INFO: functionFE
    push {r0-r8,lr}               @ save  registers
    ldr r0,iAdriTabN0
    ldr r1,[r0,r12,lsl #2]
    add r2,r1,#1
    ldr r3,[r9,r12,lsl #2]
    ldrb r4,[r3,r2]               @ extrait le contenu case
    add r5,r12,#1
    add r8,r1,#1
    str r8,[r0,r5,lsl #2]         @ nouvelle case vide
    ldr r6,iAdriTabN3
    mov r7,#'R'
    str r7,[r6,r5,lsl #2]         @ mouvement
    ldr r6,iAdriTabN4
    ldr r7,[r6,r12,lsl #2]
    str r7,[r6,r5,lsl #2]         @ N4 ??
    mov r0,r3
    bl createGame
    ldrb r3,[r0,r1]               @ exchange two boxes
    ldrb r8,[r0,r2]
    strb r8,[r0,r1]
    strb r3,[r0,r2]
    str r0,[r9,r5,lsl #2]         @ stocke la nouvelle situation
    lsr r3,r1,#2
    sub r1,r1,r3,lsl #2
    ldr r0,iAdriTabNc
    ldr r2,[r0,r4,lsl #2]         @ extrait table à la position case
    cmp r2,r1
    ble 1f
    add r7,r7,#1
    str r7,[r6,r5,lsl #2]
1:
    add r12,r12,#1
    pop {r0-r8,lr}
    bx lr                        @return
/******************************************************************/
/*     empty box go left see explain function FI ou FG en français */
/******************************************************************/
functionFL:                       @ INFO: functionFL
    push {r0-r8,lr}               @ save  registers
    ldr r0,iAdriTabN0
    ldr r1,[r0,r12,lsl #2]        @ case vide
    sub r2,r1,#1
    ldr r3,[r9,r12,lsl #2]       @ extrait jeu courant
    ldrb r4,[r3,r2]              @ extrait le contenu case
    add r5,r12,#1
    sub r8,r1,#1
    str r8,[r0,r5,lsl #2]         @ nouvelle case vide
    ldr r6,iAdriTabN3
    mov r7,#'L'
    str r7,[r6,r5,lsl #2]         @ mouvement
    ldr r6,iAdriTabN4
    ldr r7,[r6,r12,lsl #2]
    str r7,[r6,r5,lsl #2]         @ N4 ??
    mov r0,r3
    bl createGame
    ldrb r3,[r0,r1]               @ exchange two boxes
    ldrb r8,[r0,r2]
    strb r8,[r0,r1]
    strb r3,[r0,r2]
    str r0,[r9,r5,lsl #2]         @ stocke la nouvelle situation
    lsr r3,r1,#2
    sub r1,r1,r3,lsl #2           @ compute remainder
    ldr r0,iAdriTabNc
    ldr r2,[r0,r4,lsl #2]         @ extrait table colonne à la position case
    cmp r2,r1
    bge 1f
    add r7,r7,#1
    str r7,[r6,r5,lsl #2]
1:
    add r12,r12,#1
    pop {r0-r8,lr}
    bx lr                         @return
/******************************************************************/
/*     create new Game                                            */
/******************************************************************/
/* r0 contains box address            */
/* r0 return address new game  */
createGame:                          @ INFO: createGame
    push {r1-r8,lr}                  @ save  registers
    mov r4,r0                        @ save value
    mov r0,#0                        @ allocation place heap
    mov r7,#0x2D                     @ call system 'brk'
    svc #0
    cmp r0,#-1                       @ allocation error
    beq 99f
    mov r5,r0                        @ save address heap for output string
    add r0,#SIZE * SIZE              @ reservation place one element
    mov r7,#0x2D                     @ call system 'brk'
    svc #0
    cmp r0,#-1                       @ allocation error
    beq 99f
    mov r2,#0
1:                                   @ loop copy boxes
    ldrb r3,[r4,r2]
    strb r3,[r5,r2]
    add r2,r2,#1
    cmp r2,#NBBOX
    blt 1b
    add r11,r11,#1
    mov r0,r5
    b 100f
99:                                  @ error
    ldr r0,iAdrszMessErreur
    bl affichageMess
100:
    pop {r1-r8,lr}                   @ restaur registers
    bx lr                            @return
/******************************************************************/
/*     read file                                                   */
/******************************************************************/
/* r0 contains address stack begin           */
traitFic:                             @ INFO: traitFic
    push {r1-r8,fp,lr}                @ save  registers
    mov fp,r0                         @  fp <- start address
    ldr r4,[fp]                       @ number of Command line arguments
    cmp r4,#1
    movle r0,#-1
    ble 99f
    add r5,fp,#8                      @ second parameter address
    ldr r5,[r5]
    ldr r0,iAdriAdrFicName
    str r5,[r0]
    ldr r0,iAdrszMessTitre
    bl affichageMess                  @ display string
    mov r0,r5
    bl affichageMess
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                  @ display carriage return

    mov r0,r5                         @ file name
    mov r1,#O_RDWR                    @ flags
    mov r2,#0                         @ mode
    mov r7, #OPEN                     @ call system OPEN
    svc 0
    cmp r0,#0                         @ error ?
    ble 99f
    mov r8,r0                         @ File Descriptor
    ldr r1,iAdrsBuffer                @ buffer address
    mov r2,#TAILLEBUFFER              @ buffer size
    mov r7,#READ                      @ read file
    svc #0
    cmp r0,#0                         @ error ?
    blt 99f
    @ extraction datas
    ldr r1,iAdrsBuffer                @ buffer address
    add r1,r0
    mov r0,#0                         @ store zéro final
    strb r0,[r1]
    ldr r0,iAdribox                   @ game box address
    ldr r1,iAdrsBuffer                @ buffer address
    bl extracDatas
                                      @ close file
    mov r0,r8
    mov r7, #CLOSE
    svc 0
    mov r0,#0
    b 100f
99:                                   @ error
    ldr r1,iAdrszMessErreur           @ error message
    bl   displayError
    mov r0,#-1
100:
    pop {r1-r8,fp,lr}                 @ restaur registers
    bx lr                             @return
iAdriAdrFicName:              .int iAdrFicName
iAdrszMessTitre:              .int szMessTitre
iAdrsBuffer:                  .int sBuffer
/******************************************************************/
/*     extrac digit file buffer                                   */
/******************************************************************/
/* r0 contains boxs address           */
/* r1 contains buffer address         */
extracDatas:                     @ INFO: extracDatas
    push {r1-r8,lr}              @ save  registers
    mov r7,r0
    mov r6,r1
    mov r2,#0                    @ string buffer indice
    mov r4,r1                    @ start digit ascii
    mov r5,#0                    @ box index
1:
    ldrb r3,[r6,r2]
    cmp r3,#0
    beq 4f                       @ end
    cmp r3,#0xA
    beq 2f
    cmp r3,#','
    beq 3f
    add r2,#1
    b 1b
2:
    mov r3,#0
    strb r3,[r6,r2]
    ldrb r3,[r6,r2]
    cmp r3,#0xD
    addeq r2,#2
    addne r2,#1
    b 4f

3:
    mov r3,#0
    strb r3,[r6,r2]
    add r2,#1
4:
    mov r0,r4
    bl conversionAtoD
    strb r0,[r7,r5]
    cmp r0,#0
    ldreq r0,iAdriTabN0
    streq r5,[r0]                @ empty box in item zéro
    add r5,#1
    cmp r5,#NBBOX                @ number box = maxi ?
    bge 100f
    add r4,r6,r2                 @ new start address digit ascii
    b 1b
100:
    pop {r1-r8,lr}               @ restaur registers
    bx lr                        @return
/******************************************************************/
/*     control of the game solution                                      */
/******************************************************************/
/* r0 contains boxs address           */
/* r0 returns 0 if not possible       */
/* r0 returns 1 if possible           */
controlSolution:                 @ INFO: controlSolution
    push {r1-r8,lr}              @ save  registers
    mov r5,r0
    ldr r8,iAdriTabN0
    ldr r8,[r8]                  @ empty box
    @ empty box
    mov r7,#0
    cmp r8,#1
    moveq r7,#1
    beq 1f
    cmp r8,#3
    moveq r7,#1
    beq 1f
    cmp r8,#4
    moveq r7,#1
    beq 1f
    cmp r8,#6
    moveq r7,#1
    beq 1f
    cmp r8,#9
    moveq r7,#1
    beq 1f
    cmp r8,#11
    moveq r7,#1
    beq 1f
    cmp r8,#12
    moveq r7,#1
    beq 1f
    cmp r8,#14
    moveq r7,#1
1:
    rsb r6,r8,#NBBOX - 1
    add r7,r6
                                 @ count permutations
    mov r1,#-1
    mov r6,#0
2:
    add r1,#1
    cmp r1,#NBBOX
    bge 80f
    cmp r1,r8
    beq 2b
    ldrb r3,[r5,r1]
    mov r2,r1
3:
    add r2,#1
    cmp r2,#NBBOX
    bge 2b
    cmp r2,r8
    beq 3b
    ldrb r4,[r5,r2]
    cmp r4,r3
    addlt r6,#1
    b 3b
80:
    add r6,r7
    tst r6,#1
    movne r0,#0                  @ impossible
    moveq r0,#1                  @ OK

100:
    pop {r1-r8,lr}               @ restaur registers
    bx lr                        @return
/******************************************************************/
/*     game Ok ?                                      */
/******************************************************************/
/* r0 contains boxs address           */
gameOK:                          @ INFO: gameOK
    push {r1-r4,lr}              @ save  registers
    mov r2,#0
    ldrb r3,[r0,r2]
    cmp r3,#0
    moveq r3,#0xF
    add r2,#1
1:
    ldrb r4,[r0,r2]
    cmp r4,#0
    moveq r3,#0xF
    cmp r4,r3
    movle  r0,#FALSE              @ game not Ok
    ble 100f
    mov r3,r4
    add r2,#1
    cmp r2,#NBBOX -2
    ble 1b
    mov r0,#TRUE                  @ game Ok

100:
    pop {r1-r4,lr}                @ restaur registers
    bx lr                         @return
/******************************************************************/
/*     display game                                       */
/******************************************************************/
/* r0 contains boxs address           */
displayGame:                            @ INFO: displayGame
    push {r0-r5,lr}                     @ save  registers
    mov r4,r0
    ldr r0,iAdrszMessTitre
    bl affichageMess                    @ display string
    ldr r0,iAdriAdrFicName
    ldr r0,[r0]
    bl affichageMess                    @ display string
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                    @ display line return
    mov r2,#0
    ldr r1,iAdrsMessValeur
1:
    ldrb r0,[r4,r2]
    cmp r0,#0
    ldreq r0,iSpaces                    @ store spaces
    streq r0,[r1]
    beq 2f
    bl conversion10                     @ call conversion decimal
    mov r0,#0
    strb r0,[r1,#3]                     @ zéro final
2:

    ldr r0,iAdrsMessResult
    bl affichageMess                    @ display message
    add r0,r2,#1
    tst r0,#0b11
    bne 3f
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                    @ display message
3:
    add r2,#1
    cmp r2,#NBBOX - 1
    ble 1b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess                    @ display line return

100:
    pop {r0-r5,lr}                      @ restaur registers
    bx lr                               @return
iSpaces:                       .int 0x00202020       @ spaces
//iAdrszMessMoveError:           .int szMessMoveError
iAdrszCarriageReturn:          .int szCarriageReturn
iAdrsMessValeur:               .int sMessValeur
iAdrsMessResult:               .int sMessResult
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


/**@file  HybridIDA.c
 * @brief solve 4x4 sliding puzzle with IDA* algorithm
 * by RMM 2021-feb-22

 * The Interative Deepening A* is relatively easy to code in 'C' since
 * it does not need Queues and Lists to manage memory. Instead the
 * search space state is held on the LIFO stack frame of recursive
 * search function calls. Millions of nodes may be created but they
 * are automatically deleted during backtracking.

 * Run-time is a disadvantage with complex puzzles. Also it struggles
 * to solve puzzles with depth g>50. I provided a test puzzle of g=52
 * that works with ordinary search but the Rosetta challenge puzzle
 * cycles forever. The HybridIDA solves it in 18 seconds.

 * The HybridIDA solution has two phases.
 * 1. It stops searching when a permutation begins with 1234.
 * 2. Phase2 begins a regular search with the output of phase 1.

 * (But an regular one time search can be done with phase 2
 * only). Phase 1 is optional.)

 * Pros: Hybrid IDA* is faster and solves more puzzles.
 * Cons: May not find shortest path.
 */
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>

typedef unsigned char u8t;
typedef unsigned short u16t;
enum { NR=4, NC=4, NCELLS = NR*NC };
enum { UP, DOWN, LEFT, RIGHT, NDIRS };
enum { OK = 1<<8, XX = 1<<9, FOUND = 1<<10, zz=0x80 };
enum { MAX_INT=0x7E, MAX_NODES=(16*65536)*90};
enum { BIT_HDR=1<<0, BIT_GRID=1<<1, BIT_OTHER=1<<2 };
enum { PHASE1,PHASE2 };  // solution phase

typedef struct { u16t dn; u16t hn; }HSORT_T;

typedef struct {
   u8t data[NCELLS]; unsigned id; unsigned src;
   u8t h; u8t g; u8t udlr;
}NODE_T;  // contains puzzle data and metadata

NODE_T goal44={
   {1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0},0,0,0,0,0};
NODE_T work; // copy of puzzle with run-time changes

NODE_T G34={ //g=34; n=248,055; (1phase)
 {13,9,5,4, 15,6,1,8, 0,10,2,11, 14,3,7,12},0,0,0,0,0};

NODE_T G52={ // g=52; n=34,296,567; (1phase)
   {15,13,9,5, 14,6,1,4,  10,12,0,8, 3,7,11,2},0,0,0,0,0};

NODE_T G99={ // formidable Rosetta challenge (2phases)
   {15,14,1,6, 9,11,4,12, 0,10,7,3, 13,8,5,2},0,0,0,0,0};

struct {
   unsigned nodes;
   unsigned gfound;
   unsigned root_visits;
   unsigned verbose;
   unsigned locks;
   unsigned phase;
}my;

u16t  HybridIDA_star(NODE_T *pNode);
u16t  make_node(NODE_T *pNode, NODE_T *pNew, u8t udlr );
u16t  search(NODE_T *pNode, u16t bound);
u16t  taxi_dist( NODE_T *pNode);
u16t  tile_home( NODE_T *p44);
void  print_node( NODE_T *pN, const char *pMsg, short force );
u16t  goal_found(NODE_T *pNode);
char  udlr_to_char( char udlr );
void  idx_to_rc( u16t idx, u16t *row, u16t *col );
void  sort_nodes(HSORT_T *p);

int main( )
{
   my.verbose = 0;		// minimal print node
   // my.verbose |= BIT_HDR;	// node header
   // my.verbose |= BIT_GRID;	// node 4x4 data

   memcpy(&work,  &G99, sizeof(NODE_T));  // select puzzle here
   if(1){   // phase1 can skipped for easy puzzles
      printf("Phase1: IDA* search for 1234 permutation..\n");
      my.phase = PHASE1;
      (void) HybridIDA_star(&work);
   }
   printf("Phase2: IDA* search phase1 seed..\n");
   my.phase = PHASE2;
   (void)HybridIDA_star(&work);
   return 0;
}

/// \brief driver for Iterative Deepining A*
u16t HybridIDA_star(NODE_T *pN){
   my.nodes = 1;
   my.gfound = 0;
   my.root_visits = 0;
   pN->udlr = NDIRS;
   pN->g = 0;
   pN->h = taxi_dist(pN);
   pN->id = my.nodes;
   pN->src = 0;
   const char *pr = {"Start"}; // for g++
   print_node( pN,pr,1 );
   u16t depth = pN->h;
   while(1){
      depth = search(pN,depth);
      if( depth & FOUND){
         return FOUND;  // goodbye
      }
      if( depth & 0xFF00 ){
	 printf("..error %x\n",depth);
	 return XX;
      }
      my.root_visits++;
      printf("[root visits: %u, depth %u]\n",my.root_visits,depth);
   }
   return 0;
}

/// \brief search is recursive. nodes are instance variables
u16t search(NODE_T *pN, u16t bound){
   if(bound & 0xff00){ return bound; }
   u16t f = pN->g + pN->h;
   if( f > bound){ return f; }
   if(goal_found(pN)){
      my.gfound = pN->g;
      memcpy(&work,pN,sizeof(NODE_T));
      printf("total nodes=%d, g=%u \n", my.nodes, my.gfound);
      const char *pr = {"Found.."}; // for g++
      print_node( &work,pr,1 );
      return FOUND;
   }
   NODE_T news;
   // Sort successor nodes so that the lowest heuristic is visited
   // before the less promising at the same level. This reduces the
   // number of searches and finds more solutions
   HSORT_T hlist[NDIRS];
   for( short i=0; i<NDIRS; i++ ){
      u16t rv = make_node(pN,&news, i );
      hlist[i].dn = i;
      if( rv & OK ){
	 hlist[i].hn = news.h;
	 continue;
      }
      hlist[i].hn = XX;
   }
   sort_nodes(&hlist[0]);

   u16t temp, min = MAX_INT;
   for( short i=0; i<NDIRS; i++ ){
      if( hlist[i].hn > 0xff ) continue;
      temp = make_node(pN,&news, hlist[i].dn );
      if( temp & XX ) return XX;
      if( temp & OK ){
	 news.id = my.nodes++;
	 print_node(&news," succ",0 );
	 temp = search(&news, bound);
	 if(temp & 0xff00){  return temp;}
	 if(temp < min){ min = temp; }
      }
   }
   return min;
}

/// \brief sort nodes to prioitize heuristic low
void sort_nodes(HSORT_T *p){
   for( short s=0; s<NDIRS-1; s++ ){
      HSORT_T tmp = p[0];
      if( p[1].hn < p[0].hn ){tmp=p[0]; p[0]=p[1]; p[1]=tmp; }
      if( p[2].hn < p[1].hn ){tmp=p[1]; p[1]=p[2]; p[2]=tmp; }
      if( p[3].hn < p[2].hn ){tmp=p[2]; p[2]=p[3]; p[3]=tmp; }
   }
}

/// \brief return index of blank tile
u16t tile_home(NODE_T *pN ){
   for( short i=0; i<NCELLS; i++ ){
      if( pN->data[i] == 0 ) return i;
   }
   return XX;
}

/// \brief print node (or not) depending upon flags
void print_node( NODE_T *pN, const char *pMsg, short force ){
   const int tp1 = 0;
   if( my.verbose & BIT_HDR || force || tp1){
      char ch = udlr_to_char(pN->udlr);
      printf("id:%u src:%u; h=%d, g=%u, udlr=%c, %s\n",
	     pN->id, pN->src, pN->h, pN->g, ch, pMsg);
   }
   if(my.verbose & BIT_GRID || force || tp1){
      for(u16t i=0; i<NR; i++ ){
	 for( u16t j=0; j<NC; j++ ){
	    printf("%3d",pN->data[i*NR+j]);
	 }
	 printf("\n");
      }
      printf("\n");
   }
   //putchar('>');  getchar();
}

/// \brief return true if selected tiles are settled
u16t goal_found(NODE_T *pN) {
   if(my.phase==PHASE1){
      short tags = 0;
      for( short i=0; i<(NC); i++ ){
	 if( pN->data[i] == i+1 ) tags++;
      }
      if( tags==4 ) return 1;  // Permutation starts with 1234
   }

   for( short i=0; i<(NR*NC); i++ ){
      if( pN->data[i] != goal44.data[i] ) return 0;
   }
   return 1;
}

/// \brief convert UDLR index to printable char
char udlr_to_char( char udlr ){
   char ch = '?';
   switch(udlr){
   case UP:    ch = 'U'; break;
   case DOWN:  ch = 'D'; break;
   case LEFT:  ch = 'L'; break;
   case RIGHT: ch = 'R'; break;
   default: break;
   }
   return ch;
}

/// \brief convert 1-D array index to 2-D row-column
void idx_to_rc( u16t idx, u16t *row, u16t *col ){
   *row = idx/NR; *col = abs( idx - (*row * NR));
}

/// \brief make successor node with blank tile moved UDRL
/// \return success or error
u16t make_node(NODE_T *pSrc, NODE_T *pNew, u8t udlr ){
   u16t row,col,home_idx,idx2;
   if(udlr>=NDIRS||udlr<0 ){ printf("invalid udlr %u\n",udlr); return XX; }
   if(my.nodes > MAX_NODES ){ printf("excessive nodes %u\n",my.nodes);
      return XX; }
   memcpy(pNew,pSrc,sizeof(NODE_T));
   home_idx = tile_home(pNew);
   idx_to_rc(home_idx, &row, &col );

   if( udlr == LEFT)  { if( col < 1 ) return 0; col--; }
   if( udlr == RIGHT ){ if( col >= (NC-1) ) return 0; col++; }
   if( udlr == DOWN ) { if(row >= (NR-1)) return 0; row++; }
   if( udlr == UP ){	 if(row < 1) return 0; row--; }
   idx2 = row * NR + col;
   if( idx2 < NCELLS ){
      u8t *p = &pNew->data[0];
      p[home_idx] = p[idx2];
      p[idx2]     = 0; // swap
      pNew->src   = pSrc->id;
      pNew->g     = pSrc->g + 1;
      pNew->h     = taxi_dist(pNew);
      pNew->udlr  = udlr; // latest move;
      return OK;
   }
   return 0;
}

/// \brief sum of 'manhattan taxi' distance between tile locations
u16t taxi_dist( NODE_T *pN){
   u16t tile,sum = 0, r1,c1,r2,c2;
   u8t *p44 = &pN->data[0];
   for( short i=0; i<(NR*NC); i++ ){
      tile = p44[i];
      if( tile==0 ) continue;
      idx_to_rc(i, &r2, &c2 );
      idx_to_rc(tile-1, &r1, &c1 );
      sum += abs(r1-r2) + abs(c1-c2);
   }
   }
   return sum;
}


;;; Using a priority queue for the A* search
(eval-when (:load-toplevel :compile-toplevel :execute)
  (ql:quickload "pileup"))

;; * The package definition
(defpackage :15-solver
  (:use :common-lisp :pileup)
  (:export "15-puzzle-solver" "*initial-state*" "*goal-state*"))
(in-package :15-solver)

;; * Data types
(defstruct (posn (:constructor posn))
  "A posn is a pair struct containing two integer for the row/col indices."
  (row 0 :type fixnum)
  (col 0 :type fixnum))

(defstruct (state (:constructor state))
  "A state contains a vector and a posn describing the position of the empty slot."
  (matrix '#(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0) :type simple-vector)
  (empty-slot (posn :row 3 :col 3) :type posn))

(defparameter directions '(up down left right)
  "The possible directions shifting the empty slot.")

(defstruct (node (:constructor node))
  "A node contains a state, a reference to the previous node, a g value (actual
costs until this node, and a f value (g value + heuristics)."
  (state (state) :type state)
  (prev nil)
  (cost 0 :type fixnum)
  (f-value 0 :type fixnum))

;; * Some constants
(defparameter *side-size* 4 "The size of the puzzle.")

(defvar *initial-state*
  (state :matrix #(15  14  1  6
                    9  11  4 12
                    0  10  7  3
                   13   8  5  2)
         :empty-slot (posn :row 2 :col 0)))

(defvar *initial-state-2*
  (state :matrix #( 0 12  9 13
                   15 11 10 14
                    3  7  2  5
                    4  8  6  1)
         :empty-slot (posn :row 0 :col 0)))

(defvar *goal-state*
  (state :matrix #( 1  2  3  4
                    5  6  7  8
                    9 10 11 12
                   13 14 15  0)
          :empty-slot (posn :row 3 :col 3)))

;; * The functions

;; ** Accessing the elements of the puzzle
(defun matrix-ref (matrix row col)
  "Matrices are simple vectors, abstracted by following functions."
  (svref matrix (+ (* row *side-size*) col)))

(defun (setf matrix-ref) (val matrix row col)
  (setf (svref matrix (+ (* row *side-size*) col)) val))

;; ** The final predicate
(defun target-state-p (state goal-state)
  "Returns T if STATE is the goal state."
  (equalp state goal-state))

(defun valid-movement-p (direction empty-slot)
  "Returns T if direction is allowed for the current empty slot position."
  (case direction
    (up (< (posn-row empty-slot) (1- *side-size*)))
    (down (> (posn-row empty-slot) 0))
    (left (< (posn-col empty-slot) (1- *side-size*)))
    (right (> (posn-col empty-slot) 0))))

;; ** Pretty print the state
(defun print-state (state)
  "Helper function to pretty-print a state."
  (format t " ====================~%")
  (loop
     with matrix = (state-matrix state)
     for i from 0 below *side-size*
     do
       (loop
          for j from 0 below *side-size*
          do (format t "| ~2,D " (matrix-ref matrix i j)))
       (format t " |~%"))
  (format t " ====================~%"))

;; ** Move the empty slot
(defun move (state direction)
  "Returns a new state after moving STATE's empty-slot in DIRECTION assuming a
  valid direction."
  (let* ((matrix (copy-seq (state-matrix state)))
         (empty-slot (state-empty-slot state))
         (r (posn-row empty-slot))
         (c (posn-col empty-slot))
         (new-empty-slot
          (ccase direction
            (up (setf (matrix-ref matrix r c) (matrix-ref matrix (1+ r) c)
                      (matrix-ref matrix (1+ r) c) 0)
                (posn :row (1+ r) :col c))
            (down (setf (matrix-ref matrix r c) (matrix-ref matrix (1- r) c)
                        (matrix-ref matrix (1- r) c) 0)
                  (posn :row (1- r) :col c))
            (left (setf (matrix-ref matrix r c) (matrix-ref matrix r (1+ c))
                        (matrix-ref matrix r (1+ c)) 0)
                  (posn :row r :col (1+ c)))
            (right (setf (matrix-ref matrix r c) (matrix-ref matrix r (1- c))
                         (matrix-ref matrix r (1- c)) 0)
                   (posn :row r :col (1- c))))))
    (state :matrix matrix :empty-slot new-empty-slot)))

;; ** The heuristics
(defun l1-distance (posn0 posn1)
  "Returns the L1 distance between two positions."
  (+ (abs (- (posn-row posn0) (posn-row posn1)))
     (abs (- (posn-col posn0) (posn-col posn1)))))

(defun element-cost (val current-posn)
  "Returns the L1 distance between the current position and the goal-position
for VAL."
  (if (zerop val)
      (l1-distance current-posn (posn :row 3 :col 3))
      (multiple-value-bind (target-row target-col)
          (floor (1- val) *side-size*)
        (l1-distance current-posn (posn :row target-row :col target-col)))))

(defun distance-to-goal (state)
  "Returns the L1 distance from STATE to the goal state."
  (loop
     with matrix = (state-matrix state)
     with sum = 0
     for i below *side-size*
     do (loop
           for j below *side-size*
           for val = (matrix-ref matrix i j)
           for cost = (element-cost val (posn :row i :col j))
           unless (zerop val)
           do (incf sum cost))
     finally (return sum)))

(defun out-of-order-values (list)
  "Returns the number of values out of order."
  (flet ((count-values (list)
           (loop
              with a = (first list)
              with rest = (rest list)
              for b in rest
              when (> b a)
              count b)))
    (loop
       for candidates = list then (rest candidates)
       while candidates
       summing (count-values candidates) into result
       finally (return (* 2 result)))))

(defun row-conflicts (row state0 state1)
  "Returns the number of conflicts in the given row, i.e. value in the right row
  but in the wrong order. For each conflicted pair add 2 to the value, but a
  maximum of 6 to avoid over-estimation."
  (let* ((goal-row (loop
                      with matrix1 = (state-matrix state1)
                      for j below *side-size*
                      collect (matrix-ref matrix1 row j)))
         (in-goal-row (loop
                         with matrix0 = (state-matrix state0)
                         for j below *side-size*
                         for val = (matrix-ref matrix0 row j)
                         when (member val goal-row)
                         collect val)))
    (min 6 (out-of-order-values
            ;; 0 does not lead to a linear conflict
            (remove 0 (nreverse in-goal-row))))))

(defun col-conflicts (col state0 state1)
  "Returns the number of conflicts in the given column, i.e. value in the right
  row but in the wrong order. For each conflicted pair add 2 to the value, but a
  maximum of 6 to avoid over-estimation."
  (let* ((goal-col (loop
                      with matrix1 = (state-matrix state1)
                      for i below *side-size*
                      collect (matrix-ref matrix1 i col)))
         (in-goal-col (loop
                         with matrix0 = (state-matrix state0)
                         for i below *side-size*
                         for val = (matrix-ref matrix0 i col)
                         when (member val goal-col)
                         collect val)))
    (min 6 (out-of-order-values
            ;; 0 does not lead to a linear conflict
            (remove 0 (nreverse in-goal-col))))))

(defun linear-conflicts (state0 state1)
  "Returns the linear conflicts for state1 with respect to state0."
  (loop
     for i below *side-size*
     for row-conflicts = (row-conflicts i state0 state1)
     for col-conflicts = (col-conflicts i state0 state1)
     summing row-conflicts into all-row-conflicts
     summing col-conflicts into all-col-conflicts
     finally (return (+ all-row-conflicts all-col-conflicts))))

(defun state-heuristics (state)
  "Using the L1 distance and the number of linear conflicts as heuristics."
  (+ (distance-to-goal state)
     (linear-conflicts state *goal-state*)))

;; ** Generate the next possible states.
(defun next-state-dir-pairs (current-node)
  "Returns a list of pairs containing the next states and the direction for the
  movement of the empty slot."
  (let* ((state (node-state current-node))
         (empty-slot (state-empty-slot state))
         (valid-movements (remove-if-not (lambda (dir) (valid-movement-p dir empty-slot))
                                         directions)))
    (map 'list (lambda (dir) (cons (move state dir) dir)) valid-movements)))

;; ** Searching the shortest paths and reconstructing the movements
(defun reconstruct-movements (leaf-node)
  "Traverse all nodes until the initial state and return a list of symbols
describing the path."
  (labels ((posn-diff (p0 p1)
             ;; Compute a pair describing the last move
             (posn :row (- (posn-row p1) (posn-row p0))
                        :col (- (posn-col p1) (posn-col p0))))
           (find-movement (prev-state state)
             ;; Describe the last movement of the empty slot with R, L, U or D.
             (let* ((prev-empty-slot (state-empty-slot prev-state))
                    (this-empty-slot (state-empty-slot state))
                    (delta (posn-diff prev-empty-slot this-empty-slot)))
               (cond ((equalp delta (posn :row  1 :col  0)) 'u)
                     ((equalp delta (posn :row -1 :col  0)) 'd)
                     ((equalp delta (posn :row  0 :col  1)) 'l)
                     ((equalp delta (posn :row  0 :col -1)) 'r))))
           (iter (node path)
             (if (or (not node) (not (node-prev node)))
                 path
                 (iter (node-prev node)
                       (cons (find-movement (node-state node)
                                            (node-state (node-prev node)))
                             path)))))
    (iter leaf-node '())))

(defun A* (initial-state
           &key (goal-state *goal-state*) (heuristics #'state-heuristics)
             (information 0))
  "An A* search for the shortest path to *GOAL-STATE*"
  (let ((visited (make-hash-table :test #'equalp))) ; All states visited so far
    ;; Some internal helper functions
    (flet ((pick-next-node (queue)
             ;; Get the next node from the queue
             (heap-pop queue))
           (expand-node (node queue)
             ;; Expand the next possible nodes from node and add them to the
             ;; queue if not already visited.
             (loop
                with costs = (node-cost node)
                with successors = (next-state-dir-pairs node)
                for (state . dir) in successors
                for succ-cost = (1+ costs)
                for f-value = (+ succ-cost (funcall heuristics state))
                ;; Check if this state was already looked at
                unless (gethash state visited)
                do
                ;; Insert the next node into the queue
                  (heap-insert
                   (node :state state :prev node :cost succ-cost
                              :f-value f-value)
                   queue))))

      ;; The actual A* search
      (loop
         ;; The priority queue
         with queue = (make-heap #'<= :name "queue" :size 1000 :key #'node-f-value)
         with initial-state-cost = (funcall heuristics initial-state)
         initially (heap-insert (node :state initial-state :prev nil :cost 0
                                           :f-value initial-state-cost)
                                queue)
         for counter from 1
         for current-node = (pick-next-node queue)
         for current-state = (node-state current-node)
         ;; Output some information each counter or nothing if information
         ;; equals 0.
         when (and (not (zerop information))
                   (zerop (mod counter information)))
         do (format t "~Dth State, heap size: ~D, current costs: ~D~%"
                    counter (heap-count queue)
                    (node-cost current-node))

         ;; If the target is not reached continue
         until (target-state-p current-state goal-state)
         do
         ;; Add the current state to the hash of visited states
           (setf (gethash current-state visited) t)
         ;; Expand the current node and continue
           (expand-node current-node queue)
         finally (return (values (reconstruct-movements current-node) counter))))))

;; ** Pretty print the path
(defun print-path (path)
  "Prints the directions of PATH and its length."
  (format t "~{~A~} ~D moves~%" path (length path)))

;; ** Get some timing information
(defmacro timing (&body forms)
  "Return both how much real time was spend in body and its result"
  (let ((start (gensym))
	(end (gensym))
	(result (gensym)))
    `(let* ((,start (get-internal-real-time))
	    (,result (progn ,@forms))
	    (,end (get-internal-real-time)))
       (values ,result (/ (- ,end ,start) internal-time-units-per-second)))))

;; ** The main function
(defun 15-puzzle-solver (initial-state &key (goal-state *goal-state*))
  "Solves a given and valid 15 puzzle and returns the shortest path to reach the
  goal state."
  (print-state initial-state)
  (multiple-value-bind (result time)
      (timing (multiple-value-bind (path steps)
                      (a* initial-state :goal-state goal-state)
                (print-path path)
                steps))
   (format t "Found the shortest path in ~D steps and ~3,2F seconds~%" result time))
  (print-state goal-state))


// A Naive 15 puzzle solver using no memory. Nigel Galloway: October 6th., 2017
let Nr,Nc = [|3;0;0;0;0;1;1;1;1;2;2;2;2;3;3;3|],[|3;0;1;2;3;0;1;2;3;0;1;2;3;0;1;2|]
type G= |N |I |G |E |L
type N={i:uint64;g:G list;e:int;l:int}
let fN     n=let g=(11-n.e)*4 in let a=n.i&&&(15UL<<<g)
             {i=n.i-a+(a<<<16);g=N::n.g;e=n.e+4;l=n.l+(if Nr.[int(a>>>g)]<=n.e/4 then 0 else 1)}
let fI     i=let g=(19-i.e)*4 in let a=i.i&&&(15UL<<<g)
             {i=i.i-a+(a>>>16);g=I::i.g;e=i.e-4;l=i.l+(if Nr.[int(a>>>g)]>=i.e/4 then 0 else 1)}
let fG     g=let l=(14-g.e)*4 in let a=g.i&&&(15UL<<<l)
             {i=g.i-a+(a<<<4) ;g=G::g.g;e=g.e+1;l=g.l+(if Nc.[int(a>>>l)]<=g.e%4 then 0 else 1)}
let fE     e=let l=(16-e.e)*4 in let a=e.i&&&(15UL<<<l)
             {i=e.i-a+(a>>>4) ;g=E::e.g;e=e.e-1;l=e.l+(if Nc.[int(a>>>l)]>=e.e%4 then 0 else 1)}
let fL=let l=[|[I;E];[I;G;E];[I;G;E];[I;G];[N;I;E];[N;I;G;E];[N;I;G;E];[N;I;G];[N;I;E];[N;I;G;E];[N;I;G;E];[N;I;G];[N;E];[N;G;E];[N;G;E];[N;G];|]
       (fun n g->List.except [g] l.[n] |> List.map(fun n->match n with N->fI |I->fN |G->fE |E->fG))
let solve n g l=let rec solve n=match n with // n is board, g is pos of 0, l is max depth
                                |n when n.i =0x123456789abcdef0UL->Some(n.g)
                                |n when n.l>l                    ->None
                                |g->let rec fN=function h::t->match solve h with None->fN t |n->n
                                                       |_->None
                                    fN (fL g.e (List.head n.g)|>List.map(fun n->n g))
                solve {i=n;g=[L];e=g;l=0}
  let n = Seq.collect fN n


#! /usr/bin/gforth

cell 8 <> [if] s" 64-bit system required" exception throw [then]

\ In the stack comments below,
\ "h" stands for the hole position (0..15),
\ "s" for a 64-bit integer representing a board state,
\ "t" a tile value (0..15, 0 is the hole),
\ "b" for a bit offset of a position within a state,
\ "m" for a masked value (4 bits selected out of a 64-bit state),
\ "w" for a weight of a current path,
\ "d" for a direction constant (0..3)

\ Utility
: 3dup   2 pick 2 pick 2 pick ;
: 4dup   2over 2over ;
: shift   dup 0 > if lshift else negate rshift then ;

hex 123456789abcdef0 decimal constant solution
: row   2 rshift ;   : col   3 and ;

: up-valid?    ( h -- f ) row 0 > ;
: down-valid?  ( h -- f ) row 3 < ;
: left-valid?  ( h -- f ) col 0 > ;
: right-valid? ( h -- f ) col 3 < ;

: up-cost    ( h t -- 0|1 ) 1 - row swap row < 1 and ;
: down-cost  ( h t -- 0|1 ) 1 - row swap row > 1 and ;
: left-cost  ( h t -- 0|1 ) 1 - col swap col < 1 and ;
: right-cost ( h t -- 0|1 ) 1 - col swap col > 1 and ;

\ To iterate over all possible directions, put direction-related functions into arrays:
: ith ( u addr -- w ) swap cells + @ ;
create valid? ' up-valid? , ' left-valid? , ' right-valid? , ' down-valid? , does> ith execute ;
create cost ' up-cost , ' left-cost , ' right-cost , ' down-cost , does> ith execute ;
create step -4 , -1 , 1 , 4 , does> ith ;

\ Advance from a single state to another:
: bits ( h -- b ) 15 swap - 4 * ;
: tile ( s b -- t ) rshift 15 and ;
: new-state ( s h d -- s' ) step dup >r + bits 2dup tile ( s b t ) swap lshift tuck - swap r> 4 * shift + ;
: new-weight ( w s h d -- w' ) >r tuck [email protected] step + bits tile r> cost + ;
: advance ( w s h d -- w s h w' s' h' ) 4dup new-weight >r  3dup new-state >r  step over + 2r> rot ;

\ Print a solution:
: rollback   2drop drop ;
: .dir ( u -- ) s" d..r.l..u" drop 4 + swap + [email protected] emit ;
: .dirs ( .. -- ) 0 begin >r 3 pick -1 <> while 3 pick over - .dir rollback r> 1+ repeat r> ;
: win   cr ." solved (read right-to-left!): " .dirs ."  - " . ." moves" bye ;

\ The main recursive function for depth-first search:
create limit 1 ,   : deeper  1 limit +! ;
: u-turn ( .. h2 w1 s1 h1 ) 4 pick 2 pick - ;
: search ( .. h2 w1 s1 h1 )
	over solution = if win then
	2 pick limit @ > if exit then
	4 0 do dup i valid? if i step u-turn <> if i advance recurse rollback then then loop ;

\ Iterative-deepning search:
: solve   1 limit !  begin search deeper again ;

\ -1 0 hex 0c9dfbae37254861 decimal 0 solve    \ uhm.
 -1 0 hex fe169b4c0a73d852 decimal 8 solve     \ the 52 moves case
\ -1 0 hex 123456789afbde0c decimal 14 solve   \ some trivial case, 3 moves
bye


59:         H = MOD(ABS(PRODUCT(BRD)),APRIME)
004016E3   mov         esi,1
004016E8   mov         ecx,1
004016ED   cmp         ecx,2
004016F0   jg          MAIN$SLIDESOLVE+490h (0040171e)
004016F2   cmp         ecx,1
004016F5   jl          MAIN$SLIDESOLVE+46Eh (004016fc)
004016F7   cmp         ecx,2
004016FA   jle         MAIN$SLIDESOLVE+477h (00401705)
004016FC   xor         eax,eax
004016FE   mov         dword ptr [ebp-54h],eax
00401701   dec         eax
00401702   bound       eax,qword ptr [ebp-54h]
00401705   imul        edx,ecx,4
00401708   mov         edx,dword ptr H (00473714)[edx]
0040170E   imul        edx,esi
00401711   mov         esi,edx
00401713   mov         eax,ecx
00401715   add         eax,1
0040171A   mov         ecx,eax
0040171C   jmp         MAIN$SLIDESOLVE+45Fh (004016ed)
0040171E   mov         eax,esi
00401720   cmp         eax,0
00401725   jge         MAIN$SLIDESOLVE+49Bh (00401729)
00401727   neg         eax
00401729   mov         edx,10549h
0040172E   mov         dword ptr [ebp-54h],edx
00401731   cdq
00401732   idiv        eax,dword ptr [ebp-54h]
00401735   mov         eax,edx
00401737   mov         dword ptr [H (00473714)],eax
60:         write (6,*) H,bored


package main

import "fmt"

var (
    Nr = [16]int{3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3}
    Nc = [16]int{3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2}
)

var (
    n, _n      int
    N0, N3, N4 [85]int
    N2         [85]uint64
)

const (
    i = 1
    g = 8
    e = 2
    l = 4
)

func fY() bool {
    if N2[n] == 0x123456789abcdef0 {
        return true
    }
    if N4[n] <= _n {
        return fN()
    }
    return false
}

func fZ(w int) bool {
    if w&i > 0 {
        fI()
        if fY() {
            return true
        }
        n--
    }
    if w&g > 0 {
        fG()
        if fY() {
            return true
        }
        n--
    }
    if w&e > 0 {
        fE()
        if fY() {
            return true
        }
        n--
    }
    if w&l > 0 {
        fL()
        if fY() {
            return true
        }
        n--
    }
    return false
}

func fN() bool {
    switch N0[n] {
    case 0:
        switch N3[n] {
        case 'l':
            return fZ(i)
        case 'u':
            return fZ(e)
        default:
            return fZ(i + e)
        }
    case 3:
        switch N3[n] {
        case 'r':
            return fZ(i)
        case 'u':
            return fZ(l)
        default:
            return fZ(i + l)
        }
    case 1, 2:
        switch N3[n] {
        case 'l':
            return fZ(i + l)
        case 'r':
            return fZ(i + e)
        case 'u':
            return fZ(e + l)
        default:
            return fZ(l + e + i)
        }
    case 12:
        switch N3[n] {
        case 'l':
            return fZ(g)
        case 'd':
            return fZ(e)
        default:
            return fZ(e + g)
        }
    case 15:
        switch N3[n] {
        case 'r':
            return fZ(g)
        case 'd':
            return fZ(l)
        default:
            return fZ(g + l)
        }
    case 13, 14:
        switch N3[n] {
        case 'l':
            return fZ(g + l)
        case 'r':
            return fZ(e + g)
        case 'd':
            return fZ(e + l)
        default:
            return fZ(g + e + l)
        }
    case 4, 8:
        switch N3[n] {
        case 'l':
            return fZ(i + g)
        case 'u':
            return fZ(g + e)
        case 'd':
            return fZ(i + e)
        default:
            return fZ(i + g + e)
        }
    case 7, 11:
        switch N3[n] {
        case 'd':
            return fZ(i + l)
        case 'u':
            return fZ(g + l)
        case 'r':
            return fZ(i + g)
        default:
            return fZ(i + g + l)
        }
    default:
        switch N3[n] {
        case 'd':
            return fZ(i + e + l)
        case 'l':
            return fZ(i + g + l)
        case 'r':
            return fZ(i + g + e)
        case 'u':
            return fZ(g + e + l)
        default:
            return fZ(i + g + e + l)
        }
    }
}

func fI() {
    g := (11 - N0[n]) * 4
    a := N2[n] & uint64(15<<uint(g))
    N0[n+1] = N0[n] + 4
    N2[n+1] = N2[n] - a + (a << 16)
    N3[n+1] = 'd'
    N4[n+1] = N4[n]
    cond := Nr[a>>uint(g)] <= N0[n]/4
    if !cond {
        N4[n+1]++
    }
    n++
}

func fG() {
    g := (19 - N0[n]) * 4
    a := N2[n] & uint64(15<<uint(g))
    N0[n+1] = N0[n] - 4
    N2[n+1] = N2[n] - a + (a >> 16)
    N3[n+1] = 'u'
    N4[n+1] = N4[n]
    cond := Nr[a>>uint(g)] >= N0[n]/4
    if !cond {
        N4[n+1]++
    }
    n++
}

func fE() {
    g := (14 - N0[n]) * 4
    a := N2[n] & uint64(15<<uint(g))
    N0[n+1] = N0[n] + 1
    N2[n+1] = N2[n] - a + (a << 4)
    N3[n+1] = 'r'
    N4[n+1] = N4[n]
    cond := Nc[a>>uint(g)] <= N0[n]%4
    if !cond {
        N4[n+1]++
    }
    n++
}

func fL() {
    g := (16 - N0[n]) * 4
    a := N2[n] & uint64(15<<uint(g))
    N0[n+1] = N0[n] - 1
    N2[n+1] = N2[n] - a + (a >> 4)
    N3[n+1] = 'l'
    N4[n+1] = N4[n]
    cond := Nc[a>>uint(g)] >= N0[n]%4
    if !cond {
        N4[n+1]++
    }
    n++
}

func fifteenSolver(n int, g uint64) {
    N0[0] = n
    N2[0] = g
    N4[0] = 0
}

func solve() {
    if fN() {
        fmt.Print("Solution found in ", n, " moves: ")
        for g := 1; g <= n; g++ {
            fmt.Printf("%c", N3[g])
        }
        fmt.Println()
    } else {
        n = 0
        _n++
        solve()
    }
}

func main() {
    fifteenSolver(8, 0xfe169b4c0a73d852)
    solve()
}


const Nr = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
const Nc = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]

const N0 = zeros(Int, 85)
const N2 = zeros(UInt64, 85)
const N3 = zeros(UInt8, 85)
const N4 = zeros(Int, 85)
const i = 1
const g = 8
const ee = 2
const l = 4
const _n = Vector{Int32}([0])

function fY(n::Int)
    if N2[n + 1] == UInt64(0x123456789abcdef0)
        return true, n
    end
    if N4[n + 1] <= _n[1]
        return fN(n)
    end
    false, n
end

function fZ(w, n)
    if w & i > 0
        n = fI(n)
        (y, n) = fY(n)
        if y return (true, n) end
        n -= 1
    end
    if w & g > 0
        n = fG(n)
        (y, n) = fY(n)
        if y return (true, n) end
        n -= 1
    end
    if w & ee > 0
        n = fE(n)
        (y, n) = fY(n)
        if y return (true, n) end
        n -= 1
    end
    if w & l > 0
        n = fL(n)
        (y, n) = fY(n)
        if y return (true, n) end
        n -= 1
    end
    false, n
end

function fN(n::Int)
    x = N0[n + 1]
    y = UInt8(N3[n + 1])
    if x == 0
        if y == UInt8('l')
            return fZ(i, n)
        elseif y == UInt8('u')
            return fZ(ee, n)
        else
            return fZ(i + ee, n)
        end
    elseif x == 3
        if y == UInt8('r')
            return fZ(i, n)
        elseif y == UInt8('u')
            return fZ(l, n)
        else
            return fZ(i + l, n)
        end
    elseif x == 1 || x == 2
        if y == UInt8('l')
            return fZ(i + l, n)
        elseif y == UInt8('r')
            return fZ(i + ee, n)
        elseif y == UInt8('u')
            return fZ(ee + l, n)
        else
            return fZ(l + ee + i, n)
        end
    elseif x == 12
        if y == UInt8('l')
            return fZ(g, n)
        elseif y == UInt8('d')
            return fZ(ee, n)
        else
            return fZ(ee + g, n)
        end
    elseif x == 15
        if y == UInt8('r')
            return fZ(g, n)
        elseif y == UInt8('d')
            return fZ(l, n)
        else
            return fZ(g + l, n)
        end
    elseif x == 13 || x == 14
        if y == UInt8('l')
            return fZ(g + l, n)
        elseif y == UInt8('r')
            return fZ(ee + g, n)
        elseif y == UInt8('d')
            return fZ(ee + l, n)
        else
            return fZ(g + ee + l, n)
        end
    elseif x == 4 || x == 8
        if y == UInt8('l')
            return fZ(i + g, n)
        elseif y == UInt8('u')
            return fZ(g + ee, n)
        elseif y == UInt8('d')
            return fZ(i + ee, n)
        else
            return fZ(i + g + ee, n)
        end
    elseif x == 7 || x == 11
        if y == UInt8('d')
            return fZ(i + l, n)
        elseif y == UInt8('u')
            return fZ(g + l, n)
        elseif y == UInt8('r')
                return fZ(i + g, n)
        else
            return fZ(i + g + l, n)
        end
    else
        if y == UInt8('d')
            return fZ(i + ee + l, n)
        elseif y == UInt8('l')
                return fZ(i + g + l, n)
        elseif y == UInt8('r')
            return fZ(i + g + ee, n)
        elseif y == UInt8('u')
            return fZ(g + ee + l, n)
        else
            return fZ(i + g + ee + l, n)
        end
    end
end

function fI(n)
    gg = (11 - N0[n + 1]) * 4
    a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
    N0[n + 2] = N0[n + 1] + 4
    N2[n + 2] = N2[n + 1] - a + (a << 16)
    N3[n + 2] = UInt8('d')
    N4[n + 2] = N4[n + 1]
    cond = Nr[(a >> gg) + 1] <= div(N0[n + 1], 4)
    if !cond
        N4[n + 2] += 1
    end
    n += 1
    n
end

function fG(n)
    gg = (19 - N0[n + 1]) * 4
    a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
    N0[n + 2] = N0[n + 1] - 4
    N2[n + 2] = N2[n + 1] - a + (a >> 16)
    N3[n + 2] = UInt8('u')
    N4[n + 2] = N4[n + 1]
    cond = Nr[(a >> gg) + 1] >= div(N0[n + 1], 4)
    if !cond
        N4[n + 2] += 1
    end
    n += 1
    n
end

function fE(n)
    gg = (14 - N0[n + 1]) * 4
    a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
    N0[n + 2] = N0[n + 1] + 1
    N2[n + 2] = N2[n + 1] - a + (a << 4)
    N3[n + 2] = UInt8('r')
    N4[n + 2] = N4[n + 1]
    cond = Nc[(a >> gg) + 1] <= N0[n + 1] % 4
    if !cond
        N4[n + 2] += 1
    end
    n += 1
    n
end

function fL(n)
    gg = (16 - N0[n + 1]) * 4
    a = N2[n + 1] & (UInt64(0xf) << UInt(gg))
    N0[n + 2] = N0[n + 1] - 1
    N2[n + 2] = N2[n + 1] - a + (a >> 4)
    N3[n + 2] = UInt8('l')
    N4[n + 2] = N4[n + 1]
    cond = Nc[(a >> gg) + 1] >= N0[n + 1] % 4
    if !cond
        N4[n + 2] += 1
    end
    n += 1
    n
end

function solve(n)
    ans, n = fN(n)
    if ans
        println("Solution found in $n moves: ")
        for ch in N3[2:n+1] print(Char(ch)) end; println()
    else
        println("next iteration, _n[1] will be $(_n[1] + 1)...")
        n = 0; _n[1] += 1; solve(n)
    end
end

run() = (N0[1] = 8; _n[1] = 1; N2[1] = 0xfe169b4c0a73d852; solve(0))
run()


#!/usr/bin/lua
--[[
Solve 3X3 sliding tile puzzle using Astar on Lua. Requires 3mb and
millions of recursions.
by RMM  2020-may-1
]]--

local SOLUTION_LIMIT, MAX_F_VALUE = 100,100
local NR, NC, RCSIZE  = 4,4,4*4
local Up, Down, Right, Left = 'u','d','r','l'
local G_cols = {}  -- goal columns
local G_rows = {} -- goal rows
local C_cols = {} -- current cols
local C_rows = {} -- current rows
local Goal = {}
local Tiles = {}		-- the puzzle
local Solution = {}		-- final path is instance of desc
local desc  = {}		-- descending path
desc[0] = 0 -- override Lua default "1" index

-- @brief create C compatible array for Lua
local function Amake( list )
   array = {}
   for i=0, #list do
      array[i] = list[i+1] -- simulate "C" array in Lua
   end
   return array
end

G_cols= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
G_rows= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
C_cols= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
C_rows= Amake({0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, } )
Tiles = Amake({ 15,14,1,6,  9,11,4,12,  0,10,7,3, 13,8,5,2,} )
Goal  = Amake({1,2,3,4, 5,6,7,8, 9,10,11,12, 13,14,15,0,} )

local m1 = {recursions=0, found=0, threshold=0, times=0, steps=0,}
-- ---------------------------------------------------------------
-- return 1D array index given 2D row,column
local function rcidx( row, col )
   return (row * NR + col)
end

-- @brief recursive search
-- @return f_score
local function search( depth, x_row, x_col, h_score)
   local move, go_back_move, last_move_by_current
   local f_score, ix, min, temp, hscore2, idx1
   local N_minus_one = NR - 1;
   local rc1 = {row=0,col=0}
   local rc2 = {row=0,col=0}
   local gtmp = {row=0,col=0}

   f_score = depth + h_score;
   if f_score > m1.threshold then  return f_score end
   if h_score == 0 then do
      m1.found = 1
      Solution = table.concat(desc)
      return f_score  end end

   m1.recursions = m1.recursions+1
   m1.times = m1.times + 1
   if m1.times > 200000 then do
	 print("Recursions ",m1.recursions)
	 m1.times = 0
   end  end

   min = 999999
   last_move_by_current = desc[depth];
   rc1.row = x_row;
   rc1.col = x_col;
   for ix = 0,3 do
      if ix==0 then do
	    move = Up;
	    go_back_move = Down;
	    rc2.row = x_row - 1;
	    rc2.col = x_col;
		   end
      elseif ix==1 then do
	    move = Down;
	    go_back_move = Up;
	    rc2.row = x_row + 1;
	    rc2.col = x_col;
		       end
      elseif ix==2 then do
	    move = Left;
	    go_back_move = Right;
	    rc2.row = x_row;
	    rc2.col = x_col - 1;
		       end
      elseif ix==3 then do
	    move = Right;
	    go_back_move = Left;
	    rc2.row = x_row;
	    rc2.col = x_col + 1;
			end end
      if move==Up and x_row==0 then goto next end
      if move==Down and x_row==N_minus_one then goto next end
      if move==Left and x_col==0 then goto next end
      if move==Right and x_col==N_minus_one then goto next end
      if last_move_by_current==go_back_move then goto next end
      hscore2 = h_score
      idx1 = Tiles[rcidx(rc2.row,rc2.col)]
      gtmp.row = G_rows[idx1]
      gtmp.col = G_cols[idx1]
      local h_adj=0
      if go_back_move==Up then do
	    if gtmp.row < C_rows[idx1] then
	       h_adj = -1 else h_adj = 1 end end
      end
      if go_back_move==Down then do
	    if gtmp.row > C_rows[idx1] then
	       h_adj = -1 else h_adj = 1 end end
      end
      if go_back_move==Left then do
	    if gtmp.col < C_cols[idx1] then
	       h_adj = -1 else h_adj = 1 end end
      end
      if go_back_move==Right then do
	    if gtmp.col > C_cols[idx1] then
	       h_adj = -1 else h_adj = 1 end end
      end
      hscore2 = hscore2 + h_adj
      C_rows[0] = rc2.row;
      C_cols[0] = rc2.col;
      C_rows[idx1] = rc1.row;
      C_cols[idx1] = rc1.col;
      Tiles[rcidx(rc1.row,rc1.col)] = idx1;
      Tiles[rcidx(rc2.row,rc2.col)] = 0;
      desc[depth+1] = move
      desc[depth+2] = '\0'

      temp = search(depth+1, rc2.row, rc2.col, hscore2); -- descend
      -- regress
      Tiles[rcidx(rc1.row,rc1.col)] = 0
      Tiles[rcidx(rc2.row,rc2.col)] = idx1
      desc[depth+1] = '\0'
      C_rows[0] = rc1.row;
      C_cols[0] = rc1.col;
      C_rows[idx1] = rc2.row;
      C_cols[idx1] = rc2.col;
      if m1.found == 1 then return temp end
      if temp < min then  min = temp end
      ::next::  -- Lua does not have "continue;" so uses goto
   end  -- end for
   m1.found = 0;
   -- return the minimum f_score greater than m1.threshold
   return min;
end

-- @brief  Run solver using A-star algorithm
-- @param Tiles .. 3X3 sliding tile puzzle
local function solve(Tiles)
    local temp, i,j
    local x_row, x_col, h_score = 0,0,0

    m1.found = 0;
    for i=0,(NR-1) do
       for j=0, (NC-1) do
	  G_rows[ Goal[rcidx(i,j)] ] = i;
	  G_cols[ Goal[rcidx(i,j)] ] = j;
	  C_rows[ Tiles[rcidx(i,j)] ] = i;
	  C_cols[ Tiles[rcidx(i,j)] ] = j;
       end
    end

    for i=0,(NR-1) do
       for j=0, (NC-1) do
	  if Tiles[rcidx(i,j)] == 0 then do
		x_row = i;
		x_col = j;
		break;
					 end
	  end
       end
    end

   desc[0] = '$'
   desc[1] = '\0'

   h_score = 0;   -- Manhattan/Taxicab heuristic
   for  i = 1,(RCSIZE-1) do
      h_score = h_score + (math.abs(C_rows[i] - G_rows[i]) +
		    math.abs(C_cols[i] - G_cols[i]))
   end
   m1.threshold = h_score
   print("solve -> search")
   while true do
      temp = search( 0, x_row, x_col, h_score);
      if m1.found == 1 then do
	    print("Gound solution of length",#Solution-1)
	    print(Solution)
	    break;
      end end

      if temp > MAX_F_VALUE then do
	    print("Maximum f value reached! terminating! \n");
	    break;	 end
      end
      m1.threshold = temp;
   end -- while
   return 0
end

-- show sliding tile puzzle rows and columns
local function print_tiles( pt)
   local i,j,num
    for i=0,(NR-1) do
       for j=0, (NC-1) do
	  num = pt[rcidx(i,j)]
	  io.write(string.format("%02d ", num))
       end
       print("")
    end
    print("")
end

-- main(void) {
print("Solve sliding 15 tile puzzle");
m1.recursions = 0
m1.times=0
print_tiles(Tiles);
print_tiles(Goal)
solve(Tiles);


unit FifteenSolverT;
\\ Solve 15 Puzzle. Nigel Galloway; February 1st., 2019.
interface
type TN=record n:UInt64; i,g,e,l:shortint; end;
type TG=record found:boolean; path:array[0..99] of TN; end;
function solve15(const board : UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
const endPos:UInt64=$123456789abcdef0;
implementation
const N:array[0..15] of shortint=(3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3);
const I:array[0..15] of shortint=(3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2);
const G:array[0..15] of shortint=(5,13,13,9,7,15,15,11,7,15,15,11,6,14,14,10);
const E:array[0..15] of shortint=(0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4);
const L:array[0..4 ] of shortint=(0,11,19,14,16);
function solve15(const board:UInt64; const bPos:shortint; const d:shortint; const ng:shortint):TG;
var path:TG; P:^TN; Q:^TN; _g:shortint; _n:UInt64;
begin P:=@path.path; P^.n:=board; P^.i:=0; P^.g:=0; P^.e:=ng; P^.l:=bPos;
  while true do begin
    if P<@path.path then begin path.found:=false; exit(path); end;
    if P^.n=endPos  then begin path.found:=true; exit(path); end;
    if (P^.e=0) or (P^.i>d) then begin P-=1; continue; end else begin Q:=P+1; Q^.g:=E[P^.e]; end;
    Q^.i:=P^.i; _g:=(L[Q^.g]-P^.l)*4; _n:=P^.n and (UInt64($F)<<_g);
    case Q^.g of
      1:begin Q^.l:=P^.l+4; Q^.e:=G[Q^.l]-2; P^.e-=1; Q^.n:=P^.n-_n+(_n<<16); if N[_n>>_g]>=(Q^.l div 4) then Q^.i+=1; end;
      2:begin Q^.l:=P^.l-4; Q^.e:=G[Q^.l]-1; P^.e-=2; Q^.n:=P^.n-_n+(_n>>16); if N[_n>>_g]<=(Q^.l div 4) then Q^.i+=1; end;
      3:begin Q^.l:=P^.l+1; Q^.e:=G[Q^.l]-8; P^.e-=4; Q^.n:=P^.n-_n+(_n<< 4); if I[_n>>_g]>=(Q^.l mod 4) then Q^.i+=1; end;
      4:begin Q^.l:=P^.l-1; Q^.e:=G[Q^.l]-4; P^.e-=8; Q^.n:=P^.n-_n+(_n>> 4); if I[_n>>_g]<=(Q^.l mod 4) then Q^.i+=1; end;
    end;
    P+=1;
  end;
end;
end.


import planner.

main =>
    init(InitS),
    goal(GoalS),
    best_plan((InitS,GoalS),Plan),
    println(Plan).

init(InitS) =>
    M = {{15, 14, 1,  6},
         {9 , 11, 4, 12},
         {0,  10, 7,  3},
         {13,  8, 5,  2}},
    InitS = [(R,C) : T in 0..15, pos(M,T,R,C)].

goal(GoalS) =>
    M = {{1,  2,  3,  4},
         {5,  6,  7,  8},
         {9, 10, 11, 12},
         {13,14, 15,  0}},
    GoalS = [(R,C) : T in 0..15, pos(M,T,R,C)].

pos(M,T,R,C) =>
    N = len(M),
    between(1,N,R),
    between(1,N,C),
    M[R,C] == T,!.

final((S,GoalS)) => S == GoalS.

action((S,GoalS),NextS,Action,Cost) =>
    S = [P0|Tiles],
    P0 = (R0,C0),
    Cost = 1,
    (R1 = R0-1, R1 >= 1, C1 = C0, Action = u;
     R1 = R0+1, R1 =< 4, C1 = C0, Action = d;
     R1 = R0, C1 = C0-1, C1 >= 1, Action = l;
     R1 = R0, C1 = C0+1, C1 =< 4, Action = r),
    P1 = (R1,C1),
    slide(P0,P1,Tiles,Tiles1),
    S1 = [P1|Tiles1],
    NextS = (S1,GoalS).

% slide the tile at P1 to the empty square at P0
slide(P0,P1,[P1|Tiles],Tiles1) =>
    Tiles1 = [P0|Tiles].
slide(P0,P1,[Tile|Tiles],Tiles1) =>
    Tiles1=[Tile|Tiles1R],
    slide(P0,P1,Tiles,Tiles1R).

% called by the planner
heuristic((S,GoalS)) = Dist =>
    S = [_|Tiles],
    GoalS = [_|FTiles],
    Dist = sum([abs(R-FR)+abs(C-FC) :
                {(R,C),(FR,FC)} in zip(Tiles,FTiles)]).


-- demo\rosetta\Solve15puzzle.exw
constant STM = 0    -- single-tile metrics.
constant MTM = 0    -- multi-tile metrics.
if STM and MTM then ?9/0 end if -- both prohibited
--  0       0   -- fastest, but non-optimal
--  1       0   -- optimal in STM
--  0       1   -- optimal in MTM (slowest by far)

--Note: The fast method uses an inadmissible heuristic - see "not STM" in iddfs().
--      It explores mtm-style using the higher stm heuristic and may therefore
--      fail badly in some cases.

constant SIZE = 4

constant goal = { 1, 2, 3, 4,
                  5, 6, 7, 8,
                  9,10,11,12,
                 13,14,15, 0}

--
-- multi-tile-metric walking distance heuristic lookup (mmwd).
-- ==========================================================
-- Uses patterns of counts of tiles in/from row/col, eg the solved state
--  (ie goal above) could be represented by the following:
--      {{4,0,0,0},
--       {0,4,0,0},
--       {0,0,4,0},
--       {0,0,0,3}}
--  ie row/col 1 contains 4 tiles from col/row 1, etc. In this case
--  both are identical, but you can count row/col or col/row, and then
--  add them together. There are up to 24964 possible patterns. The
--  blank space is not counted. Note that a vertical move cannot change
--  a vertical pattern, ditto horizontal, and basic symmetry means that
--  row/col and col/row patterns will match (at least, that is, if they
--  are calculated sympathetically), halving the setup cost.
-- The data is just the number of moves made before this pattern was
--  first encountered, in a breadth-first search, backwards from the
--  goal state, until all patterns have been enumerated.
-- (The same ideas/vars are now also used for stm metrics when MTM=0)
--
sequence wdkey              -- one such 4x4 pattern
constant mmwd = new_dict()  -- lookup table, data is walking distance.

--
-- We use two to-do lists: todo is the current list, and everything
-- of walkingdistance+1 ends up on tdnx. Once todo is exhausted, we
-- swap the dictionary-ids, so tdnx automatically becomes empty.
-- Key is an mmwd pattern as above, and data is {distance,space_idx}.
--
integer todo = new_dict()
integer tdnx = new_dict()

--

enum UP = 1, DOWN = -1

procedure explore(integer space_idx, walking_distance, direction)
--
--  Given a space index, explore all the possible moves in direction,
--  setting the distance and extending the tdnx table.
--
integer tile_idx = space_idx+direction
    for group=1 to SIZE do
        if wdkey[tile_idx][group] then
            -- ie: check row tile_idx for tiles belonging to rows 1..4
            -- Swap one of those tiles with the space
            wdkey[tile_idx][group] -= 1
            wdkey[space_idx][group] += 1

            if getd_index(wdkey,mmwd)=0 then
                -- save the walking distance value
                setd(wdkey,walking_distance+1,mmwd)
                -- and add to the todo next list:
                if getd_index(wdkey,tdnx)!=0 then ?9/0 end if
                setd(wdkey,{walking_distance+1,tile_idx},tdnx)
            end if

if MTM then
            if tile_idx>1 and tile_idx<SIZE then
                -- mtm: same direction means same distance:
                explore(tile_idx, walking_distance, direction)
            end if
end if

            -- Revert the swap so we can look at the next candidate.
            wdkey[tile_idx][group] += 1
            wdkey[space_idx][group] -= 1
        end if
    end for
end procedure

procedure generate_mmwd()
-- Perform a breadth-first search begining with the solved puzzle state
--  and exploring from there until no more new patterns emerge.
integer walking_distance = 0, space = 4

    wdkey = {{4,0,0,0}, -- \
             {0,4,0,0}, --  } 4 tiles in correct row positions
             {0,0,4,0}, -- /
             {0,0,0,3}} --    3 tiles in correct row position
    setd(wdkey,walking_distance,mmwd)
    while 1 do
        if space<4 then explore(space, walking_distance, UP)    end if
        if space>1 then explore(space, walking_distance, DOWN) end if
        if dict_size(todo)=0 then
            if dict_size(tdnx)=0 then exit end if
            {todo,tdnx} = {tdnx,todo}
        end if
        wdkey = getd_partial_key(0,todo)
        {walking_distance,space} = getd(wdkey,todo)
        deld(wdkey,todo)
    end while
end procedure

function walking_distance(sequence puzzle)
sequence rkey = repeat(repeat(0,SIZE),SIZE),
         ckey = repeat(repeat(0,SIZE),SIZE)
    integer k = 1
    for i=1 to SIZE do  -- rows
        for j=1 to SIZE do  -- columns
            integer tile = puzzle[k


T Puzzle
   position = 0
   [Int = String] items

   F main_frame()
      V& d = .items
      print(‘+-----+-----+-----+-----+’)
      print(‘|#.|#.|#.|#.|’.format(d[1], d[2], d[3], d[4]))
      print(‘+-----+-----+-----+-----+’)
      print(‘|#.|#.|#.|#.|’.format(d[5], d[6], d[7], d[8]))
      print(‘+-----+-----+-----+-----+’)
      print(‘|#.|#.|#.|#.|’.format(d[9], d[10], d[11], d[12]))
      print(‘+-----+-----+-----+-----+’)
      print(‘|#.|#.|#.|#.|’.format(d[13], d[14], d[15], d[16]))
      print(‘+-----+-----+-----+-----+’)

   F format(=ch)
      ch = ch.trim(‘ ’)
      I ch.len == 1
         R ‘  ’ch‘  ’
      E I ch.len == 2
         R ‘  ’ch‘ ’
      E
         assert(ch.empty)
         R ‘     ’

   F change(=to)
      V fro = .position
      L(a, b) .items
         I b == .format(String(to))
            to = a
            L.break
      swap(&.items[fro], &.items[to])
      .position = to

   F build_board(difficulty)
      L(i) 1..16
         .items[i] = .format(String(i))
      V tmp = 0
      L(a, b) .items
         I b == ‘  16 ’
            .items[a] = ‘     ’
            tmp = a
            L.break
      .position = tmp
      Int diff
      I difficulty == 0
         diff = 10
      E I difficulty == 1
         diff = 50
      E
         diff = 100
      L 0 .< diff
         V lst = .valid_moves()
         [Int] lst1
         L(j) lst
            lst1.append(Int(j.trim(‘ ’)))
         .change(lst1[random:(lst1.len)])

   F valid_moves()
      V pos = .position
      I pos C [6, 7, 10, 11]
         R [.items[pos - 4], .items[pos - 1], .items[pos + 1], .items[pos + 4]]
      E I pos C [5, 9]
         R [.items[pos - 4], .items[pos + 4], .items[pos + 1]]
      E I pos C [8, 12]
         R [.items[pos - 4], .items[pos + 4], .items[pos - 1]]
      E I pos C [2, 3]
         R [.items[pos - 1], .items[pos + 1], .items[pos + 4]]
      E I pos C [14, 15]
         R [.items[pos - 1], .items[pos + 1], .items[pos - 4]]
      E I pos == 1
         R [.items[pos + 1], .items[pos + 4]]
      E I pos == 4
         R [.items[pos - 1], .items[pos + 4]]
      E I pos == 13
         R [.items[pos + 1], .items[pos - 4]]
      E
         assert(pos == 16)
         R [.items[pos - 1], .items[pos - 4]]

   F game_over()
      V flag = 0B
      L(a, b) .items
         I b != ‘     ’
            I a == Int(b.trim(‘ ’))
               flag = 1B
            E
               flag = 0B
      R flag

V g = Puzzle()
g.build_board(Int(input("Enter the difficulty : 0 1 2\n2 => highest 0 => lowest\n")))
g.main_frame()
print(‘Enter 0 to exit’)
L
   print("Hello user:\nTo change the position just enter the no. near it")
   V lst = g.valid_moves()
   [Int] lst1
   L(i) lst
      lst1.append(Int(i.trim(‘ ’)))
      print(i.trim(‘ ’)" \t", end' ‘’)
   print()
   V x = Int(input())
   I x == 0
      L.break
   E I x !C lst1
      print(‘Wrong move’)
   E
      g.change(x)
   g.main_frame()
   I g.game_over()
      print(‘You WON’)
      L.break