OCaml Pathfinding in Quadtree maze - ocaml

I have a quadTree type defined by that :
type 'a quadtree =
| Empty
| Leaf of 'a
| Node of 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree;;
Rooms defined by
type room = {
n : bool;
e : bool;
s : bool;
w : bool;
ps : coord;
exit : bool
}
Coordinates defined by
type coord = {
x : int;
y : int;
}
So TLDR of all that, I have a Quadtree of rooms that have or don't have exits up, down, left and right.
The objective now is to create a function that will find a way (if it exists) from one room to another (from its coordinates), the problem is that I don't see how to do it in OCaml...
Anyway, thanks for your time, have a good day.
Edit :
To clarify, I am the one defining the types and can alter them if needed.
Also, I tried implementing Dijkstra's algorithm (from Wikipedia's pseudo code), but being quite unfamiliar with both graphs, and OCaml's arrays and lists. To be precise, my problem -I think- comes from the fact that I'm not able to modify variables in a function, so for instance in Wikipedia's pseudo code, in this line:
u ← Q.extract_min() // Remove and return best vertex
I see how to remove the best vertex, and I see how to return it, but not both at the same time.
Or, here:
for each neighbor v of u: // where v is still in Q.
alt ← dist[u] + length(u, v)
if alt < dist[v]: // A shorter path to v has been found
dist[v] ← alt
prev[v] ← u
How do I modify dist and prev outside of the 'for' loop? Can I use a for loop or is it simpler / better to use a recursive function?
Also I should make clear that the maze is "directional", meaning that being able to go from room A to room B does not mean you'll be able to go from room B to room A.
Edit 2 :
I should have clarified this in the beginning, sorry :
The quadtree follows this rule :
| Node of North West * North East * South West * South East
Edit 3 :
Okay change of plan, turns out I was doing things very stupidly. I don't need to find the way to a certain room, just to an exit. So I tried this :
let rec contains_exit = function
| [] -> false
| e::l' when (getCell e.x e.y maze).exit -> true
| e::l' when (getCell e.x e.y maze).exit = false -> contains_exit l'
;;
let rec find_exit start way =
if is_exit start then
way
else
(let a = find_exit (northp start) way#[start] in
if contains_exit a then
way
else
(
let b = find_exit (eastp start) way#[start] in
if contains_exit b then
way
else
(
let c = find_exit (southp start) way#[start] in
if contains_exit c then
way
else
(
let d = find_exit (westp start) way#[start] in
if contains_exit d then
way
else
way
)
)
)
)
;;
But it gives me a stack overflow. After a bit of research, it seems that the line "contains_exit a" is never true, so the way is never returned and it loops !
Any idea why that is ? Is the problem my contains_exit function ?
Edit 4 :
Ended up doing this function :
let rec find_exit start way =
sleep 50000000;
let r = (Random.int 180) in
set_color (rgb r r r);
fill_rect (start.x * sizeCell + doorWidth * 2) (start.y * sizeCell + doorWidth * 2) (sizeCell - 4 * doorWidth) (sizeCell - 4 * doorWidth);
if is_exit start then
way#[start]
else
(let a = if (getCell start.x start.y maze).n && ((mem (northp start) way) = false) then find_exit (northp start) way#[start] else [] in
if a != [] then
a
else
(
let b = if (getCell start.x start.y maze).e && ((mem (eastp start) way) = false) then find_exit (eastp start) way#[start] else [] in
if b != [] then
b
else
(
let c = if (getCell start.x start.y maze).w && ((mem (westp start) way) = false) then find_exit (westp start) way#[start] else [] in
if c != [] then
c
else
(
let d = if (getCell start.x start.y maze).s && ((mem (southp start) way) = false) then find_exit (southp start) way#[start] else [] in
if d != [] then
d
else
[]
)
)
)
)
;;
it sometimes works... But other times it blocks and it goes from one room to the one below then up again then down again... I don't understand why !?
If you want to try the whole program, here it is : link

