3

我想实现 Haskellcycle函数的模拟。

如果我明确传递列表元素,这似乎微不足道:

let cycle a b c =
  let rec l = a::b::c::l in
  l

cycle 1 2 3生成递归列表1, 2, 3, 1...

但是,如何在另一个常规列表的基础上生成递归列表?

let cycle lst = ...

用法

cycle [1;2;3]

4

5 回答 5

3

在像 ML 这样的热切语言中,您需要使用流。例如

# let cycle = Stream.from (fun n -> Some (List.nth [1;2;3] (n mod 3)));;
val cycle : int Stream.t = <abstr>
# Stream.npeek 10 cycle;;
- : int list = [1; 2; 3; 1; 2; 3; 1; 2; 3; 1]
于 2013-10-18T20:02:56.830 回答
1

似乎制作这种递归列表的唯一方法是使用Obj模块。

复制列表并使其递归

let cycle lst = match lst with
  | [] -> []
  | _ ->
    let rec get_last_cell = function
      | [] -> assert false
      | _::[] as last -> last
      | _::tl -> (get_last_cell tl)
    in
    let new_lst = List.map (fun x -> x) lst in
    let last_cell = get_last_cell new_lst in
    Obj.set_field (Obj.repr last_cell) 1 (Obj.repr new_lst);
    new_lst

创建递归列表,然后插入新的 cons 单元格

let cycle lst = match lst with
  | [] -> []
  | hd::tl ->
      let rec loop cell lst =
        match lst with
        | [] -> ()
        | hd::tl ->
            let new_cell = [hd] in
            let new_cell_obj = Obj.repr new_cell in
            let cell_obj = Obj.repr cell in
            Obj.set_field new_cell_obj 1 (Obj.field cell_obj 1);
            Obj.set_field cell_obj 1 new_cell_obj;
            loop new_cell tl
      in
      let rec cyc_lst = hd::cyc_lst in
      loop cyc_lst tl;
      cyc_lst

这个想法很简单:

  1. cyc_lst创建只有一个元素的递归列表。
  2. 在 tail of 之前插入一个或多个新的 cons 单元格cyc_lst

例子

cycle [1;2]

  1. 创建递归列表cyc_lst。它在内存中表示为一个自递归的 cons 单元

    让 rec cyc_lst = hd::cyc_lst
    
    .--------。
    | |
    | +---+-|-+
    `->| 1 | * |
       +---+---+
    
  2. new_cell使用 2 作为唯一元素创建

    让 new_cell = [高清]
    
       细胞新细胞
    .--------。
    | |
    | +---+-|-+ +---+---+
    `->| 1 | * | | 2 | X |
       +---+---+ +---+---+
    
  3. new_cell尾指针设置为第一个单元格

    Obj.set_field new_cell_obj 1 (Obj.field cell_obj 1)
    
       细胞新细胞
    .--------.--------------。
    | | |
    | +---+-|-+ +---+-|-+
    `->| 1 | * | | 2 | * |
       +---+---+ +---+---+
    
  4. cell尾指针设置为new_cell

    obj.set_field cell_obj 1 new_cell_obj
    
       细胞新细胞
    .------------------------。
    | |
    | +---+---+ +---+-|-+
    `->| 1 | *------->| 2 | * |
       +---+---+ +---+---+
    

我希望 GC 可以接受这样的列表操作。如果不是,请告诉我。

于 2013-10-18T22:23:33.353 回答
1

据我所知,OCaml 不适合这种编码,除非你想深入到语言的不安全部分。

坚持语言的安全部分(但使用第 7 章中的扩展),这里有一个(不是很令人印象深刻)版本cycle,适用于长度为 3 的列表:

let cycle = function
    | [] -> []
    | [x] -> let rec res = x :: res in res
    | [x; y] -> let rec res = x :: q and q = y :: res in res
    | [x; y; z] -> let rec res = x :: t and t = y :: v and v = z :: res in res
    | _ -> failwith "list too long"

很容易看出如何将其扩展到任何所需的固定长度,而不是任意长度。

这是该功能的会话:

# #use "cyc.ml";;
val cycle : 'a list -> 'a list = <fun>
# cycle [1;2;3];;
- : int list =
[1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1;
 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2;
 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3;
 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1;
 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2;
 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; 3; 1; 2; ...]

这是我能做的最好的,无论如何。我希望它会有所帮助。

于 2013-10-18T19:48:41.713 回答
0

你也可以像这样定义它

# let cycle items =
    let buf = ref [] in
    let rec next i =
      if !buf = [] then buf := items;
      match !buf with
        | h :: t -> (buf := t; Some h)
        | [] -> None in
    Stream.from next;;
val cycle : 'a list -> 'a Stream.t = <fun>

utop # let test = cycle [1; 2; 3];;
val test : int Stream.t = <abstr> 
utop # Stream.npeek 10 test;;
- : int list = [1; 2; 3; 1; 2; 3; 1; 2; 3; 1]

这是来自:

http://ocaml.org/tutorials/streams.html

于 2013-10-18T21:02:48.283 回答
0

您需要另一个答案中的流或惰性列表:

type 'a llist = LNil | LCons of 'a * 'a llist Lazy.t
let cycle = function
| [] -> invalid_arg "cycle: empty list"
| hd::tl ->
  let rec result =
    LCons (hd, lazy (aux tl))
  and aux = function
    | [] -> result
    | x::xs -> LCons (x, lazy (aux xs)) in
  result
于 2013-10-20T15:35:14.653 回答