How is Seq unfold implemented - ocaml

I have a question about how Seq's unfold function is implemented.
I tried creating my own Seq module(My_Seq) to see if I understood how that functionality worked and I can't get my unfold to behave like Seq's unfold function.
Here's my attempt(My_Seq, note I removed all but the necessary functionality)
module type My_Seq_Sig =
sig
type 'a t
val empty: 'a t
val iter: ('a -> unit) -> 'a t -> unit
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
end
module My_Seq:My_Seq_Sig =
struct
type 'a t = unit -> 'a node
and
'a node =
| Nil
| Cons of 'a * 'a t
let empty = fun () -> Nil
let rec iter f s =
match s() with
| Nil -> ()
| Cons (e, next) -> f e; iter f next
let rec unfold f e =
match (f e) with
| None -> empty
| Some (e, next) -> fun () -> Cons (e, unfold f next)
end
Here's how I'm calling my module My_Seq:
let seq =
let line = ref 0 in
let filename = print_string "Enter filename: "; read_line() in
My_Seq.unfold
(
fun e ->
try
line := !line + 1;
Some(((string_of_int !line) ^ ": " ^ (input_line e)), e)
with
End_of_file
| _ ->
print_endline("---Read->" ^ string_of_int (!line - 1) ^ "<-Line(s)---");
close_in e;
None
)
(open_in filename)
let () =
seq |> My_Seq.iter print_endline
Here's the output from my attempt:
Enter filename: datafile
1: This is the first
2: This is the second
3: This is the third
4: This is the fourth
---Read->5<-Line(s)---
5: This is the fifth
Now if I use Seq's unfold function:
let seq2 =
let line = ref 0 in
let filename = print_string "Enter filename: "; read_line() in
Seq.unfold
(
fun e ->
try
line := !line + 1;
Some(((string_of_int !line) ^ ": " ^ (input_line e)), e)
with
End_of_file
| _ ->
print_endline("---Read->" ^ string_of_int (!line - 1) ^ "<-Line(s)---");
close_in e;
None
)
(open_in filename)
let () =
seq2 |> Seq.iter print_endline
Here's the output from using Seq's unfold function:
Enter filename: datafile
1: This is the first
2: This is the second
3: This is the third
4: This is the fourth
5: This is the fifth
---Read->5<-Line(s)---
datafile contents:
This is the first
This is the second
This is the third
This is the fourth
This is the fifth
You'll note that the outputs differ and I have no idea why. Maybe someone can shed some light on this.
That did it Guest0x0
let rec unfold f e =
fun () ->(
match (f e) with
| None -> Nil
| Some (e, next) -> Cons (e, unfold f next))

The difference lies in when the last element is computed. In your unfold, the last element is computed (in f e) when the element before it is fetched (via feeding a unit argument somewhere), while the Stdlib version computes the last element only when that element itself is fetched.
To make your unfold behaves like the Stdlib one, notice that both branches of your unfold returns a function taking unit as argument. By lifting this argument outside the whole pattern matching, the actual computation of f e will then get delayed, leading to the Stdlib behavior

Related

How to define "apply" in OCaml

I am trying to define a function that is similar to Lisp's apply. Here is my attempt:
type t =
| Str of string
| Int of int
let rec apply f args =
match args with
| (Str s)::xs -> apply (f s) xs
| (Int i)::xs -> apply (f i) xs
| [] -> f
(* Example 1 *)
let total = apply (fun x y z -> x + y + z)
[Int 1; Int 2; Int 3]
(* Example 2 *)
let () = apply (fun name age ->
Printf.printf "Name: %s\n" name;
Printf.printf "Age: %i\n" age)
[Str "Bob"; Int 99]
However, this fails to compile. The compiler gives this error message:
File "./myprog.ml", line 7, characters 25-30:
7 | | (Str s)::xs -> apply (f s) xs
^^^^^
Error: This expression has type 'a but an expression was expected of type
string -> 'a
The type variable 'a occurs inside string -> 'a
What is the meaning of this error message? How can I fix the problem and implement apply?
You cannot mix an untyped DSL for data:
type t =
| Int of int
| Float of float
and a shallow embedding (using OCaml functions as functions inside the DSL) for functions in apply
let rec apply f args =
match args with
| (Str s)::xs -> apply (f s) xs (* f is int -> 'a *)
| (Int i)::xs -> apply (f i) xs (* f is string -> 'a *)
| [] -> f (* f is 'a *)
The typechecker is complaining that if f has type 'a, f s cannot also have for type 'a since it would mean that f has simultaneously type string -> 'a and 'a (without using the recursive types flag).
And more generally, your function apply doesn't use f with a coherent type: sometimes it has type 'a, sometimes it has type int -> 'a, other times it would rather have type string -> 'a. In other words, it is not possible to write a type for apply
val apply: ??? (* (int|string) -> ... *) -> t list -> ???
You have to choose your poison.
Either go with a fully untyped DSL which contains functions, that can be applied:
type t =
| Int of int
| Float of float
| Fun of (t -> t)
exception Type_error
let rec apply f l = match f, l with
| x, [] -> f
| Fun f, a :: q -> apply (f a) q
| (Int _|Float _), _ :: _ -> raise Type_error
or use OCaml type system and define a well-typed list of arguments with a GADT:
type ('a,'b) t =
| Nil: ('a,'a) t
| Cons: 'a * ('b,'r) t -> ('a -> 'b,'r) t
let rec apply: type f r. f -> (f,r) t -> r = fun f l ->
match l with
| Nil -> f
| Cons (x,l) -> apply (f x) l
EDIT:
Using the GADT solution is quite direct since we are using usual OCaml type without much wrapping:
let three = apply (+) (Cons(1, Cons(2,Nil)))
(and we could use a heterogeneous list syntactic sugar to make this form even lighter syntactically)
The untyped DSL requires to build first a function in the DSL:
let plus = Fun(function
| Float _ | Fun _ -> raise Type_error
| Int x -> Fun(function
| Float _ | Fun _ -> raise Type_error
| Int y -> Int (x+y)
)
)
but once we have built the function, it is relatively straightforward:
let three = apply_dsl plus [Int 2; Int 1]
type t =
| Str of string
| Int of int
| Unit
let rec apply f args =
match args with
| x::xs -> apply (f x) xs
| [] -> f Unit
Let's go step by step:
line 1: apply : 'a -> 'b -> 'c (we don't know the types of f, args and apply's return type
line 2 and beginning of line 3: args : t list so apply : 'a -> t list -> 'c
rest of line 3: Since f s (s : string), f : string -> 'a but f t : f because apply (f s). This means that f contains f in its type, this is a buggy behaviour
It's actually buggy to call f on s and i because this means that f can take a string or an int, the compiler will not allow it.
And lastly, if args is empty, you return f so the return type of f is the type of f itself, another buggy part of this code.
Looking at your examples, a simple solution would be:
type t = Str of string | Int of int
let rec apply f acc args =
match args with x :: xs -> apply f (f acc x) xs | [] -> acc
(* Example 1 *)
let total =
apply
(fun acc x ->
match x with Int d -> d + acc | Str _ -> failwith "Type error")
0 [ Int 1; Int 2; Int 3 ]
(* Example 2 *)
let () =
apply
(fun () -> function
| Str name -> Printf.printf "Name: %s\n" name
| Int age -> Printf.printf "Age: %i\n" age)
() [ Str "Bob"; Int 99 ]
Since you know the type you want to work on, you don't need GADT shenanigans, just let f handle the pattern matching and work with an accumulator

How to zip each individual element from two lists into one list using OCaml

If I have an input of a tuple containing two lists of integers of the same length, and I want my output to be a list of these two lists zipped, after extracting these two lists from the tuple how do I zip each individual element into one list? For example, if my input is twolists= ([1;2;3], [4;5;6]), then I want my output to be [(1,4); (2,5); (3,6)]. How do I zip each element and add it to my output?
The function name and type is as follows:
let rec pairlists twolists = ...
val pairlists : 'a list * 'b list -> ('a * 'b) list = fun
So far I have:
let rec pairlists twolists =
let (l1, l2) = twolists in
let rec zip (l1,l2) =
match l1 with
|[] -> l2
|x :: xs -> x :: zip(l2, xs) in
twolists ;;
but this is clearly not doing what I want.
Are you looking for List.combine ?
val combine : 'a list -> 'b list -> ('a * 'b) list
Transform a pair of lists into a list of pairs: combine [a1; ...; an] [b1; ...; bn] is [(a1,b1); ...; (an,bn)].
Raises Invalid_argument if the two lists have different lengths. Not tail-recursive.
If your result list should contain elements that consist of the elements of both sublists, then you obviously have to destructure each sublist on each iteration.
If the lists are guaranteed to have the same lengths, the solution can be as simple as:
let rec zip paired_lists =
match paired_lists with
| [], [] -> []
| h1::t1, h2::t2 -> (h1, h2)::(zip (t1, t2))
| _, _ -> failwith "oops, the lists seems to have different lengths"
;;
zip ([1;2;3], [4;5;6]);;
- : (int * int) list = [(1, 4); (2, 5); (3, 6)]
But this one is not tail-recursive, which is obviously not good. The second sub-optimal thing is this reconstruction of tuple of lists on each iteration (I'm a newbie in OCaml, so chances are compiler is smart enough to avoid the unnecessary allocations, but still...). Fixing both flaws is trivial too:
let zip_tr paired_lists =
let list1, list2 = paired_lists in
let rec aux l1 l2 acc =
match l1, l2 with
| [], [] -> List.rev acc
| h1::t1, h2::t2 -> aux t1 t2 (h1, h2)::acc
| _, _ -> failwith "oops, the lists seems to have different lengths"
in aux list1 list2 []
;;
zip_tr ([1;2;3], [4;5;6]);;
- : (int * int) list = [(1, 4); (2, 5); (3, 6)]
The signature of your code does not match the expected signature :
line 2, characters 11-13:
Warning 26: unused variable l2.
Line 2, characters 7-9:
Warning 26: unused variable l1.
val pairlists : 'a list * 'a list -> 'a list = <fun>
Indeed, both possible matches return either a 'a list (this is l2) or x::zip... which is also a list of 'a type.
There should be sth like (x,y)::list in your code.
In addition, pairlists is not recursive and does not need to be declared as such, only zip is recursive.
The end of your function shall be like this (otherwise zip has no effect) :
....
let rec zip (l1,l2) =
match l1 with
|[] -> l2
|x :: xs -> x :: zip(l2, xs) in
zip twolists ;;
In addition to the other solutions mentioned, ocaml-4.08 onwards enables you to provide let+ and and+ operators which will zip a list sum-wise, where you might otherwise think of using applicatives. Whether it is an improvement on them is in the eye of the beholder:
let (let+) list f = List.map f list
let (and+) a b =
let rec loop first second =
match first,second with
first_hd::first_tl,second_hd::second_tl ->
(first_hd,second_hd)::(loop first_tl second_tl)
| _ -> []
in
loop a b
let pairlists = function
first,second ->
let+ elt1 = first
and+ elt2 = second in
[elt1 ; elt2]
(* example *)
let () =
let res = pairlists ([1;2;3], [4;5;6]) in
List.iter
(fun list -> List.iter (fun i -> Printf.printf "%d " i) list ;
print_endline "")
res
Here by way of comparison is the more traditional approach if you are using applicatives
let pure x = [x]
let (<*>) aps args =
List.concat (List.map (fun f -> List.map (fun x -> f x) args) aps)
let (<|>) aps args =
let rec loop args_rest aps_rest =
match args_rest,aps_rest with
args_hd::args_tl,aps_hd::aps_tl ->
(aps_hd args_hd)::(loop args_tl aps_tl)
| _ -> []
in
loop args aps
let pairlists = function
first,second ->
let two_list a b = a :: [b] in
pure two_list <*> first <|> second
(* example *)
let () =
let res = pairlists ([1;2;3], [4;5;6]) in
List.iter
(fun list -> List.iter (fun i -> Printf.printf "%d " i) list ;
print_endline "")
res

Ocaml cast string to list of tuples

I have the file "example.dat" with text "[(1,2); (3,4); (5,6)]". I need to get list of tuples from it. I know, how I can get it from list of ints.
# let f line = List.map int_of_string line;;
# open Printf
let file = "example.dat"
let () =
let ic = open_in file in
try
let line = input_line ic in
f line;
flush stdout;
close_in ic
with e ->
close_in_noerr ic;
raise e;;
How I must to change my functions?
Given a list of strings that represent ints, your function f returns a list of ints. It doesn't return a list of tuples.
You don't say whether you want to verify that the input has some kind of proper form. If you want to verify that it has the form of (say) a list of type (int * int) list in OCaml, this is a parsing problem that would take some work.
If you just want to extract the parts of the input line that look like ints, you can use regular expression processing from the Str module:
# let re = Str.regexp "[^0-9]+" in
Str.split re "[(1,2); (37,4); (5,6)]";;
- : string list = ["1"; "2"; "37"; "4"; "5"; "6"]
Then you can rewrite your function f to collect up each pair of ints into a tuple. I don't see a good way to use List.map for this. You might have to write your own recursive function or use List.fold_left.
Update
I will write you a function that changes a list of values into a list of pairs. I hope this isn't for a school assignment, in which case you should be figuring this out for yourself.
let rec mkpairs l =
match l with
| [] | [_] -> []
| a :: b :: rest -> (a, b) :: mkpairs rest
As you can see, this function silently discards the last element of the list if the list has an odd number of elements.
This function is not tail recursive. So that's something you could think about improving.
let open Genlex in
let open Stream in
let lexer = make_lexer ["["; "("; ","; ")"; ";"; "]";] in
let stream = lexer (of_string array_string) in
let fail () = failwith "Malformed string" in
let parse_tuple acc = match next stream with
| Int first -> ( match next stream with
| Kwd "," -> ( match next stream with
| Int second -> ( match next stream with
| Kwd ")" -> (first, second) :: acc
| _ -> fail () )
| _ -> fail () )
| _ -> fail () )
| _ -> fail ()
in
let rec parse_array acc =
match next stream with
| Kwd "(" -> parse_array (parse_tuple acc)
| Kwd ";" -> parse_array acc
| Kwd "]" -> acc
| _ -> fail ()
in
try
match next stream with
| Kwd "[" -> List.rev (parse_array [])
| _ -> fail ()
with Stream.Failure -> fail ();;

The trick for doing Stream

I am currently trying to fully understand stream. The concept is not complicated. It is like a list, but the tail part is a thunk instead of concrete sub list.
I can write stream like this:
type 'a stream_t = Nil | Cons of 'a * (unit -> 'a stream_t)
let hd = function
| Nil -> failwith "hd"
| Cons (v, _) -> v
let tl = function
| Nil -> failwith "tl"
| Cons (_, g) -> g()
let rec take n = function
| Nil -> []
| Cons (_, _) when n = 0 -> []
| Cons (hd, g) -> hd::take (n-1) (g())
let rec filter f = function
| Nil -> Nil
| Cons (hd, g) ->
if f hd then Cons (hd, fun() -> filter f (g()))
else filter f (g())
So far so good and I can write a simple stream:
let rec from i = Cons (i, fun() -> from (i+1))
Now, if I was asked to do a primes stream, I feel very difficult. I want to use sieve algorithm. Without thinking of stream, I can do it easily. But for stream, I can't do.
I searched for the code:
(* delete multiples of p from a stream *)
let sift p = filter (fun n -> n mod p <> 0)
(* sieve of Eratosthenes *)
let rec sieve = function
| Nil -> Nil
| Cons (p, g) ->
let next = sift p (g()) in
Cons (p, fun () -> sieve next)
(* primes *)
let primes = sieve (from 2)
I can almost understand that it is working. But where is the trick?
Also how to do a stream of permutation of a list?

Compose total and partial functions

I can't wrap my head around where should I put parenthesis to get it working:
let read_lines filename =
let channel = open_in filename in
Std.input_list channel;;
let print_lines filename =
List.map print_string ((^) "\n") (read_lines filename);;
^ This is the closes I've got so far. If my terminology is vague: ((^) "\n") is what I call partial function (well, because it doesn't handle all of its arguments). print_string I call total function because... well, it handles all of its arguments.
Obviously, what I would like to happen is that:
List.map applies first ((^) "\n") to the element of the list.
List.map applies print_string to the result of #1.
How? :)
Maybe you want something like that?
# let ($) f g = fun x -> f(g x);;
val ( $ ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
# let f = print_string $ (fun s -> s^"\n");;
val f : string -> unit = <fun>
# List.iter f ["a";"b";"c";"d"];;
a
b
c
d
- : unit = ()
# let g = string_of_int $ ((+)1) $ int_of_string;;
val g : string -> string = <fun>
# g "1";;
- : string = "2"
Your code didn't work because missing parenthesis:
List.map print_string ((^) "\n") xs
is parsed as
(List.map print_string ((^) "\n")) xs
when you expected
List.map (print_string ((^) "\n")) xs
A few things: List.map is probably not what you want, since it will produce a list (of unit values) rather than just iterating. ((^) "\n") is probably also not what you want, as it prepends a newline, the "\n" being the first argument. (This is not a section as in Haskell, but a straightforward partial application.)
Here's a reasonable solution that is close to what (I think) you want:
let print_lines filename =
List.iter (fun str -> print_string (str ^ "\n")) (read_lines filename)
But I would rather write
let print_lines filename =
List.iter (Printf.printf "%s\n") (read_lines filename)
Which is both clearer and more efficient.