在 F# 中有效地投影列表列表

Question

我必须对列表列表进行投影，该列表返回每个列表中每个元素的所有组合。例如：

projection([[1]; [2; 3]]) = [[1; 2]; [1; 3]].
projection([[1]; [2; 3]; [4; 5]]) = [[1; 2; 4]; [1; 2; 5]; [1; 3; 4]; [1; 3; 5]].

我想出了一个函数：

let projection lss0 =
    let rec projectionUtil lss accs =
        match lss with
        | []        ->  accs
        | ls::lss'  ->  projectionUtil lss' (List.fold (fun accs' l -> 
                                                        accs' @ List.map (fun acc -> acc @ [l]) accs) 
                                                        [] ls)
match lss0 with
| [] -> []
| ls::lss' ->         
    projectionUtil lss' (List.map (fun l -> [l]) ls)

和一个测试用例：

#time "on";;
let N = 10
let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i));;
let fss1 = projection fss0;;

这个功能现在很慢，N = 10需要10多秒才能完成。此外，我认为解决方案是不自然的，因为我必须以两种不同的方式分解同一个列表。 有什么建议可以提高函数的性能和可读性吗？

Answer 1

首先，尽可能避免列表连接 (@)，因为它是 O(N) 而不是 O(1) 前置。

我将从一个（相对）易于遵循的计划开始，了解如何计算列表的笛卡尔外积。

• 将第一个列表的每个元素附加到其余列表的笛卡尔积中的每个子列表。
• 注意基本情况。

第一版：

let rec cartesian = function
  | [] -> [[]]
  | L::Ls -> [for C in cartesian Ls do yield! [for x in L do yield x::C]]

这是将上面的句子直接翻译成代码。

现在加快速度：使用列表连接和映射代替列表推导：

let rec cartesian2 = function
  | [] -> [[]]
  | L::Ls -> cartesian2 Ls |> List.collect (fun C -> L |> List.map (fun x->x::C))

这可以通过一个序列按需计算列表来更快：

let rec cartesian3 = function
  | [] -> Seq.singleton []
  | L::Ls -> cartesian3 Ls |> Seq.collect (fun C -> L |> Seq.map (fun x->x::C))

最后一种形式是我自己使用的，因为我通常只需要迭代结果而不是一次获得所有结果。

我机器上的一些基准测试： 测试代码：

let test f N = 
  let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i))
  f fss0 |> Seq.length

FSI 的结果：

> test projection 10;;
Real: 00:00:18.066, CPU: 00:00:18.062, GC gen0: 168, gen1: 157, gen2: 7
val it : int = 3628800
> test cartesian 10;;
Real: 00:00:19.822, CPU: 00:00:19.828, GC gen0: 244, gen1: 121, gen2: 3
val it : int = 3628800
> test cartesian2 10;;
Real: 00:00:09.247, CPU: 00:00:09.250, GC gen0: 94, gen1: 52, gen2: 2
val it : int = 3628800
> test cartesian3 10;;
Real: 00:00:04.254, CPU: 00:00:04.250, GC gen0: 359, gen1: 1, gen2: 0
val it : int = 3628800

Answer 2

这个函数是 Haskell 的 sequence（虽然 sequence 更通用）。翻译成 F#：

let sequence lss =
    let k l ls = [ for x in l do for xs in ls -> x::xs ]
    List.foldBack k lss [[]]

在互动中：

> test projection 10;;
Real: 00:00:12.240, CPU: 00:00:12.807, GC gen0: 163, gen1: 155, gen2: 4
val it : int = 3628800
> test sequence 10;;
Real: 00:00:06.038, CPU: 00:00:06.021, GC gen0: 75, gen1: 74, gen2: 0
val it : int = 3628800

总体思路：避免显式递归以支持标准组合器（折叠、映射等）

Answer 3

这是一个尾递归版本。它不如其他一些解决方案快（仅比您的原始函数快 25%），但内存使用量是恒定的，因此它适用于非常大的结果集。

let cartesian l = 
  let rec aux f = function
    | [] -> f (Seq.singleton [])
    | h::t -> aux (fun acc -> f (Seq.collect (fun x -> (Seq.map (fun y -> y::x) h)) acc)) t
  aux id l

Answer 4

由于@（即 List concat）操作，您的实现速度很慢，这是一个缓慢的操作，并且以递归方式多次执行。 @ 速度慢的原因是 List 是函数式编程中的链表，并且要连接 2 个列表，您必须首先到达列表的末尾（一个接一个地遍历元素），然后附加另一个列表。

请查看 cmets 中的建议参考。希望这些能帮到你。

Answer 5

下面的版本比cartesian3还要快，并且使用了函数式编程的基本特性（不花哨的List.collect，Seq.collect...）

let cartesian xss =
    let rec add x yss s =
        match yss with
        | [] -> s
        | ys :: yss' -> add x yss' ((x :: ys) :: s)

    let rec mul xs yss p =
        match xs with
        | [] -> p
        | x :: xs' -> mul xs' yss (add x yss p)

    let rec cartesian xss c =
        match xss with
        | [] -> c
        | xs :: xss' -> cartesian xss' (mul xs c [])

    cartesian xss [ [] ]

结果

> test cartesian3 10;;
Real: 00:00:04.132, CPU: 00:00:04.109, GC Gen0: 482, Gen1: 2, Gen2: 1
val it: int = 3628800

> test cartesian 10;;
Real: 00:00:01.414, CPU: 00:00:01.406, GC Gen0: 27, Gen1: 16, Gen2: 2
val it: int = 3628800

> test cartesian3 11;;
Real: 00:00:45.652, CPU: 00:00:45.281, GC Gen0: 5299, Gen1: 5, Gen2: 1
val it: int = 39916800

> test cartesian 11;;
Real: 00:00:17.242, CPU: 00:00:16.812, GC Gen0: 260, Gen1: 174, Gen2: 6
val it: int = 39916800

这里使用的分区策略很幼稚：输入列表xss被分为头尾，我相信更聪明的策略可以提供更好的性能。

Answer 6

let crossProduct listA listB listC listD listE = 
  listA |> Seq.collect (fun a -> 
  listB |> Seq.collect (fun b -> 
  listC |> Seq.collect (fun c -> 
  listD |> Seq.collect (fun d -> 
  listE |> Seq.map (fun e -> a,b,c,d,e))