Then you can go for some thing like this:
type 'a quadtree =
| Empty
| Leaf of 'a
| Node of 'a * 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree;;
type room = {
n : bool;
e : bool;
s : bool;
w : bool;
ps : coord;
exit : bool
};;
type coord = {
x : int;
y : int;
};;
let rec treeForRoom(tree, room) =
match tree with
| Empty -> Empty
| Leaf l -> if l.ps == room.ps then l else Empty
| Node (r, n, e, s, w) as node ->
if r == room
then node
else
match ((r.ps.x - room.ps.x), (r.ps.y - room.ps.y)) with
| (0, n) -> if n > 0 then treeForRoom(w) else treeForRoom(e)
| (n, 0) -> if n > 0 then treeForRoom(s) else treeForRoom(n)
(* Assuming the root of the tree is the room we start from *)
let rec searchPath(tree, r) =
match tree with
| Empty -> (false, 0, [])
| Leaf l -> if l == r then (true, 0) else (false, 0, [])
| Node (r, n, e, s, w) as node ->
let pn = searchPath(n, r)
and pe = searchPath(e, r)
and ps = searchPath(s, r)
and pw = searchPath(w, r)
in
find_best_path(p1, p2, p3, p4)
let find_best_path(p1, p2, p3, p4) =
match (p1, p2, p3, p4) with
| ((false,_,_), (false,_,_), (false,_,_), (false,_,_)) -> (false, -1, [])
| ((true, w, p), (false,_,_), (false,_,_), (false,_,_)) -> (true, w, p)
| ((false,_,_), (true, w, p)), (false,_,_), (false,_,_)) -> (true, w, p)
| ((false,_,_), (false,_,_), (true, w, p)), (false,_,_)) -> (true, w, p)
| ((false,_,_), (false,_,_), (false,_,_),(true, w, p)) -> (true, w, p)
| ((p1ok, p1w, p1p), (p2ok, p2w, p2p),(p3ok, p3w, p3p),(p4ok, p4w, p4p)) ->
if p1ok && p2ok && p3ok && p4ok
then
min_weight([(p1ok, p1w, p1p), (p2ok, p2w, p2p),(p3ok, p3w, p3p),(p4ok, p4w, p4p)])
else
....
let rec min_weight(l) =
match l with
| [] -> (false, -1, [])
| [t] -> t
| [(to, tw, tp) as t::q] -> let (mo, mw, mp) as minw = min_weight(q) in
if tw < mw
then
t
else
minw
I added the root to the type definition ('a* ...) so I can make a function to find the good tree to go through. I also assume that the tree respect the following rule: (root, north room, east room, south room, west room) for each node (you can make an add function to ensure this property).
Then you go through the tree exploring from the end and getting the minimal weight path for then end to the start point. (It is the same weight as it goes through the same paths under the same conditions (cause you explore the tree from the start but compute the path from then end)).
This code does not take into account the possibility to pass through doors but it is a just a check to add as the way of going through the tree is already correctly oriented.
I let you complete and correct the code.
Hope it will help you.

Related

How to count the number of possible solutions for a sudoku board using backtracking

This is a followup of:
Need some feedback on my fold_neighbours attempt on this problem in Ocaml
I got some really good advices and applied them when i implemented this version.
This is what i have right now, the program can actually read a sudoku and solve it. Here is a demo:
Input board
530070000
600195000
098000060
800060003
400803001
700020006
060000280
000419005
000080079
Solved board
534678912
672195348
198342567
859761423
426853791
713924856
961537284
287419635
345286179
Input board
480006902
002008001
900370060
840010200
003704100
001060049
020085007
700900600
609200018
Solved board
487156932
362498751
915372864
846519273
593724186
271863549
124685397
738941625
659237418
This is the code at the moment
type vertex = int * int
type gamma = int
module V = Map.Make(struct
type t = vertex
let compare = Stdlib.compare
end)
module G = Set.Make(struct
type t = gamma
let compare = compare end)
type pc = gamma V.t
(* Help methods for coloring *)
let color v pc = V.find v pc
let color_vertex v c pc = V.update v (fun _ -> Some c) pc
let is_uncolored v pc = color v pc = 0
let allcolors = (let acc = ref G.empty
in
for gamma = 1 to 9 do
acc := G.add gamma (!acc)
done;
!acc
)
(* Reads a textfile representing sudoku *)
let ascii_digit c = Char.code c - Char.code '0'
let read_matrix_from_channel chan =
let rec loop i j grid =
match input_char chan with
| exception End_of_file -> grid
| '\n' -> loop (i+1) 0 grid
| '0'..'9' as c ->
loop i (j+1) ##
V.add (i,j) (ascii_digit c) grid
| _ -> invalid_arg "invalid input" in
loop 0 0 V.empty
let matrix_from_file file =
let chan = open_in file in
let r = read_matrix_from_channel chan in
close_in chan;
r
(* Prints a pretty sudokuboard (not used in the demo) *)
let print_board vertex =
let print_node (_x,_y) _grid =
if _y = 0
then Printf.printf "\n | ";
print_int _grid;
print_string " | "
in
V.iter print_node vertex
(*executes a function on all vertices *)
let fold_vertices f acc =
let acc' = ref acc in
for i=0 to 8 do
for j=0 to 8 do
acc' := f (i,j) (!acc')
done
done;
!acc'
let find_vertex pred =
fold_vertices
(fun v a -> match a with
| None -> if pred v then Some v else None
| _ -> a) None
(* neighbours *)
let is_neighbour (i,j) (i',j') =
if (i,j) = (i',j') then
false
else if i = i' || j = j' then
true
else
(i/3) = (i'/3) && (j/3) = (j'/3)
(* fold_neighbours *)
let fold_neighbours f v acc =
let ff u acc =
if is_neighbour u v then f u acc else acc
in fold_vertices ff acc
(* Checks if vertex is allowed *)
let allowed v pc =
fold_neighbours (fun u allowed ->
match color u pc with
| 0 -> allowed
| c -> G.remove c allowed)
v allcolors
(* Solve *)
let rec solve pc =
match find_vertex (fun v -> is_uncolored v pc) with
| Some v ->
let all = allowed v pc in
G.fold (fun c -> function
| None -> color_vertex v c pc |> solve
| opc -> opc)
all None
| None -> Some pc
Ive got a problem now, not sure how to this. I want to count all the possible solutions for a sudoku using backtracking. So i want to just return the number of solutions as a integer.
I think i somehow need to recursively call the solve method in a "nsolve" method. Return None if there are no solution, else i check that the solution isnt the same as earlier, if its not i return Some solution and counts up else i return None.
Otherwise,maybe there is some way to get the approximate number of solutions. Because i guess that for an almost empty sudoku board it will take a very long time to recursively get the number of solutions. An empty sudoku board have 10^21 solutions, which is a lot. I don't know how to tackle this issue.
I there another way of doing this?
This is the method im trying to implement([nsolve pc]):
(** [nsolve pc] uses backtracking to count the number of possible solution to the sudoku. *)
let rec nsolve pc = .....
The simplest way to do this is by brute-forcing it. In pseudo code this would be
fun nb_sol cpt i j grid =
if i > 8 /\ j > 8 then cpt + 1
else if is_empty grid(i)(j) then
for k = 1 to 9 do
grid(i)(j) <- k
if is_ok grid then
res += (if j > 8 then nb_sol cpt (i+1) 0 grid
else nb_sol cpt i (j+1) grid)
done
grid(i)(j) <- empty
I didn't check if it was exactly what you wanted but you got the idea :-)

