(* junk.ml *)
let flag = ref false
let get_flag = !flag
let play_cards card =
Printf.printf "%s-clause\n" (if card >= 27 && card <= 39 then "true" else "false");
(flag := if card >= 27 && card <= 39 then true else !flag);
Printf.printf "check: %B " get_flag;
In utop, I imported junk.ml and received this output
val flag : bool ref = {contents = false} val get_flag : bool = false val play_cards : int -> unit = <fun>
I called play_cards 30;; and received this output:
true-clause
check: true - : unit = ()
However, when I called get_flag I received false. I was wondering if there is a concept of using refs that I misunderstood while writing this code.
Your variable get_flag is an immutable name for the value of !flag at the time it's defined. You shouldn't expect its value to change; OCaml variables have values that are immutable.
(Some values, like flag, are immutable names for things that themselves are mutable. In other words, flag is always going to be a name for the same reference, but the value stored in the reference, !flag, can change.)
Your comments indicate you want get_flag to have different values different times. One way to get this result is to define it as a function:
let get_flag () = !flag
Now you can call the function, and at each call it returns the value of flag at the moment of the call.
# let flag = ref false
let get_flag () = !flag;;
val flag : bool ref = {contents = false}
val get_flag : unit -> bool = <fun>
# get_flag ();;
- : bool = false
# flag := true;;
- : unit = ()
# get_flag ();;
- : bool = true
Your code doesn't make sense as shown, hearts_broken and get_hearts_broken are never defined. If, however, you have made these definitions somewhere else, then it is no wonder you see the result you're seeing, because play_cards doesn't actually modify flag, as you seem to assume.
I guess you have renamed hearts_broken to flag at some point, but forgot to fix play_cards? And that happened to not cause an error because you didn't restart the toplevel, so that the old definition was still around?
Related
I've decided to do a simple exercise in OCaml, writing a guess the number application:
The solution I came up with was this:
let () =
let func_end = ref false in
while !func_end != true do
let () = print_endline "Enter guess:" in
let input = read_int () in
let bound = 50 in
let random_number = Random.int bound in
if input == random_number then
let () = print_endline "Correct!" in
func_end := true
done
I wonder if there's a more functional approach to this problem,
the use of refs seems more imperative rather than functional.
You have a while loop and a ref type, which are imperative features of OCaml, rather than functional, but you can approximate the functionality of this loop in a generalized functional way with recursion.
A while loop involves an initial state, a boolean predicate, and a body. We can pass these things to a function, with the predicate being a function which tests the state, and the body working on the state to generate a new state.
let rec do_while state pred body =
if pred state then
let state = body state in
do_while state pred body
else
state
Consider a simple example of this:
utop # do_while 1 (fun x -> x < 10) (fun x -> Printf.printf "%d\n" x; x + 1);;
1
2
3
4
5
6
7
8
9
- : int = 10
It can then be used to replace your loop. The state will be the correct number, and the guess. Of course, the guess won't exist on the first go around so we'll use a value of type int option. If the correct number and the guess are the same, the function will return true and the loop will end. Otherwise it will continue. The loop body function will prompt for input and update the state. It will also print an error message if the guess isn't correct.
let _ =
do_while
(Random.int 50, None)
(function
| (correct, Some guess) when correct = guess -> false
| _ -> true)
(fun (correct, _) ->
let () = print_endline "guess a number:" in
let guess = read_int () in
(if correct <> guess then print_endline "Incorrect guess!";
(correct, Some guess)))
As an aside, you do not need the ref type in your while loop. You can use an exception to exit the loop.
exception Exit
try
while true do
let () = print_endline "Enter guess:" in
let input = read_int () in
let bound = 50 in
let random_number = Random.int bound in
if input = random_number then raise Exit
done
with
| Exit -> ()
The "functional loop" is recursion.
A good step would be to split this into functions; something like this, perhaps
let guess () =
let () = print_endline "Enter guess: " in
read_int()
let answer () =
Random.int 50
let rec play () =
if guess () = answer () then
print_endline "Correct!"
else
play ()
But I personally feel that it's a bit unfair to create a new correct answer for every guess, so you might want to stick to just one
let guess () =
let () = print_endline "Enter guess: " in
read_int()
let answer () =
Random.int 50
let play () =
let rec with_guess it =
if guess () = it then
print_endline "Correct!"
else
with_guess it
in
with_guess ## answer ()
This can easily be extended to provide hints, such as "too high" or "too low".
I am using FsUnit.Xunit. I am getting a failure for the following test case:
[<Fact>]
let ``Initialization of DFF`` () =
dff Seq.empty Seq.empty |> should equal (seq {Zero})
The test failure is:
Message:
FsUnit.Xunit+MatchException : Exception of type 'FsUnit.Xunit+MatchException' was thrown.
Expected: Equals seq [Zero]
Actual: seq [Zero]
Stack Trace:
That.Static[a](a actual, IMatcher`1 matcher)
Signal.Initialization of DFF() line 11
I get the same error if the test is:
[<Fact>]
let ``Initialization of DFF`` () =
dff Seq.empty Seq.empty |> should equal (Seq.singleton Zero)
I have never tested equality of sequences using FsUnit.Xunit, so I am confused what's going on. I'm not even for sure what the failure message is telling me, as it seems to be saying that the expected and actual are the same. I can get this to work fine by converting the sequences to lists, but it would be nice to not have to do that.
Could someone explain what's going on here? It seems I'm not understanding the error message and thus probably something about Equals and comparing sequence values (literals?). Thanks.
Source code to be able to reproduce (I think this is everything):
type Bit =
| Zero
| One
type Signal = seq<Bit>
let Nand a b =
match a, b with
| Zero, Zero -> One
| Zero, One -> One
| One, Zero -> One
| One, One -> Zero
let Not input =
Nand input input
let And a b =
Not (Nand a b)
let Or a b =
Nand (Not a) (Not b)
let private liftToSignal1 op (signal: Signal) : Signal =
Seq.map op signal
let private liftToSignal2 op (signalA: Signal) (signalB: Signal) : Signal =
Seq.map2 op signalA signalB
let Not' = liftToSignal1 Not
let And' = liftToSignal2 And
let Or' = liftToSignal2 Or
let rec dff data clock : Signal =
seq {
yield Zero
yield! Or' (And' data clock)
(And' (dff data clock) (Not' clock))
}
This is an issue with structural vs. referential equality.
In F# seq { 'a' } = seq { 'a' } // false but [ 'a' ] = [ 'a' ] // true due to seq being IEnumerable and not supporting structural equality (or comparison).
Lists (and other F# container-like types) are much more 'intelligent', i.e. they support structural equality / comparison if the contained objects support it:
[ {| foo = StringComparison.Ordinal; bar = Some(1.23) |} ] =
[ {| foo = StringComparison.Ordinal; bar = Some(1.23) |} ] // true
but don't, if they contain anything that doesn't:
[ box(fun() -> 3) ] = [ box(fun() -> 3) ] // false
So, to make the test work, add a List.ofSeq:
dff Seq.empty Seq.empty |> List.ofSeq |> should equal [ Zero ]
I need to use hashtable of mutable variable in Ocaml, but it doesn't work out.
let link = Hashtbl.create 3;;
let a = ref [1;2];;
let b = ref [3;4];;
Hashtbl.add link a b;;
# Hashtbl.mem link a;;
- : bool = true
# a := 5::!a;;
- : unit = ()
# Hashtbl.mem link a;;
- : bool = false
Is there any way to make it works?
You can use the functorial interface, which lets you supply your own hash and equality functions. Then you write functions that are based only on the non-mutable parts of your values. In this example, there are no non-mutable parts. So, it's not especially clear what you're expecting to find in the table. But in a more realistic example (in my experience) there are non-mutable parts that you can use.
If there aren't any non-mutable parts, you can add them specifically for use in hashing. You could add an arbitrary unique integer to each value, for example.
It's also possible to do hashing based on physical equality (==), which has a reasonable definition for references (and other mutable values). You have to be careful with it, though, as physical equality is a little tricky. For example, you can't use the physical address of a value as your hash key--an address can change at any time due to garbage collection.
Mutable variables that may happen to have the same content can still be distinguished because they are stored at different locations in memory. They can be compared with the physical equality operator (==). However, OCaml doesn't provide anything better than equality, it doesn't provide a nontrivial hash function or order on references, so the only data structure you can build to store references is an association list of some form, with $\Theta(n)$ access time for most uses.
(You can actually get at the underlying pointer if you play dirty. But the pointer can move under your feet. There is a way to make use of it nonetheless, but if you need to ask, you shouldn't use it. And you aren't desperate enough for that anyway.)
It would be easy to compare references if two distinct references had a distinct content. So make it so! Add a unique identifier to your references. Keep a global counter, increment it by 1 each time you create a reference, and store the counter value with the data. Now your references can be indexed by their counter value.
let counter = ref 0
let new_var x = incr counter; ref (!counter, x)
let var_value v = snd !v
let update_var v x = v := (fst !v, x)
let hash_var v = Hashtbl.hash (fst !v)
For better type safety and improved efficiency, define a data structure containing a counter value and an item.
let counter = ref 0
type counter = int
type 'a variable = {
key : counter;
mutable data : 'a;
}
let new_var x = incr counter; {key = !counter; data = x}
let hash_var v = Hashtbl.hash v.key
You can put the code above in a module and make the counter type abstract. Also, you can define a hash table module using the Hashtbl functorial interface. Here's another way to define variables and a hash table structure on them with a cleaner, more modular structure.
module Counter = (struct
type t = int
let counter = ref 0
let next () = incr counter; !counter
let value c = c
end : sig
type t
val next : unit -> t
val value : t -> int
end)
module Variable = struct
type 'a variable = {
mutable data : 'a;
key : Counter.t;
}
let make x = {key = Counter.next(); data = x}
let update v x = v.data <- x
let get v = v.data
let equal v1 v2 = v1 == v2
let hash v = Counter.value v.key
let compare v1 v2 = Counter.value v2.key - Counter.value v1.key
end
module Make = functor(A : sig type t end) -> struct
module M = struct
type t = A.t Variable.variable
include Variable
end
module Hashtbl = Hashtbl.Make(M)
module Set = Set.Make(M)
module Map = Map.Make(M)
end
We need the intermediate module Variable because the type variable is parametric and the standard library data structure functors (Hashtbl.Make, Set.Make, Map.Make) are only defined for type constructors with no argument. Here's an interface that exposes both the polymorphic interface (with the associated functions, but no data structures) and a functor to build any number of monomorphic instances, with an associated hash table (and set, and map) type.
module Variable : sig
type 'a variable
val make : 'a -> 'a variable
val update : 'a variable -> 'a -> unit
val get : 'a variable -> 'a
val equal : 'a -> 'a -> bool
val hash : 'a variable -> int
val compare : 'a variable -> 'b variable -> int
end
module Make : functor(A : sig type t end) -> sig
module M : sig
type t = A.t variable.variable
val make : A.t -> t
val update : t -> A.t -> unit
val get : t -> A.t
val equal : t -> t -> bool
val hash : t -> int
val compare : t -> t -> int
end
module Hashtbl : Hashtbl.S with type key = M.t
module Set : Set.S with type key = M.t
module Map : Map.S with type key = M.t
end
Note that if you expect that your program may generate more than 2^30 variables during a run, an int won't cut it. You need two int values to make a 2^60-bit value, or an Int64.t.
Note that if your program is multithreaded, you need a lock around the counter, to make the incrementation and lookup atomic.
I have written some state machine in C++ and Java but never in a functional language like Ocaml
Problem is I don't know if I can just adapt code from the object languages versions, since in Ocaml records and variants are more powerful than class;
So, I need an event-driven finite state machine (hierarchical like in UML), easily configurable
Could someone experienced in the field post a simple sample of that ? Just to avoid the most common traps
thanks :)
EDIT 16/03 : Is it possible to do it without mutable state ?
And I'd like to encapsulate it properly under the name "FSM", should I choose a module or a class ?
It depends on how you have to operate the FSM, e.g., if you need to be able to store its state and continue later, or if you just want to execute it immediately. In the latter case, it's trivial to do it as a bunch of tail-recursive functions.
For example, assume the regexp C((A|B)*CD)* -- the following mutually recursive functions are a direct implementation of the respective FSM that recognises a list matching this regexp (if I didn't make any mistake :) ):
type alphabet = A | B | C | D
let rec s1 = function
| C :: rest -> s2 rest
| _ -> false
and s2 = function
| [] -> true
| (A | B) :: rest -> s2 rest
| C :: rest -> s3 rest
| _ -> false
and s3 = function
| D :: rest -> s2 rest
| _ -> false
Every function corresponds to exactly one state of the automaton and implements its transition function. Applying s1 : alphabet list -> bool will run the FSM on the argument.
PS: Note how this is an application demonstrating the benefit and elegance of tail call optimization...
Usually, you create a record corresponding to a state of the automata, and you have another type for the event triggering the transition to another state. In the state record, you have a map to find, for each event, the new state.
Let's suppose your transitions are triggered by strings:
type event = string
module EventMap = Map.Make(struct
type t = event
let compare = compare
end)
type state = {
state_info : ...; (* the content of that state, id, comment, etc. *)
mutable state_transitions : state EventMap.t;
}
let next_state current_state event =
try
EventMap.find event current_state.state_transitions
with Not_found -> current_state
Here, I supposed that unknown events stay on the same state, but you could have an error state in the record...
There is an excellent answer which demonstrates expressiveness and elegance of OCaml in representing finite state machine here:
automata in ocaml
For more serious use, you could try to look at some finite state machine library like fsm library here.
I recently created an FSM module in OCaml which you can find here
I have some special requirements for my FSM implementation which could make it not quite as nice to look at as some of the others pointed out here, however, I think the way you declare the FSM itself is kind of nice and declarative. The special requirement is that I need to be able to generate code in HDL (hardware description language) from a declarative description of the FSM in addition to being able to simulate the FSM's operation in the OCaml version. Because of this I needed to use predicate expressions instead of transition functions (otherwise, how would I translate a function to a string?) So mainly you want to focus on the FSM module there and the create and eval_fsm functions there.
Here is an example of usage:
(*********************************************************
* FSM testing *******************************************
*)
(* inputs to the FSM *)
let full = Var({name ="full"; value = F});;
let ten_minutes = Var({name = "ten_minutes"; value = F});;
let empty = Var({name = "empty"; value = F});;
let five_minutes = Var({name = "five_minutes"; value =F});;
(* T is true, F is false *)
let _ =
assign full F ;
assign ten_minutes F ;
assign empty F ;
assign five_minutes F ;;
(* outputs from the FSM *)
let water_on = Var({name = "water_on"; value = F});;
let agitate = Var({name = "agitate"; value = F});;
let drain = Var({name = "drain" ; value = F});;
let start_timer = Var({name = "start_timer"; value = F});;
let motor_on = Var({name = "motor_on"; value = F});;
let washed = Var({name = "washed"; value = F});;
let soap = Var({name = "soap"; value = F});;
let reset_actions =
assign water_on F;
assign agitate F;
assign drain F;
assign start_timer F;
assign motor_on F;;
module WashStates =
struct
type t = START | FILL | WASH | DRAIN | RINSE | SPIN | STOP
deriving(Show, Enum)
let start_state = START
end
module LogicExp =
struct
type t = boolean Logic.bexp
type var_t = boolean Logic.variable
let eval_exp exp = to_bool (Logic.eval exp)
let var_to_s = var_to_s
end
module WashFSM = FSM(WashStates)(LogicExp)
open WashStates
(* declare the state table *)
(* CS, PREDICATE, NS, ACTIONs *)
let my_fsm = [
(START, Const(T), FILL, [(water_on, T);
(soap, T)]);
(FILL, Bop(And,full,soap), WASH, [(water_on, F);
(agitate, T);
(washed, T);
(start_timer,T)]);
(WASH, ten_minutes, DRAIN,[(agitate, F);
(start_timer,F);
(empty, T)]);
(DRAIN, Bop(And,empty,soap), FILL, [(drain, F);
(soap, F);
(water_on, T)] );
(FILL, Bop(And,full,Not(soap)), RINSE,[(water_on, F);
(soap, F);
(empty, F);
(agitate, T)]);
(RINSE, ten_minutes, DRAIN, [(agitate, F);
(empty, T)] );
(DRAIN, Bop(And,empty,Not(soap)), SPIN, [(motor_on, T);
(start_timer,T)]);
(SPIN, five_minutes, STOP, [(water_on, F);
(drain, F);
(start_timer,F);
(motor_on, F)]);
(STOP, Const(T), STOP, [(motor_on, F)]);
];;
let st_table, current_state = WashFSM.create my_fsm in
let _ = assign full T in
let current_state = WashFSM.eval_fsm st_table current_state in
let _ = assign ten_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state in
let current_state = WashFSM.eval_fsm st_table current_state in
let _ = (assign ten_minutes F);(assign empty T) in
let current_state = WashFSM.eval_fsm st_table current_state in
let _ = assign five_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state in
let _ = assign five_minutes F in
let _ = assign ten_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state in
let current_state = WashFSM.eval_fsm st_table current_state in
let _ = assign five_minutes T in
let _ = WashFSM.eval_fsm st_table current_state in
(*...and so on...*)
(Please excuse the ";;" endings - I wanted to be able to cut & paste this code into the REPL)
Some of the code used here is found in the Logic project on my github (fsm.ml is part of that project). The predicate expression evaluates to either T or F (true or false). If true, then the transition is made from current state to next state. Const T means always transition. An expression such as:
Bop(And, full, soap)
Means that if both full and soap are T (true) then the expression evaluates to true.
Are there hashtables in Ocaml that use == instead of = when testing for equality of keys?
For example:
# type foo = A of int;;
# let a = A(1);;
# let b = A(1);;
# a == b;;
- : bool = false
# a = b;;
- : bool = true
# let h = Hashtbl.create 8;;
# Hashtbl.add h a 1;;
# Hashtbl.add h b 2;;
# Hashtbl.find h a;;
- : int = 2
# Hashtbl.find h b;;
- : int = 2
I'd like a hashtable that can distinguish between a and b. Is that possible?
You can use custom hashtables:
module H = Hashtbl.Make(struct
type t = foo
let equal = (==)
let hash = Hashtbl.hash
end)
And then use H instead of Hashtbl in your code.
The solution in Thomas and cago's answers is functionally correct. One issue that may trouble you if you use their solution as-is is that you will get more collisions than expected if you hash many keys that are equal for (=) and different for (==). Indeed, all keys that are equal for (=) have the same hash for Hashtbl.hash, and end up in the same bucket, where they are they recognized as different (since you asked for (==) to be used as equality function) and create different bindings. In the worst cases, the hash-table will behave with the same complexity as an association list (which, by the way, is another data structure that you could be using, and then you wouldn't have to worry about providing a hash function).
If you can accept the key of a value changing occasionally (and therefore the value being impossible to retrieve from the hash-table, since the binding is then in the wrong bucket), you can use the following low-level function as hash:
external address_of_value: 'a -> int = "address_of_value"
Implemented in C as:
#include "caml/mlvalues.h"
value address_of_value(value v)
{
return (Val_long(((unsigned long)v)/sizeof(long)));
}
You would then use:
module H = Hashtbl.Make(struct
type t = foo
let equal = (==)
let hash = address_of_value
end);;