jeudi 29 avril 2010

Project Euler #29

#load "nums.cma";;

open Big_int;;

let rec generate_combinations a1 a2 b1 b2 =
  let rec generate_single_number a b lim =
    if gt_big_int b lim then
      []
    else
      [power_big_int_positive_big_int a b] @ 
      generate_single_number 
        a (succ_big_int b) lim
  in
  if gt_big_int a1 a2 then
    []
  else
    (generate_single_number 
       a1 b1 b2) @ 
    (generate_combinations 
       (succ_big_int a1) a2 b1 b2);;

let rec uniq lst = match lst with
  [] -> []
| hd :: tl when List.exists (fun x -> eq_big_int x hd) tl -> uniq tl
| hd :: tl -> [hd] @ uniq tl;;

let a1 = big_int_of_int 2;;
let a2 = big_int_of_int 100;;
let b1 = big_int_of_int 2;;
let b2 = big_int_of_int 100;;
Printf.printf "%d\n" 
    (List.length 
       (uniq 
   (generate_combinations a1 a2 b1 b2)));;
Quick to come up but not so fast uniq function.

mercredi 28 avril 2010

Project Euler #28

let make_spiral n =
  if n mod 2 = 0 then
    raise (Invalid_argument "Size should be odd");
  let res = Array.make_matrix n n 0 in
  let last_value = n * n in
  let current_value = ref 1 in
  let i = ref (n / 2) in
  let j = ref (n / 2) in
  let shift = ref 1 in
  let delta = ref 1 in
  res.(!i).(!j) <- !current_value;
  while !current_value < last_value do
    for k = 1 to !shift do
      if !current_value < last_value then
        begin
          j := !j + !delta;
          current_value := !current_value + 1;
          res.(!i).(!j) <- !current_value;
        end;
    done;
    for k = 1 to !shift do
      if !current_value < last_value then
        begin
          i := !i + !delta;
          current_value := !current_value + 1;
          res.(!i).(!j) <- !current_value;
        end;
    done;
    delta := - !delta;
    shift := !shift + 1;
  done;
  res;;

let sum_diagonals arr = 
  let size = Array.length arr in
  let sum = ref 0 in
  for i = 0 to size - 1 do
    sum := !sum + arr.(i).(i) + arr.(i).(size - 1 - i)
  done;
  !sum - 1;;
    
Printf.printf "%d\n" (sum_diagonals (make_spiral 1001));;
Very bad OCaml ;)

lundi 26 avril 2010

Project Euler #23

(* generates array with values [1..n] *)
let rec range_array n =
  if n == 1 then
    [| n |]
  else
    Array.append (range_array (n - 1)) [| n |];;

(* calculates sum of proper divisors of given number *)
let sum_of_proper_divisors n =
  let limit = n / 2 in
  let rec sum_divisors k l =
    if k > l then
      0
    else
      if n mod k = 0 then
        k + sum_divisors (k + 1) l
      else
        sum_divisors (k + 1) l
  in
  if n = 1 then
    1
  else
    sum_divisors 1 limit;;

(* checks whether given number is abundant*)
let is_abundant n =
  n < sum_of_proper_divisors n;;

(* generates array of abundant number less than given number *)
let find_abundant_numbers n =
  let rec gen_numbers k =
    if k = n then
      [||]
    else
      if is_abundant k then
        Array.append [| k |] (gen_numbers (k + 1))
      else
        gen_numbers (k + 1)
  in
  gen_numbers 12;;

let binary_search (data:'a array) elem =
  let rec iter a b =
    if a = b then -1
    else
      let median = a + (b - a)/2 in
      match data.(median) with
      | value when value = elem -> median
      | value when value < elem -> iter (median + 1) b
      | _                       -> iter a median
  in
  iter 0 (Array.length data);;

let make_possible_sums a =
  let len = (Array.length a) - 1 in
  let res = Array.make_matrix (len + 1) (len + 1) 0 in
  for i = 0 to len do
    for j = i to len do
      res.(i).(j) <- a.(i) + a.(j)
    done
  done;
  res;;

(* sets all elements of a found in s to 0 *)
let refine_array a s =
  let to_delete = Array.make (Array.length a) false in
  let l1 = Array.length s in
  let l2 = Array.length s.(0) in
  for i = 0 to l1 - 1 do
    for j = 0 to l2 - 1 do
      let idx = binary_search a s.(i).(j) in
      if idx != -1 then
        to_delete.(idx) <- true
    done
  done;
  for i = 0 to (Array.length to_delete) - 1 do
    if to_delete.(i) then
      a.(i) <- 0
  done;;

let all_numbers = range_array 28123;;
let abundant_numbers_sums = make_possible_sums (find_abundant_numbers 28123);;
refine_array all_numbers abundant_numbers_sums;;

Printf.printf "%d\n" (Array.fold_left (+) 0 all_numbers);;
Straightforward and very slow but correct solution ;)

