locked
Tremaux's algorithm for maze solving RRS feed

  • General discussion

  • I want to share code for solving maze which is not simple connected.

    This is link with files to run code: Tremaux's algorithm.

    I have tried to be more descriptive and guess there are parts which can be done more efficiently. Any help and comments to make better code are welcome.

    Best Regards

    Stevan Tosic


    Monday, May 18, 2020 7:07 PM

All replies

  • nice done Stevan!

    adapted ur code for SB Online and works fine except some turtle pos. errors (internal sb error)

    Sub inn
      mazeTable[1] =  "XOXXXOXXXXX"
      mazeTable[2] =  "X       X O"
      mazeTable[3] =  "X XXXXX X X"
      mazeTable[4] =  "X     X    "
      mazeTable[5] =  "XXX X X X  "
      mazeTable[6] =  "O   X     X"
      mazeTable[7] =  "X XXXXXXX X"
      mazeTable[8] =  "X X   X  OX"
      mazeTable[9] =  "X X X X XXX"
      mazeTable[10] = "X   X X   X"
      mazeTable[11] = "XXXXX XXOXX"
      _ff="False"
      _tt="true"
      csz = 40
      TextWindow.WriteLine("Trémaux's Algorithm")
      GraphicsWindow.BackgroundColor="teal"
      depthSearchLimit = 45
      initVariables()
      readTable()
      drawTable()
      initTurtle()
      GraphicsWindow.PenColor="darkgreen"
      direction = dirNorth
    EndSub
    inn()
    search()
    
    Sub initTurtle  ' **** START POSITION  ****'
      turtlePath["X"][1] = 6
      turtlePath["Y"][1] = 11
      Turtle.X = turtlePath["X"][1] * csz + csz/2
      Turtle.Y = turtlePath["Y"][1] * csz + csz/2
      Turtle.Show()
      Turtle.Speed = 10
    EndSub
    
    Sub search
      stepCounter = stepCounter + 1
      checkTarget()
      If(stepCounter <= depthSearchLimit) Then
        If(direction = dirSouth) Then
          goSouth()
          Turtle.TurnLeft()
          goEast()
          Turtle.TurnRight()
          Turtle.TurnRight()
          goWest()
          Turtle.TurnLeft()
        ElseIf(direction = dirEast) Then
          goEast()
          Turtle.TurnRight()
          goSouth()
          Turtle.TurnLeft()
          Turtle.TurnLeft()
          goNorth()
          Turtle.TurnRight()
        ElseIf(direction = dirNorth) Then
          goNorth()
          Turtle.TurnRight()
          goEast()
          Turtle.TurnLeft()
          Turtle.TurnLeft()
          goWest()
          Turtle.TurnRight()
        Else
          goWest()
          Turtle.TurnLeft()
          goSouth()
          Turtle.TurnRight()
          Turtle.TurnRight()
          goNorth()
          Turtle.TurnLeft()
        EndIf
      EndIf
      stepCounter = stepCounter - 1
      checkSearchLimit()
      returnFromDeadEnd()
    EndSub
    
    Sub checkSearchLimit
      If(stepCounter = depthSearchLimit) Then
        GraphicsWindow.ShowMessage("Counter: " + stepCounter, "Limit reached!")
      EndIf
    EndSub
    
    Sub returnFromDeadEnd
      If stepCounter > 0 Then
        Turtle.Move(-csz)
      EndIf
    EndSub
    
    Sub toFieldIfFree
      isEdge = _ff
      checkUsedField()
      checkWall()
      If(isWall = _ff And isUsedField = _ff) Then
        Turtle.Move(csz)
        addUsedFieldToPath()
        search()
      EndIf
    EndSub
    
    Sub goSouth
      direction = dirSouth
      dY = 1
      dX = 0
      isEdge =_tt
      If(turtlePath["Y"][stepCounter] + dY <= numRow) Then
        toFieldIfFree()
      EndIf
    EndSub
    
    Sub goEast
      direction = dirEast
      dX = 1
      dY = 0
      isEdge =_tt
      If (turtlePath["X"][stepCounter] + dX <= numColumn) Then
        toFieldIfFree()
      EndIf
    EndSub
    
    Sub goNorth
      direction = dirNorth
      dY = -1
      dX = 0
      isEdge =_tt
      If(turtlePath["Y"][stepCounter] + dY > 0) Then
        toFieldIfFree()
      EndIf
    EndSub
    
    Sub goWest
      direction = dirWest
      dX = -1
      dY = 0
      isEdge =_tt
      If(turtlePath["X"][stepCounter] + dX > 0) Then
        toFieldIfFree()
      EndIf
    EndSub
    
    Sub addUsedFieldToPath
      turtlePath["Y"][stepCounter + 1] = turtlePath["Y"][stepCounter] + dY
      turtlePath["X"][stepCounter + 1] = turtlePath["X"][stepCounter] + dX
    EndSub
    
    Sub checkUsedField
      isUsedField = _ff
      row = turtlePath["Y"][stepCounter] + dY
      col = turtlePath["X"][stepCounter] + dX
      
      If(tableState[row][col] = charUsedField) Then
        isUsedField = _tt
      Else
        col = turtlePath["X"][stepCounter]
        row = turtlePath["Y"][stepCounter]
        tableState[row][col] = charUsedField
      EndIf
    EndSub
    
    Sub checkWall
      isWall = _ff
      row = turtlePath["Y"][stepCounter] + dY
      col = turtlePath["X"][stepCounter] + dX
      
      If (tableState[row][col] = charWall) Then
        isWall = _tt
      EndIf
    EndSub
    
    Sub setTargetColor
      GraphicsWindow.BrushColor = colorMarkedTarget
      tx = targets["X"][i]
      ty = targets["Y"][i]
      cellTable = Shapes.AddRectangle(csz, csz)
      Shapes.Move(cellTable, tx * csz, ty * csz)
    EndSub
    
    Sub checkTarget
      For i=1 To numTarget
        If(turtlePath["X"][stepCounter] = targets["X"][i] And turtlePath["Y"][stepCounter] = targets["Y"][i]) Then
          setTargetColor()
        EndIf
      EndFor
    EndSub
    
    Sub addTargetXY
      targets["Y"][numTarget] = row
      targets["X"][numTarget] = col
    EndSub
    
    Sub readTable
      row = 1
      line = mazeTable[row]
      numTarget=0
      maxCol = 0
      
      While(row <= Array.GetItemCount(mazeTable))
        numColumn = Text.GetLength(line)
        For col=1 To numColumn
          char = Text.GetSubText(line,col,1)
          If(char = charWall) Then
            tableState[row][col] = charWall
            
          ElseIf(char = charTarget) Then
            tableState[row][col] = charTarget
            numTarget = numTarget + 1
            addTargetXY()
            
          Else
            tableState[row][col] = charFreeField
          EndIf
        EndFor
        
        If(numColumn > maxCol) Then
          maxCol = numColumn
        EndIf
        
        row = row + 1
        line = mazeTable[row]
        numRow = row - 1
      EndWhile
      numColumn = maxCol
    EndSub
    
    Sub drawTable
      For y = 1 To numRow
        For x = 1 To numColumn
          If(tableState[y][x] = charWall) Then
            GraphicsWindow.BrushColor = colorWall
            cellTable = Shapes.AddRectangle(csz, csz)
            Shapes.Move(cellTable, x * csz, y * csz)
            
          ElseIf(tableState[y][x] = charTarget) Then
            GraphicsWindow.BrushColor = colorTarget
            cellTable = Shapes.AddRectangle(csz, csz)
            Shapes.Move(cellTable, x * csz, y * csz)
            
          Else
            GraphicsWindow.BrushColor = colorFreeField
            cellTable = Shapes.AddRectangle(csz, csz)
            Shapes.Move(cellTable, x * csz, y * csz)
          EndIf
        EndFor
      EndFor
    EndSub
    
    Sub explainChangeDirection
      If isUsedField Then
        TextWindow.WriteLine(msgUsed)
      ElseIf isWall Then
        TextWindow.WriteLine(msgWall)
      Else
        TextWindow.WriteLine(msgEdge)
      EndIf
    EndSub
    
    Sub initVariables
      stepCounter = 0
      isEdge =_ff
      isWall = _ff
      isUsedField = _ff
      isFree = _tt
      dirSouth = 1
      dirEast = 2
      dirNorth = 3
      dirWest  = 4
      msgBack = "BACK"
      msgWest = "WEST"
      msgEast = "EAST"
      msgNorth = "NORTH"
      msgSouth = "SOUTH"
      msgWall = "WALL"
      msgEdge = "EDGE"
      msgUsed = "USED"
      msgTarget = "TARGET"
      msgEnd = "END"
      colorWall = "darkRed"
      colorTarget = "Green"
      colorMarkedTarget = "Yellow"
      colorFreeField = "Lavender"
      charWall = "X"
      charTarget = "O"
      charUsedField = "U"
      charFreeField =  " "
    EndSub

    Wednesday, May 20, 2020 4:36 AM
  • and works in java-sb also, with some small changes due to its internal turtle errors also

    Wednesday, May 20, 2020 5:18 AM
  • Thank you Tryhest

    Fine adaptation. I have another challenge. In practise recursive algorithm is less efficient than iterative. There is a stack ripping by recursion and should be avoided. Plan is to get a main loop free for other jobs by using iterative mechanism. For example:

      While("True")
        search()
        goSouth()
        goEast()
        goNorth()
        goWest()
        toFieldIfFree()
        anotherSub()
    EndWhile
    

    There is a technique with subroutines cooperation as above. It could be tricky task. Subroutine anotherSub() should also be iterative.

    Stevan

    Wednesday, May 20, 2020 12:30 PM
  • Hi Stevan Tosic, nice Trémaux's algorithm implementation!

    I've used following algorithms to solve maze.

    • Wall follower (right-hand rule): PNC833-12 
    • Breadth first search: ZLC681-1
    • Depth-first search: NCCG877
    • A* search: PRV488-3

    Only depth-first search uses recursive call.


    Nonki Takahashi

    Saturday, May 23, 2020 12:19 PM
  • Thank you Nonki

    Your programs are a great way to learn about algorithms of this evergreen area. There are lot of interesting features. In the meantime, I have got a version of Iterative deepening depth-first search implementation for this case but it needs a bit of tuning.

    Stevan

    Sunday, May 24, 2020 5:59 PM
  • enhanced A* search: RVQ482

    • reduced 100 lines
    • removed turtle
    • faster nodes init
    • enhanced display

    Monday, May 25, 2020 8:58 PM
  • enhanced graphmaze: KJV937

    Tuesday, May 26, 2020 6:22 AM
  • turtlemaze game: DPL393

    play with cursorkeys vs CPU

    Tuesday, May 26, 2020 6:31 AM
  • just mazedesigner for sb online:

    Init()
    
    While "True"
      GenerateMaze()
      rNode = 4
      GraphicsWindow.PenColor = "#66000000"
      GraphicsWindow.PenWidth = 1
      nRows = 0
      Program.Delay(300)
    EndWhile
    
    Sub AddWallToList
      For d = 0 To 3
        colw = col + colAdj[d]
        roww = row + rowAdj[d]
        If 1 < colw And colw < cols And 1 < roww And roww < rows And cell[roww][colw] = WALL Then
          i = colw + (roww - 1) * cols
          FindWallInList()
          If i = iFound Then 
            nWalls = nWalls - 1
            iWalls[iPrev] = iWalls[iFound]
          Else
            nWalls = nWalls + 1
            iNext = iWalls[0]
            iWalls[0] = i
            iWalls[i] = iNext
            colWall[i] = colw            
            rowWall[i] = roww
            colOpp[i] = colw + colAdj[d] 
            rowOpp[i] = roww + rowAdj[d]
            colPath[i] = col              
            rowPath[i] = row             
          EndIf
        EndIf
      EndFor
    EndSub
    
    Sub ClearMaze
      GraphicsWindow.BrushColor = "White"
      GraphicsWindow.FillRectangle(0, 0, gw, gh)
      col0 = 1  
      row0 = 1
      x = x0 + (col0 - 1) * pathw
      y = y0 + (row0 - 1) * pathh
      GraphicsWindow.BrushColor = colorPassage
      GraphicsWindow.FillRectangle(x + (wallw / 2), y + (wallw / 2), pathw - wallw, pathh - wallw)  ' start cell'
      GraphicsWindow.BrushColor = colorWall
      GraphicsWindow.FillRectangle(x0 - (wallw / 2), y0 - (wallw / 2), pathw * colsPassage + wallw, wallw)
      GraphicsWindow.FillRectangle(x0 - (wallw / 2), y0 + pathh * rowsPassage - (wallw / 2), pathw * colsPassage + wallw, wallw)
      GraphicsWindow.FillRectangle(x0 - (wallw / 2), y0 - (wallw / 2), wallw, pathh * rowsPassage + wallw)
      GraphicsWindow.FillRectangle(x0 + pathw * colsPassage - (wallw / 2), y0 - (wallw / 2), wallw, pathh * rowsPassage + wallw)
      y1 = y0 + pathh * rowsPassage
      For col = 1 To colsPassage - 1
        x = x0 + pathw * col
        GraphicsWindow.FillRectangle(x - (wallw / 2), y0 - (wallw / 2), wallw, y1 - y0)
      EndFor
      x1 = x0 + pathw * colsPassage
      For row = 1 To rowsPassage - 1
        y = y0 + pathh * row
        GraphicsWindow.FillRectangle(x0 - (wallw / 2), y - (wallw / 2), x1 - x0, wallw)
      EndFor
      For row = 1 To rows
        For col = 1 To cols
          cell[row][col] = WALL
        EndFor
      EndFor
      cell[2 * row0][2 * col0] = PASSAGE 
      nWalls = 0
      edge = ""
    EndSub
    
    Sub FindWallInList
      iFound = 0
      c = 1
      While i <> iFound And c <= nWalls
        c = c + 1
        iPrev = iFound
        iFound = iWalls[iFound]
      EndWhile
    EndSub
    
    Sub GenerateMaze
      ClearMaze()
      col = 2
      row = 2
      colw = 2
      roww = 1
      KnockDownWall()
      col = cols - 1
      row = rows - 1
      colw = cols - 1
      roww = rows
      KnockDownWall()
      col = 2 * col0
      row = 2 * row0
      AddWallToList()
      While nWalls > 0
        GetRandomIndex()
        col = colOpp[i]
        row = rowOpp[i]
        If cell[row][col] = WALL Then
          colw = colWall[i]
          roww = rowWall[i]
          RemoveWallFromList()
          cell[roww][colw] = PASSAGE  
          cell[row][col] = PASSAGE   
          colp = colPath[i] ' for graph'
          rowp = rowPath[i] ' for graph'
          node1 = (rowp / 2 - 1) * colsPassage + colp / 2 ' node # for graph'
          node2 = (row / 2 - 1) * colsPassage + col / 2 ' node # for graph'
          edge[node1][node2] = "True" 
          edge[node2][node1] = "True" 
          node1 = node2
          KnockDownWall()
          AddWallToList()
        Else
          RemoveWallFromList()
        EndIf
      EndWhile
    EndSub
    
    Sub GetRandomIndex
      i = 0
      For c = 1 To Math.GetRandomNumber(nWalls)
        i = iWalls[i]
      EndFor
    EndSub
    
    Sub Init
      gw = 598
      gh = 428
      sTL = 1
      colsPassage = 11
      rowsPassage = 7
      cols = 2 * colsPassage + 1
      rows = 2 * rowsPassage + 1
      pathw = 50    ' path width'
      pathh = 50    ' path height'
      wallw = 8     ' wall width (even number)'
      colorRoute = "Gray"
      colorWall = "#444444"
      colorPassage = "White"
      x0 = (gw - colsPassage * pathw) / 2
      y0 = (gh - rowsPassage * pathh) / 2
      colAdj [0]=1
      colAdj [1]=0
      colAdj [2]=-1
      colAdj [3]=0
      rowAdj [0]=0
      rowAdj [1]=1
      rowAdj [2]=0
      rowAdj [3]=-1
      WALL = "W"
      PASSAGE = " "
    EndSub
    
    Sub KnockDownWall
      x = x0 + (col / 2 - 1) * pathw
      y = y0 + (row / 2 - 1) * pathh
      GraphicsWindow.BrushColor = colorPassage
      GraphicsWindow.FillRectangle(x + (wallw / 2), y + (wallw / 2), pathw - wallw, pathh - wallw)
      If Math.Remainder(colw, 2) = 1 Then ' vertical wall'
        x = x0 + (colw - 1) / 2 * pathw
        y1 = y0 + (roww / 2 - 1) * pathh
        y2 = y0 + (roww / 2) * pathh
        GraphicsWindow.FillRectangle(x - (wallw / 2), y1 + (wallw / 2), wallw, pathh - wallw)
      ElseIf Math.Remainder(roww, 2) = 1 Then ' horizontal wall'
        x1 = x0 + (colw / 2 - 1) * pathw
        x2 = x0 + (colw / 2) * pathw
        y = y0 + (roww - 1) / 2 * pathh
        GraphicsWindow.FillRectangle(x1 + (wallw / 2), y - (wallw / 2), pathw - wallw, wallw)
      EndIf
    EndSub
    
    Sub RemoveWallFromList
      FindWallInList()
      If i = iFound Then 
        iWalls[iPrev] = iWalls[iFound]
        iWalls[iFound] = ""
        nWalls = nWalls - 1
      EndIf
    EndSub

    Tuesday, May 26, 2020 10:42 AM
  • This is Parallel executions of Tremaux's algorithm: DSM444.


    Tuesday, May 26, 2020 1:37 PM
  • Turtle teamwork: CFR384


    Wednesday, June 3, 2020 5:34 AM
  • small updt: CFR384-0

    • removed txt window message

    try to avoid use of txtwindow, as it covers graphic one

    Wednesday, June 3, 2020 7:43 PM
  • Thanks Tryhest

    New improved version with better code quality: SGW427

    Question is: when to publish code with new Program ID? Should I published this code as a new one (ID) or to be a version of the previous (-0, -1, ... )?

    Friday, June 5, 2020 8:29 AM
  • id publishing incremental num. is a demanding task. if u want to maintain id u must import every time last id, make changes, then publish. also it doesn't work for sb-online. the old sb-online v 0.92 had different reposit so the ids were unable for sb-desktop import
    Friday, June 5, 2020 9:12 AM