type 'a tree =
| Leaf of 'a
| Node of 'a * 'a tree * 'a tree
let rec foldtree init op = function
| Leaf c -> op c init init
| Node (c, l, r) -> op c (foldtree init op l) (foldtree init op r)
let size' = foldtree 0 (fun _ l r -> 1 + l + r) (* this compiles fine *)
let size'' = foldtree 0 (fun _ l r -> 1 + l + r) (* this doesn't *)
In the above OCaml code, the definitions of size' and size'' are identical yet the latter causes a compilation error:
Error: The type of this expression, '_weak1 tree -> int,
contains type variables that cannot be generalized
They should both fail to compile, as both contain weak type variables. The compiler will only report one fatal error at a time, however.
Incidentally, you would usually fix this problem by eta-expansion:
let size tree = foldtree 0 (fun _ l r -> 1 + l + r) tree
Related
I have the following peano number written with GADTs:
type z = Z of z
type 'a s = Z | S of 'a
type _ t = Z : z t | S : 'n t -> 'n s t
module T = struct
type nonrec 'a t = 'a t
end
type 'a nat = 'a t
type e = T : 'n nat -> e
The following function to decode a 'a nat (or 'a t) into the number it encoded, works:
let to_int : type n. n t -> int =
let rec go : type n. int -> n t -> int =
fun acc n -> match n with Z -> acc | S n -> go (acc + 1) n
in
fun x -> go 0 x
but if I try to rewrite it almost exactly the same this way:
let to_int2 (type a) (a: a nat) : int =
let rec go (type a) (acc : int) (x : a nat) : int =
match x with
| Z -> acc
| S v -> go (acc + 1) v
in
go 0 a
I get a scope error. What's the difference between the two functions?
138 | | S v -> go (acc + 1) v
^
Error: This expression has type $0 t but an expression was expected of type
'a
The type constructor $0 would escape its scope
The root issue is polymorphic recursion, GADTs are a red herring here.
Without an explicit annotation, recursive functions are not polymorphic in their own definition.
For instance, the following function has type int -> int
let rec id x =
let _discard = lazy (id 0) in
x;;
because id is not polymorphic in
let _discard = lazy (id 0) in
and thus id 0 implies that the type of id is int -> 'a which leads to id having type int -> int.
In order to define polymorphic recursive function, one need to add an explicit universally quantified annotation
let rec id : 'a. 'a -> 'a = fun x ->
let _discard = lazy (id 0) in
x
With this change, id recovers its expected 'a -> 'a type.
This requirement does not change with GADTs. Simplifying your code
let rec to_int (type a) (x : a nat) : int =
match x with
| Z -> 0
| S v -> 1 + to_int v
the annotation x: a nat implies that the function to_int only works with a nat, but you are applying to an incompatible type (and ones that lives in a too narrow scope but that is secondary).
Like in the non-GADT case, the solution is to add an explicit polymorphic annotation:
let rec to_int: 'a. 'a nat -> int = fun (type a) (x : a nat) ->
match x with
| Z -> 0
| S v -> 1 + to_int v
Since the form 'a. 'a nat -> int = fun (type a) (x : a nat) -> is both a mouthful and quite often needed with recursive function on GADTs, there is a shortcut notation available:
let rec to_int: type a. a nat -> int = fun x ->
match x with
| Z -> 0
| S v -> 1 + to_int v
For people not very familiar with GADTs, this form is the one to prefer whenever one write a GADT function. Indeed, not only this avoids the issue with polymorphic recursion, writing down the explicit type of a function before trying to implement it is generally a good idea with GADTs.
See also https://ocaml.org/manual/polymorphism.html#s:polymorphic-recursion , https://ocaml.org/manual/gadts-tutorial.html#s%3Agadts-recfun , and https://v2.ocaml.org/manual/locallyabstract.html#p:polymorpic-locally-abstract .
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
I’m trying to create a function that takes an int list as an argument and returns the sum of the product between an int and its position in the list. To put in an example this : multSum [5; 11; 15] should return (5 * 1 + 11 * 2 + 15 * 3) = 72.
It should be written recursively and I’m trying while avoiding List.map or List.filter or any other prefabricated functions.
By dividing and reigning the query above, I have so far started by trying the following :
let rec tir f acc l =
match l with
|[] -> acc
|h::t -> tir f (f acc h) t ;;
val tir : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
then I moved to this :
let rec carto f a b =
match (a,b) with
|([],[])->([])
|(h1::t1,h2::t2)->(f h1 h2):: (carto f t1 t2)
|_->invalid_arg "carto";;
val carto : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
with the final idea to be able to do that :
let prod arg1 arg2 =
tir (+) 1 (carto ( * ) arg1 arg2);;
val prod : int list -> int list -> int = <fun>
But I am stuck now and I’m not sure of my orientation from here forward. I thought of trying to search for the index in a "l" and replace each index int in the acc, in order to make it work but I'm afraid I'm rather complicating things... Any help please ?
Edit 1 :
let rec multSum l =
let rec indices n xs = match xs with
| [] -> []
| h::t -> n::(indices (n+1) t)in
let rec tir f acc l =
match l with
|[] -> acc
|h::t -> tir f (f acc h) t in
let rec carto f a b =
match (a,b) with
|([],[])->([])
|(h1::t1,h2::t2)->(f h1 h2):: (carto f t1 t2)
|_->invalid_arg "carto" in
let prod arg1 arg2 =
tir (+) 0 (carto ( * ) arg1 arg2) in
prod l (indices 1 l);;
val multSum : int list -> int = <fun>
Building on your replies, surely these are 'fold' and 'map' rewritten. At least, I'm sure now that I was on the right track. I have come to put together the whole code as signaled above in Edit 1.
It seems to be working well... I know that I want a recursive function and here it is. But, do you think it could be done even shorter recursively of course?
#coredump is quite right about this looking like an ideal scenario for a fold, but the extra functions aren't really that necessary. We can just use a tuple to pass the index and sum information around, then when we're done, discard the index information from the tuple.
let sum_list_prod lst =
let (_, result) = List.fold_left
(fun (i, sum) x -> (i + 1, sum + i * x))
(1, 0)
lst
in
result
Edit: A simple implementation of a left fold to demonstrate the recursion going on here.
let rec foldl f init lst =
match lst with
| [] -> init
| first :: rest -> foldl f (f init first) rest
So working through a simple example with sum_list_prod:
sum_list_prod [2; 3; 4]
Calls the fold like so:
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (1, 0) [2; 3; 4]
And as that evaluates:
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (1, 0) [2; 3; 4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (2, 2) [3; 4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (3, 8) [4]
List.fold_left (fun (i, sum) x -> (i + 1, sum + i * x)) (4, 20) []
(4, 20)
And then we throw away the 4 because we don't need it anymore and are just left with 20.
Your tir functions looks like a fold; in fact has the exact same type as List.fold_left:
# List.fold_left;;
- : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
In the following snippets the prod function looks like a map2
# List.map2;;
- : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
You can use a fold and a map to compute the function you want, but you also need first to build a list of indices from the list of values. You could do this as follows:
let rec indices n xs = match xs with
| [] -> []
| h::t -> n::(indices (n+1) t);;
For example:
# indices 1 [5;1;3];;
- : int list = [1; 2; 3]
This is not recursive terminal, if you first computed the length of the list, how would you build the list in a recursive terminal way?
Then you should be able to call prod on a list xs and on a secondary list indices 1 xs. It is a bit wasteful because you need to build an auxiliary list, but it looks quite simple to me to understand, higher-order functions like map or fold do work on whole lists so there are fewer corner cases to consider.
But, it might be better to first write a direct recursive function for your particular problem before going the more abstract route.
The direct recursive function also requires no additional memory allocation. If you write a recursive terminal function you'll carry additional accumulator values:
the current position in the list, initially 1
the current sum of products, initially 0
Then, your function has the following skeleton:
let rec f xs index product = match xs with
| [] -> ...
| h::t -> ...
You can wrap it in a main function g:
let g xs = f xs 1 0;;
I have a module in one file that contains the type type move = Move of int. In another file, I open this module and can refer to the type by ModuleName1.move. But is it possible to construct an instance of this type in the second file, given that I'd have to use the Move i syntax, and since that Move parameter/keyword isn't really accessible from the second file?
Here's the module where I want to instantiate the type from the first module (which is called Game and contains the type type move = Move of int. It's right at the end, in the next_move function, that I want to construct a (Move 0) and pass it to make_tree, however it doesn't recognize Move since it's a parameterized type constructor from the other module:
#use "sig_player.ml" ;;
#use "game.ml" ;;
module TestAIPlayer =
struct
module PlayerGame = Game
open PlayerGame
let max_depth = 4 ;;
(* Data Definition *)
type tree = Node of PlayerGame.state * PlayerGame.move * tree list ;;
let rec make_tree (root: PlayerGame.state * PlayerGame.move) (d: int): tree =
let (s, m) = root in
let lms = PlayerGame.legal_moves s in
match lms, d with
| [], _ | _, 0 -> Node (s, m, [])
| _, _ -> Node (s, m, (List.map
(fun mv -> make_tree ((PlayerGame.next_state s mv), mv) (d - 1))
lms)) ;;
let compare_node (n1: PlayerGame.move * float) (n2: PlayerGame.move * float)
(comp: 'a -> 'a -> 'a): PlayerGame.move * float =
match n1, n2 with
| (m1, f1), (m2, f2) -> if (comp f1 f2) = f1 then n1 else n2 ;;
let rec minimax (t: tree) (mm: bool): PlayerGame.move * float =
match t with
| Node (s, m, []) -> (m, PlayerGame.estimate_value s)
| Node (s, m, children) -> let propagated = List.map
(fun c -> minimax c (not mm)) children in
(match mm with
| true -> List.fold_right
(fun x y -> compare_node x y max)
propagated (m, neg_infinity)
| false -> List.fold_right
(fun x y -> compare_node x y min)
propagated (m, infinity)) ;;
let next_move s = minimax (make_tree (s, (Move 0)) max_depth) true ;;
end ;;
module AIPlayer = (TestAIPlayer : PLAYER with module PlayerGame := Game) ;;
let rec add_tail l e = match l with
| [] -> [e]
| (h::t) -> h::(add_tail t e)
let rec fill_help l x n = match n = 0 with
true -> l
| false -> add_tail(l, x); fill_help(l, x, n-1)
let fill x n =
let l = [] in
fill_help(l, x, n)
and I'm getting the error in the interpreter
# #use "prac.ml";;
val prod : int list -> int = <fun>
val add_tail : 'a list -> 'a -> 'a list = <fun>
File "prac.ml", line 13, characters 21-27:
Error: This expression has type 'a * 'b
but an expression was expected of type 'c list
line 13 would be
| false -> add_tail(l, x); fill_help(l, x, n-1)
First of all you call fill_help with a tuple as an argument ((l, x, n-1)) even though it's not defined to take one. You should call fill_help as fill_help l x (n-1) instead. Same for add_tail.
Secondly you call a side-effect-free function (add_tail) and throw away its return value. This is almost always an error. It looks like you expect l to be different after the call to add_tail. It won't be. You probably want fill_help (add_tail l x) x (n-1).