Ocaml/FAQ/Arrays

Материал из Wiki.crossplatform.ru

Версия от 20:43, 24 ноября 2010; ViGOur (Обсуждение | вклад)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Содержание

[править] 4. Arrays

[править] Introduction

let nested = ["this"; "that"; "the"; "other"] (* string list *)
 
(* there is no such non-homogeneous list. You can do things with tuples: *)
let nested = ("this", "that", ["the"; "other"]) (* string * string * string list *)
(*-----------------------------*)
let tune = ["The"; "Star-Spangled"; "Banner"]
(*-----------------------------*)

[править] Specifying a List In Your Program

(* Note that Perl sort of munges OCaml lists and arrays into a single data
 * structure.  In OCaml, they are two distinct data structures, and one needs to
 * learn when it is best to use lists vs. arrays. *)
 
(* To initialize a list *)
let l = ["quick"; "brown"; "fox"];;
 
(* To initialize an array *)
let a = [|"quick"; "brown"; "fox"|];;
 
(*-----------------------------*)
let words s = Str.split (Str.regexp "[ \t]+") s;;
let l = words "Why are you teasing me?";;
(*-----------------------------*)
let str = "  The boy stood on the burning deck,
  It was as hot as glass.
" in
let f l =
  let sep = Str.regexp "[ \t\n]*\\(.+\\)" in
  List.map (fun s ->
    if (Str.string_match sep s 0) then
      Str.matched_group 1 s
    else
      ""
  ) l
in
f (Str.split (Str.regexp_string "\n") str);;
(*
 * - : string list =
 * ["The boy stood on the burning deck,"; "It was as hot as glass."]
 *)
 
let data = open_in "mydatafile" in
let bigarray = readlines data in
bigarray;;

[править] Printing a List with Commas

let commify_series l = 
  let rec sepChar l =
  match l with
    [] -> ", "
  | h::t -> 
       if String.contains h ',' then "; " else sepChar t in
  match l with
    [] -> ""
  | h::[] -> h
  | h1::h2::[] -> h1 ^ " and " ^ h2
  | _ ->
     let l' =
        let last::rest = List.rev l in
        (List.rev (("and " ^ last)::rest)) in
     String.concat (sepChar l) l';; 
 
let lists = 
  [
    [ "just one thing" ];
    [ "Mutt"; "Jeff" ];
    [ "Peter"; "Paul"; "Mary" ];
    [ "To our parents"; "Mother Theresa"; "God" ];
    [ "pastrami"; "ham and cheese"; "peanut butter and jelly"; "tuna" ];
    [ "recycle tired, old phrases"; "ponder big, happy thoughts" ];
    [ "recycle tired, old phrases"; 
      "ponder big, happy thoughts"; 
      "sleep and dream peacefully" ]
  ];;
 
List.iter (fun x -> printf "The list is: %s.\n" (commify_series x)) lists;;
 
(* 
The list is: just one thing.
The list is: Mutt and Jeff.
The list is: Peter, Paul, and Mary.
The list is: To our parents, Mother Theresa, and God.
The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna.
The list is: recycle tired, old phrases and ponder big, happy thoughts.
The list is: recycle tired, old phrases; ponder big, happy thoughts; and sleep and dream peacefully.
*)
 
(* Note that if you are actually using arrays instead of lists, you can either
 * reuse the above code by calling "commify_series (Array.to_list a)", or you
 * can use the following solution (which won't work with lists, but is probably
 * more efficient).
*)
 
let commify_array a =
  let len = Array.length a in
  let rec sepChar a =
    try
      for i=0 to len - 1 do
        if String.contains a.(i) ',' then raise Not_found
      done;
      ", "
    with Not_found -> "; " in
  match len with
    0 -> ""
  | 1 -> a.(0)
  | 2 -> a.(0) ^ " and " ^ a.(1)
  | _ -> 
      let buf = Buffer.create 10
      and sep = sepChar a in
      for i = 0 to len - 2 do
        Buffer.add_string buf a.(i);
        Buffer.add_string buf sep;
      done;
      Buffer.add_string buf "and ";
      Buffer.add_string buf a.(len - 1);
      Buffer.contents buf;;
 
