From c63aae300fdd5d60e270954e106c18e5507843bc Mon Sep 17 00:00:00 2001 From: Moazzam Moriani Date: Tue, 5 Jul 2022 19:58:32 +0500 Subject: [PATCH 1/4] Add count_change_iter and count_chnage_iter_multicore and their configs --- .../multicore-numerical/count_change_iter.ml | 65 +++++++++++++ .../count_change_iter_multicore.ml | 93 +++++++++++++++++++ benchmarks/multicore-numerical/dune | 29 ++++-- multicore_parallel_run_config.json | 23 +++++ run_config.json | 14 ++- run_config_byte.json | 9 ++ 6 files changed, 223 insertions(+), 10 deletions(-) create mode 100644 benchmarks/multicore-numerical/count_change_iter.ml create mode 100644 benchmarks/multicore-numerical/count_change_iter_multicore.ml diff --git a/benchmarks/multicore-numerical/count_change_iter.ml b/benchmarks/multicore-numerical/count_change_iter.ml new file mode 100644 index 0000000000..af565bf14a --- /dev/null +++ b/benchmarks/multicore-numerical/count_change_iter.ml @@ -0,0 +1,65 @@ + +(************************************************************************************* +* The main procudure cc enumerates all possible ways to distribute change for a * +* given set of different denominations of coins of certain quantities for some given * +* amount. * +*************************************************************************************) + +let n = try int_of_string @@ Sys.argv.(1) with _ -> 960 +module L = List + +(* Selectors for tuples *) +let get_1 (x,_,_) = x + +let get_2 (_,y,_) = y + +let get_3 (_,_,z) = z + + +let rec des amt coins curr acc stack = + match amt, coins, stack with + | _, _, [] -> acc + | 0, _, _ -> begin + let stack_top = L.hd stack in + let stack_rest = L.tl stack in + let get_amt = get_1 in + let get_coins = get_2 in + let get_curr = get_3 in + des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) (curr::acc) stack_rest + end + | _, [], _ -> begin + let stack_top = L.hd stack in + let stack_rest = L.tl stack in + let get_amt = get_1 in + let get_coins = get_2 in + let get_curr = get_3 in + des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) acc stack_rest + end + | _, (den, qty)::rst, _ -> begin + let new_amt = amt - den in + let new_coins = (den, qty -1)::rst in + if den > amt then + des amt rst curr acc stack + else if qty = 1 then + des new_amt rst (den::curr) acc stack + else if (L.tl coins) = [] || curr = [] then + des new_amt new_coins (den::curr) acc stack + else + des new_amt new_coins (den::curr) acc ((amt, rst, curr)::stack) + end + +let cc amt (coins : ((int * int) list)) = + let rec aux c stack = + match c with + | [] -> des amt coins [] [] stack + | _ -> aux (L.tl c) (((amt, c, []))::stack) in + aux coins [] + +let coins_input : (int * int) list = + let cs = [250 ; 100 ; 25 ; 10 ; 5 ; 1] in + let qs = [55 ; 88 ; 88 ; 99 ; 122 ; 177] in + L.combine cs qs + +let () = + let x = cc n coins_input in + Printf.printf "possibilities = %d\n" (L.length x) diff --git a/benchmarks/multicore-numerical/count_change_iter_multicore.ml b/benchmarks/multicore-numerical/count_change_iter_multicore.ml new file mode 100644 index 0000000000..77e6795fa6 --- /dev/null +++ b/benchmarks/multicore-numerical/count_change_iter_multicore.ml @@ -0,0 +1,93 @@ +let num_domains = try int_of_string @@ Sys.argv.(1) with _ -> 1 +let n = try int_of_string @@ Sys.argv.(2) with _ -> 960 + +module A = Array +module L = List +module T = Domainslib.Task + +(* Selectors for tuples *) +let get_1 (x,_,_) = x + +let get_2 (_,y,_) = y + +let get_3 (_,_,z) = z + +let rec des amt coins curr acc stack = + (* Descends down the left branch *) + match amt, coins, stack with + | _, _, [] -> acc + | 0, _, _ -> begin + let stack_top = L.hd stack in + let stack_rest = L.tl stack in + let get_amt = get_1 in + let get_coins = get_2 in + let get_curr = get_3 in + des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) (curr::acc) stack_rest + end + | _, [], _ -> begin + let stack_top = L.hd stack in + let stack_rest = L.tl stack in + let get_amt = get_1 in + let get_coins = get_2 in + let get_curr = get_3 in + des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) acc stack_rest + end + | _, (den, qty)::rst, _ -> begin + let new_amt = amt - den in + let new_coins = (den, qty -1)::rst in + if den > amt then + des amt rst curr acc stack + else if qty = 1 then + des new_amt rst (den::curr) acc stack + else if (L.tl coins) = [] || curr = [] then + des new_amt new_coins (den::curr) acc stack + else + des new_amt new_coins (den::curr) acc ((amt, rst, curr)::stack) + end + +let setup_stacks amt coins = + (* Assumes that the that qty for each den in coins is greater than or equal to 2 *) + let a = A.init (L.length coins) (fun _ -> (0,[], [], [])) in + let rec aux count c = + match c with + | [] -> a + | (den, qty)::rst -> begin + let new_amt = amt - den in + let new_c = (den, qty-1)::rst in + if den > amt then + aux count (L.tl c) + else if qty = 1 then begin + a.(count) <- (new_amt, (L.tl c), (den::[]), [(new_amt, rst, den::[])]); + aux (count+1) (L.tl c) + end else begin + a.(count) <- (new_amt, new_c, (den::[]), [(new_amt, rst, den::[])]); + aux (count+1) (L.tl c) + end + end + in + aux 0 coins + +let cc_par pool amt (coins : ((int * int) list)) arr = + let setup = setup_stacks amt coins in + let len = A.length arr in + let amt = fun (x, _, _, _) -> x in + let c = fun (_, x, _, _) -> x in + let curr = fun (_, _, x, _) -> x in + let stack = fun (_, _, _, x) -> x in + T.parallel_for pool ~start:0 ~finish:(len-1) ~body:(fun i -> + Printf.printf "%d\n" i; + arr.(i) <- des (amt setup.(i)) (c setup.(i)) (curr setup.(i)) [] (stack setup.(i)); + ) + +let coins_input : (int * int) list = + let cs = [250 ; 100 ; 25 ; 10 ; 5 ; 1] in + let qs = [55 ; 88 ; 88 ; 99 ; 122 ; 177] in + L.combine cs qs + +let arr = A.init (L.length coins_input) (fun _ -> []) + +let _ = + let pool = T.setup_pool ~num_additional_domains:(num_domains - 1) () in + T.run pool (fun () -> cc_par pool n coins_input arr); + Printf.printf "possibilites = %d\n" (A.fold_left (+) 0 (A.map L.length arr)); + T.teardown_pool pool diff --git a/benchmarks/multicore-numerical/dune b/benchmarks/multicore-numerical/dune index 6439d77296..90bcfbc78c 100644 --- a/benchmarks/multicore-numerical/dune +++ b/benchmarks/multicore-numerical/dune @@ -113,26 +113,37 @@ (modules evolutionary_algorithm_multicore) (libraries domainslib)) +(executable + (name count_change_iter) + (modes native byte) + (modules count_change_iter)) + +(executable + (name count_change_iter_multicore) + (modules count_change_iter_multicore) + (libraries domainslib)) + (alias (name multibench_parallel) (deps mandelbrot6_multicore.exe spectralnorm2_multicore.exe quicksort.exe quicksort_multicore.exe binarytrees5_multicore.exe - game_of_life.exe game_of_life_multicore.exe - matrix_multiplication.exe matrix_multiplication_multicore.exe - matrix_multiplication_tiling_multicore.exe nbody.exe - nbody_multicore.exe nqueens_multicore.exe mergesort.exe mergesort_multicore.exe - floyd_warshall.exe floyd_warshall_multicore.exe - LU_decomposition.exe LU_decomposition_multicore.exe - evolutionary_algorithm_multicore.exe evolutionary_algorithm.exe nqueens.exe)) + game_of_life.exe game_of_life_multicore.exe + matrix_multiplication.exe matrix_multiplication_multicore.exe + matrix_multiplication_tiling_multicore.exe nbody.exe + nbody_multicore.exe nqueens_multicore.exe mergesort.exe mergesort_multicore.exe + floyd_warshall.exe floyd_warshall_multicore.exe + LU_decomposition.exe LU_decomposition_multicore.exe + evolutionary_algorithm_multicore.exe evolutionary_algorithm.exe nqueens.exe + count_change_iter_multicore.exe count_change_iter.exe)) (alias (name buildbench) (deps game_of_life.exe matrix_multiplication.exe quicksort.exe mergesort.exe floyd_warshall.exe LU_decomposition.exe - evolutionary_algorithm.exe nqueens.exe)) + evolutionary_algorithm.exe nqueens.exe count_change_iter.exe)) (alias (name bytebench) (deps game_of_life.bc matrix_multiplication.bc quicksort.bc mergesort.bc floyd_warshall.bc evolutionary_algorithm.bc - LU_decomposition.bc nbody.bc mergesort.bc nqueens.bc)) + LU_decomposition.bc nbody.bc mergesort.bc nqueens.bc count_change_iter.bc)) diff --git a/multicore_parallel_run_config.json b/multicore_parallel_run_config.json index ce5f69bc59..099e2101a2 100644 --- a/multicore_parallel_run_config.json +++ b/multicore_parallel_run_config.json @@ -194,6 +194,29 @@ { "params": "24 15", "paramwrapper": "taskset --cpu-list 2-13,16-27" } ] }, + { + "executable": "benchmarks/multicore-numerical/count_change_iter.exe", + "name": "count_change_iter", + "tags": ["10s_100s", "macro_bench"], + "runs": [ + { "params": "2200", "paramwrapper": "taskset --cpu-list 2-13" } + ] + }, + { + "executable": "benchmarks/multicore-numerical/count_change_iter_multicore.exe", + "name": "count_change_iter_multicore", + "tags": ["macro_bench","10s_100s"], + "runs": [ + { "params": "1 2200", "paramwrapper": "taskset --cpu-list 2-13"}, + { "params": "2 2200", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "4 2200", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "8 2200", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "12 2200", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "16 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, + { "params": "20 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, + { "params": "24 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" } + ] + }, { "executable": "benchmarks/multicore-numerical/quicksort.exe", diff --git a/run_config.json b/run_config.json index 254e704c6f..12519521d3 100644 --- a/run_config.json +++ b/run_config.json @@ -289,7 +289,19 @@ } ] }, - + { + "executable": "benchmarks/multicore-numerical/count_change_iter.exe", + "name": "count_change_iter", + "tags": [ + "1s_10s", + "macro_bench" + ], + "runs": [ + { + "params": "1600" + } + ] + }, { "executable": "benchmarks/multicore-grammatrix/grammatrix.exe", "name": "grammatrix", diff --git a/run_config_byte.json b/run_config_byte.json index ff6f90982f..bcb4c8577c 100644 --- a/run_config_byte.json +++ b/run_config_byte.json @@ -217,6 +217,15 @@ } ] }, + { + "executable": "benchmarks/multicore-numerical/count_change_iter.bc", + "name": "count_change_iter.bc", + "runs": [ + { + "params": "2200" + } + ] + }, { "executable": "benchmarks/valet/test_lwt.bc", "name": "test_lwt.bc", From 52fc01847fd0d5df628e775adb41fa92761dae40 Mon Sep 17 00:00:00 2001 From: Moazzam Moriani Date: Wed, 6 Jul 2022 18:53:50 +0500 Subject: [PATCH 2/4] Insert more denominations in coins_input and change params based on this --- .../multicore-numerical/count_change_iter.ml | 4 ++-- .../count_change_iter_multicore.ml | 5 ++--- multicore_parallel_run_config.json | 18 +++++++++--------- run_config.json | 4 ++-- run_config_byte.json | 2 +- 5 files changed, 16 insertions(+), 17 deletions(-) diff --git a/benchmarks/multicore-numerical/count_change_iter.ml b/benchmarks/multicore-numerical/count_change_iter.ml index af565bf14a..218eb9b6ec 100644 --- a/benchmarks/multicore-numerical/count_change_iter.ml +++ b/benchmarks/multicore-numerical/count_change_iter.ml @@ -56,8 +56,8 @@ let cc amt (coins : ((int * int) list)) = aux coins [] let coins_input : (int * int) list = - let cs = [250 ; 100 ; 25 ; 10 ; 5 ; 1] in - let qs = [55 ; 88 ; 88 ; 99 ; 122 ; 177] in + let cs = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in + let qs = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in L.combine cs qs let () = diff --git a/benchmarks/multicore-numerical/count_change_iter_multicore.ml b/benchmarks/multicore-numerical/count_change_iter_multicore.ml index 77e6795fa6..346089397d 100644 --- a/benchmarks/multicore-numerical/count_change_iter_multicore.ml +++ b/benchmarks/multicore-numerical/count_change_iter_multicore.ml @@ -75,13 +75,12 @@ let cc_par pool amt (coins : ((int * int) list)) arr = let curr = fun (_, _, x, _) -> x in let stack = fun (_, _, _, x) -> x in T.parallel_for pool ~start:0 ~finish:(len-1) ~body:(fun i -> - Printf.printf "%d\n" i; arr.(i) <- des (amt setup.(i)) (c setup.(i)) (curr setup.(i)) [] (stack setup.(i)); ) let coins_input : (int * int) list = - let cs = [250 ; 100 ; 25 ; 10 ; 5 ; 1] in - let qs = [55 ; 88 ; 88 ; 99 ; 122 ; 177] in + let cs = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in + let qs = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in L.combine cs qs let arr = A.init (L.length coins_input) (fun _ -> []) diff --git a/multicore_parallel_run_config.json b/multicore_parallel_run_config.json index 099e2101a2..a022ef6b08 100644 --- a/multicore_parallel_run_config.json +++ b/multicore_parallel_run_config.json @@ -199,7 +199,7 @@ "name": "count_change_iter", "tags": ["10s_100s", "macro_bench"], "runs": [ - { "params": "2200", "paramwrapper": "taskset --cpu-list 2-13" } + { "params": "400", "paramwrapper": "taskset --cpu-list 2-13" } ] }, { @@ -207,14 +207,14 @@ "name": "count_change_iter_multicore", "tags": ["macro_bench","10s_100s"], "runs": [ - { "params": "1 2200", "paramwrapper": "taskset --cpu-list 2-13"}, - { "params": "2 2200", "paramwrapper": "taskset --cpu-list 2-13" }, - { "params": "4 2200", "paramwrapper": "taskset --cpu-list 2-13" }, - { "params": "8 2200", "paramwrapper": "taskset --cpu-list 2-13" }, - { "params": "12 2200", "paramwrapper": "taskset --cpu-list 2-13" }, - { "params": "16 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, - { "params": "20 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, - { "params": "24 2200", "paramwrapper": "taskset --cpu-list 2-13,16-27" } + { "params": "1 400", "paramwrapper": "taskset --cpu-list 2-13"}, + { "params": "2 400", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "4 400", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "8 400", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "12 400", "paramwrapper": "taskset --cpu-list 2-13" }, + { "params": "16 400", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, + { "params": "20 400", "paramwrapper": "taskset --cpu-list 2-13,16-27" }, + { "params": "24 400", "paramwrapper": "taskset --cpu-list 2-13,16-27" } ] }, diff --git a/run_config.json b/run_config.json index 12519521d3..edf781f206 100644 --- a/run_config.json +++ b/run_config.json @@ -293,12 +293,12 @@ "executable": "benchmarks/multicore-numerical/count_change_iter.exe", "name": "count_change_iter", "tags": [ - "1s_10s", + "10s_100s", "macro_bench" ], "runs": [ { - "params": "1600" + "params": "400" } ] }, diff --git a/run_config_byte.json b/run_config_byte.json index bcb4c8577c..8a1a047107 100644 --- a/run_config_byte.json +++ b/run_config_byte.json @@ -222,7 +222,7 @@ "name": "count_change_iter.bc", "runs": [ { - "params": "2200" + "params": "400" } ] }, From 234b704ae49531ec5cb97fab7e77e8116565c43e Mon Sep 17 00:00:00 2001 From: Moazzam Moriani Date: Thu, 18 Aug 2022 22:35:41 +0500 Subject: [PATCH 3/4] Refactor completely --- .../multicore-numerical/count_change_iter.ml | 78 ++++------ .../count_change_iter_multicore.ml | 134 ++++++++---------- 2 files changed, 90 insertions(+), 122 deletions(-) diff --git a/benchmarks/multicore-numerical/count_change_iter.ml b/benchmarks/multicore-numerical/count_change_iter.ml index 218eb9b6ec..ea9ae328be 100644 --- a/benchmarks/multicore-numerical/count_change_iter.ml +++ b/benchmarks/multicore-numerical/count_change_iter.ml @@ -1,64 +1,40 @@ +let n = try int_of_string @@ Sys.argv.(1) with _ -> 120 -(************************************************************************************* -* The main procudure cc enumerates all possible ways to distribute change for a * -* given set of different denominations of coins of certain quantities for some given * -* amount. * -*************************************************************************************) - -let n = try int_of_string @@ Sys.argv.(1) with _ -> 960 module L = List -(* Selectors for tuples *) -let get_1 (x,_,_) = x +type coins = (int * int) list -let get_2 (_,y,_) = y +type frame = { amt : int; coins : coins; current_enum : int list } -let get_3 (_,_,z) = z +let top = L.hd +let rest = L.tl -let rec des amt coins curr acc stack = - match amt, coins, stack with - | _, _, [] -> acc - | 0, _, _ -> begin - let stack_top = L.hd stack in - let stack_rest = L.tl stack in - let get_amt = get_1 in - let get_coins = get_2 in - let get_curr = get_3 in - des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) (curr::acc) stack_rest - end - | _, [], _ -> begin - let stack_top = L.hd stack in - let stack_rest = L.tl stack in - let get_amt = get_1 in - let get_coins = get_2 in - let get_curr = get_3 in - des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) acc stack_rest - end - | _, (den, qty)::rst, _ -> begin - let new_amt = amt - den in - let new_coins = (den, qty -1)::rst in - if den > amt then - des amt rst curr acc stack - else if qty = 1 then - des new_amt rst (den::curr) acc stack - else if (L.tl coins) = [] || curr = [] then - des new_amt new_coins (den::curr) acc stack - else - des new_amt new_coins (den::curr) acc ((amt, rst, curr)::stack) - end +let rec run_cc (acc: int list list) (f : frame) (stack : frame list) : (int list list) = + match f.amt, f.coins, stack with + | 0, _, [] -> acc + | 0, _, _ -> run_cc (f.current_enum::acc) (top stack) (rest stack) + | _, [], [] -> acc + | _, [], _ -> run_cc acc (top stack) (rest stack) + | _, (den,qty)::rst ,_ -> + if den > f.amt then + let new_f = { amt = f.amt; coins = (rest f.coins); current_enum = f.current_enum } in + run_cc acc new_f stack + else + let new_coins = if qty == 1 then + rst + else (den, qty-1)::rst in + let left = { amt = (f.amt-den); coins = new_coins; current_enum = (den :: f.current_enum) } in + let right = { amt = f.amt; coins = rst; current_enum = f.current_enum } in + run_cc acc left (right::stack) -let cc amt (coins : ((int * int) list)) = - let rec aux c stack = - match c with - | [] -> des amt coins [] [] stack - | _ -> aux (L.tl c) (((amt, c, []))::stack) in - aux coins [] +let cc amt (coins : (int * int) list) = + run_cc [] { amt = amt; coins = coins; current_enum = [] } [] let coins_input : (int * int) list = - let cs = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in - let qs = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in - L.combine cs qs + let den = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in + let qty = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in + L.combine den qty let () = let x = cc n coins_input in diff --git a/benchmarks/multicore-numerical/count_change_iter_multicore.ml b/benchmarks/multicore-numerical/count_change_iter_multicore.ml index 346089397d..84f63fc87c 100644 --- a/benchmarks/multicore-numerical/count_change_iter_multicore.ml +++ b/benchmarks/multicore-numerical/count_change_iter_multicore.ml @@ -1,92 +1,84 @@ +let n = try int_of_string @@ Sys.argv.(1) with _ -> 120 let num_domains = try int_of_string @@ Sys.argv.(1) with _ -> 1 -let n = try int_of_string @@ Sys.argv.(2) with _ -> 960 module A = Array module L = List module T = Domainslib.Task -(* Selectors for tuples *) -let get_1 (x,_,_) = x +type coins = (int * int) list -let get_2 (_,y,_) = y +type frame = { amt : int; coins : coins; current_enum : int list } -let get_3 (_,_,z) = z +let top = L.hd -let rec des amt coins curr acc stack = - (* Descends down the left branch *) - match amt, coins, stack with - | _, _, [] -> acc - | 0, _, _ -> begin - let stack_top = L.hd stack in - let stack_rest = L.tl stack in - let get_amt = get_1 in - let get_coins = get_2 in - let get_curr = get_3 in - des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) (curr::acc) stack_rest - end - | _, [], _ -> begin - let stack_top = L.hd stack in - let stack_rest = L.tl stack in - let get_amt = get_1 in - let get_coins = get_2 in - let get_curr = get_3 in - des (get_amt stack_top) (get_coins stack_top) (get_curr stack_top) acc stack_rest - end - | _, (den, qty)::rst, _ -> begin - let new_amt = amt - den in - let new_coins = (den, qty -1)::rst in - if den > amt then - des amt rst curr acc stack - else if qty = 1 then - des new_amt rst (den::curr) acc stack - else if (L.tl coins) = [] || curr = [] then - des new_amt new_coins (den::curr) acc stack - else - des new_amt new_coins (den::curr) acc ((amt, rst, curr)::stack) - end +let rest = L.tl -let setup_stacks amt coins = - (* Assumes that the that qty for each den in coins is greater than or equal to 2 *) - let a = A.init (L.length coins) (fun _ -> (0,[], [], [])) in - let rec aux count c = - match c with - | [] -> a - | (den, qty)::rst -> begin - let new_amt = amt - den in - let new_c = (den, qty-1)::rst in - if den > amt then - aux count (L.tl c) - else if qty = 1 then begin - a.(count) <- (new_amt, (L.tl c), (den::[]), [(new_amt, rst, den::[])]); - aux (count+1) (L.tl c) - end else begin - a.(count) <- (new_amt, new_c, (den::[]), [(new_amt, rst, den::[])]); - aux (count+1) (L.tl c) - end - end +let rec run_cc first_call (acc: int list list) (f : frame) (stack : frame list) : (int list list) = + match f.amt, f.coins, stack with + | 0, _, [] -> acc + | 0, _, _ -> run_cc false (f.current_enum::acc) (top stack) (rest stack) + | _, [], [] -> acc + | _, [], _ -> run_cc false acc (top stack) (rest stack) + | _, (den,qty)::rst ,_ -> + if den > f.amt then + let new_f = { amt = f.amt; coins = (rest f.coins); current_enum = f.current_enum } in + run_cc false acc new_f stack + else + let new_coins = if qty == 1 then + rst + else (den, qty-1)::rst in + let left = { amt = (f.amt-den); coins = new_coins; current_enum = (den :: f.current_enum) } in + let right = { amt = f.amt; coins = rst; current_enum = f.current_enum } in + if not first_call then run_cc false acc left (right::stack) + else + run_cc false acc left stack + +let cc amt (coins : (int * int) list) = + run_cc true [] { amt = amt; coins = coins; current_enum = [] } [] + +let rec get_deductibles amt coins = + let den = fst @@ L.hd coins in + match (den > amt) with + | false -> coins + | true -> get_deductibles amt (L.tl coins) + +let setup_frames amt coins = + let coins = get_deductibles amt coins in + let clen = L.length coins in + let a = Array.make clen { amt = 0; coins = []; current_enum = [] } in + let rec aux count coins = + match count = clen with + | true -> a + | false -> begin + let f = { + amt = amt; + coins = coins; + current_enum = [] + } in + a.(count) <- f; + aux (count+1) (L.tl coins) + end in aux 0 coins -let cc_par pool amt (coins : ((int * int) list)) arr = - let setup = setup_stacks amt coins in +let sum_lengths arr = A.fold_left (+) 0 (A.map L.length arr) + +let cc_par pool amt (coins : ((int * int) list)) = + let stacks = setup_frames amt coins in + let arr = A.init (A.length stacks) (fun _ -> []) in let len = A.length arr in - let amt = fun (x, _, _, _) -> x in - let c = fun (_, x, _, _) -> x in - let curr = fun (_, _, x, _) -> x in - let stack = fun (_, _, _, x) -> x in T.parallel_for pool ~start:0 ~finish:(len-1) ~body:(fun i -> - arr.(i) <- des (amt setup.(i)) (c setup.(i)) (curr setup.(i)) [] (stack setup.(i)); - ) + let f = stacks.(i) in + arr.(i) <- cc f.amt f.coins + ); + Printf.printf "possibilites = %d\n" (sum_lengths arr) let coins_input : (int * int) list = - let cs = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in - let qs = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in - L.combine cs qs - -let arr = A.init (L.length coins_input) (fun _ -> []) + let den = [500 ; 250 ; 150; 100 ; 75 ; 50 ; 25 ; 20 ; 10 ; 5 ; 2 ; 1] in + let qty = [22; 55 ; 88 ; 88 ; 99 ; 99 ; 122; 122; 122 ; 122; 177; 177] in + L.combine den qty let _ = let pool = T.setup_pool ~num_additional_domains:(num_domains - 1) () in - T.run pool (fun () -> cc_par pool n coins_input arr); - Printf.printf "possibilites = %d\n" (A.fold_left (+) 0 (A.map L.length arr)); + T.run pool (fun () -> cc_par pool n coins_input); T.teardown_pool pool From cee6438fa8aa970658f75de01ab9283cba56cfee Mon Sep 17 00:00:00 2001 From: Moazzam Moriani Date: Thu, 18 Aug 2022 23:13:13 +0500 Subject: [PATCH 4/4] Add missing curly brace --- run_config.json | 1 + 1 file changed, 1 insertion(+) diff --git a/run_config.json b/run_config.json index 855eb30203..c94812a3fe 100644 --- a/run_config.json +++ b/run_config.json @@ -302,6 +302,7 @@ } ] }, + { "executable": "benchmarks/multicore-numerical/mergersort.exe", "name": "mergesort", "tags": [