Euler #74

Determine the number of factorial chains that contain exactly sixty non-repeating terms.

Quite straightforward...

Euler #65

Find the sum of digits in the numerator of the 100th convergent of the continued fraction for e.

Project Euler #35

let is_prime n =
  if n < 0 then
    false
  else
    let lim = int_of_float (sqrt (float_of_int n)) in
    let rec check_mod i l =
      if i > l then
        true
      else
        if n mod i = 0 then
          false
        else
          true && (check_mod (succ i) l)
    in
    check_mod 2 lim;;

let primes n =
  let rec inner_primes i =
    if i > n then
      []
    else
      if is_prime i then
        [i] @ inner_primes (succ i)
      else
        inner_primes (succ i)
  in
  inner_primes 2;;

let circulations n = 
  let rec circulate str =
    let str_len = String.length str in
    if str_len = 1 then
      [int_of_string n]
    else
      let variant = (String.sub str 1 (str_len - 1)) ^ (String.sub str 0 1) in
      if variant = n then
        [(int_of_string variant)]
      else
        [(int_of_string variant)] @ (circulate variant)
  in
  circulate n;;

(*
let is_circular n primes = 
  let number_string = string_of_int n in
  let variants = circulations number_string in
  List.fold_left 

    (&&) 

    true 

    (List.map 

      (fun x -> List.exists (fun y -> (x = y)) primes) 

      variants);;
*)

let is_circular n =
  let number_string = string_of_int n in
  let variants = circulations number_string in
  List.fold_left (&&) true (List.map (is_prime) variants);;

let primes_till_1e6 = primes 1000000;;
let test_primes = primes_till_1e6;;

Printf.printf "%d\n" 
    (List.fold_left 
       (+) 
       0 
       (List.map 
         (fun x -> if (is_circular x) then 1 else 0 ) 
         test_primes));;

Strange thing: List.exists is quite slow, so when I switched from using List.exists (commented out) to just plain is_prime in is_circular it became possible to get result in a minute. Or maybe I just can't use List.exists properly.

Project Euler #27

#load "nums.cma"

open Big_int;;

type triple = { a: big_int; 
                b: big_int; 
                len: big_int };;

let is_prime n =
  if lt_big_int n zero_big_int then
    false
  else
    let lim = sqrt_big_int n in
    let rec check_mod i l =
      if gt_big_int i  l then
        true
      else
        if eq_big_int (mod_big_int n i) zero_big_int then
          false
        else
          true && (check_mod (succ_big_int i) l)
    in
    check_mod (big_int_of_int 2) lim;;
      
let primes n =
  let rec inner_primes i =
    if gt_big_int i n then
      []
    else
      if is_prime i then
        [i] @ inner_primes (succ_big_int i)
      else
        inner_primes (succ_big_int i)
  in
  inner_primes (big_int_of_int 2);;

let make_form a b = 
  fun n -> 
    add_big_int 
      (mult_big_int n n) 
      (add_big_int (mult_big_int a n) b);;

let sequence_length f =
  let rec advance_sequence n =
    if not (is_prime (f n)) then
      zero_big_int
    else
      add_big_int 
        unit_big_int (advance_sequence (succ_big_int n))
  in
  advance_sequence (big_int_of_int 0);;

let triple_max a b =
  if gt_big_int a.len b.len then
    a
  else
    b;;

let find_longest_sequence i1 i2 n =
  let rec make_lengths_list i =
    if gt_big_int i i2 then
      []
    else
      [{ a=i; b=n; len=sequence_length (make_form i n); }] @ 
      (make_lengths_list (succ_big_int i))
  in
  List.fold_left (triple_max) 
    { a=zero_big_int; b=zero_big_int; len=zero_big_int; } 
    (make_lengths_list i1);;

let bs = primes (big_int_of_int 1000);;
let a1 = big_int_of_string "-999";;
let a2 = big_int_of_string "999";;

let max_ab = List.fold_left (triple_max) 
    { a=zero_big_int; b=zero_big_int; len=zero_big_int; } 
    (List.map (find_longest_sequence a1 a2) bs);;

Printf.printf "%s\n" 
    (string_of_big_int (mult_big_int max_ab.a max_ab.b));;

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.

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 ;)

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

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.

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
Весьма императивное решение, с использованием ссылок.

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))

Project Euler #20

#load "nums.cma";;

open Big_int;;

let rec factorial n =
  if eq_big_int n unit_big_int then
    unit_big_int
  else
    mult_big_int n (factorial (pred_big_int n));;

