From ff66b8a160b557ff62080ca734f0daa4795073a3 Mon Sep 17 00:00:00 2001 From: Fay Carsons Date: Sat, 28 Oct 2023 12:30:06 -0400 Subject: [PATCH 1/3] circle packing example first draft --- examples/circle_packing.ml | 89 ++++++++++++++++++++++++++++++++++++++ examples/dune | 5 +++ lib/shape.mli | 2 + 3 files changed, 96 insertions(+) create mode 100644 examples/circle_packing.ml diff --git a/examples/circle_packing.ml b/examples/circle_packing.ml new file mode 100644 index 0000000..5dbd95a --- /dev/null +++ b/examples/circle_packing.ml @@ -0,0 +1,89 @@ +open Joy.Shape + +(* global constants // RNG initialization *) +let resolution = (500, 500) +let min_radius = 3 +let max_radius = 50 +let num_circles = 500 +let max_attempts = 2000 +let _ = Stdlib.Random.self_init + +let palette = + [ + (107, 108, 163); + (135, 188, 189); + (111, 153, 84); + (150, 155, 199); + (137, 171, 124); + (67, 68, 117); + (44, 45, 84); + ] + +(* utility Functions *) +let distance ({ x = x1; y = y1 } : point) ({ x = x2; y = y2 } : point) = + let dx = float_of_int x2 -. float_of_int x1 in + let dy = float_of_int y2 -. float_of_int y1 in + let dist = sqrt ((dx *. dx) +. (dy *. dy)) in + int_of_float dist + +(* determines if two circles overlap *) +let overlap ({ c = c1; radius = r1 } : circle) + ({ c = c2; radius = r2 } : circle) = + let dist = distance c1 c2 in + dist < r1 + r2 + +(* creates a random point within screen bounds *) +let rand_point () = + { + x = Stdlib.Random.full_int (fst resolution) - (fst resolution / 2); + y = Stdlib.Random.full_int (snd resolution) - (snd resolution / 2); + } + +(* creates a circle with a random center point and radius *) +let rand_circle () = + let point = rand_point () in + { + c = point; + radius = min_radius + Stdlib.Random.full_int (max_radius - min_radius); + } + +let pack_circles () = + (* checks whether a circle intersects with a list of circles *) + let check_overlap lst current = + List.fold_right (fun curr acc -> overlap curr current || acc) lst false + in + (* creates a new circle, checks if it intersects previous circles, + if max attempts have been reached, + or if the desired number of circles have been created. + From there it either recurses with or without the new circle, + or returns the list of circles *) + let rec pack lst attempts = + let new_circle = rand_circle () in + let does_overlap = check_overlap lst new_circle in + let safe = List.length lst < num_circles - 1 && attempts < max_attempts in + if does_overlap && safe then pack lst (attempts + 1) + else if not safe then new_circle :: lst + else pack (new_circle :: lst) attempts + in + let attempts = 0 in + let lst = [ { c = { x = 0; y = 0 }; radius = 10 } ] in + pack lst attempts + +(* pulls a random color from the 'palette' list + sets draw color with it + then draws circle *) +let draw_with_color circle = + let idx = Stdlib.Random.full_int (List.length palette - 1) in + let r, g, b = List.nth palette idx in + Graphics.set_color (Graphics.rgb r g b); + render_shape circle + +let () = + set_dimensions (fst resolution) (snd resolution); + init (); + Graphics.set_line_width 2; + let circles = pack_circles () in + (* converting circle type to more general 'shape' type for rendering *) + let circles = List.map (fun c -> circle ~x:c.c.x ~y:c.c.y c.radius) circles in + List.iter draw_with_color circles; + close () diff --git a/examples/dune b/examples/dune index 27ea231..b07fb75 100644 --- a/examples/dune +++ b/examples/dune @@ -97,3 +97,8 @@ (name complex) (modules complex) (libraries joy)) + +(executable + (name circle_packing) + (modules circle_packing) + (libraries joy)) diff --git a/lib/shape.mli b/lib/shape.mli index 34eba11..9e2f8f8 100644 --- a/lib/shape.mli +++ b/lib/shape.mli @@ -1,5 +1,7 @@ type shape type shapes = shape list +type point = { x : int; y : int } +type circle = { c : point; radius : int } val render_shape : shape -> unit val circle : ?x:int -> ?y:int -> int -> shape From 1ca1e2ee2f9c0b110074652984ae987e2d8b3817 Mon Sep 17 00:00:00 2001 From: Fay Carsons Date: Sat, 28 Oct 2023 20:15:42 -0400 Subject: [PATCH 2/3] added concentric circles --- examples/circle_packing.ml | 38 +++++++++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/examples/circle_packing.ml b/examples/circle_packing.ml index 5dbd95a..7f0e5ac 100644 --- a/examples/circle_packing.ml +++ b/examples/circle_packing.ml @@ -1,11 +1,11 @@ open Joy.Shape (* global constants // RNG initialization *) -let resolution = (500, 500) -let min_radius = 3 -let max_radius = 50 -let num_circles = 500 -let max_attempts = 2000 +let resolution = (1200, 900) +let min_radius = 10 +let max_radius = 200 +let num_circles = 5000 +let max_attempts = 50000 let _ = Stdlib.Random.self_init let palette = @@ -35,8 +35,8 @@ let overlap ({ c = c1; radius = r1 } : circle) (* creates a random point within screen bounds *) let rand_point () = { - x = Stdlib.Random.full_int (fst resolution) - (fst resolution / 2); - y = Stdlib.Random.full_int (snd resolution) - (snd resolution / 2); + x = Stdlib.Random.full_int (fst resolution * 2) - fst resolution; + y = Stdlib.Random.full_int (snd resolution * 2) - snd resolution; } (* creates a circle with a random center point and radius *) @@ -76,14 +76,30 @@ let draw_with_color circle = let idx = Stdlib.Random.full_int (List.length palette - 1) in let r, g, b = List.nth palette idx in Graphics.set_color (Graphics.rgb r g b); - render_shape circle + Graphics.draw_circle circle.c.x circle.c.y circle.radius + +let make_concentric circle = + let rec choose lst = + let first = List.hd (List.rev lst) in + if first.radius <= 1 then lst + else + let new_circle = + { + c = first.c; + radius = + int_of_float + (float_of_int first.radius *. 0.9); + } + in + choose (lst @ [ new_circle ]) + in + choose [ circle ] let () = set_dimensions (fst resolution) (snd resolution); init (); - Graphics.set_line_width 2; + Graphics.set_line_width 4; let circles = pack_circles () in - (* converting circle type to more general 'shape' type for rendering *) - let circles = List.map (fun c -> circle ~x:c.c.x ~y:c.c.y c.radius) circles in + let circles = List.flatten (List.map make_concentric circles) in List.iter draw_with_color circles; close () From dd3127e8351c130b544c8aca8b67223952c54f00 Mon Sep 17 00:00:00 2001 From: Fay Carsons Date: Tue, 21 Nov 2023 12:51:00 -0500 Subject: [PATCH 3/3] refactored to fix type issues, added more comments, parameter tweaks --- .gitignore | 3 +- examples/circle_packing.ml | 76 ++++++++++++++++++++------------------ lib/shape.mli | 1 - 3 files changed, 42 insertions(+), 38 deletions(-) diff --git a/.gitignore b/.gitignore index 02b9a8a..5cdba60 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ _build -.vscode \ No newline at end of file +.vscode +.DS_Store \ No newline at end of file diff --git a/examples/circle_packing.ml b/examples/circle_packing.ml index 7f0e5ac..f75389d 100644 --- a/examples/circle_packing.ml +++ b/examples/circle_packing.ml @@ -2,55 +2,60 @@ open Joy.Shape (* global constants // RNG initialization *) let resolution = (1200, 900) -let min_radius = 10 -let max_radius = 200 -let num_circles = 5000 -let max_attempts = 50000 -let _ = Stdlib.Random.self_init +let min_radius = 20 +let max_radius = 150 +let num_circles = 5_000 +let max_attempts = 100_000 +let shrink_factor = 0.85 +let _ = Stdlib.Random.self_init () let palette = [ + (* purple *) (107, 108, 163); + (* light blue *) (135, 188, 189); + (* green *) (111, 153, 84); + (* light purple *) (150, 155, 199); + (* light green *) (137, 171, 124); + (* dark purple *) (67, 68, 117); + (* darker purple *) (44, 45, 84); ] (* utility Functions *) -let distance ({ x = x1; y = y1 } : point) ({ x = x2; y = y2 } : point) = + +(* distance between two points *) +let distance (x1, y1) (x2, y2) = let dx = float_of_int x2 -. float_of_int x1 in let dy = float_of_int y2 -. float_of_int y1 in let dist = sqrt ((dx *. dx) +. (dy *. dy)) in int_of_float dist -(* determines if two circles overlap *) -let overlap ({ c = c1; radius = r1 } : circle) - ({ c = c2; radius = r2 } : circle) = - let dist = distance c1 c2 in +(* determines if two circles overlaps *) +let overlaps (p1, r1) (p2, r2) = + let dist = distance p1 p2 in dist < r1 + r2 (* creates a random point within screen bounds *) let rand_point () = - { - x = Stdlib.Random.full_int (fst resolution * 2) - fst resolution; - y = Stdlib.Random.full_int (snd resolution * 2) - snd resolution; - } + ( Stdlib.Random.full_int (fst resolution * 2) - fst resolution, + Stdlib.Random.full_int (snd resolution * 2) - snd resolution ) (* creates a circle with a random center point and radius *) let rand_circle () = let point = rand_point () in - { - c = point; - radius = min_radius + Stdlib.Random.full_int (max_radius - min_radius); - } + (point, min_radius + Stdlib.Random.full_int (max_radius - min_radius)) +(* creates a lis of packed circles *) let pack_circles () = (* checks whether a circle intersects with a list of circles *) - let check_overlap lst current = - List.fold_right (fun curr acc -> overlap curr current || acc) lst false + let check_overlaps lst current = + List.fold_right (fun curr acc -> overlaps curr current || acc) lst false in (* creates a new circle, checks if it intersects previous circles, if max attempts have been reached, @@ -59,14 +64,14 @@ let pack_circles () = or returns the list of circles *) let rec pack lst attempts = let new_circle = rand_circle () in - let does_overlap = check_overlap lst new_circle in + let does_overlap = check_overlaps lst new_circle in let safe = List.length lst < num_circles - 1 && attempts < max_attempts in if does_overlap && safe then pack lst (attempts + 1) else if not safe then new_circle :: lst else pack (new_circle :: lst) attempts in let attempts = 0 in - let lst = [ { c = { x = 0; y = 0 }; radius = 10 } ] in + let lst = [ rand_circle () ] in pack lst attempts (* pulls a random color from the 'palette' list @@ -76,30 +81,29 @@ let draw_with_color circle = let idx = Stdlib.Random.full_int (List.length palette - 1) in let r, g, b = List.nth palette idx in Graphics.set_color (Graphics.rgb r g b); - Graphics.draw_circle circle.c.x circle.c.y circle.radius + render_shape circle +(* turns a circle into a list of concentric circles *) let make_concentric circle = - let rec choose lst = - let first = List.hd (List.rev lst) in - if first.radius <= 1 then lst + let rec shrink lst = + let point, radius = List.hd (List.rev lst) in + if radius <= 1 then lst else let new_circle = - { - c = first.c; - radius = - int_of_float - (float_of_int first.radius *. 0.9); - } + (point, int_of_float (float_of_int radius *. shrink_factor)) in - choose (lst @ [ new_circle ]) + shrink (lst @ [ new_circle ]) in - choose [ circle ] + shrink [ circle ] +(* main fn *) let () = set_dimensions (fst resolution) (snd resolution); init (); - Graphics.set_line_width 4; + Graphics.set_line_width 3; let circles = pack_circles () in let circles = List.flatten (List.map make_concentric circles) in - List.iter draw_with_color circles; + List.iter + (fun ((x, y), radius) -> draw_with_color (circle ~x ~y radius)) + circles; close () diff --git a/lib/shape.mli b/lib/shape.mli index 9e2f8f8..f0bd924 100644 --- a/lib/shape.mli +++ b/lib/shape.mli @@ -1,7 +1,6 @@ type shape type shapes = shape list type point = { x : int; y : int } -type circle = { c : point; radius : int } val render_shape : shape -> unit val circle : ?x:int -> ?y:int -> int -> shape