OCaml variant augmentation boilerplates - recursion

Is there a way to efficiently "augment" or attach some more information without much boilerplate?
That is, given types
type orig =
| A
| B of orig
| C of orig * orig
and type dat = int
and type aug =
| AugA of dat
| AugB of dat * aug
| AugC of dat * aug * aug
and functions
let _cnt = ref 0
let gen_dat () =
let _ = _cnt := !_cnt + 1 in
!_cnt
let rec augment (o: orig) : ao =
match o with
| A -> AugA (gen_dat ())
| B o -> AugB (gen_dat (), augment o)
| C (o1, o2) -> AugC (gen_dat (), augment o1, augment o2)
I think this is a trivial structural recursion on its components, and I have to do repeat this type of identical manipulations on several types with 10+ patterns (Multiple augs each with its own augment function associated).
This leads to a long, tedious boilerplate code. Is there a way to abstract away this manipulation in OCaml, e.g., with help of ppx?

Related

Errors while iterating and processing the split string in recursive functions

Let's say we have a string
"+x1 +x2 -x3
+x4 +x5 -x6
..."
and a type formula:
type formula =
| Bot
| Top
| Atom of string
| Imp of (formula * formula)
| Or of (formula * formula)
| And of (formula * formula)
| Not of formula
let atom x = Atom x
(aka predicate logic)
and we want to:
Create a function which takes one line, splits it and turns it into disjunction using the formula type. (sort of like Or(Atom "x1", Atom "x2", Not Atom "x3") if we give the first line as an input)
I've written this:
let string_to_disj st =
let lst = Str.split (Str.regexp " \t") st in
let rec total lst =
match lst with
| [] -> Or (Bot, Bot) (*Is this correct btw?*)
| h :: t -> Or (string_to_lit h, total t);;
where
let string_to_lit =
match String.get s 0 with
| '+' -> atom (String.sub s 1 (String.length s-1))
| '-' -> Not(atom(String.sub s 1 (String.length s-1)))
| _ -> atom(s);;
However, string_to_disj raises a syntax error at line
| h :: t -> Or (string_to_lit h, total t)
What have I done wrong?
You have let rec total lst but you have no matching in. Every let requires a matching in. (Except at the top level of a module where it is for defining exported symbols of the module).
Also note that you are defining a function named total but you have no calls to the function except the one recursive call.

Inserting into a family tree (a real old-school family tree)

