Microsoft.FSharp.Collections.Listモジュール相当をリストの再帰で実装し、FsCheckでテスト

XList.fs

(* see http://msdn.microsoft.com/en-us/library/ee353738.aspx *)

module XList

open NUnit.Framework
open FsCheck

let fsCheck testable =
    Check.QuickThrowOnFailure testable

// shuffle an array (in-place)
let shuffle a =
  let rand = new System.Random()
  let swap (a: _[]) x y =
    let tmp = a.[x]
    a.[x] <- a.[y]
    a.[y] <- tmp    
  Array.iteri (fun i _ -> swap a i (rand.Next(i, Array.length a))) a

let isEqualTo expected actual =
  if expected <> actual then
    failwithf "expected:\n%A\nactual:\n%A" expected actual

(* ('State -> 'T -> 'State) -> 'State -> 'T list -> 'State *)
let fold folder state list =
  let rec loop xs state =
    match xs with
    | [] -> state
    | h :: t -> loop t (folder state h)
  loop list state

[<Test>]
let ``test fold``() =
  fsCheck <| fun x (list: int list) ->
    fold (+) x list = List.fold (+) x list

(* ('T -> 'State -> 'State) -> 'T list -> 'State -> 'State *)
let foldBack folder list state =
  let rec loop xs cont =
    match xs with
    | [] -> cont state
    | h :: t -> loop t (fun state -> cont (folder h state))
  loop list id

[<Test>]
let ``test foldBack``() =
  let folder = fun x s -> 2 * (x + s)
  fsCheck <| fun (list: int list) x ->
    foldBack folder list x = List.foldBack folder list x

(* ('T -> 'T -> 'T) -> 'T list -> 'T *)
let reduce reduction list =
  match list with
  | [] -> invalidArg "list" "empty"
  | h :: t -> fold reduction h t

[<Test>]
let ``test reduce``() =
  fsCheck <| fun (xs : int list) ->
    not (List.isEmpty xs) ==> lazy (reduce (+) xs = List.reduce (+) xs)

(* ('T -> 'T -> 'T) -> 'T list -> 'T *)
let reduceBack reduction list =
  let rec loop xs cont =
    match xs with
    | [] -> invalidArg "list" "empty"
    | [x] -> cont x
    | h :: t -> loop t (fun state -> cont (reduction h state))
  loop list id

[<Test>]
let ``test reduceBack``() =
  let reduction = fun x s -> 2 * (x + s)
  fsCheck <| fun (list: int list) ->
    not (List.isEmpty list) ==> lazy (reduceBack reduction list = List.reduceBack reduction list)

(* 'T list -> 'T list -> 'T list *)
let append list1 list2 =
  foldBack (fun x state -> x :: state) list1 list2

[<Test>]
let ``test append``() =
  fsCheck <| fun (list1: int list) (list2: int list) ->
    append list1 list2 = List.append list1 list2

(* ('T -> ^U) -> 'T list -> ^U (requires ^U with static member (+) and ^U with static member DivideByInt and ^U with static member Zero) *)
let inline averageBy projection (list: 'T list)  : ^U 
    when ^U : (static member ( + ) : ^U * ^U -> ^U) 
    and  ^U : (static member DivideByInt : ^U * int -> ^U) 
    and  ^U : (static member Zero : ^U) =
  let rec loop xs sum count =
    match xs with
    | [] -> 
      if count = 0 then 
        invalidArg "list" "empty"
      else 
        LanguagePrimitives.DivideByInt sum count
    | h :: t -> 
      loop t (sum + (projection h)) (count + 1)
  loop list (LanguagePrimitives.GenericZero) 0

[<Test>]
let ``test averageBy``() =
  fsCheck <| fun (list: int list) ->
    not (List.isEmpty list) ==> lazy (averageBy decimal list = List.averageBy decimal list)

(* ^T list -> ^T (requires ^T with static member (+) and ^T with static member DivideByInt and ^T with static member Zero) *)
let inline average list =
  averageBy id list

[<Test>]
let ``test average``() =
  (* TODO *)
  fsCheck <| fun (list: int list) ->
    not (List.isEmpty list) ==> lazy (average (list |> List.map decimal) = List.average (list |> List.map decimal))

(* ('T -> 'U option) -> 'T list -> 'U list *)
let choose chooser list =
  let rec loop xs cont =
    match xs with
    | [] -> cont []
    | h :: t -> 
      let x = chooser h
      loop t (fun acc -> cont (match x with Some v -> v :: acc | _ -> acc))
  loop list id

[<Test>]
let ``test choose``() =
  let chooser = fun x -> if x > 3 then Some x else None
  fsCheck <| fun (list: int list) ->
    choose chooser list = List.choose chooser list

(* ('T -> 'U list) -> 'T list -> 'U list *)
let collect mapping list =
  let rec loop xs acc =
    match xs with
    | [] -> acc
    | h :: t ->
      let x = mapping h
      loop t (match x with [] -> acc | ys -> append acc ys)
  loop list []

[<Test>]
let ``test collect``() =
  let mapping = fun x -> if x > 3 then [x; -x] else []
  fsCheck <| fun (list: int list) ->
    collect mapping list = List.collect mapping list

(* list<'T list> -> 'T list *)
let concat lists =
  collect id lists

[<Test>]
let ``test concat``() =
  fsCheck <| fun (lists: int list list) ->
    concat lists = List.concat lists

(* 'T list *)
let empty<'T> : 'T list = []

[<Test>]
let ``test empty``() =
  empty |> isEqualTo (List.empty)

(* ('T -> bool) -> 'T list -> bool *)
let exists predicate list = 
  let rec loop xs =
    match xs with
    | [] -> false
    | h :: t -> if predicate h then true else loop t
  loop list
  
[<Test>]
let ``test exists``() =
  let predicate = fun x -> x = 5
  fsCheck <| fun (list: int list) ->
    exists predicate list = List.exists predicate list

(* ('T -> bool) -> 'T list -> 'T list *)
let filter predicate list =
  let rec loop xs cont =
    match xs with
    | [] -> cont []
    | h :: t ->
      let x = predicate h
      loop t (fun acc -> cont (if x then (h :: acc) else acc))
  loop list id

[<Test>]
let ``test filter``() =
  let predicate = fun x -> x % 2 = 0
  fsCheck <| fun (xs: int list) ->
    filter predicate xs = List.filter predicate xs

(* ('T -> bool) -> 'T list -> 'T option *)
let tryFind predicate list =
  let rec loop xs =
    match xs with
    | [] -> None
    | h :: t -> if predicate h then Some h else loop t
  loop list

[<Test>]
let ``test tryFind``() =
  let predicate = fun x -> x % 2 = 0
  fsCheck <| fun (xs: int list) ->
    tryFind predicate xs = List.tryFind predicate xs

(* ('T -> bool) -> 'T list -> 'T *)
let find predicate list =
  match tryFind predicate list with
  | Some v -> v
  | _ -> raise <| System.Collections.Generic.KeyNotFoundException()

[<Test>]
let ``test find``() =
  let predicate = fun x -> x * x > 5
  find predicate [0..6] |> isEqualTo (List.find predicate [0..6])

(* ('T -> bool) -> 'T list -> int option *)
let tryFindIndex predicate list =
  let rec loop xs i =
    match xs with
    | [] -> None
    | h :: t -> 
      if predicate h then Some i else loop t (i + 1)
  loop list 0

[<Test>]
let ``test tryFindIndex``() =
  let predicate = fun x -> x * x > 5
  tryFindIndex predicate [1..6] |> isEqualTo (List.tryFindIndex predicate [1..6])

(* ('T -> bool) -> 'T list -> int *)
let findIndex predicate list =
  match tryFindIndex predicate list with
  | Some i -> i
  | _ -> raise <| new System.Collections.Generic.KeyNotFoundException()

[<Test>]
let ``test findIndex``() =
  let predicate = fun x -> x * x > 5
  findIndex predicate [1..6] |> isEqualTo (List.findIndex predicate [1..6])

(* ('T -> bool) -> 'T list -> bool *)
let forall predicate list =
  let rec loop xs =
    match xs with
    | [] -> true
    | h :: t -> if predicate h then loop t else false
  loop list

[<Test>]
let ``test forall``() =
  let predicate = fun x -> x < 10
  forall predicate [1..3] |> isEqualTo (List.forall predicate [1..3])
  forall predicate [9..13] |> isEqualTo (List.forall predicate [9..13])

(* 'T list -> 'T *)
let head list =
  match list with
  | [] -> invalidArg "list" "empty"
  | h :: t -> h

[<Test>]
let ``test head``() =
  head [1..3] |> isEqualTo 1

(* int -> (int -> 'T) -> 'T list *)
let init length initializer =
  let rec loop i n cont =
    if n <= 0 then 
      cont []
    else 
      let x = initializer i
      loop (i + 1) (n - 1) (fun acc -> cont (x :: acc))
  loop 0 length id

[<Test>]
let ``test init``() =
  init 3 ((*) 2) |> isEqualTo (List.init 3 ((*) 2))

(* 'T list -> bool *)
let isEmpty list =
  match list with
  | [] -> true
  | _ -> false

[<Test>]
let ``test isEmpty``() =
  fsCheck <| fun (xs: int list) ->
    isEmpty xs = List.isEmpty xs

(* (int -> 'T -> unit) -> 'T list -> unit *)
let iteri action list =
  let rec loop xs i =
    match xs with
    | [] -> ()
    | h :: t -> action i h; loop t (i + 1)
  loop list 0

[<Test>]
let ``test iteri``() =
  fsCheck <| fun (xs: int list) ->
    let r1 = ref 0
    let r2 = ref 0
    iteri (fun i x -> r1 := !r1 + x + i) xs
    List.iteri (fun i x -> r2 := !r2 + x + i) xs
    !r1 = !r2

(* ('T -> unit) -> 'T list -> unit *)
let iter action list =
  iteri (fun _ x -> action x) list

[<Test>]
let ``test iter``() =
  fsCheck <| fun (xs: int list) ->
    let r1 = ref 0
    let r2 = ref 0
    iter (fun x -> r1 := !r1 + x) xs
    List.iter (fun x -> r2 := !r2 + x) xs
    !r1 = !r2

(* 'T list -> init *)
let length list =
  fold (fun state x -> state + 1) 0 list

[<Test>]
let ``test length``() =
  fsCheck <| fun (xs: int list) ->
    length xs = List.length xs

(* (int -> 'T -> 'U) -> 'T list -> 'U list *)
let mapi mapping list =
  let rec loop xs i cont =
    match xs with
    | [] -> cont []
    | h :: t ->
      let x = mapping i h 
      loop t (i + 1) (fun acc -> cont (x :: acc))
  loop list 0 id

[<Test>]
let ``test mapi``() =
  let mapping = fun i x -> x * i
  fsCheck <| fun (xs: int list) ->
    mapi mapping xs = List.mapi mapping xs

(* ('T -> 'U) -> 'T list -> 'U list *)
let map mapping list =
  mapi (fun _ x -> mapping x) list

[<Test>]
let ``test map``() =
  let mapping = (*) 2
  fsCheck <| fun (xs: int list) ->
    map mapping xs = List.map mapping xs

(* ('T -> 'U) -> 'T list -> 'T (requires comparison) *)
let maxBy projection list =
  reduce (fun state x -> if projection state > projection x then state else x) list

[<Test>]
let ``test maxBy``() =
  let projection = fun x -> -x
  fsCheck <| fun (xs: int list) ->
    not (List.isEmpty xs) ==> lazy (maxBy projection xs = List.maxBy projection xs)

(* 'T list -> 'T (requires comparison) *)
let max list =
  maxBy id list

[<Test>]
let ``test max``() =
  fsCheck <| fun (xs: int list) ->
    not (List.isEmpty xs) ==> lazy (max xs = List.max xs)

(* ('T -> 'U) -> 'T list -> 'T (requires comparison) *)
let minBy projection list =
  reduce (fun state x -> if projection state < projection x then state else x) list

[<Test>]
let ``test minBy``() =
  let projection = fun x -> -x
  fsCheck <| fun (xs: int list) ->
    not (List.isEmpty xs) ==> lazy (minBy projection xs = List.minBy projection xs)

(* 'T list -> 'T (requires comparison) *)
let min list =
  minBy id list

[<Test>]
let ``test min``() =
  fsCheck <| fun (xs: int list) ->
    not (List.isEmpty xs) ==> lazy (min xs = List.min xs)

(* 'T list -> int -> 'T *)
let nth list index =
  let rec loop xs n =
    match xs with
    | [] -> invalidArg "index" "index is outside"
    | h :: t -> if n = 0 then h else loop t (n - 1)
  loop list index

[<Test>]
let ``test nth``() =
  fsCheck <| fun (xs: int list) n -> 
    (not (List.isEmpty xs) && List.length xs > n && n > 0) ==> lazy (nth xs n = List.nth xs n)

(* ('T -> bool) -> 'T list -> 'T list * 'T list *)
let partition predicate list =
  let rec loop list cont =
    match list with
    | [] -> cont ([], [])
    | h :: t -> loop t (fun (xs, ys) -> 
      let x = predicate h
      cont (if x then h :: xs, ys else xs, h :: ys))
  loop list id

[<Test>]
let ``test partition``() =
  partition (fun x -> x < 3) [1;4;5;3;2] |> isEqualTo ([1;2], [4;5;3])

(* ('T -> 'U option) -> 'T list -> 'U option *)
let tryPick chooser list =
  let rec loop xs =
    match xs with
    | [] -> None
    | h :: t -> 
      match chooser h with
      | Some v -> Some v
      | _ -> loop t
  loop list

[<Test>]
let ``test tryPick``() =
  let key = 3
  let chooser = fun x -> if x = key then Some x else None
  let arb() = Arb.fromGen (gen { 
    let! xs = Arb.generate<int list> 
    let a = List.toArray (key :: xs)
    shuffle a
    return List.ofArray a})
  fsCheck <| fun () -> Prop.forAll (arb()) <| fun xs ->
    tryPick chooser xs = List.tryPick chooser xs

(* ('T -> 'U option) -> 'T list -> 'U *)
let pick chooser list =
  match tryPick chooser list with
  | Some v -> v
  | _ -> raise <| new System.Collections.Generic.KeyNotFoundException()

[<Test>]
let ``test pick``() =
  let key = 3
  let chooser = fun x -> if x = key then Some x else None
  let arb() = Arb.fromGen (gen { 
    let! xs = Arb.generate<int list> 
    let a = List.toArray (key :: xs)
    shuffle a
    return List.ofArray a})
  fsCheck <| fun () -> Prop.forAll (arb()) <| fun xs ->
    pick chooser xs = List.pick chooser xs

(* int -> 'T -> 'T list *)
let replicate count initial =
  let rec loop n acc =
    if n < 0 then invalidArg "count" "negative value"
    elif n = 0 then acc
    else loop (n - 1) (initial :: acc)
  loop count []

[<Test>]
let ``test replicate``() =
  fsCheck <| fun (count: int) (initial: string) ->
    count > 0 ==> lazy (replicate count initial = List.replicate count initial)

(* 'T list -> 'T list *)
let rev list =
  fold (fun state x -> x :: state) [] list

[<Test>]
let ``test rev``() =
  fsCheck <| fun (list: int list) ->
    rev list = List.rev list

(* ('State -> 'T -> 'State) -> 'State -> 'T list -> 'State list *)
let scan folder state list =
  let rec loop state xs acc =
    match xs with
    | [] -> rev acc
    | h :: t -> 
      let s = folder state h
      loop s t (s :: acc)
  loop state list [state]

[<Test>]
let ``test scan``() =
  fsCheck <| fun state (list: int list) ->
    scan (+) state list = List.scan (+) state list

(* ('T -> 'State -> 'State) -> 'T list -> 'State -> 'State list *)
let scanBack folder list state =
  let rec loop xs cont =
    match xs with
    | [] -> cont (state, [state])
    | h :: t -> 
      loop t (fun (state, states) -> 
        let s = folder h state
        cont (s, s :: states))
  loop list (fun (state, states) -> states)

[<Test>]
let ``test scanBack``() =
  let folder = fun x s -> 2 * (x + s)
  fsCheck <| fun (list: int list) state ->
    scanBack folder list state = List.scanBack folder list state

(* ('T -> 'Key) -> 'T list -> 'T list (requires comparison) *)
let sortBy projection list =
  let rec qsort xs =
    match xs with
    | [] -> []
    | x :: xs -> 
      let lt y = projection y < projection x
      let ge y = projection x <= projection y
      qsort (filter lt xs) @ [x] @ qsort (filter ge xs)
  qsort list

[<Test>]
let ``test sortBy``() =
  fsCheck <| fun (list: (char * int) list) ->
    sortBy fst list = List.sortBy fst list

(* 'T list -> 'T list (requires comparison) *)
let sort list =
  sortBy id list

[<Test>]
let ``test sort``() =
  fsCheck <| fun (list: int list) ->
    sort list = List.sort list

(* ('T -> 'T -> int) -> 'T list -> 'T list *)
let sortWith comparer list=
  let rec qsort xs =
    match xs with
    | [] -> []
    | x :: xs -> 
      let lt y = comparer y x < 0
      let ge y = comparer y x >= 0
      qsort (filter lt xs) @ [x] @ qsort (filter ge xs)
  qsort list

[<Test>]
let ``test sortWith``() =
  let comparer a b = if a < b then 1 elif a > b then -1 else 0
  sortWith comparer [3;1;2;5;6] |> isEqualTo (List.sortWith comparer [3;1;2;5;6])

(* (int -> int) -> 'T list -> 'T list *)
let permute indexMap list =
  let rec loop list i acc =
    match list with
    | [] -> acc
    | h :: t -> 
      loop t (i + 1) ((indexMap i, h) :: acc)
  (loop list 0 []) |> sortBy fst |> map snd 

[<Test>]
let ``test permute``() =
  fsCheck <| fun (list: int list) ->
    let indexMap = fun i -> (i + 1) % length list
    permute indexMap list = List.permute indexMap list

(* ('T -> ^U) -> 'T list -> ^U (requires ^U with static member (+) and ^U with static member Zero) *)
let inline sumBy projection (list: ^T list) : ^U
    when ^U : (static member ( + ) : ^U * ^U -> ^U) 
    and  ^U : (static member Zero : ^U) =
  fold (fun state x -> state + projection x) (LanguagePrimitives.GenericZero<(^U)>) list

[<Test>]
let ``test sumBy``() =
  fsCheck <| fun (list: (char * int) list) ->
    lazy (sumBy snd list = List.sumBy snd list)

(* 'T list -> ^T (requires ^T with static member (+) and ^T with static member Zero) *)
let inline sum (list: ^T list) : ^T =
  sumBy id list

[<Test>]
let ``test sum``() =
  fsCheck <| fun (list: int list) ->
    lazy (sum list = List.sum list)

(* 'T list -> 'T list *)
let tail list =
  match list with
  | [] -> invalidArg "list" "empty"
  | _ :: t -> t

[<Test>]
let ``test tail``() =
  fsCheck <| fun (list: int list) ->
    not (List.isEmpty list) ==> lazy (tail list = List.tail list)

(* ('T1 * 'T2) list -> 'T1 list * 'T2 list *)
let unzip list =
  let rec loop xs cont =
    match xs with
    | [] -> cont ([], [])
    | (x, y) :: t -> 
      loop t (fun (xs, ys) -> cont (x :: xs, y :: ys))
  loop list id

[<Test>]
let ``test unzip``() =
  fsCheck <| fun (list: (int * string) list) ->
    lazy (unzip list = List.unzip list)

(* 'T1 list -> 'T2 list -> ('T1 * 'T2) list *)
let zip list1 list2 =
  let rec loop xs ys cont =
    match xs, ys with
    | [], [] -> cont []
    | [], _  | _, [] -> invalidArg "list1 and list2" "different length"
    | x :: xs, y :: ys ->
      loop xs ys (fun acc -> cont ((x, y) :: acc))
  loop list1 list2 id

[<Test>]
let ``test zip``() =
  fsCheck <| fun (list: int list) ->
    lazy (zip list list = List.zip list list)