let arrays = 
  [|
    [| "just one thing" |];
    [| "Mutt"; "Jeff" |];
    [| "Peter"; "Paul"; "Mary" |];
    [| "To our parents"; "Mother Theresa"; "God" |];
    [| "pastrami"; "ham and cheese"; "peanut butter and jelly"; "tuna" |];
    [| "recycle tired, old phrases"; "ponder big, happy thoughts" |];
    [| "recycle tired, old phrases"; 
      "ponder big, happy thoughts"; 
      "sleep and dream peacefully" |]
  |];;
 
Array.iter (fun x -> printf "The list is: %s.\n" (commify_array x)) arrays;;

[править] Changing Array Size

(*
   OK, OCaml just doesn't work with arrays the same way tha Perl does.  In
   Ocaml, Arrays are immutable in their shape, while containing mutable
   contents.  You can simulate this example as shown below (which only works for
   string arrays), or you can get resizeable arrays from a library such as
   extlib <http://ocaml-lib.sourceforge.net/>
*)
 
let what_about_that_array a =
  let len = Array.length a in
  printf "The array now has %d elements.\n" len;
  printf "The index of the last element is %d.\n" (if len=0 then 0 else len-1);
  printf "Element 3 is \"%s\".\n" a.(3);; 
 
let resizeArray a s =
  (* begin stupid hack to work like the Perl example *)
  let s = s + 1 in
  (* end stupid hack to work like the Perl example *)
  assert (s >= 0);
  let len = Array.length a in
  if s = len then a else
    if s < len then
      Array.sub a 0 s
    else
      Array.append a (Array.make (s - len) "");;
 
let people = [|"Crosby"; "Stills"; "Nash"; "Young"|];;
what_about_that_array people;;
 
(*
The array now has 4 elements.
The index of the last element is 3.
Element 3 is "Young".
*)
 
let people = resizeArray people 2;;
what_about_that_array people;;
 
(*
The array now has 3 elements.
The index of the last element is 2.
Exception: Invalid_argument "index out of bounds".
*)
 
let people = resizeArray people 10000;;
what_about_that_array people;;
(*
The array now has 10001 elements.
The index of the last element is 10000.
Element 3 is "".
*)

[править] Doing Something with Every Element in a List

Array.iter complain bad_users;;
(* Or for lists *)
List.iter complain bad_users;;
 
