1. Vincent Fiack
  2. ocaml-toys

Commits

vfiack  committed 30eb194

added basic bfs search, still slow with lists

  • Participants
  • Parent commits 87e9938
  • Branches default

Comments (0)

Files changed (4)

File maze/astar.ml

View file
+module Pathfinding = struct 
+  type cost = { steps: int; estimation: int; camefrom: int * int }
+  
+  type node =
+    | Unknown
+    | Closed
+    | Exploring of cost
+    | Explored of cost
+  
+  exception No_path_found
+  
+  module type ExplorationType = sig
+    val matrix : node array array
+    val heuristic : int * int -> int
+  end
+  
+  module MakeExploration = functor(E: ExplorationType) ->
+    struct
+      let matrix = E.matrix
+      let heuristic = E.heuristic
+      
+      let is_explorable maze node =
+        if not (Maze.is_passable maze node) then false
+        else match matrix.(fst node).(snd node) with
+          | Closed -> false
+          | Unknown -> true
+          | Exploring _ -> true
+          | Explored _ -> false
+      
+      let get_steps node = match matrix.(fst node).(snd node) with
+        | Exploring cost -> cost.steps
+        | Explored cost -> cost.steps
+        | Closed -> max_int
+        | Unknown -> invalid_arg "unknown node"
+      
+      let set_exploring node steps camefrom =
+        matrix.(fst node).(snd node) <- Exploring { steps = steps; estimation = steps + (heuristic node); camefrom = camefrom }
+      
+      let set_explored node = 
+        let explored = match matrix.(fst node).(snd node) with
+          | Exploring cost -> Explored cost
+          | _ -> invalid_arg ("not really explored: " ^ string_of_int (fst node) ^ ", " ^ string_of_int (snd node))
+        in 
+        matrix.(fst node).(snd node) <- explored
+
+		  let rec reconstruct_path node path =
+		    let camefrom = match matrix.(fst node).(snd node) with
+		      | Explored cost -> cost.camefrom
+		      | Exploring cost -> cost.camefrom
+		      | _ -> node
+		    in
+		    if camefrom = node then node :: path
+		    else reconstruct_path camefrom (node :: path)
+        
+    end
+  
+  module MakeOpenSet(E: ExplorationType) = Set.Make(struct
+      type t = int * int
+      let estimate node = match node with
+        | Exploring cost -> cost.estimation
+        | Explored cost -> cost.estimation
+        | Unknown -> max_int
+        | Closed -> max_int
+      
+      let compare a b =
+        let score_a = estimate E.matrix.(fst a).(snd a) in
+        let score_b = estimate E.matrix.(fst b).(snd b) in
+        let diff = score_a - score_b in
+        if diff = 0 then Pervasives.compare a b else diff
+    end)
+  
+  let find_path maze start goal =
+    let module Exploration = MakeExploration(struct 
+      let matrix = Array.make_matrix (Maze.width maze) (Maze.height maze) Unknown 
+      let heuristic = Maze.distance goal 
+      end)
+    in 
+    let module OpenSet = MakeOpenSet(Exploration) in
+    let openset = ref (OpenSet.singleton start) in
+    let select_best set = OpenSet.min_elt set in
+    Exploration.set_exploring start 0 start;
+    let rec loop () =
+      if OpenSet.is_empty !openset then raise No_path_found
+      else
+        let current = select_best !openset in
+        if current = goal then List.rev (Exploration.reconstruct_path goal [])
+        else begin
+          openset := OpenSet.remove current !openset;
+          Exploration.set_explored current;
+          
+          let neighbors = Maze.neighbor_nodes maze current in
+          let explore node =
+            if Exploration.is_explorable maze node then
+              let tentative_steps = (Exploration.get_steps current) + 1 in
+              if not (OpenSet.mem node !openset) then begin
+                Exploration.set_exploring node tentative_steps current;
+                openset := OpenSet.add node !openset;
+              end
+              else if tentative_steps < (Exploration.get_steps node) then Exploration.set_exploring node tentative_steps current
+          in
+          List.iter explore neighbors;
+          loop ()
+        end
+    in
+    loop () 
+end
+
+let sample =
+  "@    ####               #####\n" ^
+  "   #          ######### #####\n" ^
+  "##  ######### ##           ##\n" ^
+  "#   ######### ## ######### ##\n" ^
+  "# ########### ## ######### ##\n" ^
+  "#                #######    X\n" ^
+  "############## ########  ####\n" ^
+  "##############          #####"
+
+let () =
+  let maze, goal, ants = Maze.Parser.from_file "maze/maze.txt" in
+  let start = List.hd ants in
+  let before = Unix.gettimeofday () in
+  let path = Pathfinding.find_path maze start goal in
+  
+  for i = 0 to 1_000 do
+    ignore (Pathfinding.find_path maze start goal)
+  done;
+  
+  let after = Unix.gettimeofday () in
+  Maze.walk maze (List.rev path);
+  Maze.draw maze;
+  Printf.printf "%d steps\n" (List.length path);
+  let time = (after -. before) *. 1000. in
+  Printf.printf "%f ms\n" time

