Changing a mutable field in OCaml - syntax-error

When I run the following code I get a syntax error, although as far as I can tell the syntax is correct. This attempts to implement a queue structure, where the function from_list converts a list to a queue with the corresponding values. I wrote str_of_int_q to print the contents of a queue. x and y are supposed to be two nodes, with x at the head and y at the tail.
;; open Assert
type 'a qnode = {v: 'a;
mutable next: 'a qnode option}
type 'a queue = {mutable head: 'a qnode option;
mutable tail: 'a qnode option}
let from_list (l: 'a list) : 'a queue =
let rec loop (l2: 'a list) (qu: 'a queue) =
begin match l2 with
| [] -> qu
| [x] -> let y = {v = x; next = None} in
qu.head <- Some y; qu.tail <- Some y;
qu
| h1::h2::t -> let y = qu.head in
let z = {v = h1; next = y} in
qu.head <- Some z;
qu
end
in loop l {head = None; tail = None}
let str_of_int_q (q: int queue) : string =
let rec loop (r: int qnode option) (s: string) : string =
begin match r with
| None -> s
| Some n -> loop n.next (s ^ (string_of_int n.v))
end
in loop q.head ""
let x = {v = 1; next = None}
let y = {v = 2; next = None}
x.next <- Some y;
let z = {head = Some x; tail = Some y}
;; print_endline (str_of_int_q z)
My error:
line 32, characters 7-9:
Error: Syntax error
Line 32 is the line x.next <- Some y; and characters 7-9 indicate the <-. But I'm storing into a mutable field an object of the appropriate type, so I don't see what's going wrong.

Top-level statements are separated by ;; in OCaml. However, ;; is optional before several keywords, such as let, open, type, etc. This is why you don't need ;; most of the time.
In your case, ;; is needed to disambiguate between let y = {v = 2; next = None} and x.next <- Some y. The latter is an expression and doesn't start with a special keyword, so OCaml doesn't know to insert an implicit ;; here.
See also http://ocaml.org/learn/tutorials/structure_of_ocaml_programs.html#The-disappearance-of.
As explained there, you can either do
let y = {v = 2; next = None}
;; x.next <- Some y
or
let y = {v = 2; next = None}
let () = x.next <- Some y
This latter solution works because by introducing a dummy binding we're starting our statement with let, which disambiguates again.
Note: I've also removed the trailing ; from your code. ; is actually an infix operator that combines two expressions (by throwing the result of the first one away and returning the result of the second one). This is not what you want here.

Related

Why do I get an Unbound value Error even though it works in the Terminal in Ocaml

There has to be a minor error in my code because it works in the VSC-Terminal but not in the editor but I do not understand what it could be,
I get the Unbound value Error for the avg_grade and get_grades functions
Let studentlist be a list which safes student records. Each student has a (int*float) grades-list which safes a numeration as a int and the actual grades as floats.
My aim is to calculate the average grade of a single student with the function avg_grade.
I call the single student-record with the age with the get_student function.
type student = {
name : string;
age : int;
grades : (int*float) list;
}
let studentlist =
[ {name="alex"; age=7; grades=[(1,3.)]} ;
{name="bianca"; age=6; grades=[(1, 2.); (2, 3.)]} ]
(* main-function to calculate the average *)
let avg_grade a lst =
try
grades_sum a lst /. length a lst
with
Not_found -> 0.0
(* function to add all the float-grades,
it calls the list with get_grades *)
let grades_sum a lst =
List.fold_left (fun i (_,b) -> i +. b) 0. (get_grades a lst)
(* calls the grades of a single record which is called per age *)
let get_grades a lst =
(get_student a lst).grades
(*calls a single student-record*)
let get_student a lst =
List.find (fun {age;_} -> a = age) lst
(* computes the length of the given grades-list *)
let length a lst =
float_of_int (List.length (get_grades a lst))
You have this:
let avg_grade a lst = try grades_sum a lst /. length a lst with Not_found -> 0.0
But grades_sum isn't defined until after that line of code, so you get:
Error: Unbound value grades_sum
Additionally, a style suggestion. The |> operator may be useful for cleaning up some of your code. For better understanding of how it works:
let (|>) x f = f x
This allows something like f (g (h x)) to be written h x |> g |> f. Doing this lets us see that h x is being evaluated first. The result of that is sent to g, and then finally to f.
Both do the same thing, but the latter may be more expressive of what the code is doing.
You could use this to rewrite:
let length a lst =
float_of_int (List.length (get_grades a lst))
As:
let length a lst =
get_grades a lst |> List.length |> float_of_int

F# comparing lambdas for equality

I would like to try and compare F# lambdas for equality. This is, at first inspection, not possible.
let foo = 10
let la = (fun x y -> x + y + foo)
let lb = (fun x y -> x + y + foo)
printfn "lambda equals %b" (la = lb)
which generates the error
The type '('a -> 'b -> int)' does not support the 'equality' constraint because it is a function typeF# Compiler(1)
However, and surprisingly, it is possible to serialize lambda functions.
open System.Runtime.Serialization.Formatters.Binary
open System.IO
let serialize o =
let bf = BinaryFormatter()
use ms = new MemoryStream()
bf.Serialize(ms,o)
ms.ToArray()
let ByteToHex bytes =
bytes
|> Array.map (fun (x : byte) -> System.String.Format("{0:X2}", x))
|> String.concat System.String.Empty
let foo = 10
let la = (fun x y -> x + y + foo)
let lb = (fun x y -> x + y + foo)
let a = serialize la
let b = serialize lb
printfn "%s" (ByteToHex a)
printfn "%s" (ByteToHex b)
printfn "lambda equals %b" (a = b)
which suggests that if they can be serialized they can be compared. However, inspection of the byte stream for this example shows two bytes where there is a difference.
Is there possibly a strategy to solve this problem by intelligently comparing the byte arrays?
From an equivalence perspective, functions aren't meaningfully serialized.
Curryable functions in F# are implemented as derived from FSharpFunc.
let la = (fun x y -> x + y + foo)
would be implemented as an instance of the following class (in equivalent C#):
[Serializable] class Impl : FSharpFunc<int, int, int>
{
public int foo;
Impl(int foo_) => foo = foo_;
public override int Invoke(int x, int y) =>
x + y + _foo;
}
What binary serialization captures would be the full typename and the value of foo.
In fact if we look at strings in the byte stream we see:
test, Version=1.0.0.0, Culture=neutral, PublicKeyToken=null
Program+la#28
foo
...where la#28 is the name of our derived class.
Where the byte stream for la and lb differs is the name of the implementing class. The implementations of la and lb could be entirely different.
You could, for instance, change lb into let lb = (fun x y -> x * y + foo), and the result would be same for both runs.
You can however, do this with Code Quotations:
let foo = 10
let la = <# fun x y -> x + y + foo #>
let lb = <# fun x y -> x + y + foo #>
printfn "Is same: %b" (la.ToString() = lb.ToString()) //true
F# also supports Expression<Func<>> (C#'s expression trees) - which is also a valid avenue for comparison.

Hofstadter Female and Male sequences in SML

This is my first SML program. I am trying to write a function that returns the first number to the nth number of Hofstadter's Female or Male sequence in list form. What I have so far is:
val m = fn (n) => if n = 0 then 1 :: [] else m f (n - 1);
val f = fn (n) => if n = 0 then 0 :: [] else f m (n - 1);
You can learn about the sequence here:
https://en.wikipedia.org/wiki/Hofstadter_sequence#Hofstadter_Female_and_Male_sequences
The error that I am getting is:
[opening sequence.sml]
sequence.sml:1.49 Error: unbound variable or constructor: f
sequence.sml:1.47-1.58 Error: operator is not a function [tycon mismatch]
operator: int list
in expression:
(m <errorvar>) (n - 1)
val it = () : unit
How can I correct this?
I ended up taking this approach:
fun
m (n) = if n = 0 then 0 else n - (f (m (n - 1)))
and
f (n) = if n = 0 then 1 else n - (m (f (n - 1)));
val seq = fn n => List.tabulate((n), f);
It is quite slow. If anybody has a faster version, then I'd love to see it.
Although you have already fixed them, there were two problems with your original approach:
Function application is left-associative in SML so m f (n - 1) was being interpreted as (m f) (n - 1), not the desired m (f (n - 1)). You can fix this by explicitly specifying the bracketing m (f (n - 1)).
To be able to call f from m and m from f, you need to use the keyword fun instead of val on the first declaration (to make the function recursive), and the keyword and instead of fun or val on the second declaration (to make the function mutually recursive with the first function). This would look like
fun f n = ... (* I can call f or m from here! *)
and m n = ... (* I can call f or m from here! *)
To make it faster, you can memoize! The trick is to make f and m take as arguments memoized versions of themselves.
(* Convenience function: Update arr[i] to x, and return x. *)
fun updateAndReturn arr i x = (Array.update (arr, i, SOME x); x)
(*
* Look up result of f i in table; if it's not found, calculate f i and
* store in the table. The token is used so that deeper recursive calls
* to f can also try to store in the table.
*)
fun memo table f token i =
case Array.sub (table, i)
of NONE => updateAndReturn table i (f token i)
| SOME x => x
(*
* Given f, g, and n : int, returns a tuple (f', g') where f' and g' are memoized
* versions of f and g, respectively. f' and g' are defined only on the domain
* [0, n).
*)
fun memoizeMutual (f, g) n =
let
val fTable = Array.array (n, NONE)
val gTable = Array.array (n, NONE)
fun fMemo i = memo fTable f (fMemo, gMemo) i
and gMemo i = memo gTable g (gMemo, fMemo) i
in
(fMemo, gMemo)
end
fun female _ 0 = 1
| female (f, m) n = n - m (f (n - 1))
fun male _ 0 = 0
| male (m, f) n = n - f (m (n - 1))
fun hofstadter upTo =
let
val (male', female') = memoizeMutual (male, female) upTo
in
(List.tabulate (upTo, male'), List.tabulate (upTo, female'))
end
I renamed f and m to female and male. The memoized fMemo and gMemo are threaded through female and male by memoizeMutual. Interestingly, if we call male', then results for both male' and female' are memoized.
To confirm it's indeed faster, try evaluating hofstadter 10000. It's much faster than the forever that your version would take.
As a final note, the only recursive functions are fMemo and gMemo. Every other function I wrote could be written as an anonymous function (val memoizeMutual = fn ..., val female = fn ..., etc.), but I chose not to do so because the syntax for writing recursive functions is much more compact in SML.
To generalize this, you could replace the array version of memoizing with something like a hash table. Then we wouldn't have to specify the size of the memoization up front.

Proof in Coq that equality is reflexivity

The HOTT book writes on page 51:
... we can prove by path induction on p: x = y that
$(x, y, p) =_{ \sum_{(x,y:A)} (x=y)} (x, x, refl x)$ .
Can someone show me how to prove this in Coq?
Actually, it is possible to prove this result in Coq:
Notation "y ; z" := (existT _ y z) (at level 80, right associativity).
Definition hott51 T x y e :
(x; y; e) = (x; x; eq_refl) :> {x : T & {y : T & x = y} } :=
match e with
| eq_refl => eq_refl
end.
Here, I've used a semicolon tuple notation to express dependent pairs; in Coq, {x : T & T x} is the sigma type \sum_{x : T} T x. There is also a slightly easier-to-read variant, where we do not mention y:
Definition hott51' T x e : (x; e) = (x; eq_refl) :> {y : T & x = y} :=
match e with
| eq_refl => eq_refl
end.
If you're not used to writing proof terms by hand, this code might look a bit mysterious, but it is doing exactly what the HoTT book says: proceeding by path induction. There's one crucial bit of information that is missing here, which are the type annotations needed to do path induction. Coq is able to infer those, but we can ask it to tell us what they are explicitly by printing the term. For hott51', we get the following (after some rewriting):
hott51' =
fun (T : Type) (x : T) (e : x = x) =>
match e as e' in _ = y' return (y'; e') = (x; eq_refl) with
| eq_refl => eq_refl
end
: forall (T : Type) (x : T) (e : x = x),
(x; e) = (x; eq_refl)
The important detail there is that in the return type of the match, both x and e are generalized to y' and e'. The only reason this is possible is because we wrapped x in a pair. Consider what would happen if we tried proving UIP:
Fail Definition uip T (x : T) (e : x = x) : e = eq_refl :=
match e as e' in _ = y' return e' = eq_refl with
| eq_refl => eq_refl
end.
Here, Coq complains, saying:
The command has indeed failed with message:
In environment
T : Type
x : T
e : x = x
y' : T
e' : x = y'
The term "eq_refl" has type "x = x" while it is expected to have type
"x = y'" (cannot unify "x" and "y'").
What this error message is saying is that, in the return type of the match, the e' has type x = y', where y' is generalized. This means that the equality e' = eq_refl is ill-typed, because the right-hand side must have type x = x or y' = y'.
Simple answer: you can't. All proofs of x = y in Coq are not instances of eq_refl x. You will have to assume Uniqueness of Identity Proof to have such a result. This is a very nice axiom, but it's still an axiom in the Calculus of Inductive Constructions.

How to optimize splitting in F# more?

This code is splitting a list in two pieces by a predicate that take a list and return false in the moment of splitting.
let split pred ys =
let rec split' l r =
match r with
| [] -> []
| x::xs -> if pred (x::l) then x::(split' (x::l) xs) else []
let res = split' [] ys
let last = ys |> Seq.skip (Seq.length res) |> Seq.toList
(res, last)
Do someone knows more optimal and simpler ways to do that in F#?
Well you can make it tail recursive but then you have to reverse the list. You wouldn't want to fold it since it can exit out of the recursive loop at any time. I did a little testing and reversing the list is more than made up for by tail recursion.
// val pred : ('a list -> bool)
let split pred xs =
let rec split' l xs ys =
match xs with
| [] -> [], ys
| x::xs -> if pred (x::l) then (split' (x::l) xs (x::ys)) else x::xs, ys
let last, res = split' [] xs []
(res |> List.rev, last)
A version similar to Brian's that is tail recursive and takes a single value predicate.
// val pred : ('a -> bool)
let split pred xs =
let rec split' xs ys =
match xs with
| [] -> [], ys
| x::xs -> if pred x then (split' xs (x::ys)) else (x::xs), ys
let last, res = split' xs []
(res |> List.rev, last)
This is different from the library function partition in that it stops taking elements as soon as the predicate returns false kind of like Seq.takeWhile.
// library function
let x, y = List.partition (fun x -> x < 5) li
printfn "%A" x // [1; 3; 2; 4]
printfn "%A" y // [5; 7; 6; 8]
let x, y = split (fun x -> x < 5) li
printfn "%A" x // [1; 3]
printfn "%A" y // [5; 7; 2; 4; 6; 8]
Not tail-recursive, but:
let rec Break pred list =
match list with
| [] -> [],[]
| x::xs when pred x ->
let a,b = Break pred xs
x::a, b
| x::xs -> [x], xs
let li = [1; 3; 5; 7; 2; 4; 6; 8]
let a, b = Break (fun x -> x < 5) li
printfn "%A" a // [1; 3; 5]
printfn "%A" b // [7; 2; 4; 6; 8]
// Also note this library function
let x, y = List.partition (fun x -> x < 5) li
printfn "%A" x // [1; 3; 2; 4]
printfn "%A" y // [5; 7; 6; 8]
Here is some foldr way:
let split' pred xs = let f (ls,rs,cond) x = if cond (ls#[x]) then (ls#[x],rs,cond) else (ls,rs#[x],(fun _->false))
let ls,rs,_ = List.fold f ([],[],pred) xs
ls, rs