diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/dialog.ml | 2 | ||||
| -rw-r--r-- | src/dialog.mli | 1 | ||||
| -rw-r--r-- | src/poly.ml | 109 | ||||
| -rw-r--r-- | src/visualwall.ml | 2 | ||||
| -rw-r--r-- | src/wall.ml | 94 | ||||
| -rw-r--r-- | src/wallgen.ml | 44 | ||||
| -rw-r--r-- | src/wallsolve.ml | 82 |
7 files changed, 197 insertions, 137 deletions
diff --git a/src/dialog.ml b/src/dialog.ml index 826d280..2658035 100644 --- a/src/dialog.ml +++ b/src/dialog.ml @@ -167,7 +167,7 @@ let save_export_file ~title ?(folder = "") ?(name = "") () = None else if Option.is_none choice || - overwrite_check ~filename:(Option.get choice) + overwrite_check ~filename:(Option.get choice) then choice else diff --git a/src/dialog.mli b/src/dialog.mli index 29bcf12..71dbb44 100644 --- a/src/dialog.mli +++ b/src/dialog.mli @@ -16,6 +16,7 @@ val save_file : ?folder:string -> ?name:string -> unit -> string option val export_file : ?folder:string -> ?name:string -> unit -> string option +(* I hate GTK colors *) val colors : fore:(int * int * int) -> back:(int * int * int) -> ((int * int * int) * (int * int * int)) option diff --git a/src/poly.ml b/src/poly.ml index ed32263..d5260ed 100644 --- a/src/poly.ml +++ b/src/poly.ml @@ -17,9 +17,10 @@ let one = PolyMap.singleton Z.zero Z.one let singleton ~coeff ~expnt = - if coeff = Z.zero - then zero - else PolyMap.singleton expnt coeff + if coeff = Z.zero then + zero + else + PolyMap.singleton expnt coeff let ( ~$ ) (a, b) = singleton ~coeff:a ~expnt:b @@ -35,10 +36,13 @@ let of_zint a = let of_arraylist_helper p (coeff,expnt) = - if coeff = Z.zero then p - else if PolyMap.mem expnt p - then PolyMap.add expnt Z.((PolyMap.find expnt p) + coeff) p - else PolyMap.add expnt coeff p + if coeff = Z.zero then + p + else + if PolyMap.mem expnt p then + PolyMap.add expnt Z.((PolyMap.find expnt p) + coeff) p + else + PolyMap.add expnt coeff p let to_list a = List.rev_map (fun (expnt,coeff) -> (coeff,expnt)) (PolyMap.bindings a) @@ -56,39 +60,36 @@ let of_array a = let degree p = match (PolyMap.max_binding_opt p) with - None -> Z.zero - | Some (k,v) -> k + None -> Z.zero + | Some (k,v) -> k let get_coeff ~expnt p = match (PolyMap.find_opt expnt p) with - None -> Z.zero - | Some v -> v + None -> Z.zero + | Some v -> v let stringifier (coeff, expnt) = let sign_str = if coeff < Z.zero then "-" else "+" in let coeff_str = - if Z.abs coeff = Z.one && expnt <> Z.zero - then "" + if Z.abs coeff = Z.one && expnt <> Z.zero then "" else Z.to_string (Z.abs coeff) in let expnt_str = - if expnt = Z.zero - then "" - else if expnt = Z.one - then "x" + if expnt = Z.zero then "" + else if expnt = Z.one then "x" else "x^" ^ (Z.to_string expnt) in (sign_str, coeff_str ^ expnt_str) let to_string a = - let pieces = List.map stringifier (to_list a) - in if List.length pieces = 0 - then "0" - else let first_term_sign = if fst (List.hd pieces) = "-" then "-" else "" in - let first_term = first_term_sign ^ (snd (List.hd pieces)) in - let term_concat s (x,y) = s ^ " " ^ x ^ " " ^ y in - let remaining_terms = List.fold_left term_concat "" (List.tl pieces) in - first_term ^ remaining_terms + let pieces = List.map stringifier (to_list a) in + if List.length pieces = 0 then "0" + else + let first_term_sign = if fst (List.hd pieces) = "-" then "-" else "" in + let first_term = first_term_sign ^ (snd (List.hd pieces)) in + let term_concat s (x,y) = s ^ " " ^ x ^ " " ^ y in + let remaining_terms = List.fold_left term_concat "" (List.tl pieces) in + first_term ^ remaining_terms let print a = print_string (to_string a) @@ -105,9 +106,11 @@ let pp_print format a = Format.pp_print_string format (" " ^ (fst item)); Format.pp_print_space format (); Format.pp_print_string format (snd item) in - if List.length pieces = 0 - then Format.pp_print_string format "0" - else (do_first (List.hd pieces); List.iter do_rest (List.tl pieces)) + if List.length pieces = 0 then + Format.pp_print_string format "0" + else + (do_first (List.hd pieces); + List.iter do_rest (List.tl pieces)) @@ -116,21 +119,18 @@ let neg = let add a b = let f key x y = - if Z.(x + y) = Z.zero - then None + if Z.(x + y) = Z.zero then None else Some Z.(x + y) in PolyMap.union f a b let sub a b = let f key x y = match (x, y) with - (None, None) -> None - | (Some v, None) -> Some v - | (None, Some v) -> Some Z.(~- v) - | (Some v1, Some v2) -> - if Z.(v1 - v2) = Z.zero - then None - else Some Z.(v1 - v2) + (None, None) -> None + | (Some v, None) -> Some v + | (None, Some v) -> Some Z.(~- v) + | (Some v1, Some v2) -> + if Z.(v1 - v2) = Z.zero then None else Some Z.(v1 - v2) in PolyMap.merge f a b let single_mul expnt coeff p = @@ -143,11 +143,13 @@ let mul a b = let div_rem a b = let rec helper dividend quotient remainder = - if dividend = zero - then (quotient, remainder) - else if degree b > degree dividend - then (quotient, add dividend remainder) - else let (dsor_expnt, dsor_coeff) = PolyMap.max_binding b in + if dividend = zero then + (quotient, remainder) + else + if degree b > degree dividend then + (quotient, add dividend remainder) + else + let (dsor_expnt, dsor_coeff) = PolyMap.max_binding b in let (dend_expnt, dend_coeff) = PolyMap.max_binding dividend in let (coeff_div, coeff_rem) = Z.div_rem dend_coeff dsor_coeff in let expnt_diff = Z.(dend_expnt - dsor_expnt) in @@ -155,17 +157,20 @@ let div_rem a b = let dividend_adjusted = sub dividend divisor_adjusted in let new_dividend = PolyMap.remove dend_expnt dividend_adjusted in let new_quotient = - if coeff_div <> Z.zero - then PolyMap.add expnt_diff coeff_div quotient - else quotient in + if coeff_div <> Z.zero then + PolyMap.add expnt_diff coeff_div quotient + else + quotient in let new_remainder = - if coeff_rem <> Z.zero - then PolyMap.add dend_expnt coeff_rem remainder - else remainder in - helper new_dividend new_quotient new_remainder - in if b = zero - then raise Division_by_zero - else helper a zero zero + if coeff_rem <> Z.zero then + PolyMap.add dend_expnt coeff_rem remainder + else + remainder in + helper new_dividend new_quotient new_remainder in + if b = zero then + raise Division_by_zero + else + helper a zero zero let div a b = fst (div_rem a b) diff --git a/src/visualwall.ml b/src/visualwall.ml index 773f226..bde6fd8 100644 --- a/src/visualwall.ml +++ b/src/visualwall.ml @@ -108,7 +108,7 @@ let main () = for j = 0 to !y_dim - 1 do for i = !x_offset to !x_dim + !x_offset - 1 do if My_Wall.has_value !number_wall ~x:i ~y:j && - Z.rem (My_Wall.get !number_wall ~x:i ~y:j) (Z.of_int !modulus) <> My_Algebra.zero + Z.rem (My_Wall.get !number_wall ~x:i ~y:j) (Z.of_int !modulus) <> My_Algebra.zero then !pixmap_area#set_foreground (`RGB !background_color) else diff --git a/src/wall.ml b/src/wall.ml index 6c11939..fd3f69d 100644 --- a/src/wall.ml +++ b/src/wall.ml @@ -57,16 +57,20 @@ module Make (A : Algebra) = let has_value wall ~x ~y = if x >= 0 && x < x_length wall && y >= 0 && y < y_length wall - then match wall.(x).(y) with - None -> false - | Some _ -> true - else false + then + match wall.(x).(y) with + None -> false + | Some _ -> true + else + false let get_opt wall ~x ~y = if x >= 0 && x < x_length wall && y >= 0 && y < y_length wall - then wall.(x).(y) - else None + then + wall.(x).(y) + else + None @@ -92,11 +96,13 @@ module Make (A : Algebra) = let next_valid_left wall ~x ~y = let rec walker x1 = - if x1 < 0 - then None - else if Option.is_some (get_opt wall ~x:x1 ~y) - then Some x1 - else walker (x1-1) in + if x1 < 0 then + None + else + if Option.is_some (get_opt wall ~x:x1 ~y) then + Some x1 + else + walker (x1-1) in walker x @@ -112,9 +118,10 @@ module Make (A : Algebra) = A.mul a a let rec power ~base ~num ~denom ~times = - if times <= 0 - then Some base - else let*? new_base = safe_div (A.mul base num) denom in + if times <= 0 then + Some base + else + let*? new_base = safe_div (A.mul base num) denom in power ~base:new_base ~num ~denom ~times:(times-1) @@ -160,9 +167,12 @@ module Make (A : Algebra) = let*? top = next_nonzero_up wall ~x ~y:(y-1) in let*? left = next_nonzero_left wall ~x ~y:(top+1) in let*? right = next_nonzero_right wall ~x ~y:(top+1) in - if y - 1 > top && right - left > 0 && right - left + 1 > y - 1 - top - then Some A.zero - else None + if y - 1 > top && right - left > 0 && + right - left + 1 > y - 1 - top + then + Some A.zero + else + None @@ -251,12 +261,14 @@ module Make (A : Algebra) = let rec attempt_order wall ~x ~y funcs = - if funcs = [] - then None - else let r = (List.hd funcs) wall ~x ~y in - if Option.is_some r - then r - else attempt_order wall ~x ~y (List.tl funcs) + if funcs = [] then + None + else + let r = (List.hd funcs) wall ~x ~y in + if Option.is_some r then + r + else + attempt_order wall ~x ~y (List.tl funcs) let create ~dimx ~dimy ~init = let result = Array.make_matrix dimx dimy None in @@ -273,8 +285,10 @@ module Make (A : Algebra) = let v = attempt_order result ~x:i ~y:j [cross_rule; long_cross_rule; zero_window; horseshoe_rule; broken_cross_rule] in result.(i).(j) <- v; - if Option.is_some v && Option.get v <> A.zero - then do_exit := false + if Option.is_some v && + Option.get v <> A.zero + then + do_exit := false done; if !do_exit then raise Exit done; @@ -292,16 +306,21 @@ module Make (A : Algebra) = let get wall ~x ~y = if x >= 0 && x < x_length wall && y >= 0 && y < y_length wall - then match wall.(x).(y) with - None -> raise Not_found - | Some v -> v - else raise Not_found + then + match wall.(x).(y) with + None -> raise Not_found + | Some v -> v + else + raise Not_found let last_nonzero_row wall = let rec checker x y = - if wall.(x).(y) <> Some A.zero && wall.(x).(y) <> None - then (if y + 1 = y_length wall then y else checker 0 (y + 1)) - else (if x + 1 = x_length wall then y - 1 else checker (x + 1) y) + if wall.(x).(y) <> Some A.zero && + wall.(x).(y) <> None + then + (if y + 1 = y_length wall then y else checker 0 (y + 1)) + else + (if x + 1 = x_length wall then y - 1 else checker (x + 1) y) in checker 0 0 @@ -310,13 +329,14 @@ module Make (A : Algebra) = let result = ref "" in for i = 0 to (x_length wall) - 2 do let v = wall.(i).(y) in - if Option.is_some v - then result := !result ^ (A.to_string (Option.get v)) ^ "," - else result := !result ^ "," + if Option.is_some v then + result := !result ^ (A.to_string (Option.get v)) ^ "," + else + result := !result ^ "," done; let v = wall.(x_length wall - 1).(y) in - if Option.is_some v - then result := !result ^ (A.to_string (Option.get v)); + if Option.is_some v then + result := !result ^ (A.to_string (Option.get v)); !result let to_string wall = diff --git a/src/wallgen.ml b/src/wallgen.ml index c27f0eb..240fbc4 100644 --- a/src/wallgen.ml +++ b/src/wallgen.ml @@ -18,25 +18,31 @@ let anon_fun item = let input_immediate items = - if Array.length !input_seq > 0 - then (prerr_endline "Error: Multiple input sequences specified"; exit 2) - else try input_seq := Util.read_integer_list items + if Array.length !input_seq > 0 then + (prerr_endline "Error: Multiple input sequences specified"; + exit 2) + else + try input_seq := Util.read_integer_list items with Util.Not_an_integer s -> prerr_endline ("Error: The argument '" ^ s ^ "' is not an integer"); exit 2 let input_from_file filename = - if Array.length !input_seq > 0 - then (prerr_endline "Error: Multiple input sequences specified"; exit 2) - else try input_seq := Util.read_sequence_file filename + if Array.length !input_seq > 0 then + (prerr_endline "Error: Multiple input sequences specified"; + exit 2) + else + try input_seq := Util.read_sequence_file filename with Util.Not_an_integer s -> prerr_endline ("Error: The item '" ^ s ^ "' from file '" ^ filename ^ "' is not an integer"); exit 2 let use_random len = - if Array.length !input_seq > 0 - then (prerr_endline "Error: Multiple input sequences specified"; exit 2) - else input_seq := Sequence.random ~len + if Array.length !input_seq > 0 then + (prerr_endline "Error: Multiple input sequences specified"; + exit 2) + else + input_seq := Sequence.random ~len @@ -65,14 +71,22 @@ module My_Wall = Wall.Make (My_Algebra) let _ = - if Array.length Sys.argv <= 1 then (Arg.usage speclist usage_msg; exit 1); + if Array.length Sys.argv <= 1 then + (Arg.usage speclist usage_msg; + exit 1); + Arg.parse speclist anon_fun usage_msg; - if Array.length !input_seq = 0 then (prerr_endline "Error: No input sequence provided"; exit 2); - let result = My_Wall.create - ~dimx:(Array.length !input_seq) - ~dimy:!depth_limit - ~init:!input_seq in + if Array.length !input_seq = 0 then + (prerr_endline "Error: No input sequence provided"; + exit 2); + + let result = + My_Wall.create + ~dimx:(Array.length !input_seq) + ~dimy:!depth_limit + ~init:!input_seq in + My_Wall.print result diff --git a/src/wallsolve.ml b/src/wallsolve.ml index 1e0e8e2..a626ab4 100644 --- a/src/wallsolve.ml +++ b/src/wallsolve.ml @@ -17,17 +17,21 @@ let anon_fun item = let input_immediate items = - if Array.length !input_seq > 0 - then (prerr_endline "Error: Multiple input sequences specified"; exit 2) - else try input_seq := Util.read_integer_list items + if Array.length !input_seq > 0 then + (prerr_endline "Error: Multiple input sequences specified"; + exit 2) + else + try input_seq := Util.read_integer_list items with Util.Not_an_integer s -> prerr_endline ("Error: The argument '" ^ s ^ "' is not an integer"); exit 2 let input_from_file filename = - if Array.length !input_seq > 0 - then (prerr_endline "Error: Multiple input sequences specified"; exit 2) - else try input_seq := Util.read_sequence_file filename + if Array.length !input_seq > 0 then + (prerr_endline "Error: Multiple input sequences specified"; + exit 2) + else + try input_seq := Util.read_sequence_file filename with Util.Not_an_integer s -> prerr_endline ("Error: The item '" ^ s ^ "' from file '" ^ filename ^ "' is not an integer"); exit 2 @@ -58,29 +62,39 @@ module My_Wall = Wall.Make (My_Algebra) let _ = - if Array.length Sys.argv <= 1 then (Arg.usage speclist usage_msg; exit 1); + if Array.length Sys.argv <= 1 then + (Arg.usage speclist usage_msg; + exit 1); + Arg.parse speclist anon_fun usage_msg; - if Array.length !input_seq = 0 then (prerr_endline "Error: No input sequence provided"; exit 2); - if Array.length !input_seq < 2 - then (prerr_endline "Error: Input sequence not long enough to solve"; exit 2); + if Array.length !input_seq = 0 then + (prerr_endline "Error: No input sequence provided"; + exit 2); + + if Array.length !input_seq < 2 then + (prerr_endline "Error: Input sequence not long enough to solve"; + exit 2); (* Convert input integer sequence into the right sort of input polynomial sequence. *) let poly_offset n = Poly.of_list [(Z.neg !input_seq.(n), Z.one); (!input_seq.(n+1), Z.zero)] in - let poly_inputs = Array.init (Array.length !input_seq - 1) poly_offset in + let poly_inputs = + Array.init (Array.length !input_seq - 1) poly_offset in (* Generate the number wall and look at the bottom most non-zero row. *) - let scribbles = My_Wall.create - ~dimx:(Array.length poly_inputs) - ~dimy:!depth_limit - ~init:poly_inputs in + let scribbles = + My_Wall.create + ~dimx:(Array.length poly_inputs) + ~dimy:!depth_limit + ~init:poly_inputs in let row_of_interest = My_Wall.last_nonzero_row scribbles in (* Test whether there is actually a row of zeros under the row of interest. *) - if row_of_interest = My_Wall.y_length scribbles - 1 - then (prerr_endline "Error: Depth limit too low to solve sequence"; exit 2); + if row_of_interest = My_Wall.y_length scribbles - 1 then + (prerr_endline "Error: Depth limit too low to solve sequence"; + exit 2); (* Test whether the row of interest has enough entries to be sure of them all being the same. *) let exists_pred x = @@ -89,8 +103,9 @@ let _ = Array.fold_left ( + ) 0 in let naturals_to n = Array.init n (fun n -> n) in - if array_sum (Array.map exists_pred (naturals_to (My_Wall.x_length scribbles))) < 3 - then (prerr_endline "Error: Input sequence not long enough to solve"; exit 2); + if array_sum (Array.map exists_pred (naturals_to (My_Wall.x_length scribbles))) < 3 then + (prerr_endline "Error: Input sequence not long enough to solve"; + exit 2); (* Need to normalize the polynomials in the row as if they were set equal to zero. *) let rec gcd a b = @@ -111,17 +126,20 @@ let _ = ~y:row_of_interest) in (* Check for degeneracy. *) - if Poly.degree key_poly = Z.zero - then (prerr_endline "Error: Result is degree zero, not sure how that happened"; exit 2); + if Poly.degree key_poly = Z.zero then + (prerr_endline "Error: Result is degree zero, not sure how that happened"; + exit 2); (* Check that all the polynomials in the row of interest are equal once normalized. *) let equals_pred x = let value = My_Wall.get_opt scribbles ~x ~y:row_of_interest in - if Option.is_some value - then normalize (Option.get value) = key_poly - else true in - if not (Array.for_all equals_pred (naturals_to (My_Wall.x_length scribbles))) - then (prerr_endline "Error: Polynomials differ, maybe try a longer sequence?"; exit 2); + if Option.is_some value then + normalize (Option.get value) = key_poly + else + true in + if not (Array.for_all equals_pred (naturals_to (My_Wall.x_length scribbles))) then + (prerr_endline "Error: Polynomials differ, maybe try a longer sequence?"; + exit 2); (* Print out the polynomial as if it was a recurrence relation with the highest degree term *) (* being on the left hand side and the remaining terms being on the right hand side. *) @@ -141,17 +159,19 @@ let _ = print_newline (); (* This... should probably never trigger, but might as well check anyway. *) - if Poly.degree key_poly > Z.of_int (Array.length !input_seq) - then (prerr_endline "Error: Recurrence relation longer than input sequence... wtfhow?"; exit 2); + if Poly.degree key_poly > Z.of_int (Array.length !input_seq) then + (prerr_endline "Error: Recurrence relation longer than input sequence... wtfhow?"; + exit 2); (* Calculate and print the predicted next number of the input sequence. *) let calc_next p inp = let lhs = List.hd p in let rhs = List.map (fun (x,y) -> (Z.neg x, y)) (List.tl p) in let rec process result terms = - if terms = [] - then result - else let current = List.hd terms in + if terms = [] then + result + else + let current = List.hd terms in let index = Array.length inp - Z.(to_int (snd lhs - snd current)) in process Z.(result + fst current * inp.(index)) (List.tl terms) in Z.div (process Z.zero rhs) (fst lhs) in |