Project Euler #25


Quite obvious

vendredi 23 avril 2010

Project Euler #21

let proper_divisors_sum n =
  let limit = n / 2 in
  let rec proper_divisors_list n k =
    if k > limit then
      []
    else
      if n mod k = 0 then
        [k] @ (proper_divisors_list n (k + 1))
      else
        proper_divisors_list n (k + 1)
  in
  List.fold_left (+) 0 (proper_divisors_list n 1);;

let amicable_numbers_sum n =
  let rec amicable_numbers k =
    if k > n then
      []
    else
      let b = proper_divisors_sum k in
      let a = proper_divisors_sum b in
      if (a != b) && (a = k) then
        [k] @ (amicable_numbers (k + 1))
      else
        amicable_numbers (k + 1)
  in
  List.fold_left (+) 0 (amicable_numbers 2);;

Printf.printf "%d\n" (amicable_numbers_sum 10000);;
Quite straightforward and surely using lists ;) Actually we can sum without intermediate lists.

dimanche 18 avril 2010

Project Euler #24

(* swaps elements of indexes i and j in array a*)
let swap a i j =
  let t = a.(i) in
  a.(i) <- a.(j); a.(j) <- t;;

(* reverses part of array a from index i to the end of array*)
let reverse a i =
  let l = (Array.length a) - 1 in
  for k = 0 to (l - i)/2 do
    swap a (i + k) (l - k)
  done;;

(* generates next permutation of array *)
let make_next_permutation a =
  let j = ref 0 in
  let l = ref 0 in
  for i = 0 to (Array.length a) - 2 do
    if a.(i) < a.(i+1) then
      j.contents <- i
  done;
  for i = 0 to (Array.length a) - 1 do
    if a.(!j) < a.(i) then
      l.contents <- i
  done;
  swap a !j !l; 
  reverse a (!j+1);;

let make_permutations a =
  let t = ref 1 in
  while !t < 1000000 do
    make_next_permutation a; 
    t := (!t + 1); 
  done;;

let t = [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 |];;
make_permutations t;;
Array.iter (Printf.printf "%d") t;;
Printf.printf "\n";;

http://en.wikipedia.org/wiki/Permutation#Systematic_generation_of_all_permutations
Весьма императивное решение, с использованием ссылок.

lundi 12 avril 2010

Project Euler #22

#load "str.cma";;

let char_value c = (int_of_char c) - (int_of_char 'A') + 1;;

let word_value s =
  let word_length = String.length s in
  let rec sum_letters s n =
    if n == 0 then
      char_value s.[0]
    else
      (char_value s.[n]) + (sum_letters s (n-1))
  in
  sum_letters s (word_length - 1);;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> 
      try Some (input_line channel) 
      with End_of_file -> None);;

let lines datafile =
  let xs = ref [] in
  Stream.iter
    (fun x -> xs := x :: !xs)
    (line_stream_of_channel (open_in datafile));
  List.rev !xs;;

let content = List.sort (String.compare)
    (List.map 
       (fun x -> 
     let l = String.length x 
     in 
     String.sub x 1 (l - 2)) 
       (List.concat 
      (List.map
         (Str.split 
        (Str.regexp_string ","))
             (lines (Sys.argv.(1))))));;

let rec sum l n = match l with
  h :: t -> ((word_value h) * n) + (sum t (n+1))
| [] -> 0;;
       
Printf.printf "%d\n" (sum content 1)

Project Euler #18 and #67

#load "str.cma";;
#load "nums.cma";;

let array_of_string delim s = 
  Array.of_list 
    (List.map 
       (int_of_string) 
       (Str.split (Str.regexp_string delim) s));;

let line_stream_of_channel channel =
  Stream.from
    (fun _ -> 
      try Some (input_line channel) 
      with End_of_file -> None);;

let lines datafile =
  let xs = ref [] in
  Stream.iter
    (fun x -> xs := x :: !xs)
    (line_stream_of_channel (open_in datafile));
  List.rev !xs;;

let content = Array.of_list
    (List.map 
       (array_of_string " ") 
       (lines (Sys.argv.(1))));;

(* r1 - long array, r2 - short array *)
let max_row r1 r2 = 
  let lr2 = Array.length r2 in
  let sum = Array.make lr2 0 in
  for i = 0 to lr2 - 1 do
    sum.(i) <- max (r1.(i) + r2.(i)) (r1.(i+1) + r2.(i))
  done;
  sum;;

let calc_sum tr =
  let tl = Array.length tr in
  for n = tl - 1 downto 1 do
    tr.(n-1) <- (max_row tr.(n) tr.(n-1))
  done;
  tr.(0).(0);;
    
Printf.printf "%s\n" (string_of_int (calc_sum content))