seafood has quit [Read error: 60 (Operation timed out)]
sgnb`` has joined #ocaml
sgnb` has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
angerman has joined #ocaml
sgnb`` is now known as sgnb
jonasb has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
sanguine1 is now known as sanguinev
Camarade_Tux has quit ["Quitte"]
Camarade_Tux has joined #ocaml
jonasb has quit [Remote closed the connection]
Mr_Awesome has joined #ocaml
angerman has quit []
Camarade_Tux has quit ["Leaving"]
paul424 has quit [Read error: 104 (Connection reset by peer)]
RamzaB has joined #ocaml
RamzaB has left #ocaml []
ched_ has joined #ocaml
Ched has quit [Read error: 110 (Connection timed out)]
hkBst has quit [Read error: 104 (Connection reset by peer)]
AxleLonghorn has joined #ocaml
hello_test has joined #ocaml
<hello_test>
Anyone have a minute I'm knew to OCaml and having some trouble understanding something.
<hello_test>
I'm trying to develop a recursive function that takes an adjacency list and converts it to pairs. For example the function should take a list such as [(1,[2;3;8]);(2,[4;5;6])] and generate a list of pairs like [(1,2);(1,3);(1,8);(2,4);(2,5);(2,6)]
<hello_test>
I keep getting stumped on how to handle the list part of the pair. I use fst head to get the '1' but not sure how to loop over the snd head list and combine them in the function
<mrvn>
let conv list = let rec loop acc = function [] -> List.rev acc | (a, blist) :: xs -> loop (List.fold_left (fun acc b -> (a, b)::acc) acc blist) xs in loop [] list
<mrvn>
untested
* hello_test
tests
<mrvn>
The loop loops over the pairs and the List.fold_left goes over the inner list and adds them to the front of acc. And at the end you invert acc to get the order you specified.
<hello_test>
I have to look at the manual I am not familiar enough with how these List operations work. I get the general idea though. Thank you.
<AxleLonghorn>
pattern matching is your friend hello_test.
<mrvn>
hello_test: let fold_left fn acc = function [] -> acc | x::xs -> fold_left ((fn x)::acc) xs
<mrvn>
aeh, fn acc x
<hello_test>
mrvn: why [] -> acc?
<hello_test>
I usually [] -> [] as first thing in pattern match
<mrvn>
It folds the elements of the list into acc using fn from left to right. At the end (at []) it returns acc
<hello_test>
I just have a lot of difficulty understanding this list module.
palomer has joined #ocaml
<palomer>
yo, where can i find examples on sexplib?
<AxleLonghorn>
the aux function in pairup should probably be turned into a one liner using an anonymous function
<mrvn>
AxleLonghorn: List.concat is slow and I bet not tail recursive.
tripwyre has joined #ocaml
<AxleLonghorn>
it isn't
<thelema>
tail recursion is overrated - as long as you don't bust the stack, tail recursion's overhead isn't worth it.
<mrvn>
thelema_: a graph with maybe 100 nodes will overflow it
<kaustuv>
tail recursion has overhead?
<mrvn>
thelema_: and quadratic speed instead of linear makes a difference
<mrvn>
kaustuv: not neccessarily.
<thelema>
for basic List operations?
<mrvn>
Actualy often tail recursion will have less overhead because it doesn't have to allocate stack frames.
<kaustuv>
when you say "often", do you mean "always"?
<mrvn>
thelema_: concat has to go to the end of the list and then reuild it on the way back. With n nodes with m vertices that takes O(n * m) time, worst case O(n^2).
<mrvn>
m vertices each
biv_ has joined #ocaml
<mrvn>
Actualy more, O(n * n * m) or something.
<mrvn>
n concats of a list that grows by m every run.
<thelema>
two possible overheads to make basic list operations tail recursive: 1) reversing the list at the end, 2) cheating with a mutable list and Obj.magicing it into a proper list.
<mrvn>
thelema_: or 3) not caring about the order
<mrvn>
Some list operations are just naturally tail recursive
<thelema>
The second obviously has less overhead, but I benchmarked extlib's list functions and found them not as fast as stdlib up to the point that stdlib broke stack
<thelema>
like rev, yes.
<mrvn>
Isn't 2 bad for the GC?
<thelema>
I don't think so - no reallocation
<thelema>
just type-system trickery
<mrvn>
interferes with the ageing.
<thelema>
even the authors of extlib went through pains to try 1000 steps of non-tail recursion before switching to a tail-recursive algorithm
<mrvn>
thelema_: tail recursive is always safer,
<mrvn>
thelema_: the cheat with a mutable list makes the algorithm tail recursive too
arquebus has left #ocaml []
<thelema>
yes, that's why they do that cheat. But they do 1000 steps of straightforward looping on the stack before switching algorithms
<mrvn>
They actualy switch in the middle if the list becomes too long?
<thelema>
well, they can't do a List.length beforehand to know what algorithm to use...
<mrvn>
And how exactly does that help if you have 3 or 4 of them stacked together? The innermost will overflow the stack
<thelema>
so yes, they do normal recursion with a counter, and when that counter gets high enough (1000 by default, IIRC), they switch to a tail-recursive algorithm.
<mrvn>
The counting probably costs more time than reversing the list at the end.
<thelema>
it's not perfect, but I don't see maps stacked that deep often. And my computer blows stack around ...
* thelema
checks
<sanguinev>
Do it perfectly O(n), doing it with counting and reversing O(3n), overflowing the stack O(1)? :P
<mrvn>
sanguinev: It tends to overflow the stack just when thesize becomes interesting. :)
<mrvn>
So you write your code with simple, small test cases and everything works and then when you use it for real *BOOM*
<sanguinev>
mrvn: It wouldn't be fun if things just worked the way they were meant to...
<kaustuv>
If you are working with such algorithms, you should use a better data structure than vanilla lists. Join lists have O(1) concat, for example.
<thelema>
sanguinev: reversing is worse than 3n - GC overhead of allocation
<sanguinev>
thelema: I wasn't being serious...
<thelema>
especially when your list is larger than the size of the small heap
<mrvn>
thelema_: GC overhead is const. allocation is verry fast
<thelema>
not allocation - deallocation.
<mrvn>
thelema_: still const
<mrvn>
but yes, when you overflow the small heap it becomes more expensive
<thelema>
maybe... but a big enough constant that I'd rather not.
sirGrey has quit [Read error: 110 (Connection timed out)]
<mrvn>
Then again, if your list is that big then non-tail-recursive will overflow the stack.
<mrvn>
thelema_: and mutable lists don't need the List.rev and no extra allocations.
<thelema>
of course there's reasons people use the built-in List.
<mrvn>
And don't forget that a List.concat will allocate as well. If you can eliminate a List.concat from the loop by doing a List.rev at the end you will always win.
<thelema>
if you're working with a lot of data, it's usually not the right data structure.
<mrvn>
I wouldn't say that. You just have to be carefull what you do.
<thelema>
Extlib's List.concat only re-allocates its first argument
<mrvn>
thelema_: which is usualy the bigger one.
<thelema>
but if it's not... I wouldn't want to rev.
<mrvn>
If it is not then you can move the concat into the inner loop where you build the smaller list, turn that tail recursive and append the elements as you build them one by one.
<mrvn>
which is why the first one is usualy the big one. :)
<kaustuv>
Just use a double-ended queue if your algorithm involves repeated snocing
<thelema>
I agree that it sucks when your code dies at an unpredictable N size of input, but it's important to note that especially for the situations where List is actually the right data structure, it's often not worth the extra costs of tail recursion.
<mrvn>
I just don't see the extra cost. I usualy havesomething that runs in O(n^2) or O(n^3) and then the cost of O(n) for List.rev at the end is irelevant.
<mrvn>
Or n is so small that it doesn't matter either way.
<mrvn>
There are many cases where you know the list will be ~10 items and then just do whatever reads best.
<thelema>
yup.
<mrvn>
But if I know the list will be O(n) big then I take some pain to make it tail-recursive. I hate when the stack overflows.
<mrvn>
If that means not using lists then that is an option too. :)
<kaustuv>
I just CPS transform my whole program because I am deathly afraid of the stack
<mrvn>
kaustuv: hehe.
<thelema>
kaustuv: good call
<mrvn>
kaustuv: at university we did that when learning to write a compiler. Makes code generation quite simple.
kaustuv has left #ocaml []
verte_ has joined #ocaml
verte has quit [Nick collision from services.]
verte_ is now known as verte
paul424 has joined #ocaml
<paul424>
hey is there any build-in type that have method toString ????
<AxleLonghorn>
What are you looking for exactly paul424?
<paul424>
I am looking for an object which would meeet my specification ;) i.e. it must have the method toStyring
<paul424>
as far as I look over there isn't any ready to use objects .........
<paul424>
so best would be to write a wrapper around Int32 containning toString method
<AxleLonghorn>
objects do exist in the language, but most people don't really write programs using objects
<paul424>
AxleLonghorn: lecture assigment ;)
<AxleLonghorn>
val to_string : int32 -> string
<AxleLonghorn>
Return the string representation of its argument, in signed decimal.
<AxleLonghorn>
there's a function in the Int32 module that takes an int32 and returns a string
<itewsh>
"PING of int*int" is "PING of int and int" ?
<thelema>
no, I think it wouldn't work - you'd need [with PING a,b -> (a,b)]
<thelema>
or maybe not...
<thelema>
hmmm...
<kaustuv>
(slightly offtopic) There is an odd inconsistency in the ocaml pattern syntax that I've always hated: you can say [function Some(a,b) -> (a,b) | None -> (8,8)] even though Some is a unary constructor.
* thelema
looks up his code
<Yoric[DT]>
itewsh: yes (first version in the regular syntax, second version in the revised syntax)
<thelema>
Yoric[DT]: he's probably not in revised syntax.
<itewsh>
hmm
_zack has joined #ocaml
<Yoric[DT]>
thelema: sure, I'm just using the revised syntax to show that it's a syntax oddity.
<theIdeaMen>
The issue is that there is a difference between a constructor with two parameters and a constructor with one parameter that is a tuple
<thelema>
Yoric[DT]: and to utterly confuse a newbie. :)
<Yoric[DT]>
thelema: that's a bonus :)
<kaustuv>
paul424: are you a refugee from SML? If so, you should note that .mli is not quite the same as .sig. In the .mli the signature should be there nakedly, without the name and the sig ... end delimiters.
<kaustuv>
and in the module there should be no module name and struct ... end.
<kaustuv>
The module name is inferred from the file name (by capitalizing the first letter of the file name), and the signature is unnamed.
<paul424>
kaustuv: they didn't told me that , thanks ;(
<paul424>
;)
<thelema>
Yoric[DT]: do we have an identity function anywhere in batteries?
<kaustuv>
Std.identity
<Yoric[DT]>
thelema: Standard.identity .
<Yoric[DT]>
(or just identity)
<thelema>
ok.
<Alpounet>
would you expect higher order functions for manipulating 2D/3D vectors ?
<Cheshire>
yes
<Alpounet>
(I mean mathematical vectors)
<thelema>
Alpounet: in a library dealing with vectors, I'd expect some higher order functions
<paul424>
ok big thx to everyone, now works ;)
<Yoric[DT]>
cool :)
<Alpounet>
thelema, what kind ?
<Alpounet>
one that would have a functional argument and 2 vectors, then applying the argument two the two vectors ?
<Alpounet>
to the two vectors*
<thelema>
hmmm... probably not - too easily done with standard syntax
<thelema>
maybe a HO dot product
<Yoric[DT]>
A HO dot product?
<Yoric[DT]>
What's that?
<Yoric[DT]>
Isn't that a [fold] or [fold2]?
<thelema>
higher order dot product, so you can work in a different field...
<thelema>
hmm... yes, that'd be a fold3
<thelema>
err fold2
<Yoric[DT]>
[fold3]?
<Yoric[DT]>
Ah, ok.
<Alpounet>
thelema, can you give an example of use ?
paul424 has quit ["ChatZilla 0.9.84 [Firefox 3.0.6/2009011913]"]
<thelema>
dot plus_mod7 times_mod13 v1 v2
<thelema>
I dunno what you would use that for, though...
<Yoric[DT]>
:)
<thelema>
maybe for non-int vectors, you'd want to combine and reduce in interesting ways.
<thelema>
dot Matrix.add Matrix.mult v1 v2
<thelema>
for getting the dot product of a pair of vectors whose elements were matrices
<Yoric[DT]>
I guess we would need someone who actually uses matrices to answer this kind of questions.
<kaustuv>
wouldn't it be better to define a Vector.Make() functor that takes add and mult arguments?
slash_ has quit ["leaving"]
<Alpounet>
kaustuv, actually I plan to parametrize the module by a module defining the operations my module needs for doing operations
slash_ has joined #ocaml
<Alpounet>
however, there are 2 points of view... One seing vectors as tuple of coordinates, i.e floats, complex numbers, ...
<Alpounet>
s/tuple/tuples
<Alpounet>
the other being whatever-we-can-put-in-a-vector-space
<Alpounet>
I'm done with Vector2D and Vector3D, with floats but soon parametrized by a module for operations on floats/complex numbers/...
<Alpounet>
using things already done in Batteries
<thelema>
Alpounet: is efficiency a top priority?
<Alpounet>
thelema, I assume it must be efficient, but not necessarly super-efficient
<thelema>
ok. you'd need to defunctorize floats and use a record of floats to get super-efficient
<flx_>
defunctorizing would be a lot nicer if ocamldefun worked :)
<Alpounet>
Heh.
itewsh has quit [Connection timed out]
<Alpounet>
Don't worry, until now, everything is in records
theIdeaMen has quit [Remote closed the connection]
itewsh has joined #ocaml
<Alpounet>
Thats why I'm wondering if it's necessary to define the generalistic notion of vector
<Alpounet>
(i.e element of a vector space)
<kaustuv>
If you want super efficient vectorized FP code, you need to write it in SSE2 assembly. No C compiler is clever enough to do it right.
<flx_>
not even intel's?
<flx_>
if it does, it might require you to write in the exact pattern it recognizes
<Alpounet>
That's not the goal... The goal is to provide something efficient enough for real world use, not for the quickest-real-time-application-seen
<flx_>
because iirc I've seen C-code that magically gets converted to SSE ops
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
<kaustuv>
I don't know this firsthand (cue salt shaker) but my friends who write games for a living tell me that they routinely get 15x speedup over compiler-generated FP code by writing it by hand.
ikaros has joined #ocaml
<Yoric[DT]>
Floating-Point or Functional Programming?
<thelema>
Yoric[DT]: I bet Floating Point
<Yoric[DT]>
probably
<Yoric[DT]>
Well, gottago, though.
<Yoric[DT]>
Talk to you later.
alexyk has quit []
willb has joined #ocaml
* thelema
finds it distasteful that IString and IRope are duplicated between extSet and extMap
willb has quit [Client Quit]
willb has joined #ocaml
<Yoric[DT]>
thelema: don't hesitate to export these into String.IString and String.IRope
* thelema
is doing that now
<thelema>
you mean Rope.IRope
* thelema
is adding his numeric_compare function as a basis for sets and maps
<thelema>
to have "abc32" < "abc210" ( useful for filenames )
alexyk has joined #ocaml
<Yoric[DT]>
Good idea.
<Yoric[DT]>
Still, gottago :)
<Alpounet>
Bye Yoric[DT]
<thelema>
bye
<Yoric[DT]>
(actually, *very* good idea)
<thelema>
now the big question: ExtString.IString or ExtString.String.IString?
biv_ has quit [Remote closed the connection]
biv has joined #ocaml
<Alpounet>
I'd say the first...
<thelema>
of course the difficult part of all this is how it comes out for the user...
<thelema>
I think ExtString.IString would have to be referenced as that, while ExtString.String.IString would come out as String.IString
<thelema>
The last option is Interfaces.IString
<thelema>
nah
itewsh has quit [Read error: 110 (Connection timed out)]
vuln has joined #ocaml
itewsh has joined #ocaml
hello_test has quit [Remote closed the connection]
itewsh has quit [Read error: 110 (Connection timed out)]
mattam has quit ["Lost terminal"]
itewsh has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
mattam has joined #ocaml
s4tan has quit []
_zack has quit ["Leaving."]
biv has quit ["Ухожу я от вас (xchat 2.4.5 или старше)"]
Associat0r has joined #ocaml
kaustuv has left #ocaml []
<thelema>
There's some build problem with test_string - I don't think I broke it, but I can't finish now - gotta get on plane.
<thelema>
bye
thelema has quit ["BitchX has bite! (Just ask Mike Tyson!)"]
ikaros has left #ocaml []
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
sitasleeppantere is now known as sitaktif
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
Stefan_vK1 has joined #ocaml
Stefan_vK2 has joined #ocaml
Stefan_vK3 has joined #ocaml
Stefan_vK has quit [Read error: 110 (Connection timed out)]
Stefan_vK1 has quit [Read error: 110 (Connection timed out)]
Stefan_vK has joined #ocaml
Stefan_vK2 has quit [Read error: 110 (Connection timed out)]
kaustuv has joined #ocaml
Stefan_vK3 has quit [Read error: 110 (Connection timed out)]
Amorphous has quit [Read error: 110 (Connection timed out)]
slash_ has quit ["leaving"]
slash_ has joined #ocaml
Amorphous has joined #ocaml
yziquel has joined #ocaml
yziquel has quit [Remote closed the connection]
Stefan_vK1 has joined #ocaml
OChameau has quit [Read error: 113 (No route to host)]
mib_pi7ntu has joined #ocaml
<mfp>
any batteries committer around?
<mfp>
just realized that iter f (PMap.enum x) doesn't yield the elements in the same order as PMap.iter
<mfp>
same for PSet, Map and Set
<Yoric[DT]>
Can you file a bug?
<Yoric[DT]>
I'll try and take a look this evening or tomorrow.
<mfp>
... untested because conditional compilation is failing
<mfp>
w/ GODI -section 3.11 the redefined Gc.control record doesn't match INRIA's
<mfp>
the conditional compilation magic for mutable allocation_policy : int; is failing
<mib_pi7ntu>
Hi. when compiling I get a Fatal error: exception Failure("Ocaml and preprocessor have incompatible versions"). How can I check the versions of ocaml and of the compiled syntax extension I'm dealing with?
<mfp>
if I do build/optcomp/optcomp_o.byte src/core/extlib.mli in _build (ocamlbuild's), the output doesn't have allocation_policy in Gc.control, even though the version is version 3.11.0
mib_pi7ntu is now known as yziquel____
<mfp>
yziquel____: as a workaround, you can try to add pr_o.cmo to the camlp4o command you're using
<mfp>
so that it goes through the textual representation, instead of a serialized AST
Stefan_vK has quit [Read error: 110 (Connection timed out)]
<yziquel____>
Uhh... how do insert pr_o.cmo in such a statement: ocamlfind ocamldep -syntax camlp4o -package pgocaml.statements *.mli *.ml > makefile-depend
Stefan_vK1 has quit [Read error: 110 (Connection timed out)]
jeremiah has joined #ocaml
alexyk has quit []
ikaros_ has joined #ocaml
ikaros_ has quit [Read error: 104 (Connection reset by peer)]
Alpounet has quit ["Ex-Chat"]
Stefan_vK has joined #ocaml
m3ga has joined #ocaml
<Yoric[DT]>
mfp: it would be nice to have a testcase we could add to our testsuite.