Signature mismatch when trying to use a module in another module

I'm having a problem where I have one module trying to use another one, but I'm getting an error claiming there's a signature mismatch and I'm not certain why. I was pretty sure I was doing this right though. Here's some code:
module type ITEM =
sig
type item
val leq : item * item -> bool
val initial : item
end
module type HEAP =
sig
type item
type tree
exception InitHeap
val depth : tree -> int
val initHeap : int -> tree
val insert : item * tree -> tree
val isHeap : tree -> bool
val maxHeap : tree -> item
val replace : item * tree -> item * tree
val size : tree -> int
val top : tree -> item
end
module Heap (Item: ITEM) : HEAP =
struct
type item = Item.item
let leq(p, q) : bool = Item.leq(p,q)
let max(p,q) = if leq(p,q) then q else p
and min(p,q) = if leq(p,q) then p else q
let intmax((p : int),q) = if p <= q then q else p
type tree =
| L of item
| N of item * tree * tree
exception InitHeap
let rec initHeap n =
if (n < 1) then raise InitHeap
else if n = 1 then L Item.initial
else let t = initHeap(n - 1)
in N (Item.initial, t, t)
let rec top t =
match t with
| (L i) -> i
| N (i,_,_) -> i
let rec isHeap t =
match t with
| (L _) -> true
| (N(i,l,r)) ->
leq(i,top l) && leq(i,top r) && isHeap l && isHeap r
let rec depth t =
match t with
| (L _) -> 1
| N(i,l,r) -> 1 + intmax(depth l,depth r)
let rec replace (i,h) = (top h, insert(i,h))
and insert (i, h) =
match h with
| L _ -> L i
| N (_,l,r) ->
if leq(i,min(top l,top r))
then N(i,l,r)
else if leq((top l),(top r))
then N(top l,insert(i,l),r)
else N(top r,l,insert(i,r))
let rec size h =
match h with
| L _ -> 1
| N (_,l,r) -> 1 + size l + size r
let rec maxHeap h =
match h with
| (L i) -> i
| N (_,l,r) -> max(maxHeap l, maxHeap r)
end
So Heap includes a bunch of functions that just do simple operations on a Heap but for some reason ocaml thinks that the signature for HEAP is supposed to include functions for ITEM, but I just want to pull ITEM functions into HEAP
The error I get:
Error: Signature mismatch:
Modules do not match:
sig val leq : int * int -> bool end
is not included in
ITEM
The value `initial' is required but not provided
File "lab13.ml", line 28, characters 8-26: Expected declaration
The type `item' is required but not provided
File "lab13.ml", line 26, characters 8-17: Expected declaration
Thanks for any help in advance!
You most probably wrote
module type HEAD = functor (Head:ITEM) -> sig … end
(and not module type HEAD = functor (Head:HEAD) -> sig … end which is recursely using the HEAD module type which is a type error )
when you meant
module type HEAD = sig … end
Adding the functor(HEAD:ITEM) -> … part makes HEAD the signature or a functor. Therefore
module Heap (Item: ITEM) : HEAP
is the same thing as
module Heap (Item: ITEM) : functor(Heap:HEAP) -> sig … end
in other words, the signature that you added make Heap a higher-order functor; which is obviously not the case of the implementation.
Unfortunately, error messages in presence of functors are lacking right now, and the type-checker does not detail error in this specific case for now.
Rewriting the HEAD module type as
module type HEAD = sig … end
should fix this problem.

