Ocaml/FAQ/Numbers

(* Something like this must be done differently in OCaml because of its
* type-safety.  Some of the tests will use regular expressions, but most won't *)
let has_NonDigits s = 
  try ignore (search_forward (regexp "[^0-9]") s); true
  with Not_found -> true;;
let is_NaturalNumber s =
  try let n = int_of_string s in n > 0 with Failure _ -> false;;
let is_Integer s =
  try ignore(int_of_string s); true with Failure _ -> false;;
let is_DecimalNumber s =
  try ignore(int_of_string s); true with Failure _ ->
    try let n = float_of_string s in (abs_float f) >= 1. 
    with Failure _ -> false;;
let is_CFloat s = 
  try ignore(float_of_string s); true 
  with Failure _ -> false;;
 
(* One of the above predicates can then be used as needed *)
if predicate s then
  (* is a number *)
else
  (* is not a number *)

(*-----------------------------*)
(* equalStr num1 num2 accuracy returns true if num1 and num2 
   are equal to accuracy decimal places *)
 
(* done by converting to strings, a la the Perl example *)   
let equalStr num1 num2 accuracy =
  let p x = sprintf "%.*f" accuracy x in
  (p num1) = (p num2)
 
(* Done in a more or less sane way, i.e. treating them as numbers *)
let equal num1 num2 accuracy =
  let chop x = floor (x *. (10. ** (float accuracy))) in
  (chop num1) = (chop num2);;
 
(*-----------------------------*)
let wage = 536;;
let week = 40 * wage;;
Printf.printf "One week's wage is %.2f\n" ((float week) /. 100.);;
(*-----------------------------*)

(*-----------------------------*)
let rounded digits fl = float_of_string (sprintf "%.*f" digits fl);;
(*-----------------------------*)
let a = 0.255;;
let b = float_of_string (sprintf "%.2f" a);;
let c = rounded 2 a;;
printf "Unrounded %f\nRounded %f\nOther rounded %f\n" a b c;;
printf "Unrounded %f\nRounded %.2f\nOther rounded %f\n" a c (rounded 2 a);;
 
(*
 * Unrounded 0.255000
 * Rounded 0.260000
 * Other rounded 0.260000
 * Unrounded 0.255000
 * Rounded 0.26
 * Other rounded 0.260000
 *)
 
(*-----------------------------*)
(* To "round" to the nearest integer, use ceil, floor, or truncate.  Note that
truncate converts the float to an integer, so a conversion back to a float is
necessary *)
let fs = [3.3; 3.5; 3.7; -. 3.3];;
printf "number\tint\tfloor\tceil\n";
List.iter 
  (fun x -> printf "%.1f\t%.1f\t%.1f\t%.1f\n" x (float (truncate x)) (floor x) (ceil x)) 
  fs;;
 
(*
 * number       int     floor   ceil
 * 3.3  3.0     3.0     4.0
 * 3.5  3.0     3.0     4.0
 * 3.7  3.0     3.0     4.0
 * -3.3 -3.0    -4.0    -3.0
 *) 
 
(* Or if you really want an integer in column 2 *)
printf "number\tint\tfloor\tceil\n";
List.iter 
  (fun x -> printf "%.1f\t%d\t%.1f\t%.1f\n" x (truncate x) (floor x) (ceil x)) 
  fs;;
 
(* 
 * number       int     floor   ceil
 * 3.3  3       3.0     4.0
 * 3.5  3       3.0     4.0
 * 3.7  3       3.0     4.0
 * -3.3 -3      -4.0    -3.0
 *)

(*-----------------------------*)
(* 
 * Two versions in each direction -- one to deal with decimal strings,
 * and the other to deal with decimal integers.  Binary numbers will
 * always be strings 
 *)
 
let binStr_of_decInt i =
  let rec strip_bits i s =
    match i with
      0 -> s
    | _ -> strip_bits (i lsr 1) ((string_of_int (i land 0x01)) ^ s) in
  strip_bits i "";;
 
let binStr_of_decStr i =
  let rec strip_bits i s =
    match i with
      0 -> s
    | _ -> strip_bits (i lsr 1) ((string_of_int (i land 0x01)) ^ s) in
  strip_bits (int_of_string i) "";;
(* Of course if you have binStr_of_decInt already, it's easier to just call
   binStr_of_decInt (int_of_string i) *)
 
(*-----------------------------*)
let decInt_of_binStr s =
  int_of_string ("0b" ^ s);;
 
let decStr_of_binStr s =
  string_of_int (int_of_string ("0b" ^ s));;
(*-----------------------------*)
let numInt = decInt_of_binStr "0110110";; (* numInt = 54 *)
let numInt = decStr_of_binStr "0110110";; (* numInt = "54" *)
let bin1 = binStr_of_decInt 54;;   (* bin1 = "110110" *)
let bin2 = binStr_of_decStr "54";; (* bin2 = "110110" *)
(*-----------------------------*)

(*-----------------------------*)
(* The boring way is to use a for loop... *)
for i = low to high do
  (* Do your stuff *)
  (* Note, if what you want to do in the loop does not have have type unit, you
     need to wrap it with ignore, e.g. ignore (2 * i) *)
done
 
(* Or you skip the syntactic sugar and write it recursively yourself *)
let rec loop low high f =
  if low > high then
    ()
  else
    begin
      ignore (f low);
      loop (succ low) high f
    end;;
 
(* and now with stepsize different from 1 *)
let rec loopStep low high step f =
  if low > high then
    ()
  else
    begin
      ignore (f low);
      loopStep (low + step) high f
    end;;
 
 
(* Or, if you don't mind wasting space, you can use the useful iter functions
 *)
(* Array based *)
let makeArraySequence lo hi =
  Array.init (hi - lo + 1) (fun i -> i + lo);;
Array.iter ( your function here ) (makeArraySequence lo hi);;
 
(* List based *)
let makeListSequence lo hi = 
  let rec msHelper lo hi l =
    match (a - b) with
    0 -> b::l
        | _ -> msHelper a (b-1) (b::l) in
  msHelper lo hi [];;
List.iter ( your function here ) (makeListSequence lo hi);;
(*-----------------------------*)
printf "Infancy is: ";
for i = 0 to 2 do
  printf "%d " i
done;;
 
print_newline();;
 
printf "Toddling is: ";
loop 3 4 (fun i -> printf "%d " i);;
 
print_newline ();;
 
printf "Childhood is: ";
Array.iter (fun i -> printf "%d " i) (makeArraySequence 5 12);;
 
print_newline();;
 
(*
 * Infancy is: 0 1 2
 * Toddling is: 3 4
 * Childhood is: 5 6 7 8 9 10 11 12
 *) 
(*-----------------------------*)

(* Based on Groovy version by Paul King. *)
 
let roman_map =
  [1000, "M"; 900, "CM"; 500, "D"; 400, "CD"; 100, "C"; 90, "XC";
   50,   "L"; 40,  "XL"; 10,  "X"; 9,   "IX"; 5,   "V"; 4,  "IV"; 1, "I"]
 
let roman arabic =
  let rec loop remains text map =
    match map with
      | (key, value) :: rest ->
          if remains >= key
          then loop (remains - key) (text ^ value) map
          else loop remains text rest
      | [] -> text in
  loop arabic "" roman_map
 
let arabic roman =
  let rec loop text sum map =
    match map with
      | (key, value) :: rest ->
          if (String.length text >= String.length value
              && String.sub text 0 (String.length value) = value)
          then (loop
                  (String.sub
                     text
                     (String.length value)
                     (String.length text - String.length value))
                  (sum + key)
                  map)
          else loop text sum rest
      | [] -> sum in
  loop (String.uppercase roman) 0 roman_map
 
(*-----------------------------*)
 
(* Alternative version by Ken Wakita. *)
let roman arabic =
  let nstr s n = String.concat "" (Array.to_list (Array.make n s)) in
  snd (List.fold_left
         (fun (arabic, roman) (arab, rom) ->
           arabic mod arab, roman ^ (nstr rom (arabic / arab)))
         (arabic, "")
         roman_map)
 
(*-----------------------------*)
 
let () =
  let roman_fifteen = roman 15 in
  Printf.printf "Roman for fifteen is %s\n" roman_fifteen;
  let arabic_fifteen = arabic roman_fifteen in
  Printf.printf "Converted back, %s is %d\n" roman_fifteen arabic_fifteen
 
(* Roman for fifteen is XV
   Converted back, XV is 15 *)

(*-----------------------------*)
let random_int lo hi =
  (Random.int (hi - lo + 1)) + lo;;
 
let random_float lo hi =
  (Random.float (hi -. lo +. 1.)) +. lo;;
(*-----------------------------*)
let random_number = random_int 25 75 in
  printf "%d\n" random_number;;
(*-----------------------------*)
let elem = arr.(Random.int (Arry.length arr))
(*-----------------------------*)
let uc = Array.init 26 (fun i -> Char.chr (i+ (Char.code 'A')))
and lc = Array.init 26 (fun i -> Char.chr (i+ (Char.code 'a')))
and nums = Array.init 10 (fun i -> Char.chr (i + (Char.code '0')))
and puncs = [| '!'; '@'; '$'; '%'; '^'; '&'; '*' |];;
let chars = Array.concat [uc; lc; nums; puncs];;
 
(* to generate the random password as a char array *)
let password = Array.init 8 (fun i -> chars.(Random.int (Array.length chars)));;
(* to generate the random password as a string *)
let passString = 
  let s = String.make 8 ' ' in
  for i=0 to 7 do 
        s.[i] <- chars.(Random.int (Array.length chars))
  done;
  s;;
 
(*-----------------------------*)

(* Seed the generator with an integer *)
Random.init 5;;
 
(* Seed the generator with an array of integers *)
Random.full_init [| 1; 2; 178653; -62 |];;
 
(* Automatically seed the generator in a system-dependant manner *)
Random.self_init ();;

(* This requires installation of the third party the cryptokit library... *)
let prng = Cryptokit.Random.secure_rng;;
let buf = String.make 10 ' ';;
(* random_bytes buf pos len stores len random bytes in string buf, starting at position pos *)
prng#random_bytes buf 0 10;;  (* buf now contains 10 random bytes *)

(* Note that this will return just one of the numbers, as returning either one
* or the other would requires always constructing an array or a list -- this
* just returns a float *)
 
let gaussianRand () =
  let rec getW () =
    let u1 = 2. *. (Random.float 1.) -. 1.
    and u2 = 2. *. (Random.float 1.) -. 1. in
    let w = u1 *. u1 +. u2 *. u2 in
    if w >= 0. then w,u1,u2 else getW () in
  let w,u1,u2 = getW () in
  let w = sqrt((-2. *. (log w)) /. w) in
  let g2 = u1 *. w
  and g1 = u2 *. w in
  g1;; 
 
 
(* note that because of the way dist is used, it makes the most sense to return
* it as a sorted associative list rather than another hash table *)
let weightToDist whash =
  let total = Hashtbl.fold (fun k v b -> b +. v) whash 0. in
  let dist = Hashtbl.fold (fun k v b -> (v,k)::b) whash [] in
  List.sort compare dist;;
 
let rec weightedRand dhash =
  let r = ref (Random.float 1.) in
  try 
    let v,k = List.find (fun (v,k) -> r := !r -. v; !r < 0.) dhash in k
  with Not_found -> weightedRand dhash;;  
 
let mean,dev = 25.,2. in
let salary = gaussianRand () *. sdev +. mean;;
printf "You have been hired at $%.2f\n" salary;;

let pi = acos(-. 1.);;
let degrees_of_radians r = 180. *. r /. pi;;
let radians_of_degrees d = d *. pi /. 180.;;
 
let sinDeg d = sin (radians_of_degrees d);;
let cosDeg d = cos (radians_of_degrees d);;

(* cos, sin, tan, acos, asin, atan, sinh, cosh and tanh are all standard
functions, but missing functions, such as secant can be construced in the usual
way... *)
 
let sec x = 1. /. (sin x);;

(* to take a natural log, use the log function *)
let log_e = log 100.;;
 
(* to take a log to base 10, use the log10 function *)
let log_10 = log10 100.;;
 
(* to take a log to an arbitrary base, use traditional identities *)
let logB base x = (log x) /. (log base);;

let mmult m1 m2 =
  let dim m =
    Array.length m,Array.length m.(0) in
  let r1,c1 = dim m1
  and r2,c2 = dim m2 in
  if c1 <> r2 then raise (Invalid_argument "Matrix dimensions don't match")
  else
    begin
      let dotP v1 v2 =
        let sum = ref 0. in
        for i = 0 to Array.length v1 - 1 do 
          sum := !sum +. (v1.(i) *. v2.(i))
        done;
        !sum in
      let row m i = m.(i)
      and col m i = Array.init (Array.length m) (fun r -> m.(r).(i)) in
      let res = Array.make_matrix r1 c2 0. in
      for r = 0 to pred r1 do
        for c = 0 to pred c2 do
          res.(r).(c) <- dotP (row m1 r) (col m2 c)
        done
      done;
      res
    end;;

(*-----------------------------*)
(* c = a * b manually *)
type cplx = { real : float; imag : float; };;
let c = {real = a.real *. b.real -. a.imag *. b.imag;
         imag = a.imag *. b.real +. b.imag *. a.real};;
(*-----------------------------*)
 
(* c = a * b using the Complex module *)
open Complex;;
 
let c = Complex.mul a b;;
(* Note that we could have simply said let c = mul a b, but a later binding of a value to the
   name mul would render the complex mul invisible after that, Complex.mul is
   less ambiguous. *)
(*-----------------------------*)
let a = {real=3.; imag=5.};;
let b = {real=2.; imag=(-. 2.);}
let c = {real = a.real *. b.real -. a.imag *. b.imag;
         imag = a.imag *. b.real +. b.imag *. a.real};;
printf "c = %f+%fi\n" c.real c.imag;;
 
(* c = 16.000000+4.000000i *)
 
let a = {re=3.; im=5.};;
let b = {re=2.; im=(-. 2.);}
let c = mul a b;;
printf "c = %f+%fi\n" c.re c.im;;
 
(* c = 16.000000+4.000000i *)
 
let d = {re=3.; im=4.};;
let s = sqrt d in
printf "sqrt(%.2f+%.2fi) = %.2f+%.2fi\n" d.re d.im s.re s.im;;
 
(* sqrt(3.00+4.00i) = 2.00+1.00i *)

(* Since integers and strings are very different things in OCaml, we will
   represent both octal and hexidecimal values as strings *)
 
let oct_of_hex h =
  Printf.sprintf "%0o" (int_of_string ("0x" ^ h));;
let hex_of_oct o =
  Printf.sprintf "%0x" (int_of_string ("0o" ^ o));;
 
(* One small problem is that OCaml integers are 31 (or 63) bit values, if you need
   something larger, you can use the following for a full 32 bits: *)
let oct_of_hex32 h =
  Printf.sprintf "%0lo" (Int32.of_string ("0x" ^ h));;
let hex_of_oct32 o =
  Printf.sprintf "%0lx" (Int32.of_string ("0o" ^ o));;
 
(* Or this for 64 bits: *)
let oct_of_hex64 h =
  Printf.sprintf "%0Lo" (Int64.of_string ("0x" ^ h));;
let hex_of_oct64 o =
  Printf.sprintf "%0Lx" (Int64.of_string ("0o" ^ o));;
 
(* For anything else you have to roll your own *)
let chopn n s =
  (* Chops strings into list of n byte substrings *)
  match s with 
    "" -> [""] (* avoids wierd edge case *)
    | _ ->
      let ex = (String.length s) mod n in
      let ss = if ex = 0 then s else ((String.make (n-ex) '0') ^ s) in
      let rec schopn x s l =
        match x with
          0 -> (String.sub s 0 n)::l
          | _ -> schopn (x-n) s ((String.sub s x n)::l) in
      schopn (String.length ss - n) ss [];;
 
let long_oct_of_hex h =
  let choppedH = chopn 6 h in
  let f x = int_of_string ("0x" ^ x) in
  String.concat "" (List.map (fun x -> Printf.sprintf "%08o" (f x)) choppedH);;
 
let long_hex_of_oct o =
  let choppedO = chopn 8 o in
  let f x = int_of_string ("0o" ^ x) in
  String.concat "" (List.map (fun x -> Printf.sprintf "%06x" (f x)) choppedO);;
(*-----------------------------*)
(* Since octal, hex and decimal are all the same internally, we don't need to do
    any explicit conversion *)
printf "Gimme a number in decimal, octal, or hex: ";;
let num = read_int ();;
printf "%d %x %o\n" num num num;;
(*-----------------------------*)
printf "Enter file permission in octal: ";;
let permissions = try read_int ()
with Failure message -> failwith "Exiting...\n";;
printf "The decimal value is %d\n" permissions;;

(* This example requires the PCRE library, available at:
   http://www.ocaml.info/home/ocaml_sources.html#pcre-ocaml *)
#directory "+pcre";;
#load "pcre.cma";;
 
let rev_string s =
  let s' = String.copy s in
  let i = ref (String.length s - 1) in
  String.iter (fun c -> s'.[!i] <- c; decr i) s;
  s'
 
let commify s =
  rev_string
    (Pcre.replace ~pat:"(\\d\\d\\d)(?=\\d)(?!\\d*\\.)" ~templ:"$1,"
       (rev_string s))
 
(*-----------------------------*)
 
(* more reasonable web counter :-) *)
let () =
  Random.self_init ();
  let hits = Random.int32 2147483647l in
  Printf.printf "Your web page received %s accesses last month.\n"
    (commify (Int32.to_string hits))
(* Your web page received 1,670,658,439 accesses last month. *)

(* Hardcoded examples can be done as follows: *)
Printf.printf "It took %d hour%s\n" n (if n <> 1 then "s" else "");;
Printf.printf "It took %d centur%s\n" n (if n <> 1 then "ies" else "y");;
 
(* For a more general solution *)
(* First define the rules *)
(* Note: the OS needs to support dynamic loading of C libraries for this *)
#load "str.cma";;
 
let rules = 
  List.map (fun x -> (Str.regexp (fst x)),(snd x))
    ["\\([psc]h\\)$\\|z$","\\0es";
     "\\(ff\\)$\\|\\(ey\\)$","\\0s";
     "f$","ves";
     "y$","ies";
     "ix$","ices";
     "ius$","ii";
     "[sx]$","\\0es";
     "non","na"];;
 
let f w x =
  ignore(Str.search_forward (fst x) w 0); 
  Str.replace_first (fst x) (snd x) w;;
 
let rec exn_map ex fn1 fn2 l =
  match l with
    [] -> fn2
  | h::t -> try (fn1 h) with ex -> exn_map ex fn1 fn2 t;;
 
let pluralize x = (* "wish" in *)
  exn_map Not_found (f x) (x ^ "s") rules;;
 
(* Note: This next example doesn't work on the odd cases *)
let nouns = ["fish"; "fly"; "ox"; "species"; "genus"; "phylum"; "cherub";
             "radius"; "jockey"; "index"; "matrix"; "mythos"; "phenomenon";
             "formula"];;
List.iter (fun x -> printf "One %s, two %s\n" x (pluralize x)) nouns;;

(* Note: the OS needs to support dynamic loading of C libraries for this
   otherwise you will need to link the nums library with the code at comple time *)
#load "nums.cma";;
open Big_int;;
 
let cmd = [|"bigfact"; "8"; "9"; "96"; "2178"; 
            "239322000000000000000000"; "25000000000000000000000000"; "17"|];;
 
(* This will raise an exception if a nonnumeric string is in the argument list
*)
let argList = 
  Array.map big_int_of_string (Array.sub cmd 1 ((Array.length cmd) - 1));;
 
let factorize num = 
  let two = big_int_of_int 2 and four = big_int_of_int 4 in
  let rec genFactors (i,sqi) n fList =
    if eq_big_int n unit_big_int then fList else
    if lt_big_int n sqi then ((n,1)::fList) else
      let newn = ref n and fcount = ref 0 in
      while  (eq_big_int (mod_big_int !newn i) zero_big_int) do
          newn := div_big_int !newn i;
          fcount := !fcount + 1;
      done;
      let nexti,nextsqi = 
          if eq_big_int i two then
              (add_big_int i unit_big_int),
                (add_big_int sqi (add_big_int (mult_big_int i two)
                 unit_big_int))
          else
              (add_big_int i two),
                (add_big_int sqi (add_big_int (mult_big_int i four) two)) in
      genFactors (nexti,nextsqi) !newn (if !fcount = 0 then fList else
          ((i,!fcount)::fList)) in
   genFactors (two,four) num [];;
 
let _ = 
  Array.iter
  (fun n ->
    let l = factorize n in
    match l with
      [(x,1)] -> printf "%s\tPrime!\n" (string_of_big_int x)
    | _ -> 
        printf "%s\t" (string_of_big_int n);
        List.iter
          (fun (x,count) -> let sx = string_of_big_int x in
            if count = 1 then printf "%s " sx
            else printf "%s**%d " sx count)
          (List.rev l);
    print_newline()) argList;;