let int_list_of_string s =
  let len = String.length s in
  let rec chars_of_string s n =
    if n == 0 then
      [int_of_char s.[0] - int_of_char '0']
    else
      (chars_of_string s (n - 1)) @ [(int_of_char s.[n]) - int_of_char '0']
  in
  chars_of_string s (len - 1);;
  
Printf.printf "%d\n" 
    (List.fold_left 
       (+) 
       0 
       (int_list_of_string 
      (string_of_big_int 
         (factorial 
        (big_int_of_int 100)))));;

Project Euler #6

#load "nums.cma"

open Big_int;;

let rec sum_of_squares n = 
  if eq_big_int n unit_big_int then
    unit_big_int
  else
    add_big_int (square_big_int n) (sum_of_squares (pred_big_int n));;

let square_of_sum n =
  let rec sum n =
    if eq_big_int n unit_big_int then
      unit_big_int
    else
      add_big_int n (sum (pred_big_int n))
  in
  square_big_int (sum n);;

let s1 = sum_of_squares (big_int_of_int 100);;
let s2 = square_of_sum (big_int_of_int 100);;

let result = sub_big_int s2 s1;;

Printf.printf "%s\n" (string_of_big_int result);;

Сначала написал с использованием встроенных int, перепутал местами суммы при вычитании, получил отрицательный результат, подумал, что проблема с переполнением int, переписал при помощи Big_int, после чего и обнаружил, что перепутал суммы местами.

Project Euler #4

(* Checks if int is palindrome *)
let is_palindrome n = 
  let str = string_of_int n in
  let len = String.length str in
  let rec check_char s n =
    if n == len - 1 then
      (String.get s n == String.get s 0)
    else
      (String.get s n == String.get s (len - 1 - n)) && (check_char s (n + 1))
  in
  check_char str 0;;

(* check if n is a product of two 3-digit numbers *)
let is_product n = 
  let rec check_numbers i j n =
    let rest = n mod i in
    let modulo = n / i in
    let mod_length = String.length (string_of_int modulo) in
    if i = j then
      false
    else if (rest == 0) && (mod_length == 3) then 
      begin
        Printf.printf "%d %d\n" i modulo;
        true
      end
    else
      check_numbers (i+1) j n
  in
  check_numbers 100 999 n;;

(* looks for palindromes which a products of two 3-digit numbers*)
let rec check_range n m =
  if n == m then
    -1
  else if (is_palindrome n) && (is_product n) then
    n
  else
    check_range (n-1) m;;

Printf.printf "%d\n" (check_range 998001 10000)

Изначально пытался просто переделать двойной цикл с проверкой в рекурсию, в итоге оказалось проще перебрать числа в одной рекурсии.

Project Euler #3

#load "nums.cma"

open Big_int;;

let num = big_int_of_string "600851475143";;

let solution n =
  let rec factorize m p =
    if ge_big_int p m then
      Printf.printf "%s\n" (string_of_big_int m)
    else
      if eq_big_int (mod_big_int m p) zero_big_int then
        factorize (div_big_int m p) (big_int_of_int 2)
      else
        factorize m (succ_big_int p)
  in
  factorize n (big_int_of_int 2);;

solution num;;

Решение вида "а давайте-ка найдем все простые числа до sqrt(N), а потом найдем максимальное, которое разделит N без остатка", что прокатило для C++, в Ocaml оказалось неосуществимо в разумные сроки ;)

Project Euler #2

#load "nums.cma";;
open Big_int;;

let rec fib a b = function
        | 0 -> a
        | 1 -> b
        | n when n > 1 -> fib b (add_big_int a b) (n - 1)
        | _ -> raise (Invalid_argument "");;

let rec fib_range n =
        let fn = fib zero_big_int unit_big_int n in
        if lt_big_int fn (big_int_of_string "4000000") then
                if eq_big_int 
                (mod_big_int fn (big_int_of_int 2)) 
                zero_big_int then
                        fn :: (fib_range (n + 1))
                else
                        zero_big_int :: fib_range (n + 1)
        else
                [];;

Printf.printf "%s\n" (string_of_big_int 
(List.fold_left (add_big_int) zero_big_int (fib_range 0)));;

Генерация списка по причинам детского восторга от fold, в принципе можно было сразу суммировать.

Project Euler #1

let rec range n m = if n > m then [] else n :: range (n + 1) m;;
Printf.printf "%d\n" 
  (List.fold_left (+) 0 (List.map 
     (fun n -> if n mod 3 == 0 or n mod 5 == 0 then n else 0) 
        (range 1 999)))