I am a bit new to OCaml. I want to implement product construction algorithm for automata in OCaml. I am confused how to represent automata in OCaml. Can someone help me?
A clean representation for a finite deterministic automaton would be:
type ('state,'letter) automaton = {
initial : 'state ;
final : 'state -> bool ;
transition : 'letter -> 'state -> 'state ;
}
For instance, an automaton which determines whether a word contains an odd number of 'a' could be represented as such:
let odd = {
initial = `even ;
final = (function `odd -> true | _ -> false) ;
transition = (function
| 'a' -> (function `even -> `odd | `odd -> `even)
| _ -> (fun state -> state))
}
Another example is an automation which accepts onlythe string "bbb" (yes, these are taken from this online handout) :
let bbb = {
initial = `b0 ;
final = (function `b3 -> true | _ -> false) ;
transition = (function
| 'b' -> (function `b0 -> `b1 | `b1 -> `b2 | `b2 -> `b3 | _ -> `fail)
| _ -> (fun _ -> `fail))
}
Automaton product is described mathematically as using the cartesian product of the state sets as the new sets, and the natural extensions of the final and transition functions over that set:
let product a b = {
initial = (a.initial, b.initial) ;
final = (fun (x,y) -> a.final x && b.final y) ;
transition = (fun c (x,y) -> (a.transition c x, b.transition c y)
}
This product automaton computes the intersection of two languages. You can also use || in lieu of && to implement the union of two languages.
Related
I am trying to write a function run taking a parameter to parametrize its level of execution. I want this function to return its output after a given level. I used GADTs to have the output of run depends on its input.
Here is the code:
type _ level_output =
| FirstO : int -> int level_output
| SecondO : float -> float level_output
| ThirdO : string -> string level_output
type _ run_level_g =
| First : int run_level_g
| Second : float run_level_g
| Third : string run_level_g
type run_level = Any : 'a run_level_g -> run_level
let first _ =
(*do stuff*)
1
let second _ =
(*do stuff*)
2.5
let third _ =
(*do stuff*)
"third"
let run1 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
match level with
| First -> FirstO out
| Second ->
let out = second out in
SecondO out
| Third ->
let out = second out in
let out = third out in
ThirdO out
let run2 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
if Any level = Any First
then FirstO out
else
let out = second out in
if Any level = Any Second
then SecondO out
else
let out = third out in
ThirdO out
type (_,_) eq = Eq : ('a,'a) eq
let eq_level (type a b) (x:a run_level_g) (y:b run_level_g) : (a, b) eq option =
match x, y with
| First, First -> Some Eq
| Second, Second -> Some Eq
| Third, Third -> Some Eq
| _ -> None
let cast_output (type a b) (Eq:(a, b) eq) (v:a level_output) : b level_output = v
let run3 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
let eq = eq_level First level in
match eq with
| Some eq -> cast_output eq (FirstO out)
| None ->
let out = second out in
let eq = eq_level Second level in
match eq with
| Some eq -> cast_output eq (SecondO out)
| None ->
let out = third out in
let eq = eq_level Third level in
match eq with
| Some eq -> cast_output eq (ThirdO out)
| None -> failwith "this can't happen"
There are three versions of run. The first one works well but there is code duplication, which I would like to remove. I would like my function to look more like run2 but this one does not compile because the type checker can't infer the type from the if-condition. An answer to that problem is run3 but now I have this clunky failwith case that obviously can't happen.
I was wondering if there was a way for me to have the best of both worlds, a function with no code duplication and no failwith case?
I find your function run1 the most readable one, by far.
One possibility to remove some code duplication may be to make run1 recursive.
First, one can define a short helper function to extract data from level_output
let proj (type a) (x:a level_output): a =
match x with
| FirstO x -> x
| SecondO x -> x
| ThirdO x -> x;;
then a recursive variant of run may be written as
let rec run: type a. a run_level_g -> 'b -> a level_output =
fun level data -> match level with
| First -> FirstO(first data)
| Second -> SecondO(second ## proj ## run First data)
| Third -> ThirdO(third ## proj ## run Second data);;
In OCaml, it seems that "fun" is the binding operator to me. Does OCaml have built-in substitution? If does, how it is implemented? is it implemented using de Bruijn index?
Just want to know how the untyped lambda-calculus can be implemented in OCaml but did not find such implementation.
As Bromind, I also don't exactly understand what you mean by saying "Does OCaml have built-in substitution?"
About lambda-calculus once again I'm not really understand but, if you talking about writing some sort of lambda-calculus interpreter then you need first define your "syntax":
(* Bruijn index *)
type index = int
type term =
| Var of index
| Lam of term
| App of term * term
So (λx.x) y will be (λ 0) 1 and in our syntax App(Lam (Var 0), Var 1).
And now you need to implement your reduction, substitution and so on. For example you may have something like this:
(* identity substitution: 0 1 2 3 ... *)
let id i = Var i
(* particular case of lift substitution: 1 2 3 4 ... *)
let lift_one i = Var (i + 1)
(* cons substitution: t σ(0) σ(1) σ(2) ... *)
let cons (sigma: index -> term) t = function
| 0 -> t
| x -> sigma (x - 1)
(* by definition of substitution:
1) x[σ] = σ(x)
2) (λ t)[σ] = λ(t[cons(0, (σ; lift_one))])
where (σ1; σ2)(x) = (σ1(x))[σ2]
3) (t1 t2)[σ] = t1[σ] t2[σ]
*)
let rec apply_subs (sigma: index -> term) = function
| Var i -> sigma i
| Lam t -> Lam (apply_subs (function
| 0 -> Var 0
| i -> apply_subs lift_one (sigma (i - 1))
) t)
| App (t1, t2) -> App (apply_subs sigma t1, apply_subs sigma t2)
As you can see OCaml code is just direct rewriting of definition.
And now small-step reduction:
let is_value = function
| Lam _ | Var _ -> true
| _ -> false
let rec small_step = function
| App (Lam t, v) when is_value v ->
apply_subs (cons id v) t
| App (t, u) when is_value t ->
App (t, small_step u)
| App (t, u) ->
App (small_step t, u)
| t when is_value t ->
t
| _ -> failwith "You will never see me"
let rec eval = function
| t when is_value t -> t
| t -> let t' = small_step t in
if t' = t then t
else eval t'
For example you can evaluate (λx.x) y:
eval (App(Lam (Var 0), Var 1))
- : term = Var 1
OCaml does not perform normal-order reduction and uses call-by-value semantics. Some terms of lambda calculus have a normal form than cannot be reached with this evaluation strategy.
See The Substitution Model of Evaluation, as well as How would you implement a beta-reduction function in F#?.
I don't exactly understand what you mean by saying "Does OCaml have built-in substitution? ...", but concerning how the lambda-calculus can be implemented in OCaml, you can indeed use fun : just replace all the lambdas by fun, e.g.:
for the church numerals: you know that zero = \f -> (\x -> x), one = \f -> (\x -> f x), so in Ocaml, you'd have
let zero = fun f -> (fun x -> x)
let succ = fun n -> (fun f -> (fun x -> f (n f x)))
and succ zero gives you one as you expect it, i.e. fun f -> (fun x -> f x) (to highlight it, you can for instance try (succ zero) (fun s -> "s" ^ s) ("0") or (succ zero) (fun s -> s + 1) (0)).
As far as I remember, you can play with let and fun to change the evaluation strategy, but to be confirmed...
N.B.: I put all parenthesis just to make it clear, maybe some can be removed.
Given
type 'a set = { insert : 'a -> 'a set; contains : 'a -> bool }
How can I implement
val empty : 'a set
?
I've tried closing over something, say a list, but the return type is wrong.. since it is. (ignoring the fact that the performance characteristics here are terrible :-) )
let empty =
let rec insert_f set a =
match set with
| [] -> a :: []
| k :: rest ->
if k = a then
k :: rest
else
k :: insert_f rest a
in
let rec contains_f set a =
match set with
| [] -> false
| k :: rest ->
if k = key then
true
else contains_f rest a
in
{ insert = insert_f []; contains = contains_f []}
directly writing the empty is not the easiest in such data structure, as you will need to write the insert, which will contains again an insert and so one... So let's write first the insert:
let rec insert : 'a set -> 'a -> 'a set = fun s x -> {
insert = (fun y -> failwith "TODO");
contains = (fun y -> if x = y then true else s.contains y) }
in insert, you want to recursively call insert, but the first parameter will be the record you are writing. So here is the complete solution:
let rec insert : 'a set -> 'a -> 'a set = fun s x ->
let rec ss = {
insert = ( fun y -> insert ss y);
contains = (fun y -> if x = y then true else s.contains y)}
in ss
let rec empty = {
insert = (fun x -> insert empty x);
contains = (fun x -> false)}
First of all, it's bool, not boolean. :)
Second, this definition is quite cumbersome. But you can do something like:
let empty = {
insert=(fun x -> {
insert=(fun x -> assert false);
contains=(fun x-> assert false)});
contains=(fun x -> false)}
with your implementations of insert and contains for non-empty sets in place of "assert false" of course.
A hint for implementing insert and contains: don't use any lists, use compositions of a functions from existing and new sets.
You can find nice examples in e.g. "On Understanding Data Abstraction, Revisited" by W. Cook, that paper is available online.
So I have a list of stmt (algebraic type) that contain a number of VarDecl within the list.
I'd like to reduce the list from stmt list to VarDecl list.
When I use List.filter I can eliminate all other types but I'm still left with a stmt list.
I found that I was able to do the filtering as well as the type change by folding, but I can't figure out how to generalize it (I need this pattern many places in the project).
let decls = List.fold_left
(fun lst st -> match st with
| VarDecl(vd) -> vd :: lst
| _ -> lst
) [] stmts in
Is there a better way to perform a filter and cast to a variant of the list type?
Assuming you have a type like
type stmt = VarDecl of int | Foo of int | Bar | Fie of string
and a stmt list, Batteries lets you do
let vardecl_ints l =
List.filter_map (function Vardecl i -> Some i | _ -> None) l
let foo_ints l =
List.filter_map (function Foo i -> Some i | _ -> None) l
which I think is about as concise as you're going to get. I don't
think you can make general "list-getters" for ADT's, because e.g.
let bars l =
List.filter_map (function Bar -> Some Bar | _ -> None) l
https://github.com/ocaml-batteries-team/batteries-included/blob/d471e24/src/batList.mlv#L544
has the Batteries implementation of filter_map, if you don't want the
dependency. A functional version with [] instead of dst would be quite similar, only doing
(x::dst) and a |>List.rev at the end.
You could use GADTs or polymorphic variants, but both tend to drive up complexity.
Here's a rough sketch of how you might approach this problem with polymorphic variants:
type constant = [ `Int of int | `String of string ]
type var = [ `Var of string ]
type term = [ constant | var | `Add of term * term ]
let rec select_vars (list : term list) : var list =
match list with
| [] -> []
| (#var as v)::list -> v::select_vars list
| _::list -> select_vars list
let rec select_constants (list : term list) : constant list =
match list with
| [] -> []
| (#constant as k)::list -> k::select_constants list
| _::list -> select_constants list
Another possibility is to pull the bits of a var out into an explicit type of which you can have a list:
type var = {
...
}
type term =
| Int of int
| Var of var
This has some overhead over having the bits just be constructor args, and a var is not a term, so you will likely need to do some wrapping and unwrapping.
It's hard to answer without seeing your type definition (or a simplified version of it).
Note, though, that if you have this definition:
type xyz = X | Y | Z
The values X, Y, and Z aren't types. They're values. Possibly Vardecl is a value also. So you can't have a list of that type (in OCaml).
Update
One thing I have done for cases like this is to use the type projected from the one variant you want:
type xyz = X | Y of int * int | Z
let extract_proj v l =
match v with
| X | Z -> l
| Y (a, b) -> (a, b) :: l
let filter_to_y l =
List.fold_right extract_proj l []
Here's a toplevel session:
type xyz = X | Y of int * int | Z
val extract_proj : xyz -> (int * int) list -> (int * int) list = <fun>
val filter_to_y : xyz list -> (int * int) list = <fun>
# filter_to_y [X; Z; Y(3,4); Z; Y(4,5)];;
- : (int * int) list = [(3, 4); (4, 5)]
I am new to F#, about two months, and I recently finished the FParsec tutorial and started looking for more examples. The more I read the more confused I became, and then I started to see references to styles. I looked for more styles and came up with this list.
Combinator style
Monadic style
Arrow style
Direct style
Can someone list all of the styles and explain and demonstrate how each one works with a common problem, e.g. parse
“(abc
(b CDEF
(de 1 E)
(f 234)
)
(h 3)
(jkl H)
)”
into
[Lower "abc";
Group[Lower "b"; Upper "CDEF";
Group [Lower "de"; Number "1"; Upper "E"];
Group [Lower "f"; Number "234"]];
Group [Lower "h"; Number "3"];
Group [Lower "jkl"; Upper "H"]
]
Using
Type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
EDIT
I picked up combinator and monadic style from a comment in FParsec and a delimiter based syntax
Direct style is always appearing as Direct Style Monadic Parser
Arrow style appears in Parsec: Direct Style Monadic Parser Combinators For The Real World I haven’t read all of this.
EDIT
Per suggestion
Combinator style
type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
type Parser = Parser<out, unit>
let isUpper = fun c -> isAsciiUpper c
let upper : Parser =
many1Satisfy isUpper .>> ws
|>> fun x -> Upper(x)
let isLower = fun c -> isAsciiLower c
let lower : Parser=
many1Satisfy isLower .>> ws
|>> fun x -> Lower(x)
let isNumber = fun c -> isDigit c
let number : Parser =
many1Satisfy isNumber .>> ws
|>> fun x -> Number(x)
let groupRef, groupImpl = createParserForwardedToRef()
let item : Parser =
lower <|> upper <|> number <|> groupRef
let items =
many item .>> ws
|>> fun x -> Group(x)
do groupImpl := between (pchar '(') (pchar ')') items .>> ws
let test () =
match run groupRef "(abc (b CDEF (de 1 E) (f 234)) (h 3) (jkl H) )" with
| Success(result, _, _) -> printf "Success: %A" result
| Failure(errorMsg, _, _) -> printf "Failure: %s" errorMsg
Monadic style
type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
type Parser = Parser<out, unit>
let isUpper = fun c -> isAsciiUpper c
let upper : Parser = parse {
let! x = many1Satisfy isUpper
do! ws
return Upper(x)
}
let isLower = fun c -> isAsciiLower c
let lower = parse {
let! x = many1Satisfy isLower
do! ws
return Lower(x)
}
let isNumber = fun c -> isDigit c
let number = parse {
let! x = many1Satisfy isNumber
do! ws
return Number(x)
}
let groupRef, groupImpl = createParserForwardedToRef()
let group = parse {
let! x = groupRef
do! ws
return x
}
let item =
lower <|> upper <|> number <|> group
let items = parse {
let! x = many item
do! ws
return Group(x)
}
do groupImpl := between (pchar '(') (pchar ')') items
let test () =
match run group "(abc (b CDEF (de 1 E) (f 234)) (h 3) (jkl H) )" with
| Success(result, _, _) -> printf "Success: %A" result
| Failure(errorMsg, _, _) -> printf "Failure: %s" errorMsg