L- OCaml中的系统

Question

参考：L-制度

我主要是在这里寻找一般风格的东西，特别是：

• 如果我的类型参数太疯狂-我想要两个参数，以便变量和常量可以有它们自己的类型。
• 如果我能使用一些我不知道的库功能。
• 如果可能有某种基于类型的方法来避免我在do_rule中引发的异常。每个可能的变量都应该有一个规则，所以异常在逻辑上是不必要的，但是我不知道如何将它告诉编译器。

(* ************************************************************************* *
 * L-System types
 *)

(* Some elements of L-Systems can be replaced (Variables from alphabet 'a)
   and some cannot (Constants from alphabet 'b) *)
type ('a, 'b) element =
    | Var of 'a
    | Const of 'b ;;

(* Type for current state of L-System. The system's axiom is its IC state *)
type ('a, 'b) state = (('a, 'b) element) list ;;

(* Rules associate elements of the Variable type with states *)
type ('a, 'b) rule = 'a * ('a, 'b) state ;;

(* L-Systems just have to define their axiom and production rules *)
type ('a, 'b) l_system = {
    axiom : ('a, 'b) state ;
    rules : ('a, 'b) rule list ;
} ;;


(* ************************************************************************* *
 * Production
 *)

(* Run the L-System for @n generations *)
let produce (system : ('a, 'b) l_system) (n : int) : ('a, 'b) state =
    (* helper: find and apply @x's rule *)
    let rec do_rule (x : 'a) (rules : (('a, 'b) rule) list) =
        match rules with
        | [] -> 
        raise (Failure "Incomplete rule set.")
        | (y, st)::rest -> 
        if x == y then st else do_rule x rest
    in
    (* helper: find this state's successor *)
    let rec advance state rules acc : ('a, 'b) state = 
        match state with
        | [] -> 
        acc
        | (Var x)::tl ->
        advance tl rules (acc @ (do_rule x rules))
        | (Const x)::tl ->
        advance tl rules (acc @ [Const x])
    in
    (* main recursive helper *)
    let rec iterate state rules n : ('a, 'b) state =
        match n with
        | 0 -> state
        | _ -> iterate (advance state rules []) rules (n - 1)
    in iterate system.axiom system.rules n ;;


(* ************************************************************************* *
 * Examples
 *)

(* Algae *)
type two_alphabet = X | Y ;;
let algae : (two_alphabet, unit) l_system = {
    axiom = [Var X] ;
    rules = [
             (Y, [Var X]);
             (X, [Var X; Var Y])
            ]
} ;;
let bloom = produce algae 10 ;;

(* Dragon *)
type square_draw_constants = DrawForward | Left90 | Right90 ;;
let dragon : (two_alphabet, square_draw_constants) l_system = {
    axiom = [Const DrawForward; Var X] ;
    rules = [
             (X, [Var X; Const Right90; Var Y; Const DrawForward; Const Right90]);
             (Y, [Const Left90; Const DrawForward; Var X; Const Left90; Var Y])
            ]
} ;;
let a_dragon = produce dragon 10 ;;

Answer 1

这是有趣的玩，所以谢谢你写它和张贴的问题！

在对它进行了一段时间的实验之后，我试着看看是否可以缩小produce的大小。我没有要展示的所有中间步骤，但我做了以下转换：

• 我删除了类型说明符，因为编译器能够自行确定类型。这是味道的问题，你当然可以把它们放回去。但是，它使我更容易看到在以后的转换中方便使用的参数。
• advance只在iterate中使用。do_rule只在advance中使用，所以我将它们移动到彼此内部声明。
• 一旦函数嵌套在它们的封闭函数中，我就能够删除一些参数，因为它们可以从外部范围中引用。
• 您将变量映射到它们的扩展是使用一个“关联列表”，所以我在List模块中使用了一个函数来进行查找。如果映射不存在，则抛出一个异常，因此我们不需要自己引发异常(尽管错误消息不会像您的那样好)。
• 由于我们正在迭代一个列表并积累一个结果，所以我用一个advance实例替换了您的List.fold_left函数。

应用这些转换后，函数如下所示：

let produce system =
  let rec iterate state = function
    | 0 ->
       state
    | n ->
       let subst acc = function
         | Var x ->
            acc @ (List.assoc x system.rules)
         | (Const _) as item ->
            acc @ [item]
       in
       iterate (List.fold_left subst [] state) (n - 1)
  in iterate system.axiom

当迭代达到20时，系统的性能进一步出现问题。原因是produce将每个项附加到列表的末尾，这是一个O(n)操作。以您的藻类字母表为例，30次扩展在列表中产生了200多万个元素。当这个结果正在建立时，它创建了临时列表，从1到2百万元素！这使得算法O(n^2)很好地工作在几个扩展中，但是当迭代变得更大时，速度会迅速减慢。

我们知道在列表的开头添加一个元素是一个固定时间的操作，所以如果我们反向构建列表，然后调用List.rev来逆转结果，我们就会将算法更改为O(n)复杂度。

我还想知道是否有必要建立中间名单。在笔和纸上，写下步骤是有意义的，但也许我们可以写算法，这样它才能生成最终的列表。事实证明，这样做很容易:我们从一个空列表开始，在初始状态下使用List.fold_left。无论何时我们找到要扩展的项目，我们都会用扩展调用List.fold_left，并将我们正在进行的结果提供给它。

这个新版本，produce'，看起来如下：

let produce' system n =
  let rec process n res = function
    | (Var x) as h ->
       if n > 0 then
         match List.assoc x system.rules with
         | nl ->
            List.fold_left (process (n - 1)) res nl
         | exception Not_found ->
            h :: res
       else
         h :: res
    | (Const _) as h ->
       h :: res in
  List.rev @@ List.fold_left (process n) [] system.axiom

我使用以下函数进行了一些粗略的性能度量：

let tm f a b =
  let t_start = Unix.gettimeofday () in
  let result = f a b in
  let t_end = Unix.gettimeofday () in
  (List.length result, t_end -. t_start);;

tm produce algae 1;;  (* for example *)

为n运行几个值会在我的系统上产生以下计时：

 N    produce   produce'    final size

 1       2 us       2 us             1
 5       8 us       6 us            13
10     285 us      49 us           144
15      33 ms     0.5 ms         1,597
20     7.3 s      6.4 ms        17,711
25                 90 ms       196,418
30                1.2 s      2,178,309
35                 14 s     24,157,817

我没有在produce上运行更大的数字，因为运行时间增长很快，我不想等待。

希望你觉得这有帮助。