Insert implementation for a trie in Ocaml

I don't have any idea on how to change the code for my add function.
type trie = Node of bool * (char * trie) list
let explode word =
let rec explode' i acc =
if i < 0 then acc else explode' (i-1) (word.[i] :: acc)
in explode' (String.length word - 1) []
let rec exists w tr = match w, tr with
| [], Node (b, _) -> b
| h::t, Node (_, l) -> try exists t (List.assoc h l) with Not_found -> false
let rec add w tr = match w, tr with
| [], Node (_, l) -> Node (true, l)
| h :: t, Node (b, l) -> try add t (List.assoc h l)
with Not_found -> Node (false, (h, add t tr) :: l)
The problem is when List.assoc h l finds something , then I don't keep track of my structure, no Node is built during the recursive call so I am losing data.
Example :
# let empty = Node(true, []);;
- : trie = Node (true, [])
# let w = explode "hi";;
val w : char list = ['h'; 'i']
# let ww = explode "hit";;
val ww : char list = ['h'; 'i'; 't']
# let tr = add w x;;
val tr : trie = Node (false, [('h', Node (false, [('i', Node (true, []))]))])
# add ww tr;;
- : trie = Node (false, [('t', Node (true, []))])
It seems your basic plan is to work down through the data structure with List.assoc, then add your new node when you find the right spot. This makes sense if you can modify the structure. However, your data structure is immutable. With immutable data, your basic plan must be to build a new data structure rather than to modify the old one. So you have to imagine yourself finding the right spot while keeping traack of the old structure along the way, then building up a new structure starting from the spot.
Here's some code that keeps an association list counting the number of instances of characters seen so far. Note that it returns a new association list rather than modifying the old one (which is impossible):
let rec add_char_count list char =
match list with
| [] -> [(char, 1)]
| (hchar, hcount) :: t ->
if hchar = char then (hchar, hcount + 1) :: t
else (hchar, hcount) :: add_char_count t char
The recursive call (hchar, hcount) :: add_char_count t char is the spot where the old structure is remembered. It rebuilds the old structure from the part of the list before where the new character is added.