File maze/bfs.ml

View file
+module Pathfinding = struct
+    exception No_path_found
+
+  let build_path maze current visited = 
+    let rec loop current nodes path =  match nodes with
+      | [] ->  path
+      | (node, cost)::lst -> 
+        if Maze.get maze node <> '@' && cost = (snd current) - 1 
+          && Maze.distance node (fst current) = 1 
+          then loop (node, cost) lst (node::path)
+        else loop current lst path       
+    in    
+    loop current (List.rev visited) []
+    
+  
+  let find_path maze (goal:int*int) ants = 
+    let root = (goal, 0) in
+    let rec loop queue visited = 
+      if queue = [] then raise No_path_found;
+      let current = List.hd queue and queue = List.tl queue in
+      let tile = Maze.get maze (fst current) in
+      match tile with
+        | '@' -> build_path maze current visited
+        | '#' -> loop queue visited
+        | _ -> 
+          let incr_cost node = node, (snd current) + 1 in
+          let not_visited node = not (List.mem node visited) in
+          let neighbors = List.map incr_cost (Maze.neighbor_nodes maze (fst current)) in
+          let new_neighbors = List.filter not_visited neighbors in
+          loop (queue @ new_neighbors) (visited @ new_neighbors)
+    in
+    loop [root] [root]
+end
+
+let sample =
+  "    @####          @    #####\n" ^
+  "@  #          ######### #####\n" ^
+  "##  #########@##    @      ##\n" ^
+  "#   ######### ## ######### ##\n" ^
+  "# ########### ## ### ##### ##\n" ^
+  "#@                X  ### @   \n" ^
+  "############## ##### ##  ####\n" ^
+  "##############          #####"
+
+let () =
+  let maze, goal, ants = Maze.Parser.from_string sample in
+  let before = Unix.gettimeofday () in
+  let path = Pathfinding.find_path maze goal ants in
+  
+  for i = 0 to 1_000 do
+    ignore (Pathfinding.find_path maze goal ants)
+  done;
+  
+  let after = Unix.gettimeofday () in
+  Maze.walk maze (List.rev path);
+  Maze.draw maze;
+  Printf.printf "%d steps\n" (List.length path);
+  let time = (after -. before) *. 1000. in
+  Printf.printf "%f ms\n" time

File maze/maze.ml

View file
-module MazeParse = struct
+module Parser = struct
   let split separator s =
     let list = ref [] in
     let start = ref 0 in
     List.rev !list
   
   let from_string str =
-    let start = ref (0, 0) and goal = ref (0, 0) in
+    let ants = ref [] and goal = ref (0, 0) in
     let lines = split '\n' str in
     let height, width = List.length lines, String.length (List.hd lines) in
     let maze = Array.make_matrix width height ' ' in
     for x = 0 to width -1 do
       for y = 0 to height -1 do
         maze.(x).(y) <- (List.nth lines y).[x];