I'm learning F# and I'm trying to solve this exercise but my solution feels really... heavy and I suspect that there might an easier way of solving this task.
The task goes like that:
Declare two mutually recursive functions:
insertChildOf: Name -> FamilyTree -> FamilyTree -> FamilyTree option
insertChildOfInList: Name -> FamilyTree -> Children -> Children option
The value of insertChildOf n c t = Some t when t is the family tree obtained from t by insertion of c as a child of the person with name n. The value is None if such an insertion is not possible. Similarly, the value of insertChildOfInList n c cs = Some cs when cs is the list of children obtained from cs by inserting c as a child of a person named n in one of the children in cs. The value is None if such an insertion is not possible. Note that the person named n may occur anywhere in the family tree.
The type for the tree:
type Name = string;;
type Sex =
| M // male
| F // female
type YearOfBirth = int;;
type FamilyTree = P of Name * Sex * YearOfBirth * Children
and Children = FamilyTree list;;
You can assume that the tree has the following proprieties.
All children are younger than their parent.
The children are arranged form the oldest to the youngest.
Make sure that the tree you return also has those parameters.
My code:
let rec insertChildOf n c t =
let (P (_, _, yobi, _)) = c
match t with
| (P (name, sex, yob, children)) when n = name && yob < yobi ->
match insertHere c children -infinity with
| Some a -> Some ( P (name, sex, yob, a ))
| None -> None
| (P (name, _, yob, children)) when n = name && yob > yobi -> None
| (P (n, s, y, children)) ->
match insertChildOfInList n c children with
| Some a -> Some ( P (n, s, y, a ))
| None -> None
and insertChildOfInList n c cs =
match cs with
| h::t ->
match insertChildOf n c h with
| Some h2 ->
match insertChildOfInList n c t with
| Some a -> Some (h2::a)
| None -> None
| None -> None
| [] -> Some []
and insertHere t cs acc =
match cs with
| [] -> Some [t]
| h::tail ->
let (P (_, _, yob, _)) = t
let (P (_, _, yob2, _)) = h
if acc < yob && yob < yob2 then Some (t::h::tail)
else if yob = yob2 then None
else // h::(insertHere t tail (float yob2))
match insertHere t tail (float yob2) with
| Some a -> Some (h::a )
| None -> None
Once again, my question is: Can I do it in any simpler way?
Also, is there any way to return None if we didn't find FamilyTree with the right name? The one way I can think of is making all the functions return one more extra value called (found) which would signal if the node with the correct name was found, and creating a wrapper that would check the value of that variable and return None if the found was false.
To be honest, it isnt really any shorter than yours.
I've not used any 'fancy' library methods (e.g. things like sortby, or Option.map as you havent either)
I can't guarentee that its completely correct
I've written it as explicit lambda functions to make the types explicit - this isnt normal.
I didnt use the tuple syntax you need, because i find tuple syntax clumsy in this example.
I've put some test cases at the end.
type Name = string
type Sex =
| M // male
| F // female
type YearOfBirth = int
type FamilyTree =
{ name: string
sex: Sex
yearOfBirth: YearOfBirth
children: Children
}
and Children = FamilyTree list
let makeFamilyTree name sex yearOfBirth children =
{ name = name
sex = sex
yearOfBirth = yearOfBirth
children = children
}
let rec addChild : FamilyTree -> Children -> Children =
fun newChild children ->
match children with
| [] ->
[newChild]
| eldest :: tail when eldest.yearOfBirth < newChild.yearOfBirth ->
newChild :: eldest :: tail
| eldest :: tail ->
eldest :: addChild newChild tail
let rec insertChildOf: Name -> FamilyTree -> FamilyTree -> FamilyTree option =
fun name childTree tree ->
let childrenMaybe =
if name = tree.name && tree.yearOfBirth < childTree.yearOfBirth then
addChild childTree tree.children
|> Some
else
insertChildOfInList name childTree tree.children
match childrenMaybe with
| Some children ->
Some { tree with children = children }
| None ->
None
and insertChildOfInList: Name -> FamilyTree -> Children -> Children option =
fun name childTree children ->
match children with
| [] ->
None
| eldest :: younger ->
match insertChildOf name childTree eldest with
| Some eldest' ->
Some (eldest' :: younger)
| _ ->
None
let jon =
{ name = "Jon"
sex = Sex.M
yearOfBirth = 1100
children = []
}
let jon2 =
insertChildOf
"Jon"
(makeFamilyTree
"Dave"
Sex.M
1120
[])
jon
let jon3 =
insertChildOf
"Dave"
(makeFamilyTree
"Mary"
Sex.F
1140
[])
jon2.Value
let jon4 =
insertChildOf
"Dave"
(makeFamilyTree
"Elizabeth"
Sex.F
1141
[])
jon3.Value
let jon5 =
insertChildOf
"Dave"
(makeFamilyTree
"George"
Sex.F
1142
[])
jon4.Value

Comparison in pattern matching in OCaml

I want to write a function set which changes the index i in the 'a array a to the value 'a v and raise an invalid_argument exception if i is bigger then the length-1 of the array.
I know that this can be done with if/then/else:
let set i v a =
let l = Array.length a in
if i > (l-1) then
raise (Invalid_argument "index out of bounds")
else
a.(i) <- v
However I want to know if this can be achieved in a pure functional approach, using pattern matching and the OCaml standard library. I don't how to compare values inside the pattern matching, I get an error at the marked line:
let set i v a =
let l = Array.length a in
match i with
>>>>>> | > l-1 -> raise (Invalid_argument "index out of bounds")
| _ -> a.(i) <- v
Is there a workaround to achieve this? perhaps with a helper function?
An if expression is a pure functional approach, and is also the right approach. In general, pattern matching has the purpose of deconstructing values; it's not an alternative to an if.
However, it's still possible to do this with pattern matching:
let set i v a =
let l = Array.length a in
match compare l i with
| 1 -> a.(i) <- v
| _ -> raise ## Invalid_argument "index out of bounds"
EDIT: Apparently, compare can return other values than -1, 0 and 1 so this version is not reliable (but you wouldn't use it anyway, would you?)...
Or, more efficiently
let set i v a =
let l = Array.length a in
match l > i with
| true -> a.(i) <- v
| false -> raise ## Invalid_argument "index out of bounds"
But then you realize that matching over a boolean is just an if. Which is why the correct version is still
let set i v a =
let l = Array.length a in
if l > i then a.(i) <- v
else raise ## Invalid_argument "index out of bounds"
BlackBeans' answer is correct. But also know that pattern-matching in OCaml can take advantage of conditional guards when you want to place a conditional on a pattern.
Consider the following simple example.
type species = Dog | Cat
type weight = int
type pet = Pet of species * weight
let sound = function
| Pet (Dog, weight) when weight < 10 -> "Yip!"
| Pet (Dog, _) -> "Woof!"
| Pet (Cat, weight) when weight > 100 -> "ROAR!!!"
| _ -> "Meow!"
The patterns Pet (Dog, weight) and Pet (Dog, _) would otherwise match the same values (with the latter not binding a name to the weight).
An equivalent with if/else would look like:
let sound = function
| Pet (Dog, weight) ->
if weight < 10 then "Yip!"
else "Woof!"
| Pet (Cat, weight) ->
if weight > 100 -> "ROAR!!!"
else "Meow!"
In many ways which you prefer boils down to opinion, and which you feel is more expressive.

Recursion in F#, expected type int but got type "int list -> int"

I'm new to F# and want to implement a least common multiple function of a list by doing it recursively, e.g. lcm(a,b,c) = lcm(a, lcm(b,c)), where lcm of two elements is calculated from the gcd.
I have the following code. I try to match the input of the lcm function with a list of two elements, and otherwise a general list, which I split up into its first element and the remaining part. The part "lcm (tail)" gives a compiler error. It says it was expected to have type "int" but has type "int list -> int". It looks like it says that the expression "lcm tail" is itself a function, which I don't understand. Why is it not an int?
let rec gcd a b =
if b = 0
then abs a
else gcd b (a % b)
let lcmSimple a b = a*b/(gcd a b)
let rec lcm list = function
| [a;b] -> lcmSimple a b
| head::tail -> lcmSimple (head) (lcm (tail))
Best regards.
When defining the function as let f = function | ..., the argument to the function is implicit, as it is interpreted as let f x = match x with | ....
Thus let rec lcm list = function |... is a function of two variables, which are list and the implicit variable. This is why the compiler claims that lcm tail is a function - only one variable has been passed, where it expected two. A better version of the code is
let rec gcd a b =
if b = 0
then abs a
else gcd b (a % b)
let lcmSimple a b = a*b/(gcd a b)
let rec lcm = function
| [a;b] -> lcmSimple a b
| head::tail -> lcmSimple (head) (lcm (tail))
| [] -> 1
where the last case has been included to complete the pattern.

How to create a cached recursive type?

open System
open System.Collections.Generic
type Node<'a>(expr:'a, symbol:int) =
member x.Expression = expr
member x.Symbol = symbol
override x.GetHashCode() = symbol
override x.Equals(y) =
match y with
| :? Node<'a> as y -> symbol = y.Symbol
| _ -> failwith "Invalid equality for Node."
interface IComparable with
member x.CompareTo(y) =
match y with
| :? Node<'a> as y -> compare symbol y.Symbol
| _ -> failwith "Invalid comparison for Node."
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
type NodeDict<'a> = Dictionary<'a,Node<'a>>
let get_nodify_tag =
let mutable i = 0
fun () -> i <- i+1; i
let nodify (dict: NodeDict<_>) x =
match dict.TryGetValue x with
| true, x -> x
| false, _ ->
let x' = Node(x,get_nodify_tag())
dict.[x] <- x'
x'
let d = Dictionary(HashIdentity.Structural)
let nodify_ty x = nodify d x
let rec int_string_stream =
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]
In the above example, the int_string_stream gives a type error, but it neatly illustrates what I want to do. Of course, I want both sides to get tagged with the same symbol in nodify_ty. When I tried changing the Rec type to Node<Lazy<Ty>> I've found that it does not compare them correctly and each sides gets a new symbol which is useless to me.
I am working on a language, and the way I've dealt with storing recursive types up to now is by mapping Rec to an int and then substituting that with the related Ty in a dictionary whenever I need it. Currently, I am in the process of cleaning up the language, and would like to have the Rec case be Node<Ty> rather than an int.
At this point though, I am not sure what else could I try here. Could this be done somehow?
I think you will need to add some form of explicit "delay" to the discriminated union that represents your types. Without an explicit delay, you'll always end up fully evaluating the types and so there is no potential for closing the loop.
Something like this seems to work:
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
| Delayed of Lazy<Ty>
// (rest is as before)
let rec int_string_stream = Delayed(Lazy.Create(fun () ->
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]))
This will mean that when you pattern match on Ty, you'll always need to check for Delayed, evaluate the lazy value and then pattern match again, but that's probably doable!

Resources