I am reading a repository and I encountered this function in the body of some Yojson json parsing code:
let load_problems channel =
let open Yojson.Basic.Util in
let j = Yojson.Basic.from_channel channel in
...
let rec unpack x =
try magical (x |> to_int) with _ ->
try magical (x |> to_float) with _ ->
try magical (x |> to_bool) with _ ->
try
let v = x |> to_string in
if String.length v = 1 then magical v.[0] else magical v
with _ ->
try
x |> to_list |> List.map ~f:unpack |> magical
with _ -> raise (Failure "could not unpack")
in
...
where magical = Obj.magic. I understand what Obj.magic is (it's the equivalent to Unsafe.Coerce in Haskell), but I don't see why a type coercion is necessary here. The Yojson.Basic.Util functions the author uses should already either succeed or fail to do this conversion. Any intuition?
EDIT:
I feel I was depriving #glennsl of context, so here is the immediately following passage in which unpack is used:
let tf = j |> member "tasks" |> to_list |> List.map ~f:(fun j ->
let e = j |> member "examples" |> to_list in
let task_type = j |> member "request" |> deserialize_type in
let examples = e |> List.map ~f:(fun ex -> (ex |> member "inputs" |> to_list |> List.map ~f:unpack,
ex |> member "output" |> unpack)) in
let maximum_frontier = j |> member "maximumFrontier" |> to_int in
let name = j |> member "name" |> to_string in
let task =
(try
let special = j |> member "specialTask" |> to_string in
match special |> Hashtbl.find task_handler with
| Some(handler) -> handler (j |> member "extras")
| None -> (Printf.eprintf " (ocaml) FATAL: Could not find handler for %s\n" special;
exit 1)
with _ -> supervised_task) ~timeout:timeout name task_type examples
in
(task, maximum_frontier))
in
There are a number of different task_handlers, but the one I happen to be concerned with is defined as follows:
(fun extras ?timeout:(timeout = 0.001) name ty examples ->
let open Yojson.Basic.Util in
let cost_matters =
try
extras |> member "costMatters" |> to_bool
with _ -> assert false
in
let by = match examples with
| [([0],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| [([1],y)] ->
Bigarray.(Array1.of_array int8_unsigned c_layout (Array.of_list y))
| _ -> failwith "not a turtle task" in
{ name = name ;
task_type = ty ;
log_likelihood =
(fun p ->
try
match run_recent_logo ~timeout p with
| Some(bx,cost) when (LogoLib.LogoInterpreter.fp_equal bx by 0) ->
(if cost_matters then (0.-.cost)*.10. else 0.)
| _ -> log 0.
with (* We have to be a bit careful with exceptions if the
* synthesized program generated an exception, then we just
* terminate w/ false but if the enumeration timeout was
* triggered during program evaluation, we need to pass the
* exception on
*)
| UnknownPrimitive(n) -> raise (Failure ("Unknown primitive: "^n))
| EnumerationTimeout -> raise EnumerationTimeout
| _ -> log 0.0)
});;
The author also uses ;; in a lot of files..another quirk.
Related
If I have an input of a tuple containing two lists of integers of the same length, and I want my output to be a list of these two lists zipped, after extracting these two lists from the tuple how do I zip each individual element into one list? For example, if my input is twolists= ([1;2;3], [4;5;6]), then I want my output to be [(1,4); (2,5); (3,6)]. How do I zip each element and add it to my output?
The function name and type is as follows:
let rec pairlists twolists = ...
val pairlists : 'a list * 'b list -> ('a * 'b) list = fun
So far I have:
let rec pairlists twolists =
let (l1, l2) = twolists in
let rec zip (l1,l2) =
match l1 with
|[] -> l2
|x :: xs -> x :: zip(l2, xs) in
twolists ;;
but this is clearly not doing what I want.
Are you looking for List.combine ?
val combine : 'a list -> 'b list -> ('a * 'b) list
Transform a pair of lists into a list of pairs: combine [a1; ...; an] [b1; ...; bn] is [(a1,b1); ...; (an,bn)].
Raises Invalid_argument if the two lists have different lengths. Not tail-recursive.
If your result list should contain elements that consist of the elements of both sublists, then you obviously have to destructure each sublist on each iteration.
If the lists are guaranteed to have the same lengths, the solution can be as simple as:
let rec zip paired_lists =
match paired_lists with
| [], [] -> []
| h1::t1, h2::t2 -> (h1, h2)::(zip (t1, t2))
| _, _ -> failwith "oops, the lists seems to have different lengths"
;;
zip ([1;2;3], [4;5;6]);;
- : (int * int) list = [(1, 4); (2, 5); (3, 6)]
But this one is not tail-recursive, which is obviously not good. The second sub-optimal thing is this reconstruction of tuple of lists on each iteration (I'm a newbie in OCaml, so chances are compiler is smart enough to avoid the unnecessary allocations, but still...). Fixing both flaws is trivial too:
let zip_tr paired_lists =
let list1, list2 = paired_lists in
let rec aux l1 l2 acc =
match l1, l2 with
| [], [] -> List.rev acc
| h1::t1, h2::t2 -> aux t1 t2 (h1, h2)::acc
| _, _ -> failwith "oops, the lists seems to have different lengths"
in aux list1 list2 []
;;
zip_tr ([1;2;3], [4;5;6]);;
- : (int * int) list = [(1, 4); (2, 5); (3, 6)]
The signature of your code does not match the expected signature :
line 2, characters 11-13:
Warning 26: unused variable l2.
Line 2, characters 7-9:
Warning 26: unused variable l1.
val pairlists : 'a list * 'a list -> 'a list = <fun>
Indeed, both possible matches return either a 'a list (this is l2) or x::zip... which is also a list of 'a type.
There should be sth like (x,y)::list in your code.
In addition, pairlists is not recursive and does not need to be declared as such, only zip is recursive.
The end of your function shall be like this (otherwise zip has no effect) :
....
let rec zip (l1,l2) =
match l1 with
|[] -> l2
|x :: xs -> x :: zip(l2, xs) in
zip twolists ;;
In addition to the other solutions mentioned, ocaml-4.08 onwards enables you to provide let+ and and+ operators which will zip a list sum-wise, where you might otherwise think of using applicatives. Whether it is an improvement on them is in the eye of the beholder:
let (let+) list f = List.map f list
let (and+) a b =
let rec loop first second =
match first,second with
first_hd::first_tl,second_hd::second_tl ->
(first_hd,second_hd)::(loop first_tl second_tl)
| _ -> []
in
loop a b
let pairlists = function
first,second ->
let+ elt1 = first
and+ elt2 = second in
[elt1 ; elt2]
(* example *)
let () =
let res = pairlists ([1;2;3], [4;5;6]) in
List.iter
(fun list -> List.iter (fun i -> Printf.printf "%d " i) list ;
print_endline "")
res
Here by way of comparison is the more traditional approach if you are using applicatives
let pure x = [x]
let (<*>) aps args =
List.concat (List.map (fun f -> List.map (fun x -> f x) args) aps)
let (<|>) aps args =
let rec loop args_rest aps_rest =
match args_rest,aps_rest with
args_hd::args_tl,aps_hd::aps_tl ->
(aps_hd args_hd)::(loop args_tl aps_tl)
| _ -> []
in
loop args aps
let pairlists = function
first,second ->
let two_list a b = a :: [b] in
pure two_list <*> first <|> second
(* example *)
let () =
let res = pairlists ([1;2;3], [4;5;6]) in
List.iter
(fun list -> List.iter (fun i -> Printf.printf "%d " i) list ;
print_endline "")
res
What does the |> operator mean in the following example?
open Framework
open Template
let () =
create_server ()
|> get "/" (fun req -> h1 ["This is the index page."] |> respond)
|> get "/:name" (fun req ->
Printf.sprintf "Hello, %s!" (param req "name") |> respond)
|> listen 1337
The example is taken from this github repo https://github.com/jdan/ocaml-web-framework
The operator |> is the "reverse function application" operator.
In other words, x |> f has the same meaning as f x.
The operator form is useful for writing a "pipeline" of function applications without requiring parentheses.
let f_parenthesized x = int_of_float (abs_float (sin x))
let f_pipelined x = x |> sin |> abs_float |> int_of_float
(This function is not very useful, it's just an example.)
I have some tests on infinite lazy structures that might run indefinitely if the tested function is not correctly implemented, but I can’t find in the OUnit docs how to set a timeout on tests.
If you're using OUnit2, the following should work:
let tests =
"suite" >::: [OUnitTest.TestCase (
OUnitTest.Short,
(fun _ -> assert_equal 2 (1+1))
);
OUnitTest.TestCase (
OUnitTest.Long,
(fun _ -> assert_equal 4 (2+2))
)]
The type test_length is defined as:
type test_length =
| Immediate
| Short
| Long
| Huge
| Custom_length of float
I don't think that oUnit provides this functionality. I remember having to do this a while back and this is the quick hack I've come up with:
let race seconds ~f =
let ch = Event.new_channel () in
let timeout = Thread.create (fun () ->
Thread.delay seconds;
`Time_out |> Event.send ch |> Event.sync
) () in
let tf = Thread.create (fun () ->
`Result (f ()) |> Event.send ch |> Event.sync) () in
let res = ch |> Event.receive |> Event.sync in
try
Thread.kill timeout;
Thread.kill tf;
res
with _ -> res
let () =
let big_sum () =
let arr = Array.init 1_000_000 (fun x -> x) in
Array.fold_left (+) 0 arr in
match race 0.0001 ~f:big_sum with
| `Time_out -> print_endline "time to upgrade";
| `Result x -> Printf.printf "sum is: %d\n" x
This worked well enough for my use case but I'd definitely would not recommend using this if only because race will not work as you'd expect if ~f does no allocations or calls Thread.yield manually.
I can't wrap my head around where should I put parenthesis to get it working:
let read_lines filename =
let channel = open_in filename in
Std.input_list channel;;
let print_lines filename =
List.map print_string ((^) "\n") (read_lines filename);;
^ This is the closes I've got so far. If my terminology is vague: ((^) "\n") is what I call partial function (well, because it doesn't handle all of its arguments). print_string I call total function because... well, it handles all of its arguments.
Obviously, what I would like to happen is that:
List.map applies first ((^) "\n") to the element of the list.
List.map applies print_string to the result of #1.
How? :)
Maybe you want something like that?
# let ($) f g = fun x -> f(g x);;
val ( $ ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
# let f = print_string $ (fun s -> s^"\n");;
val f : string -> unit = <fun>
# List.iter f ["a";"b";"c";"d"];;
a
b
c
d
- : unit = ()
# let g = string_of_int $ ((+)1) $ int_of_string;;
val g : string -> string = <fun>
# g "1";;
- : string = "2"
Your code didn't work because missing parenthesis:
List.map print_string ((^) "\n") xs
is parsed as
(List.map print_string ((^) "\n")) xs
when you expected
List.map (print_string ((^) "\n")) xs
A few things: List.map is probably not what you want, since it will produce a list (of unit values) rather than just iterating. ((^) "\n") is probably also not what you want, as it prepends a newline, the "\n" being the first argument. (This is not a section as in Haskell, but a straightforward partial application.)
Here's a reasonable solution that is close to what (I think) you want:
let print_lines filename =
List.iter (fun str -> print_string (str ^ "\n")) (read_lines filename)
But I would rather write
let print_lines filename =
List.iter (Printf.printf "%s\n") (read_lines filename)
Which is both clearer and more efficient.
Suppose I have some code like this:
List.map (fun e -> if (e <> 1) then e + 1 else (*add nothing to the list*))
Is there a way to do this? If so, how?
I want to both manipulate the item if it matches some criteria and ignore it if it does not. Thus List.filter wouldn't seem to be the solution.
SML has a function mapPartial which does exactly this. Sadly this function does not exist in OCaml. However you can easily define it yourself like this:
let map_partial f xs =
let prepend_option x xs = match x with
| None -> xs
| Some x -> x :: xs in
List.rev (List.fold_left (fun acc x -> prepend_option (f x) acc) [] xs)
Usage:
map_partial (fun x -> if x <> 1 then Some (x+1) else None) [0;1;2;3]
will return [1;3;4].
Or you can use filter_map from extlib as ygrek pointed out.
Both Batteries and Extlib provide an equivalent of mapPartial: their extended List module sprovide a filter_map function of the type ('a -> 'b option) -> 'a list -> 'b list, allowing the map function to select items as well.
Another solution would be to use directly a foldl :
let f e l = if (e <> 1)
then (e + 1)::l
else l
in List.fold_left f [] list
But my preference is filter_map as Michael Ekstrand provided
Alternatively you can filter your list then apply the map on the resulted list as follows :
let map_bis predicate map_function lst =
List.map map_function (List.filter predicate lst);;
# val map_bis : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list = <fun>
Usage :
# map_bis (fun e -> e<>1) (fun e -> e+1) [0;1;2;3];;
- : int list = [1; 3; 4]
You can also map values to singleton lists if you want to keep them or empty lists if you don't, and then concat the results.
List.concat (List.map (fun e -> if (e <> 1) then [e + 1] else []) my_list)
use
let rec process = function
| 1 :: t -> process t
| h :: t -> (h + 1) :: (process t)
| [] -> []
or tail recursive
let process =
let rec f acc = function
| 1 :: t -> f acc t
| h :: t -> f ((h + 1) :: acc) t
| [] -> List.rev acc in
f []
or with a composition of standard functions
let process l =
l |> List.filter ((<>)1)
|> List.map ((+)1)
The OCaml standard library has had List.filter_map since 4.08. This can therefore now be written as:
List.filter_map (fun e -> if e <> 1 then Some (e + 1) else None)