<mrvn>
Ok, something more complex. I want a function that returns the power set of a set. I.e. a set containing all possible subsets.
<mrvn>
set being represented as lists.
<doodo>
ok
<mrvn>
pow [1;2] ==> [[]; [1]; [2]; [1;2]];
<mrvn>
Clear what I mean?
<doodo>
yeah a got you
<mrvn>
The way to do this is again recursive. You go through the list and at each point you generate the subsets with and without the first element.
<mrvn>
let rec pow list = match list with ....
<mrvn>
First case: What happens to the empty list?
<doodo>
so like the powerset of an empty list? that would be a set containing the empty set, so like, [[]]?
<mrvn>
doodo: exactly.
<mrvn>
second case, we have some first element: | x::xs ->
<mrvn>
First we need all the possible subsets without the x, how do you do that?
<doodo>
hmm, without the x? why not do all the subsets the contain x?
<mrvn>
All the subset with x are all the subsets without x with x added to each.
learner has joined #ocaml
<mrvn>
doodo: xs is the set with x, how do you compute all the subsets of that?
<mrvn>
without x
<learner>
someone knows a good tutorial for ounit
<doodo>
to compute all subets i am not sure.
<mrvn>
doodo: you call pow
<mrvn>
let rec pow list = match list with | [] -> [[]] | x::xs -> let t = pow xs in ...
<mrvn>
Now in t we have all the subsets without x. An idea how to get the subsets with x now?
<learner>
no one?
<mrvn>
01:19 < mrvn> All the subset with x are all the subsets without x with x added to each. ==> we need a function that adds x to each element of t.
<doodo>
mrvn: like you said before. i got you
<mrvn>
Can you write such a function?
<doodo>
mrvn: so given a list of lists, add x to each sublist?
<mrvn>
yes. add_one 1 [[]; [2]] ==> [[1]; [1; 2]]
<doodo>
let me try
julm has joined #ocaml
<doodo>
sorry i got distracted making my peanut butter, sir rache and cheese sandwich
<doodo>
cheeder cheese, creamy peanute butter and lots of sir racha
<doodo>
its sounds nasty
<thelema>
sriracha
<doodo>
yeah
<doodo>
sriracha and peanut butter is da bomb
<doodo>
its basically kung pow chicken with no chicken in a sandwitch
<thelema>
okay, I'll take your word for that.
coucou747 has joined #ocaml
myu2 has joined #ocaml
<doodo>
yeah so thanks for all your guy's help, especially mrvn and thelema. I appreciate you guys helping me try and understand this stuff. ill probably be back later. peace
doodo has quit [Quit: Page closed]
oriba has quit [Quit: Verlassend]
<orbitz>
doodoo figure out his assignment?
<mrvn>
no
<orbitz>
shame
<orbitz>
i still contend the accumulator version is superior
<mrvn>
Tail recursive can do large lists too but the other is much simpler to understand.
<mrvn>
I often have code like this: let name args = let rec loop acc args = ... in loop init args. I wonder if optional/default args would be better there.
lewis1711 has joined #ocaml
<thelema>
mrvn: actually, better is writing two toplevel functions, let name_int acc args = ... let name args = loop init args
<thelema>
actually, I take this back, only if you don't pass all args is it better
<mrvn>
What exactly does it do there? let foo x y = match x with None -> y + 1 | Some x -> x + y. right?
<thelema>
let x = match x with None -> 1 | Some x -> x in x+y
<mrvn>
right. that gives the same asm.
<thelema>
exactly - ocaml doesn't rewrite your code.
<mrvn>
For performance that is a stupid way to implement it. But then the caller doesn't need to know the default arg. But that should be easily knowable same way cross module inlineing works.
<thelema>
it allows the arg to be computed based on other args
<thelema>
I guess technically taht computation could be inlined at the call site...
<mrvn>
thelema: that computation would then be inlined
<mrvn>
hehe.
<thelema>
attaching code to be run before your function is called seems like troublemaking to me...
<mrvn>
the way ocaml does it you only have one code generator for optional arguments and optional arguments with default value.
<thelema>
same codegen for labeled arguments too
<mrvn>
# let foo ?x y = x+y;;
<mrvn>
Error: This expression has type 'a option but an expression was expected of type int
<mrvn>
# let foo ?(x = 1) y = x+y;;
<mrvn>
different type inference though
<mrvn>
val foo : ?x:int -> int -> int = <fun>
<thelema>
yup, some syntax
<thelema>
syntax magic
<mrvn>
# let foo ?x y = let x = match x with None -> 1 | Some x -> x in x+y;;
<mrvn>
val foo : ?x:int -> int -> int = <fun>
<mrvn>
or maybe not. The ? is just an implicit option.
<mrvn>
# let foo ?x y = y;;
<mrvn>
val foo : ?x:'a -> 'b -> 'b = <fun>
<mrvn>
Strange though that it isn't 'a option there.
<mrvn>
ahh, never mind. I was thinking wrong.
<thelema>
# let foo ~x y = let x = match x with None -> 1 | Some x -> x in x+y;;
<thelema>
val foo : x:int option -> int -> int = <fun>
<mrvn>
It is an 'a option but the option is hidden in the ?
<mrvn>
anyway. given all that using a default argument for the acc init is a bad thing. then it has to match that against None on every loop.
<mrvn>
But it saves a third of the lines...*sigh*
elehack has quit [Ping timeout: 246 seconds]
elehack has joined #ocaml
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
<mrvn>
Remember the bubble_fold function I mentioned a while back? Here is the grouping using bzblle_fold: http://paste.debian.net/105598/
ftrvxmtrx has quit [Read error: Operation timed out]
ftrvxmtrx has joined #ocaml
Amorphous has quit [Ping timeout: 272 seconds]
Amorphous has joined #ocaml
<elehack>
heh. I just finished writing test cases for a module in my code base only to realize that Batteries already includes a module with the same functionality
* elehack
makes note to rip out custom code in favor of batteries
<orbitz>
mrvn: good call
elehack has quit [Quit: Farewell, programs.]
jonafan_ has joined #ocaml
jonafan has quit [Ping timeout: 264 seconds]
noisymouse has joined #ocaml
<noisymouse>
how can I do print statements in ocaml?
myu2 has joined #ocaml
<julm>
noisymouse: print_endline
<noisymouse>
all i get is what the types of the function arguments and the output
<noisymouse>
I just don't understand... I have print_strings in my functions, and I call the functions, but nothing goes to my output
<noisymouse>
????
<noisymouse>
And I've googled this already, and I don't really see anyone explain it
<noisymouse>
it's really frustrating me
drunK has quit [Remote host closed the connection]
<orbitz>
noisymouse: i'm not understanding you
<orbitz>
let () = print_endline "Hello world"
ftrvxmtrx has quit [Ping timeout: 240 seconds]
jonafan__ has joined #ocaml
jonafan_ has quit [Ping timeout: 246 seconds]
ftrvxmtrx has joined #ocaml
ulfdoz has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 276 seconds]
joewilliams is now known as joewilliams_away
ftrvxmtrx has joined #ocaml
eye-scuzzy has quit [Ping timeout: 240 seconds]
eye-scuzzy has joined #ocaml
eye-scuzzy has quit [Quit: leaving]
eye-scuzzy has joined #ocaml
mjonsson has quit [Remote host closed the connection]
ikaros has joined #ocaml
cyanure has joined #ocaml
ulfdoz has quit [Ping timeout: 255 seconds]
eye-scuzzy has quit [Quit: leaving]
eye-scuzzy has joined #ocaml
eye-scuzzy has quit [Client Quit]
eye-scuzzy has joined #ocaml
cyanure has quit [Ping timeout: 246 seconds]
ikaros has quit [Quit: Leave the magic to Houdini]
oriba has joined #ocaml
Snark_ has joined #ocaml
Modius has quit [Read error: Connection reset by peer]
Modius_ has joined #ocaml
ymasory has quit [Quit: Leaving]
ftrvxmtrx has quit [Ping timeout: 255 seconds]
lamawithonel has quit [Ping timeout: 255 seconds]
lamawithonel_ has joined #ocaml
ftrvxmtrx has joined #ocaml
myu2 has quit [Ping timeout: 276 seconds]
Yoric has joined #ocaml
ttamttam has joined #ocaml
mike_mcclurg has joined #ocaml
Modius_ has quit [Quit: "Object-oriented design" is an oxymoron]
boscop has joined #ocaml
Yoric has quit [Quit: Yoric]
ftrvxmtrx has quit [Quit: Leaving]
ttamttam has quit [Ping timeout: 250 seconds]
lewis1711 has left #ocaml []
sgnb has quit [Remote host closed the connection]
avsm1 has quit [Quit: Leaving.]
sgnb has joined #ocaml
_andre has joined #ocaml
ftrvxmtrx has joined #ocaml
avsm has joined #ocaml
Yoric has joined #ocaml
mnabil has joined #ocaml
mnabil has quit [Remote host closed the connection]
ttamttam has joined #ocaml
mcclurmc has quit [Quit: Leaving]
mnabil has joined #ocaml
oriba_ has joined #ocaml
oriba_ has quit [Client Quit]
<avsm2>
someone recently released a utility that graphs module dependencys for ocaml sources; but i cant find it... anyone remember it?
<flux>
I was going to suggest ocamldep, but I guess not
mikemc has quit [Remote host closed the connection]
mikemc has joined #ocaml
mikemc has quit [Remote host closed the connection]
mikemc has joined #ocaml
mikemc has quit [Remote host closed the connection]
mikemc has joined #ocaml
mikemc has quit [Remote host closed the connection]
mikemc has joined #ocaml
myu2 has joined #ocaml
Snark_ is now known as Snark
mnabil has joined #ocaml
Associat0r has joined #ocaml
oriba has quit [Quit: Verlassend]
mattam has joined #ocaml
mcclurmc has joined #ocaml
derdon has joined #ocaml
smerz has joined #ocaml
Associat0r has quit [Quit: Associat0r]
Associat0r has joined #ocaml
Associat0r has quit [Client Quit]
Associat0r has joined #ocaml
Associat0r has quit [Client Quit]
Associat0r has joined #ocaml
<thomasga>
I have : val fn : foo -> bar -> unit; is there a way to decompose that into type t = foo -> bar and val fn : t -> unit (ie. how to abstract left-associativity ?)
<flux>
hmm
<flux>
a function that is given arguments "foo" and "bar" and returns unit, how could it be decomposed into a function that given "foo" returns "bar"?
<thomasga>
yea I know
ftrvxmtrx has quit [Remote host closed the connection]
<thomasga>
I am just trying to find a way to abstract the parameters of a function ... but I agree that it doesn't make sense :-)
ftrvxmtrx has joined #ocaml
<thomasga>
will uncurry it, then ...
<mrvn>
foo -> (bar -> unit) and (foo -> bar) -> unit works.
<mrvn>
foo -> bar -> unit is the former.
<thomasga>
yup
<mrvn>
thomasga: if I understand you right then there is no need to uncurry anything, just use () explicitly.
myu2 has quit [Ping timeout: 240 seconds]
fremo__ has quit [Read error: Connection reset by peer]
myu2 has joined #ocaml
<thelema>
thomasga: what you're trying to do requires further assumptions
<thelema>
your assumption is that you have a function foo -> (bar -> unit) and you want to turn it into a function (foo -> bar) -> unit
<thelema>
s/your assumption/your requirement/
<thelema>
this can't be done in general. For example, [let f x y = if x = g y then print "x"] has type foo -> (bar -> unit)
<thomasga>
I have a module signature : module type S = sig fn : t1 -> ... -> tn -> unit end and I would like to abstract t1 -> ... -> tn away into something like module type S = sig type params val fn : params -> unit end
<thomasga>
but yes, I am aware that what I am proposing is theoritically nonsense :-)
<thelema>
but without knowledge of g, you can't make an equivalent function (foo -> bar) -> unit
<thomasga>
I am just trying to find a practical solution
<thelema>
thomasga: the practical solution is to use a list or tuple to aggregate your arguments
jm_ocaml has joined #ocaml
<thomasga>
yup, it is what I was afraid of ... but some of the ti are optional arguments
<thomasga>
so it's a bit painful to encode
fremo__ has joined #ocaml
<thelema>
list of (string, int) pairs?
<flux>
maybe you find use for structures like (foo * (bar * (baz * unit)))
<thomasga>
sig type 'a params val fn : unit params end maybe
<mrvn>
or continuation passing style
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
Julien_T has quit [Read error: Operation timed out]
Julien_T has joined #ocaml
bp has joined #ocaml
<bp>
hi
derdon has left #ocaml []
bp has quit [Quit: Quitte]
<thelema>
bye
rien_ has joined #ocaml
joewilliams_away is now known as joewilliams
* thelema
wishes he had a sparse non-unicode rope instead of the unicode ropes in batteries
<mfp>
thelema: huh... Batteries' ropes were originally non-unicode, the code should be around
<thelema>
mfp: yes, I'm sure it's somewhere. especially considering this mauricio guy wrote them...
<noisymouse>
the relevant part is the dbll function
ttamttam has quit [Remote host closed the connection]
<jonafan>
there are two dbll functions?
<noisymouse>
are there? that might be the problem
<jonafan>
also it appears that you only provide two arguments when you call dbll
<noisymouse>
that's all it requires, right?
<jonafan>
dbll grammar depth backtrackStack
<noisymouse>
oh
<jonafan>
the two arguments get curried and you get a function back
ymasory has joined #ocaml
<mrvn>
# dbll cfg0 arg2;;
<mrvn>
- : (string list * (string * string list) list * cat list) list -> (string * string list) list * (string list * (string * string list) list * cat list) list
<mrvn>
= <fun>
<mrvn>
That is what you get for partial applications.
<thelema>
which is why when you expect something to run, do "let () = dbll cfg0 arg2 [];;"
<noisymouse>
ok now I'm at least getting some output
<mrvn>
(List.rev output,backtrack) (* what does this do? [see test -> reverses both lists returning a a tuple of reversed lists in the order received *) (* End state?, output representation of current state? *)
<mrvn>
It only reverses one list
<noisymouse>
oh
ftrvxmtrx has quit [Quit: Leaving]
<noisymouse>
anyway, depth is definitely an integer and the second argument
<noisymouse>
I just haven't implemented it yet because I don't understand the rest of the code
<noisymouse>
ok thx for the help
<noisymouse>
looks like my problem was just defining the function twice :(
<noisymouse>
I was staring at the thing for several hours last night and it was such an obvious mistake
<thelema>
let anon_fun str = acc := str :: acc in parse ... anon_fun ..; assert (acc <> []);
<thelema>
with !'s as necessary
<jado>
but that won't print the help message generated by Arg right?
<thelema>
if (acc = []) then (Arg.usage ...; exit 1)
<jado>
ok thanks
<kaustuv_>
gildor: would you accept patches to the oasis user manual? There are a number of English mistakes that sometimes make it a bit confusing.
<jado>
but that's weird: at some point it's written "The reason for the error: unknown option, invalid or missing argument, etc" but there seems to be no way to force an argument with Arg unless you make the test yourself
<hcarty>
jado: That is correct. You have to verify that required arguments have been provided.
<kaustuv_>
Arg is old and broken. Batteries.OptParse is the new hotness.
<jado>
ouch :/
<jado>
but that's not a 'standard' library?
<adrien>
is OptParse really different? still doesn't look very nice to use
<hcarty>
kaustuv_: Thanks for the pointer. What does OptParse offer that the old 'n busted Arg does not?
<kaustuv_>
hcarty: I was being a bit facetious, but I do find the ~first argument to OptParser.parse kind of useful for implementing subcommands with their own options
<kaustuv_>
hcarty: I also like the grouping. With Arg I have to manually insert \ns in the description
ygrek has joined #ocaml
elehack has joined #ocaml
<jado>
how can i use Arg.align? i put a space as a first space of each doc string but that didn't really align anything
<kaustuv_>
did you remember to say "let opts = Arg.align opts in" before calling Arg.parse?
<jado>
yes
<kaustuv_>
Then -help should display them aligned properly
<jado>
true :)
<jado>
but not Arg.usage
<kaustuv_>
do you use the aligned opts for that too?
<jado>
hm sorry
<jado>
thanks
<kaustuv_>
basically, when you declare your opts, say: let opts = Arg.align [ "-foo", Arg.Set foo, " Do a foo" ; etc. ] in
<jado>
yes it's better this way
elehack has quit [Ping timeout: 255 seconds]
<jonafan>
why don't i know how to use findlib?
Snark has quit [Quit: Ex-Chat]
mnabil has quit [Ping timeout: 265 seconds]
jado has quit [Read error: Connection reset by peer]
<ygrek>
jonafan, because you didn't read the "user manual"?
<adrien>
to be honest, you probably want to start with examples
<jonafan>
trying to use ocamlmktop so batteries loads automatically
<jonafan>
it doesn't work with any package that has a subdirectory in /usr/lib/ocaml
smerz has quit [Quit: Ex-Chat]
<thelema>
jonafan: why don't you use the ocamlinit script that comes with batteries to start it automatically?
<alexyk>
I need to have a function which is called with a record type. I later redefine the type in different modules, adding fields; but I'm calling the function only with a minimal subset of fields. Is there a way to do it with records, or I'd have to use OO?
<thelema>
sorry, you need OO for that - ocaml's records don't nest
<mrvn>
they do but really ugly.
<alexyk>
so if I'm replacing a record with a class; how can I pattern-match an object on value field names, to achieve the same effect as {field1 =v1; field2 =v2} = recval?
<thelema>
well, you can put records within records, but you can't do subtyping between record types in the nice way - passing {a=2;b=3} to (fun {a=a} -> a+1)
<mrvn>
alexyk: Option 1) Obj.magic. 2) extendable records type 'a foo = { x:int; data:'a }
<alexyk>
ok...
<mrvn>
alexyk: no pattern matching on members of a class
<alexyk>
mrvn: so a series of extractions, rcval#field1, ... only?
<mrvn>
alexyk: which you can put into a match again if you like
<mrvn>
In my B-Tree I have type key_type = One | Two type key = { key_type : key_type; hash : int } and type 'a leaf = { key_type : key_type; hash : int; data : 'a } and I have functions to_key and from_key
ulfdoz has quit [Ping timeout: 276 seconds]
<alexyk>
can records have default values?
<alexyk>
for fields
<thelema>
no
<thelema>
use a constructor function to do that.
<alexyk>
kk
<gildor>
kaustuv_: the manual is mostly generated from oasis itself, if you patch in the oasis source, I would be glad to accept your patches
ygrek has quit [Ping timeout: 240 seconds]
coucou747 has quit [Quit: 0x2a]
Edward has quit [Ping timeout: 240 seconds]
<alexyk>
what's the prettiest way to write let power10 n = 10*..*10 n times?
<alexyk>
(integer)
<alexyk>
in Batteries
seafood has joined #ocaml
<alexyk>
e.g.: let power10 times = E.fold ( * ) 1 (E.repeat ~times 10)
ikaros has quit [Quit: Leave the magic to Houdini]
alexyk has quit [Quit: alexyk]
jm_ocaml has quit [Remote host closed the connection]
Edward has joined #ocaml
seafood has quit [Quit: seafood]
Fullma has joined #ocaml
myu2 has joined #ocaml
lamawithonel__ has joined #ocaml
lamawithonel_ has quit [Ping timeout: 255 seconds]