I tried to create a thread which does a calculation of the fibonacci-numbers. That worked fine, but then I tried to create another thread that stops the calculation-thread if it takes more than x seconds to calculate.
Here is my code:
module TimedFuture : sig
type 'a t
val create : ('a -> 'b) -> 'a -> float -> 'b t
val get : 'a t -> 'a option
end = struct
type 'a t = 'a Event.channel
let create f a t =
let c = Event.new_channel () in
let rec loop f = f (); loop f in
let task () =
let b = f a in
loop (fun () -> Event.(sync (send c b)))
in
let start_calc_thread () =
let t1 = Thread.create task () in
while ((Unix.gettimeofday () -. t) < 1.0) do
Printf.printf "Thread should keep running: %f\n"
(Unix.gettimeofday () -. t);
done;
try Thread.kill t1 with t1 -> ();
Printf.printf "Thread stoped\n"
in
let _ = Thread.create start_calc_thread () in
c
let get c = Some Event.(sync (receive c))
end
let option_to_i o = match o with
| None -> 0
| Some x -> x
let test =
let rec f x = match x with
| 1 -> 1
| 2 -> 1
| _ -> f (x-1) + f (x-2)
in
let t = Unix.gettimeofday () in
let ff = TimedFuture.create f 40 t in
Printf.printf "\nResult: %i\n" (option_to_i (TimedFuture.get ff)),
ff
When I compile the code and run it, the calculation thread doesn't stop working, although I get the "Thread stopped" in terminal.
Do you see my fault?
A thread can be interrupted in only specific cancellation points, in particular, in points where a user code passes control back to the runtime, so that the latter can do its work. One particular cancellation point is allocation. Since your code doesn't allocate, and reasonably implemented Fibonacci will not allocate either, it is not possible to stop it. If your real algorithm indeed doesn't have cancellation points, then you should either add them explicitly or use processes. To add explicit cancellation point, one can just add Thread.yield.
Related
I was studying references in SML.
I wrote the following code:
let
val f = (fn (s) => s := ref((!(!s)) + 2))
val x = ref (5)
val y = ref x
in
(f y ; !x)
end;
I'm trying to get to val it = 7 : int, although my program prints val it = 5 : int. I can't understand why. I am sure the problem is in the f function but can't understand why.
What I'm trying to do: f function should update the argument y to be ref(ref(7)) so x could be ref(7). but for some reason it doesn't work. What is the problem?
Updating y to point to a new ref does not update x. There's a new reference created during the call to f, let's call it z. Before the call we have:
x -> 5
y -> x
where -> is "points to". After the call it is:
x -> 5
y -> z
z -> 7
Edit: One possible way to actually update x is by defining f as follows:
val f = fn r => !r := 7
When invoking f y, this updates the reference pointed to by y, which is x. But whether that is the "right" solution depends on what you actually want to achieve.
As Andreas Rossberg suggests, val f = fn r => !r := 7 could be one way to update the int of an int ref ref to 7. But instead of 7 you could write anything. If, instead, you want to increase by two the int being pointed indirectly to, a hybrid between your attempt and Andreas'es suggestion could be
fun f r = !r := !(!r) + 2
Here, !r := ... means "dereference r to get the int ref it points to, and update that int ref so that it instead points to ...", and !(!r) + 2 means "dereference r twice to get the int it indirectly points to, and add two to it." At this point, you have not changed what r points to (like you do with s := ref ...), and you're using the value it points to indirectly using the double-dereference !(!r).
A test program for this could be:
val x = ref 5
val y = ref x
fun f r = !r := !(!r) + 2
fun debug str =
print ( str ^ ": x points to " ^ Int.toString (!x) ^ " and "
^ "y points indirectly to " ^ Int.toString (!(!y)) ^ ".\n" )
val _ = debug "before"
val _ = f y
val _ = debug "after"
Running this test program yields:
before: x points to 5 and y points indirectly to 5.
after: x points to 7 and y points indirectly to 7.
It happens quite often that it is costly to calculate a property from a value. So it would be better to be able to store the property once it is calculated. I am wondering how to code this properly.
Let's take an example. Assume we have a type integer, and very often we need to calculate prime factors of a value of such type (let's assume the prime factors of a negative integer is None):
module I =
struct
type t = C of int
type pf = (int list) option
let calculate_prime_factors (x: t) : pf =
(* a costly function to calculate prime factors *)
... ...
let get_prime_factors (x: t) : pf =
calculate_prime_factors x
end
let () =
let v = I.C 100 in
let pf_1 = I.get_prime_factors v in
let pf_2 = I.get_prime_factors v in
let pf_3 = I.get_prime_factors v in
...
At the moment, get_prime_factors just calls calculate_prime_factors, as a consequence, all the calculations of pf_1, pf_2, pf_3 are time consuming. I would like to have a mechanism to enable storing prime factors inside the module, so that as long as the integer does not change, the second and third times of get_prime_factors just read what have been stored.
Does anyone know how to modify the module I to achieve this?
It is possible that we need references to make this mechanism possible (eg, let vr = ref (I.C 100) in ...). It is OK for me to use references. But I don't know how to trigger automatically calculate_prime_factors if the hold value (ie, !vr) is changed.
What you want to do is memoization, no ?
You could try this :
module I =
struct
type t = C of int
type pf = (int list) option
let calculate_prime_factors (x: t) : pf =
(* a costly function to calculate prime factors *)
... ...
module HI = Hashtbl.Make (struct
type t = C of int
let equal = (=)
let hash (C x) = x
end)
let get_prime_factors =
let h = Hashtbl.create 17 in
fun x ->
try Hashtbl.find h x
with
Not_found -> let pf = calculate_prime_factors x in
Hashtbl.add h x pf;
pf
end
let () =
let v = I.C 100 in
let pf_1 = I.get_prime_factors v in
let pf_2 = I.get_prime_factors v in
let pf_3 = I.get_prime_factors v in
...
You could adapt it for negative integers (with exceptions, for example, which is better than options) but I hope you get the idea.
Looks like, that you're looking for this solution:
module I = struct
type t = {
c : int;
mutable result : int option;
}
let create c = {c; result = None}
let calculate_prime_factors t = match t.result with
| Some r -> r
| None ->
let r = do_calculate t.c in
t.result <- Some r;
r
end
This is called memoizing. And this particular example can be solved even easier, with Lazy computations.
module I = struct
type t = int Lazy.t
let create c = lazy (do_calculate c)
let calculate_prime_factors = Lazy.force
end
I would do the following :
let get_prime_factors x =
match get x with
| None ->
let res = calculate_prime_factors x
in
begin
set x res ;
res
end
| Some res -> res
;;
You need a mutable data structure accessed by get and set. For instance, with a reference on a list (but you may prefer a hashtable) :
let my_storage = ref [] (* or something mutable *)
let get x =
if List.mem_assoc x !my_storage
then Some (List.assoc x !my_storage)
else None
let set x r =
my_storage := (x,r) :: !my_storage ;;
You can also use exceptions instead of the option type (None and Some _).
I found a great haskell solution (source) for generating a Hofstadter sequence:
hofstadter = unfoldr (\(r:s:ss) -> Just (r, r+s:delete (r+s) ss)) [1..]
Now, I am trying to write such a solution in F#, too. Unfortunately (I am not really familar to F#) I had no success so far.
My problem is, that when I use a sequence in F#, it seems not to be possible to remove an element (like it is done in the haskell solution).
Other data structures like arrays, list or set which allow to remove elements are not generating an infinite sequence, but operate on certain elements, only.
So my question: Is it possible in F# to generate an infinite sequence, where elements are deleted?
Some stuff I tried so far:
Infinite sequence of numbers:
let infinite =
Seq.unfold( fun state -> Some( state, state + 1) ) 1
Hofstadter sequence - not working, because there is no del keyword and there are more syntax errors
let hofstadter =
Seq.unfold( fun (r :: s :: ss) -> Some( r, r+s, del (r+s) ss)) infinite
I thought about using Seq.filter, but found no solution, either.
I think you need more than a delete function on sequence. Your example requires pattern matching on inifinite collections, which sequence doesn't support.
The F# counterpart of Haskell list is LazyList from F# PowerPack. LazyList is also potentially infinite and it supports pattern matching, which helps you to implement delete easily.
Here is a faithful translation:
open Microsoft.FSharp.Collections.LazyList
let delete x xs =
let rec loop x xs = seq {
match xs with
| Nil -> yield! xs
| Cons(x', xs') when x = x' -> yield! xs'
| Cons(x', xs') ->
yield x'
yield! loop x xs'
}
ofSeq (loop x xs)
let hofstadter =
1I |> unfold (fun state -> Some(state, state + 1I))
|> unfold (function | (Cons(r, Cons(s, ss))) ->
Some(r, cons (r+s) (delete (r+s) ss))
| _ -> None)
|> toSeq
There are a few interesting things here:
Use sequence expression to implement delete to ensure that the function is tail-recursive. A non-tail-recursive version should be easy.
Use BigInteger; if you don't need too many elements, using int and Seq.initInfinite is more efficient.
Add a case returning None to ensure exhaustive pattern matching.
At last I convert LazyList to sequence. It gives better interoperability with .NET collections.
Implementing delete on sequence is uglier. If you are curious, take a look at Remove a single non-unique value from a sequence in F# for reference.
pad's solution is nice but, likely due to the way LazyList is implemented, stack overflows somewhere between 3-4K numbers. For curiosity's sake I wrote a version built around a generator function (unit -> 'a) which is called repeatedly to get the next element (to work around the unwieldiness of IEnumerable). I was able to get the first 10K numbers (haven't tried beyond that).
let hofstadter() =
let delete x f =
let found = ref false
let rec loop() =
let y = f()
if not !found && x = y
then found := true; loop()
else y
loop
let cons x f =
let first = ref true
fun () ->
if !first
then first := false; x
else f()
let next =
let i = ref 0
fun () -> incr i; !i
Seq.unfold (fun next ->
let r = next()
let s = next()
Some(r, (cons (r+s) (delete (r+s) next)))) next
In fact, you can use filter and a design that follows the haskell solution (but, as #pad says, you don't have pattern matching on sequences; so I used lisp-style destruction):
let infinite = Seq.initInfinite (fun i -> i+1)
let generator = fun ss -> let (r, st) = (Seq.head ss, Seq.skip 1 ss)
let (s, stt) = (Seq.head st, Seq.skip 1 st)
let srps = seq [ r + s ]
let filtered = Seq.filter (fun t -> (r + s) <> t) stt
Some (r, Seq.append srps filtered)
let hofstadter = Seq.unfold generator infinite
let t10 = Seq.take 10 hofstadter |> Seq.toList
// val t10 : int list = [1; 3; 7; 12; 18; 26; 35; 45; 56; 69]
I make no claims about efficiency though!
Is there a way to use functions in Discriminated Unions? I am looking to do something like this:
Type Test<'a> = Test of 'a-> bool
I know this is possible in Haskell using newtype and I was wondering what the equivalent in F# would be.
Thanks.
type Test<'A> = Test of ('A -> bool)
As an expansion on desco's answer you can apply the function tucked into Test with pattern matching:
type Test<'a> = Test of ('a -> bool)
// let applyTest T x = match T with Test(f) -> f x
// better: (as per kvb's comment) pattern match the function argument
let applyTest (Test f) x = f x
Example:
// A Test<string>
let upperCaseTest = Test (fun (s:string) -> s.ToUpper() = s)
// A Test<int>
let primeTest =
Test (fun n ->
let upper = int (sqrt (float n))
n > 1 && (n = 2 || [2..upper] |> List.forall (fun d -> n%d <> 0))
)
In FSI:
> applyTest upperCaseTest "PIGSMIGHTFLY";;
val it : bool = true
> applyTest upperCaseTest "PIGSMIgHTFLY";;
val it : bool = false
> [1..30] |> List.filter (applyTest primeTest);;
val it : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29]
I'm working on an experimental programming language that has global polymorphic type inference.
I recently got the algorithm working sufficiently well to correctly type the bits of sample code I'm throwing at it. I'm now looking for something more complex that will exercise the edge cases.
Can anyone point me at a source of really gnarly and horrible code fragments that I can use for this? I'm sure the functional programming world has plenty. I'm particularly looking for examples that do evil things with function recursion, as I need to check to make sure that function expansion terminates correctly, but anything's good --- I need to build a test suite. Any suggestions?
My language is largely imperative, but any ML-style code ought to be easy to convert.
My general strategy is actually to approach it from the opposite direction -- ensure that it rejects incorrect things!
That said, here are some standard "confirmation" tests I usually use:
The eager fix point combinator (unashamedly stolen from here):
datatype 'a t = T of 'a t -> 'a
val y = fn f => (fn (T x) => (f (fn a => x (T x) a)))
(T (fn (T x) => (f (fn a => x (T x) a))))
Obvious mutual recursion:
fun f x = g (f x)
and g x = f (g x)
Check out those deeply nested let expressions too:
val a = let
val b = let
val c = let
val d = let
val e = let
val f = let
val g = let
val h = fn x => x + 1
in h end
in g end
in f end
in e end
in d end
in c end
in b end
Deeply nested higher order functions!
fun f g h i j k l m n =
fn x => fn y => fn z => x o g o h o i o j o k o l o m o n o x o y o z
I don't know if you have to have the value restriction in order to incorporate mutable references. If so, see what happens:
fun map' f [] = []
| map' f (h::t) = f h :: map' f t
fun rev' [] = []
| rev' (h::t) = rev' t # [h]
val x = map' rev'
You might need to implement map and rev in the standard way :)
Then with actual references lying around (stolen from here):
val stack =
let val stk = ref [] in
{push = fn x => stk := x :: !stk,
pop = fn () => stk := tl (!stk),
top = fn () => hd (!stk)}
end
Hope these help in some way. Make sure to try to build a set of regression tests you can re-run in some automatic fashion to ensure that all of your type inference behaves correctly through all changes you make :)