(* For the hashtable example, we'd iterate over the table itself *)
 
Hashtbl.iter (fun k v -> printf "%s=%s\n" k v) h;; 
 
(* Of course if you want to iterate over the keys in lexicographic order, then
 * you'll need to build a list of keys, sort it, then iterate over that *)
 
List.iter (fun x -> printf "%s=%s\n" x (Hashtbl.find env x))
  (List.sort compare (Hashtbl.fold (fun k v b -> k::b) env []));;
 
Array.iter (fun x -> if get_usage x > max_quota then complain x) all_users;;
(* or for lists of users *)
List.iter (fun x -> if get_usage x > max_quota then complain x) all_users;;
 
(* for this example, we're going to assume that the output of the who command is
 * contained in the list named who, with one line of output per list element.
 * This example requires the use of the Str module which is not loaded or linked
 * by default (but is part of the standard library), at the toplevel, use the
 * directive "#load "str.cma"
*)
 
List.iter 
  (fun x -> 
    try 
      ignore (Str.search_forward (Str.quote "tchrist") x 0);
      print_endline x;
    with Not_found -> ()) who;;
 
(* To iterate over all lines read in from some channel we would do the following *)
 
let iter_channel f ic =
  try
    while true do
      f (input_line ic)
    done
  with Not_found -> ();;
 
(* and the example would then be written as *)
iter_channel
  (fun  s ->
    let reverse s ='let len = String.length s in
      let s' = String.create len in
      for i = 0 to len - 1 do
        s'.[len-i-1] <- s.[i]
      done;
      s' in
    (* assuming we have written a chomp workalike *)
    let s = chomp s in
    List.iter 
      (fun x -> print_endline (reverse x)) 
      (Str.split (Str.regexp "[ \t]+") s)) fh;;
 
(* In OCaml the iterator variable also is an alias for the current element,
 * however, because of the functional nature of OCaml, unless the elements of
 * the array are references, the only way to change them is by resetting the
 * value of the array to something new -- this is best done using iteri *)
 
let a = [|1; 2; 3|];;
Array.iteri (fun i x -> a.(i) <- x-1) a;;
 
(* or, with references *)
 
let a = [| ref 1; ref 2; ref 3 |];;
Array.iter (fun x -> x := !x - 1) a;;
 
(* You can, of course, use map to create a new array with the desired contents
 * as well *)
let a = [| 0.5; 3.|];;
let b = [|0.; 1.|];;
Array.iter (printf "%f ") (Array.map (( *. ) 7.) (Array.append a b));;
 
 
let strip s =
  Str.replace_first (Str.regexp "^[ \t\n]") ""
    (Str.replace_first (Str.regexp "[ \t\n$]") "" s);;
 
 
let sc,ar,h = 
  strip sc,
  Array.map strip ar,
  (Hashtbl.iter (fun k v -> Hashtbl.replace h k (strip v)) h; h);;
 
(* of course, the Hashtbl.replace already destructively updates the old
 * hashtable... *)

[править] Iterating Over an Array by Reference

(* iterate over elements of array in arrayref *)
 
Array.iter (fun x -> (* do something with x *)) !arrayref;;
 
for i = 0 to Array.length !arrayref - 1 do
  (* do something with !arrayref.(i) *)
done
 
let fruits = [| "Apple"; "Blackberry" |];;
let fruit_ref = ref fruits;;
Array.iter (printf "%s tastes good in a pie.\n") !fruit_ref;;
 
for i = 0 to  Array.length !fruit_ref - 1 do
  printf "%s tastes good in a pie.\n" !fruit_ref.(i)
done;;
 
Hashtbl.add namelist "felines" (ref rogue_cats);;
Array.iter (printf "%s purrs hypnotically.\n") !(Hashtbl.find namelist
"felines");;
print_endline "--More--\nYou are controlled.";;
 
for i=0 to Array.length !(Hashtbl.find namelist "felines") - 1 do
  printf "%s purrs hypnotically.\n" !(Hashtbl.find namelist "felines").(i)
done;;

[править] Extracting Unique Elements from a List

(* For lists, the most "natural" way to do this is by walking the list and
 * looking for duplicates of each item *)
 
let rec uniquesOnly l = 
  let rec contains x l =
    match l with
      [] -> false
    | h::t -> if x = h then true else contains x t in
  match l with 
    [] -> []
  | h::t -> if contains h t then uniquesOnly t else h::(uniquesOnly t);;
 
(* if you have a lot of duplicates, it might be better to use List.filter *)
let rec uniquesOnly l =
  match l with
    [] -> []
  | h::t -> h::(uniquesOnly (List.filter ((<>) h) t));;
 
(* Or, for lists or arrays, you can use a hashtable *)
(* Straightforward *)
let uniquesOnly l =
  let seen = Hashtbl.create 17
  and uniq = ref [] in
  List.iter 
    (fun x -> 
      if not (Hashtbl.mem seen x) then 
        (Hashtbl.add seen x 1; uniq := (x::!uniq)))
    l;
  !uniq;;
 
(* Or more likely *)
let uniquesOnly l =
  let seen = Hashtbl.create 17 in
  List.iter (fun x -> Hashtbl.replace seen x 1) l;
  Hashtbl.fold (fun k v b -> k::b) seen [];;
 
(* To apply a user function to each unique element of a list, one would likely
 * do something like *)
 
let userUnique f l =
  List.map f (uniquesOnly l);;
 
(* Generate a list of users logged in, removing duplicates.  Note that this
 * example requires linking with the Unix and Str libraries. *)
let who () =
  let w = Unix.open_process_in "who"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> !l;;
 
let ucnt = Hashtbl.create 17;;
List.iter 
  (fun x -> 
    Hashtbl.replace ucnt (Str.replace_first (Str.regexp "[ \t].*$") "" x) 1)
  (who ());;
let users = Hashtbl.fold (fun k v b -> k::b) ucnt [];;
 
printf "users logged in: %s";;
List.iter (printf "%s ") users;;

[править] Finding Elements in One Array but Not Another

(* using hashtables, like the cookbook *)
let arrayDiff a b = 
  let seen = Hashtbl.create 17 
  and l = ref [] in
  Array.iter (fun x -> Hashtbl.add seen x 1) b;
  Array.iter (fun x -> if not (Hashtbl.mem seen x) then l := x::!l) a;
  Array.of_list !l;;

[править] Computing Union, Intersection, or Difference of Unique Lists

let a = [ 1;3;5;6;7;8 ];;
let b = [ 2;3;5;7;9 ];;
 
let union = Hashtbl.create 13
and isect = Hashtbl.create 13
and diff = Hashtbl.create 13;;
 
(* simple solution for union and intersection *)
List.iter (fun x -> Hashtbl.add union x 1) a;;
List.iter 
  (fun x -> hashtbl.add (if Hashtbl.mem union x then isect else union) x 1) b;;
let u = Hashtbl.fold (fun k v b -> k::b) union []
and i = Hashtbl.fold (fun k v b -> k::b) isect [];;
 
(* Union, intersection, and symmetric difference *)
let hincr h x = 
  let v = try Hashtbl.find h x with Not_found -> 0 in
  Hashtbl.replace h x (v+1);;
 
let count = Hashtbl.create 13;;
List.iter (fun x -> Hashtbl.add count x 1) a;;
List.iter (hincr count) b;;
let u,i,d =
  let u = Hashtbl.fold (fun k v b -> (k,v)::b) count [] in
  let i,d = List.partition(fun x -> snd x = 2) u in
  let vo l = List.map fst l in
  (vo u),(vo i),(vo d);;

[править] Appending One Array to Another

(* For lists, use the @ operator for two lists, or List.concat for a list of
 * lists, for arrays, use Array.append for two arrays, or Array.concat for a
 * list of arrays*)
 
let list1 = list1 @ list2;;
let array1 = Array.append array1 array2;;
 
let members = [| "Time"; "Flies" |];;
let initiates = [| "An"; "Arrow" |];;
let members = Array.append members initiates;;
 
(* It is easiest to write a splice workalike and then just use the new function
 * much like in Perl *)
 
let splice ?length ?list arr off =
  let len = Array.length arr in
  let off = if off < 0 then len + off else off in
  let l,back =
    match length with
      None -> (len - off),[||]
    | Some l -> 
        l,
        (let boff = off + l in
        try Array.sub arr boff (len - boff)  with Invalid_argument _ -> [||]) in
  let front = Array.sub arr 0 off
  and mid = 
    match list with 
      None -> [||] 
    | Some a -> a
  and sp = Array.sub arr off l in
  sp,Array.concat [front;mid;back];;
 
let _,members = 
  splice members 2 ~length:0 ~list:(Array.append [|"Like"|] initiates);;
Array.iter (printf "%s ") members; print_newline ();;
 
let _,members = splice members 0 ~length:1 ~list:[|"Fruit"|];;
let _,members = splice members (-2) ~length:2 ~list:[|"A"; "Banana"|];;
Array.iter (printf "%s ") members; print_newline ();;

[править] Reversing an Array

(* To reverse a list, use List.rev *)
let reversed = List.rev l;;
 
(* For an array, it is probably easiest to use Array.init *)
 
let revArray a = 
  let len = Array.length a - 1 in
  Array.init len+1 (fun i -> a.(len - i);;
 
let reversed = revArray a;;
 
(* Or one can use a for loop *)
for i = Array.length a - 1 downto 0 do
  (* Do something to a.(i) *)
done;;

[править] Processing Multiple Elements of an Array

(* To remove multiple elements from an array at once, one can use the splice
 * function from section 4.9 *)
 
(* Remove n elements from the front of arr *)
front,arr = splice arr 0 ~length:n;;
rear,arr = splice arr (-n);;
 
(* this can also be wrapped as an explicit function *)
 
let shift2 a = splice a 0 ~length:2;;
let pop2 a = splice a (-2);;
 
(* This lets you do something like Perl's hinkey pattern matching *)
let friends = [|"Peter"; "Paul"; "Mary"; "Jim"; "Tim" |];;
let [|this; that|],friends = shift2 friends;;
 
let beverages = [|"Dew"; "Jolt"; "Cola"; "Sprite"; "Fresca"|];;;
let pair,beverages =  pop2 beverages;;

[править] Finding the First List Element That Passes a Test

(* To find the first element in a list that satisfies some predicate, just use
 * the List.find function to return an 'a option *)
 
match
  (try Some (List.find (fun x -> x > 10) l)
  with Not_found -> None)
with
    None -> (* unfound *)
  | Some x -> (* Do something with x *);;
 
(* Note that this is a very general form, and can be shortened in some cases *)
let pf l =
  try 
    printf "hah! Found %d!\n" (List.find (fun x -> x > 10) l)
  with 
    Not_found -> "Sorry charly!\n";;
 
(*
# pf [1;2;3;4;5;6];;
Sorry charly!
 
# pf [1;2;3;50;100];;
Hah!  Found 50!
*)
 
(* To return the index of a matching element in an array, we can use exceptions
 * to short circuit the search *)
 
exception Found of int;;
 
let findi pred arr = 
  Array.iteri (fun i x -> if pred x then raise (Found i)) arr;
  raise Not_found;;
 
let f arr = 
try
  findi (fun x -> x > 10) arr
with
  Found i -> printf "element %d is a big element - %d\n" i arr.(i)
| Not_found -> printf "Only small values here!\n";;
 
(*
# f [|1; 2; 3; 4; 5; 6|];;
Only small values here!
 
# f [|1; 2; 3; 4; 5; 60; 8; 9; 100|];;
element 5 is a big element - 60
*)
 
let highest_engineer =
  List.find (fun x -> x#category = "engineer") employees in
  printf "Highest paid engineer is: %s\n" highest_engineer#name;;

[править] Finding All Elements in an Array Matching Certain Criteria

(* to find all elements of a list that satisfy a certain predicate, just use the
 * List.find_all function *)
 
let matching = List.find_all ( (* predicate *) l;;
 
(* for an array, it's likely easiest to convert the original array to a list,
 * use List.find_all, and convert that list into an array *)
let matching = 
  Array.ofList (List.find_all ( (*predicate *) ) (Array.to_list a));;
 
(* the next example requires use of the Str library, which must be linked in.
 * In the toplevel environment use `#load "str.cma"' *)
 
let bigs = List.find_all (fun x -> x > 1000000) nums;;
let pigs = List.find_all (fun x -> (Hashtbl.find users x) > 1e7) 
            (Hashtbl.fold (fun k v b -> k::b) users []);;
 
let matching = 
  List.find_all (fun x -> Str.string_match (Str.regexp "gnat") x 0) (who ());;
 
let engineers = List.find_all (fun x -> x#position = "Engineer") employees;;
 
let secondary_assistance = 
  List.find_all (fun x -> x#income >= 26000 && x#income < 30000) applicants;;

[править] Sorting an Array Numerically

(* OCaml is smart enough to figure out if a list is full of numbers or
 * non-numbers, so the polymorphic compare function works just fine *)
let sorted = List.sort compare unsorted;;
 
(* note that Array.sort sorts the given array in place, so unexpected results
 * can occur, e.g.
let sorted = Array.sort compare unsorted;;
 
 * results in unsorted referring to the now sorted array, and sorted referring
 * to something of type unit *)
 
(* pids is an unsorted list of process IDs *)
List.iter (printf "%d\n") (List.sort compare pids);;
print_endline "Select a process ID to kill:";;
let pid = read_int () in
  Unix.kill pid Sys.sigterm;
  Unix.sleep 2;
  Unix.kill pid Sys.sigterm;;
 
let descending = List.sort (fun x y -> compare y x) unsorted;;

[править] Sorting a List by Computable Field

(* since compare orders tuples by first comparing the first slot then, if they
 * were equal, comparing the second slot, and so on, we can sort by computable
 * fields as follows *)
 
let sorted = 
  List.map snd (List.sort compare (List.map (fun x-> (compute x),x) unsorted));;
 
let ordered = List.sort (fun x y -> compare x#name y#name) employees;;
List.iter (fun x -> printf "%s earns $%2f\n" x#name x#salary)
  (List.sort (fun x y -> compare x#name y#name) employees);;
 
let sorted_employees = 
  List.map snd (List.sort compare (List.map (fun x-> (compute x),x) unsorted)) in
  List.iter (fun x -> printf "%s earns $%2f\n" x#name x#salary) sorted_employees;
  List.iter 
    (fun x -> if Hashtbl.mem bonus x#ssn then printf "%s got a bonus!\n" x#name)
    sorted_employees;;
 
let sorted = 
  List.sort 
    (fun x y ->
      match compare x#name y#name with
        0 -> compare x#age y#age
      | c -> c)
    employees;;
 
(* Assuming we have a getpwent function that returns a value of type users, or
 * throws an End_of_file exception when done (not sure what getpwent is supposed
 * to do), then we can write *)
 
let getUsers () = 
  let l = ref [] in
  try
    while true do
      l := (getpwent ())::!l
    done
  with End_of_file -> !l;;
 
List.iter 
  (fun x -> print_endline x#name) 
  (List.sort (fun x y -> compare x#name y#name) (getUsers ()));;
 
let sorted = List.sort (fun x y -> compare x.[1] y.[1]) strings;;
 
let sorted = 
  List.map snd
    (List.sort compare (List.map (fun x -> (String.length x),x) strings));;
 
let sorted_fields = 
  List.map snd
    (List.sort compare 
      (List.map 
        (fun x ->
          (try 
            ignore(Str.search_forward (Str.regexp "[0-9]+") x 0);
            int_of_string (Str.matched_string x)
          with Not_found -> max_int),x) 
        strings));;
 
let passwd () =
  let w = Unix.open_process_in "cat /etc/passwd"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> !l;;
 
(* for illustration purposes, we provide a function to return the (non-comment)
 * contents of /etc/passwd *)
let passwd () =
  let w = Unix.open_process_in "cat /etc/passwd"
  and l = ref [] in
  try
    while true do
      l := (input_line w)::!l
        done;
        !l
  with End_of_file -> 
    List.filter (fun x -> x.[0] <> '#') !l;;
 
let sortedPasswd = 
  List.map (fun Some x -> snd x)
  (List.sort compare
   (List.filter (function Some x -> true | None -> false)
    (List.map
      (fun x -> 
        match Str.split (Str.regexp ":") x with
          name::_::uid::gid::t -> Some ((gid,uid,name),x)
        | _ -> None) 
     (passwd ()))));;

[править] Implementing a Circular List

(* To get a true circular list, one can use the let rec construct *)
 
let rec processes = 1::2::3::4::5::processes;;
while true do
  let process::processes = process in
  printf "Handling process %d\n" process;
  Unix.sleep 2;
done;;
 
(* or one can use these somewhat inefficient functions to simulate the Perl
 * examples *)
 
let popleft l =
  match l with
    [] -> raise Not_found
  | h::t -> h,(t @ [h]);;
 
let popright l =
  match List.rev l with
    [] -> raise Not_found
  | h::t -> h,(h::(List.rev t));;
 
let processes = ref [1;2;3;4;5];;
while true do
  let process,np = popleft !processes in
  processes := np;
  printf "Handling process %d\n" process;
  flush_all ();
  Unix.sleep 1;
done;;

[править] Randomizing an Array

let fisher_yates_shuffle a =
  for i = Array.length a - 1 downto 1 do
    let x = a.(i)
    and r = Random.int (i+1) in
    a.(i) <- a.(r);
    a.(r) <- x;
  done;;

[править] Program: words

(* Assuming we start with a list of all the data called data, and assuming we
 * already have the curent number of screen columns in a variable cols *)
 
let words data cols =
  let strippedData = 
    Array.of_list 
      (List.map (Str.replace_first (Str.regexp "[ \t\n]+$") "") data) in
  let maxlen = 
    (Array.fold_left (fun m s -> max m (String.length s)) 0 strippedData) + 1 in
  let cols = if cols < maxlen then 1 else cols / maxlen in
  let rows = ((Array.length strippedData - 1) + cols)/cols in
  let bufs = Array.init rows (fun x -> Buffer.create (cols * maxlen)) in
  for i = 0 to Array.length strippedData - 1 do
    let dst = String.make maxlen ' '
    and src = strippedData.(i) in
    String.blit src 0 dst 0 (String.length src);
    Buffer.add_string bufs.(i mod rows) dst
  done;
  Array.iter (fun x -> print_endline (Buffer.contents x)) bufs;;

[править] Program: permute

(* Note: This routine uses the splice routine written in section 4.9 *)
 
let tsc_permute arr =
  if Array.length arr > 0 then print_endline "Perms:";
  let rec permute arr perms =
    match Array.length arr with
      0 -> Array.iter (printf "%s ") perms; print_newline ();
    | _ ->
        for i = 0 to Array.length arr - 1 do
          let v,ni = splice arr i ~length:1 in
          permute ni (Array.append v perms);
        done in
  permute arr [||];;
 
(* Note: This example is going to permute the words of a given string - also, I
 * don't feel like bringing in the BigInt module, so we will trim any array
 * longer than 12 elements down to 12 before permuting *)
 
let fact = Array.append [|Some 1|] (Array.make 11 None);;
let rec factorial n =
  match fact.(n) with
    Some f -> f
  | None -> let f = n*(factorial (n-1)) in fact.(n) <- Some f; f;;
 
let n2pat n len =
  let rec nh n i pat =
    if i > len+1 then pat
    else
      nh (n/i) (i+1) ((n mod i)::pat) in
  nh n 1 [];;
 
let pat2perm pat =
  let rec ph source pat perm =
    match pat with
      [] -> perm
    | h::t ->
        let v,s = splice source h ~length:1 in
        ph s t (v.(0)::perm) in
  Array.of_list (ph (Array.init (List.length pat) (fun i -> i)) pat []);;
 
let n2perm n len =
  pat2perm (n2pat n len);;
 
let mjd_permute s =
  let arr = 
    let arr = Array.of_list (Str.split (Str.regexp "[ \t]+") s) in
    try
      Array.sub arr 0 12
    with Invalid_argument _ -> arr in
  let len = Array.length arr - 1 in
  for i = 0 to factorial (len+1) do
    let perm = Array.map (fun i -> arr.(i)) (n2perm i len) in
    Array.iter (printf "%s ") perm; print_newline ();
  done;;