-        if maze.(x).(y) = 'S' then start := x, y
-        else if maze.(x).(y) = 'G' then goal := x, y
+        if maze.(x).(y) = '@' then ants := (x, y) :: !ants
+        else if maze.(x).(y) = 'X' then goal := x, y
       done
     done;
-    maze, !start, !goal
+    maze, !goal, !ants
   
   let from_file filename =
     let channel = open_in_bin filename in
     from_string (Buffer.contents buffer)
 end
 
-module Maze = struct
-  let width maze = Array.length maze
-  let height maze = Array.length maze.(0)
-  let get maze (x, y) = maze.(x).(y)
-  let set maze (x, y) value = maze.(x).(y) <- value
-  
-  let walk maze path =
-    let walk_once coords = set maze coords '.' in
-    List.iter walk_once path
-  
-  let draw maze =
-    for y = 0 to (height maze) -1 do
-      for x = 0 to (width maze) -1 do
-        print_char (get maze (x, y))
-      done;
-      print_newline ()
-    done
-  
-  let is_passable maze coord = get maze coord <> '#'
-  
-  let distance (x1, y1) (x2, y2) =
-    let square x = x * x in
-    let sqrt_int x = int_of_float (sqrt (float_of_int x)) in
-    sqrt_int (square (x1 - x2) + square (y1 - y2))
-  
-  let neighbor_nodes maze (x, y) =
-    let nodes = [] in
-    let nodes = if x > 0 then (x -1, y) :: nodes else nodes in
-    let nodes = if x < (width maze) - 1 then (x +1, y) :: nodes else nodes in
-    let nodes = if y > 0 then (x, y -1) :: nodes else nodes in
-    let nodes = if y < (height maze) - 1 then (x, y +1) :: nodes else nodes in
-    nodes
-end
+let width maze = Array.length maze
+let height maze = Array.length maze.(0)
+let get maze (x, y) = maze.(x).(y)
+let set maze (x, y) value = maze.(x).(y) <- value
 
-(***********************************************************)
+let walk maze path =
+  let walk_once coords = set maze coords '.' in
+  List.iter walk_once path;
+  set maze (List.hd (List.rev path)) 'X'
 
-module Pathfinding = struct 
-  type cost = { steps: int; estimation: int; camefrom: int * int }
-  
-  type node =
-    | Unknown
-    | Closed
-    | Exploring of cost
-    | Explored of cost
-  
-  exception No_path_found
-  
-  module type ExplorationType = sig
-    val matrix : node array array
-    val heuristic : int * int -> int
-  end
-  
-  module MakeExploration = functor(E: ExplorationType) ->
-    struct
-      let matrix = E.matrix
-      let heuristic = E.heuristic
-      
-      let is_explorable maze node =
-        if not (Maze.is_passable maze node) then false
-        else match matrix.(fst node).(snd node) with
-          | Closed -> false
-          | Unknown -> true
-          | Exploring _ -> true
-          | Explored _ -> false
-      
-      let get_steps node = match matrix.(fst node).(snd node) with
-        | Exploring cost -> cost.steps
-        | Explored cost -> cost.steps
-        | Closed -> max_int
-        | Unknown -> invalid_arg "unknown node"
-      
-      let set_exploring node steps camefrom =
-        matrix.(fst node).(snd node) <- Exploring { steps = steps; estimation = steps + (heuristic node); camefrom = camefrom }
-      
-      let set_explored node = 
-        let explored = match matrix.(fst node).(snd node) with
-          | Exploring cost -> Explored cost
-          | _ -> invalid_arg ("not really explored: " ^ string_of_int (fst node) ^ ", " ^ string_of_int (snd node))
-        in 
-        matrix.(fst node).(snd node) <- explored
+let draw maze =
+  for y = 0 to (height maze) -1 do
+    for x = 0 to (width maze) -1 do
+      print_char (get maze (x, y))
+    done;
+    print_newline ()
+  done
 
