let to_roman n =
  let pairs = [
    (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")
  ] in
  let rec aux n pairs acc =
    match pairs with
    | [] -> acc
    | (v, s) :: rest ->
      if n >= v then aux (n - v) pairs (acc ^ s)
      else aux n rest acc
  in
  aux n pairs ""
;;

List.fold_left
  (fun acc n -> acc + String.length (to_roman n))
  0
  [1; 4; 9; 14; 49; 99; 444; 1994; 3888]