F# Performance: What is making this code so slow?

This F# code is an attempt to solve Project Euler problem #58:
let inc = function
| n -> n + 1
let is_prime = function
| 2 -> true
| n when n < 2 || n%2=0-> false
| n ->
[3..2..(int (sqrt (float n)))]
|> List.tryFind (fun i -> n%i=0)
|> Option.isNone
let spir = Seq.initInfinite (fun i ->
let n = i%4
let a = 2 * (i/4 + 1)
(a*n) + a + (a-1)*(a-1))
let rec accum se p n =
match se with
| x when p*10 < n && p <> 0 -> 2*(n/4) + 1
| x when is_prime (Seq.head x) -> accum (Seq.tail x) (inc p) (inc n)
| x -> accum (Seq.tail x) p (inc n)
| _ -> 0
printfn "%d" (accum spir 0 1)
I do not know the running time of this program because I refused to wait for it to finish. Instead, I wrote this code imperatively in C++:
#include "stdafx.h"
#include "math.h"
#include <iostream>
using namespace std;
int is_prime(int n)
{
if (n % 2 == 0) return 0;
for (int i = 3; i <= sqrt(n); i+=2)
{
if (n%i == 0)
{
return 0;
}
}
return 1;
}
int spir(int i)
{
int n = i % 4;
int a = 2 * (i / 4 + 1);
return (a*n) + a + ((a - 1)*(a - 1));
}
int main()
{
int n = 1, p = 0, i = 0;
cout << "start" << endl;
while (p*10 >= n || p == 0)
{
p += is_prime(spir(i));
n++; i++;
}
cout << 2*(i/4) + 1;
return 0;
}
The above code runs in less than 2 seconds and gets the correct answer.
What is making the F# code run so slowly? Even after using some of the profiling tools mentioned in an old Stackoverflow post, I still cannot figure out what expensive operations are happening.
Edit #1
With rmunn's post, I was able to come up with a different implementation that gets the answer in a little under 30 seconds:
let inc = function
| n -> n + 1
let is_prime = function
| 2 -> true
| n when n < 2 || n%2=0-> false
| n ->
[3..2..(int (sqrt (float n)))]
|> List.tryFind (fun i -> n%i=0)
|> Option.isNone
let spir2 =
List.unfold (fun state ->
let p = fst state
let i = snd state
let n = i%4
let a = 2 * (i/4 + 1)
let diag = (a*n) + a + (a-1)*(a-1)
if p*10 < (i+1) && p <> 0 then
printfn "%d" (2*((i+1)/4) + 1)
None
elif is_prime diag then
Some(diag, (inc p, inc i))
else Some(diag, (p, inc i))) (0, 0)
Edit #2
With FuleSnabel's informative post, his is_prime function makes the above code run in under a tenth of a second, making it faster than the C++ code:
let inc = function
| n -> n + 1
let is_prime = function
| 1 -> false
| 2 -> true
| v when v % 2 = 0 -> false
| v ->
let stop = v |> float |> sqrt |> int
let rec loop vv =
if vv <= stop then
if (v % vv) <> 0 then
loop (vv + 2)
else
false
else
true
loop 3
let spir2 =
List.unfold (fun state ->
let p = fst state
let i = snd state
let n = i%4
let a = 2 * (i/4 + 1)
let diag = (a*n) + a + (a-1)*(a-1)
if p*10 < (i+1) && p <> 0 then
printfn "%d" (2*((i+1)/4) + 1)
None
elif i <> 3 && is_prime diag then
Some(diag, (inc p, inc i))
else Some(diag, (p, inc i))) (0, 0)
There is no Seq.tail function in the core F# library (UPDATE: Yes there is, see comments), so I assume you're using the Seq.tail function from FSharpx.Collections. If you're using a different implementation of Seq.tail, it's probably similar -- and it's almost certainly the cause of your problems, because it's not O(1) like you think it is. Getting the tail of a List is O(1) because of how List is implemented (as a series of cons cells). But getting the tail of a Seq ends up creating a brand new Seq from the original enumerable, discarding one item from it, and returning the rest of its items. When you go through your accum loop a second time, you call Seq.tail on that "skip 1 then return" seq. So now you have a Seq which I'll call S2, which asks S1 for an IEnumerable, skips the first item of S1, and returns the rest of it. S1, when asked for its first item, asks S0 (the original Seq) for an enumerable, skips its first item, then returns the rest of it. So for S2 to skip two items, it had to create two seqs. Now on your next run through when you ask for the Seq.tail of S2, you create S3 that asks S2 for an IEnumerable, which asks S1 for an IEnumerable, which asks S0 for an IEnumerable... and so on. This is effectively O(N^2), when you thought you were writing an O(N) operation.
I'm afraid I don't have time right now to figure out a solution for you; using List.tail won't help since you need an infinite sequence. But perhaps just knowing about the Seq.tail gotcha is enough to get you started, so I'll post this answer now even though it's not complete.
If you need more help, comment on this answer and I'll come back to it when I have time -- but that might not be for several days, so hopefully others will also answer your question.
Writing performant F# is very possible but requires some knowledge of patterns that have high relative CPU cost in a tight loop. I recommend using tools like ILSpy to find hidden overhead.
For instance one could imagine F# exands this expression into an effective for loop:
[3..2..(int (sqrt (float n)))]
|> List.tryFind (fun i -> n%i=0)
|> Option.isNone
However it currently doesn't. Instead it creates a List that spans the range using intrinsic operators and passes that to List.tryFind. This is expensive when compared to the actual work we like to do (the modulus operation). ILSpy decompiles the code above into something like this:
public static bool is_prime(int _arg1)
{
switch (_arg1)
{
case 2:
return true;
default:
return _arg1 >= 2 && _arg1 % 2 != 0 && ListModule.TryFind<int>(new Program.Original.is_prime#10(_arg1), SeqModule.ToList<int>(Operators.CreateSequence<int>(Operators.OperatorIntrinsics.RangeInt32(3, 2, (int)Math.Sqrt((double)_arg1))))) == null;
}
}
These operators aren't as performant as they could be (AFAIK this is currently being improved) but no matter how effecient allocating a List and then search it won't beat a for loop.
This means the is_prime is not as effective as it could be. Instead one could do something like this:
let is_prime = function
| 1 -> false
| 2 -> true
| v when v % 2 = 0 -> false
| v ->
let stop = v |> float |> sqrt |> int
let rec loop vv =
if vv <= stop then
(v % vv) <> 0 && loop (vv + 2)
else
true
loop 3
This version of is_prime relies on tail call optimization in F# to expand the loop into an efficient for loop (you can see this using ILSpy). ILSpy decompile the loop into something like this:
while (vv <= stop)
{
if (_arg1 % vv == 0)
{
return false;
}
int arg_13_0 = _arg1;
int arg_11_0 = stop;
vv += 2;
stop = arg_11_0;
_arg1 = arg_13_0;
}
This loop doesn't allocate memory and is just a rather efficient loop. One see some non-sensical assignments but hopefully the JIT:er eliminate those. I am sure is_prime can be improved even further.
When using Seq in performant code one have to keep in mind it's lazy and it doesn't use memoization by default (see Seq.cache). Therefore one might easily end up doing the same work over and over again (see #rmunn answer).
In addition Seq isn't especially effective because of how IEnumerable/IEnumerator are designed. Better options are for instance Nessos Streams (available on nuget).
In case you are interested I did a quick implementation that relies on a simple Push Stream which seems decently performant:
// Receiver<'T> is a callback that receives a value.
// Returns true if it wants more values, false otherwise.
type Receiver<'T> = 'T -> bool
// Stream<'T> is function that accepts a Receiver<'T>
// This means Stream<'T> is a push stream (as opposed to Seq that uses pull)
type Stream<'T> = Receiver<'T> -> unit
// is_prime returns true if the input is prime, false otherwise
let is_prime = function
| 1 -> false
| 2 -> true
| v when v % 2 = 0 -> false
| v ->
let stop = v |> float |> sqrt |> int
let rec loop vv =
if vv <= stop then
(v % vv) <> 0 && loop (vv + 2)
else
true
loop 3
// tryFind looks for the first value in the input stream for f v = true.
// If found tryFind returns Some v, None otherwise
let tryFind f (s : Stream<'T>) : 'T option =
let res = ref None
s (fun v -> if f v then res := Some v; false else true)
!res
// diagonals generates a tuple stream of all diagonal values
// The first value is the side length, the second value is the diagonal value
let diagonals : Stream<int*int> =
fun r ->
let rec loop side v =
let step = side - 1
if r (side, v + 1*step) && r (side, v + 2*step) && r (side, v + 3*step) && r (side, v + 4*step) then
loop (side + 2) (v + 4*step)
if r (1, 1) then loop 3 1
// ratio computes the streaming ratio for f v = true
let ratio f (s : Stream<'T>) : Stream<float*'T> =
fun r ->
let inc r = r := !r + 1.
let acc = ref 0.
let count = ref 0.
s (fun v -> (inc count; if f v then inc acc); r (!acc/(!count), v))
let result =
diagonals
|> ratio (snd >> is_prime)
|> tryFind (fun (r, (_, v)) -> v > 1 && r < 0.1)

Layout a binary search tree

This is the problem 65 in OCaml 99
Given a binary search and layout it like this:
The y axis of a node is easy as it is just the level number, starting from 1.
The x asix of a node is bit more complicated, but through observation, assuming the height of the whole tree is h, then the x of a node is the max size of the left child as if it is a full tree, i.e., x = 2 ^ (h-y)-1
However, there is a special case where the x of the left most node is always 1 that we need to handle.
Here is my code:
type 'a btree = Empty | Node of 'a * 'a btree * 'a btree
type 'a pos_binary_tree =
| E (* represents the empty tree *)
| N of 'a * int * int * 'a pos_binary_tree * 'a pos_binary_tree
let rec height = function
| Empty -> 0
| Node (_,l,r) -> 1 + max (height l) (height r)
let get_fullsize h level = (2. ** (Float.of_int (h+1-level)) |> Int.of_float) - 1
let layout_btree2_correct t =
let h = height t in
let rec lay off y = function
| Empty -> get_fullsize h y, E
| Node (w, Empty, r) when off = 0 ->
let wtr, newr = lay 1 (y+1) r in
1+wtr, N (w, 1, y+1, E, newr)
| Node (w, l, r) ->
let wt1, newl = lay off (y+1) l in
let wt2, newr = lay (off+wt1+1) (y+1) r in
wt1+wt2+1, N (w, off+wt1+1, y, newl, newr)
in
lay 0 1 t |> snd
What I do are:
get the height of the whole tree
always return back the full width that it might occupy
x should be the left node width + 1
For the special case of the left most node, it returns 1 + width of right as the width
In my way, I have to travel the tree one time first to get the height. Anyone can suggest better implementation, for example, just travel the tree once?
Are you asking for different algorithms to search the tree? Or different ways to implement that algorithm?
The Trees and Tree Algorithms section may be helpful to you. http://interactivepython.org/runestone/static/pythonds/index.html