środa, 23 lutego 2011

More list-monadic sundries


let concat_map f l =
  let rec cmap_f accu = function
    | [] -> accu
    | a::l -> cmap_f (List.rev_append (f a) accu) l
  in
  List.rev (cmap_f [] l)

let rec concat_foldr f l init =
  match l with
    | [] -> init
    | a::l -> concat_map (f a) (concat_foldr f l init)

let map_reduce mapf redf red0 l =
  match List.sort (fun x y -> compare (fst x) (fst y))
    (List.map mapf l) with
      | [] -> []
      | (k0, v0)::tl ->
        let k0, vs, l =
          List.fold_left (fun (k0, vs, l) (kn, vn) ->
     if k0 = kn then k0, vn::vs, l
            else kn, [vn], (k0,vs)::l)
     (k0, [v0], []) tl in
        List.rev_map (fun (k,vs) -> k, List.fold_left redf red0 vs)
          ((k0,vs)::l)

let rec update_assoc k v0 f l =
  let rec aux acc = function
    | [] -> List.rev_append acc [k, f v0]
    | (a, b as pair) :: l ->
      if a = k then List.rev_append acc ((k, f b)::l)
      else aux (pair :: acc) l in
  aux [] l

let cons e l = e::l