-		  let rec reconstruct_path node path =
-		    let camefrom = match matrix.(fst node).(snd node) with
-		      | Explored cost -> cost.camefrom
-		      | Exploring cost -> cost.camefrom
-		      | _ -> node
-		    in
-		    if camefrom = node then node :: path
-		    else reconstruct_path camefrom (node :: path)
-        
-    end
-  
-  module MakeOpenSet(E: ExplorationType) = Set.Make(struct
-      type t = int * int
-      let estimate node = match node with
-        | Exploring cost -> cost.estimation
-        | Explored cost -> cost.estimation
-        | Unknown -> max_int
-        | Closed -> max_int
-      
-      let compare a b =
-        let score_a = estimate E.matrix.(fst a).(snd a) in
-        let score_b = estimate E.matrix.(fst b).(snd b) in
-        let diff = score_a - score_b in
-        if diff = 0 then Pervasives.compare a b else diff
-    end)
-  
-  let find_path maze start goal =
-    let module Exploration = MakeExploration(struct 
-      let matrix = Array.make_matrix (Maze.width maze) (Maze.height maze) Unknown 
-      let heuristic = Maze.distance goal 
-      end)
-    in 
-    let module OpenSet = MakeOpenSet(Exploration) in
-    let openset = ref (OpenSet.singleton start) in
-    let select_best set = OpenSet.min_elt set in
-    Exploration.set_exploring start 0 start;
-    let rec loop () =
-      if OpenSet.is_empty !openset then raise No_path_found
-      else
-        let current = select_best !openset in
-        if current = goal then List.rev (Exploration.reconstruct_path goal [])
-        else begin
-          openset := OpenSet.remove current !openset;
-          Exploration.set_explored current;
-          
-          let neighbors = Maze.neighbor_nodes maze current in
-          let explore node =
-            if Exploration.is_explorable maze node then
-              let tentative_steps = (Exploration.get_steps current) + 1 in
-              if not (OpenSet.mem node !openset) then begin
-                Exploration.set_exploring node tentative_steps current;
-                openset := OpenSet.add node !openset;
-              end
-              else if tentative_steps < (Exploration.get_steps node) then Exploration.set_exploring node tentative_steps current
-          in
-          List.iter explore neighbors;
-          loop ()
-        end
-    in
-    loop () 
-end
+let is_passable maze coord = get maze coord <> '#'
 
-let sample =
-  "S    ####               #####\n" ^
-  "   #          ######### #####\n" ^
-  "##  ######### ##           ##\n" ^
-  "#   ######### ## ######### ##\n" ^
-  "# ########### ## ######### ##\n" ^
-  "#                #######    G\n" ^
-  "############## ########  ####\n" ^
-  "##############          #####"
+let distance (x1, y1) (x2, y2) =
+  let square x = x * x in
+  let sqrt_int x = int_of_float (sqrt (float_of_int x)) in
+  sqrt_int (square (x1 - x2) + square (y1 - y2))
 
-let () =
-  let maze, start, goal = MazeParse.from_file "maze/maze.txt" in
-  let before = Unix.gettimeofday () in
-  let path = Pathfinding.find_path maze start goal in
-  
-  for i = 0 to 1_000 do
-    ignore (Pathfinding.find_path maze start goal)
-  done;
-  
-  let after = Unix.gettimeofday () in
-  Maze.walk maze path;
-  Maze.draw maze;
-  Printf.printf "%d steps\n" (List.length path);
-  let time = (after -. before) *. 1000. in
-  Printf.printf "%f ms\n" time
+let neighbor_nodes maze (x, y) =
+  let nodes = [] in
+  let nodes = if x > 0 then (x -1, y) :: nodes else nodes in
+  let nodes = if x < (width maze) - 1 then (x +1, y) :: nodes else nodes in
+  let nodes = if y > 0 then (x, y -1) :: nodes else nodes in
+  let nodes = if y < (height maze) - 1 then (x, y +1) :: nodes else nodes in
+  nodes

File maze/maze.txt

View file
-S  ############################################################################
+@  ############################################################################
 ##  ###########################################################################
 ## ############################################################################
 ## ###########        ###################                ######################
 ######################################### #####################################
 #########################################                                  ####
 ########################################################################## ####
-##########################################################################    G
+##########################################################################    X