Mr_Awesome has quit ["and the Awesome Level drops"]
dibblego has joined #ocaml
delamarche has joined #ocaml
pango_ has joined #ocaml
chessguy has joined #ocaml
pango has quit [Remote closed the connection]
yondalf has joined #ocaml
<flux-_>
dark_light, it is my understanding, that Event.choose (or poll) will not dicard events not read: thus you could iterate until poll returns galse to get all the events
<dark_light>
flux-_, so even if i don't remove read events it will work?
<dark_light>
flux-_, what you meant by galse?
<flux-_>
uh. typo + brainfart: None
<dark_light>
but poll isn't applied for a list of events,
<flux-_>
uh, right
<flux-_>
:)
<dark_light>
and Event.poll apparently will not return if you provide a empty list to it
<flux-_>
I haven't used the Event-module for some time now, after writing an asynchrobou
<flux-_>
asynchronous clone of it
<flux-_>
(I love the interface)
<dark_light>
o.o'
<flux-_>
maybe I could hand you a copy
<dark_light>
flux-_, my problem is: i have an let evsend ch ev = Event.sync(Event.send ch ev)) and i am doing: evsend ch1 ev1; evsend ch2 ev2 what is somewhat stupid, right?
<flux-_>
if you want to send both those objects then that's what you'll need to do
<flux-_>
commented functions are part of the public interface
<flux-_>
not much documentation or .mli there :).
<flux-_>
plus it has a global mutex..
<flux-_>
but it handles closing the channel much better than Event
<flux-_>
two differences: poll uses a list, send isn't synchronized
<flux-_>
also, it could be more efficient.. but it's mostly an asynchronous drop-in-replacement for Event
<flux-_>
some day I wish to make it more efficient and integrate timeout plus filedescriptor-support
<flux-_>
dark_light, argh, now I perused Event.mli, and I was referring to doing Event.poll (Event.choose [a; b; c])
<dark_light>
Hmmmmmmmm..
<dark_light>
so i have to repeat Event.poll (Event.choose [a; b; c]) until..?
<dark_light>
ps: hmm i will read what you said
<flux-_>
(msgqueue.ml doesn't provide choose; I should fix that too)
<dark_light>
eh. hmmmm
<dark_light>
flux-_, what about using Event and still having this? impossible? :(
danly has joined #ocaml
<flux-_>
maybe possible :)
<flux-_>
until it returns None
<flux-_>
all parties doing Event.sync(Event.write ..) should stay stuck until the data is transmitted.. no?
danly has quit [Remote closed the connection]
<dark_light>
flux-_, but i may want to send two things and syncronize later
<dark_light>
because they are unrelated
<flux-_>
oh
<flux-_>
well then you either want a nuffering thread, or Msgqueue..
<dark_light>
nuffering?
<flux-_>
:-)
<flux-_>
buffering
<dark_light>
Errr buffering?:
<flux-_>
yes
<flux-_>
(writing example..)
Skal has joined #ocaml
<dark_light>
your code seems intersting but I wanted to use the official lib, because, uh, I almost know how it works.. and seems fine (unhapply I can't do what i want, but send a thing and then send another isn't *too* bad)
<flux-_>
like: let buf inch outch = let rec loop outbuf = match Event.select ([Event.wrap (fun a -> 'In a) (Event.recv inch)] @ (if outbuf <> [] then [Event.wrap (fun () -> 'Out) (Event.write outch (List.hd putbuf))]) in 'In a -> loop (a::outbuf) | 'Out -> loop (List.tl outbuf) in loop []
<flux-_>
it should give the idea.. (I didn't try conpiling that)
<flux-_>
it misses "else []"
<flux-_>
uh
<flux-_>
and those 's should be backticks
danly has joined #ocaml
<flux-_>
but they are difficult to type on this mobile :)
yondalf has quit ["leaving"]
danly has quit [Client Quit]
<flux-_>
(infact impossible)
danly has joined #ocaml
<flux-_>
so you insert a new thread that acts as a proxy between your two threads
<flux-_>
and the writes go through immediately, because that buffering thread reads them
<flux-_>
buffering thread gets never stuck
MisterC has joined #ocaml
<flux-_>
you will obviously need now two channels instead of one..
sponge45 has joined #ocaml
Smerdyakov has quit ["Leaving"]
<flux-_>
(hello?)
<dark_light>
oh
<dark_light>
hmm
Skal has quit [Connection timed out]
<dark_light>
!!!!!
<dark_light>
flux-_, :o
<dark_light>
flux-_, why the Event.choose can't return the list of unselected events too?
<dark_light>
is there any way i can make Event.choose returning, let's say, 'a event * ('a event list) ? :~~~
<dark_light>
(another function of course)
<dark_light>
if it's not possible to continue with Event module, i think i will be with the current bad way to do it
<dark_light>
i didn't found any "with".. :P
<flux-_>
right, s/in/with/ :)
<flux-_>
but no, I don't think there is a way
<flux-_>
so you are choosing from multiple sources?
<flux-_>
and you'd like to list the events that wewrn't active?
<flux-_>
you could Event.wrap them: Event.wrap (fun a -> 0, a) ..; Event.wrap (fun a -> 1, a) etc
<flux-_>
and you would get a number indicating the source active
<dark_light>
hmmmm
danly has quit ["Leaving"]
<dark_light>
but Event.wrap will return for every event, even those that was alredy syncronized
<dark_light>
i could use Event.wrap_abort .. wrap_abort ev fn returns the event that performs the same communications as ev, but if it is not selected the function fn is called after the synchronization.
<dark_light>
so the function somehow modify an side-effect value that say it isn't waiting for sync
_velco has joined #ocaml
_shawn has quit [Read error: 104 (Connection reset by peer)]
_shawn has joined #ocaml
pango__ has joined #ocaml
pango_ has quit [Remote closed the connection]
dibblego has quit ["Leaving"]
delamarche has quit []
chris2 has joined #ocaml
delamarche has joined #ocaml
delamarche has quit []
delamarche has joined #ocaml
kral has joined #ocaml
sponge45 has left #ocaml []
Slack4020 has joined #ocaml
<Slack4020>
what do you guys think of ocaml used as a scritping web lang ?
dark_light has quit [Dead socket]
dibblego has joined #ocaml
love-pingoo has joined #ocaml
smimou has joined #ocaml
pango__ has quit [Remote closed the connection]
_fab has joined #ocaml
pango has joined #ocaml
chris2 has quit [Read error: 110 (Connection timed out)]
velco has joined #ocaml
buluca has quit [Read error: 104 (Connection reset by peer)]
smimou has quit ["bli"]
Snark has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
dibblego has quit [Read error: 110 (Connection timed out)]
chessguy2 has joined #ocaml
slipstream-- has quit [Read error: 104 (Connection reset by peer)]
slipstream has joined #ocaml
chessguy has quit [Read error: 145 (Connection timed out)]
jajs has joined #ocaml
llama32 has joined #ocaml
<llama32>
what does let x = .. in .. actually mean in ocaml? tutorials suggest that - rather than evaluating x and storing it, it [at least conceptually] replaces every occurence of it with the expression it ='s, but is this actually the case? if i let x = open "taco.txt" [whatever the equivalent of open is in ocaml], then use it multiple times within scope - can i safely assume that open "taco.txt" will be called only once, and the same value used each
<llama32>
time?
<flux-_>
yes, it will be opened only once
<llama32>
ok, good
<flux-_>
I guess the tutorial is merely attempting to make a difference between "mutable variables" and "bindings"
<llama32>
yeah
<flux-_>
actually I've learned to like the term "immutable variable", but I guess ymmv
<love-pingoo>
llama32: what manual are you refering too ?
<love-pingoo>
-o
<llama32>
i can't remember, it's something i read the other day and i haven't touched ocaml [or the computer for that matter] since
_shawn has quit [Read error: 104 (Connection reset by peer)]
_shawn has joined #ocaml
m3ga has joined #ocaml
ruben17 has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
bluestorm has joined #ocaml
ruben17 has quit ["rcirc on GNU Emacs 22.0.50.1"]
jajs has quit [Remote closed the connection]
bluestorm has quit [Remote closed the connection]
bluestorm has joined #ocaml
ikaros_ has joined #ocaml
buluca has joined #ocaml
ikaros_ has quit ["Leaving"]
pango_ has joined #ocaml
pango has quit [Remote closed the connection]
velco has quit [Read error: 110 (Connection timed out)]
velco has joined #ocaml
chris2 has joined #ocaml
jajs has joined #ocaml
zak_ has joined #ocaml
llama32 has quit [Read error: 110 (Connection timed out)]
duncanm has quit [Read error: 110 (Connection timed out)]
velco has quit [Read error: 110 (Connection timed out)]
velco_ is now known as velco
pango_ has joined #ocaml
pango has quit [Remote closed the connection]
zak_ has quit ["Leaving"]
chessguy has joined #ocaml
duncanm has joined #ocaml
delamarche has quit []
kral has quit [Read error: 113 (No route to host)]
smimou has joined #ocaml
love-pingoo has quit ["Leaving"]
jordan- has joined #ocaml
<jordan->
I am trying to print while matching a list -- does anyone know what's wrong with something like: [] -> [] | (h::t) -> ((print_string x); my_func t);; ? it iterates the list but does not print on the way
<pango_>
channels are buffered, you need a flush stdout somewhere
<pango_>
(either directly, or using some function that uses it, like print_newline ())
<bluestorm>
btw pango, does \n in Printf.* flush the buffer ?
<pango_>
no, printf "%!" does
<bluestorm>
hm
<bluestorm>
ok
<jordan->
calling print_newline doesn't do it
<bluestorm>
so (Printf.printf "%s\n%!") is the same than print_endline ?
<pango_>
bluestorm: from functionality point of view, I'd say yes
<jordan->
I have (print_string x; print_string y; print_newline (); my_func t)
<bluestorm>
ok
Smerdyakov has joined #ocaml
<jordan->
btw is it good practice to nest if's as in: if then (if x then y) else y or is there a different ocaml idiom?
<pango_>
jordan-: sometimes that can be translated into pattern matching... When it's not possible, nested ifs are fine
<pango_>
jordan-: could you paste an example of non-working printing function ? (in http://nopaste.tshw.de/, or your favorite nopaste site)
<bluestorm>
pango_: do you think nopaste.... perform better than pastebin.be ?
<pango_>
bluestorm: anything but pastebin.com is fine (even if it seems more zippy than usual today... did they fix their problem ?)
<jordan->
yes, absolutely, one sec
<bluestorm>
pango_: but nopaste... hover on lines is weird
<pango_>
bluestorm: "don't do that then" ;)
<jordan->
ah my bad, i got it to work; thanks. also thanks for the pattern matching tip, it looks much neater than my nested ifs
_shawn has quit [Read error: 104 (Connection reset by peer)]
_shawn has joined #ocaml
bdbit has joined #ocaml
<bdbit>
hi all
<bdbit>
I'm trying to learn OCaml, may I bug you with some questions?
<bdbit>
firstly, this tutorial (http://www.ocaml-tutorial.org/the_basics) states, that there is no performance difference between "let rec" and "let". what is the use then in favoring one over the other in case you do not need recursion?
<bdbit>
moreover, is there any need for lookup tables in OCaml? I am planning on doing some very CPU intensive calculation (mainly factorials up to 52 and C(n,k) up to n=52, k=5). Would lookup tables help or hurt in OCaml?
<Snark>
lookup tables should help, I would say
<pango_>
if you don't use the "rec" keyword, the use of current function/value's identifier refers to previous definition (if one exists)
<bdbit>
the tutorial stated that. but is there any point in doing such a thing?
<bdbit>
i guess it has to do with "let fact 0 = 0; let fact n = n */ fact n" ?
<pango_>
that's not unusual for values... let x = read_line () in let x = int_of_string x in let x = x + 5 in ...
<bdbit>
ahh
<pango_>
(whether it's good style depends on taste and cases)
<bdbit>
that means i have to type let everytime i want to reuse a variable?
<bdbit>
*redefine
<pango_>
that's no different from any other definitions
<bdbit>
ahh.
<pango_>
some use it for functions too, but I find ioften more confusing
<bdbit>
is it good style to use "let" for variables and "let rec" for functions`
bluestorm is now known as bluestorm_aw
<pango_>
nested functions definitions are usually a better alternative
<bdbit>
could you provide an example`
<pango_>
(to functions redefinitions)
<pango_>
I only use let rec when needed
<bdbit>
i wouldn't ever use a function redefinition ever O_o
<bdbit>
couldn't think of a case
<pango_>
makes it easier to spot recursive functions, for one
rillig has joined #ocaml
<bdbit>
duh
<bdbit>
i'll brb, forgot to start irssi under screen
bdbit has quit ["leaving"]
bdbit has joined #ocaml
<bdbit>
re
<bdbit>
is there something like an OCaml style guide?`
<mellum>
bdbit: It rather seems you have too much of it.
<mellum>
It's usually a good idea to do everything as high level as possible and optimize later.
<bdbit>
of course, but I already kind of have it laid out in my mind
<bdbit>
already implemented it in ruby :-)
<mellum>
and it's too slow?
<bdbit>
(even profiled it to 1/10th runtime already)
<bdbit>
*and optimized
<bdbit>
yes
<mellum>
well, beating ruby shouldn't be too hard ;)
<bdbit>
i get to about 100.000 value retrievals per second
<bdbit>
by switching to Ocaml I expect a performance gain of up to 1:20
<bdbit>
that would mean roughly 2.000.000 values per second, that's nearly the whole table. this kind of performance just HAS to suffice, with 100k I'm not too sure ;-)
<bdbit>
(besides, I want to learn functional programming and OCaml has strangely appealed to me for some time anyway ^^)
bluestorm_aw is now known as bluestorm
<mellum>
bdbit: but arrays are not functional :)
<bdbit>
mellum: is there a functional table of speeding up the calculation of an algorithm like factorial?
<bdbit>
s/table/way
<mellum>
well, you can have functional data structures that work like arrays, but they tend to be somewhat slower.
<bdbit>
I need it many, many times a second, all the same factorials... I suppose I cannot rely on the optimization optimizing my calls away?
<mellum>
lazy functional programming languages like Haskell would, but not ocaml.
<bdbit>
ahh, true. it would probably fix up the function to only regard n = 0..52 because nothing else is ever used..
<bdbit>
but I don't see this deviation as a counterindication for OCaml and a big plus for Haskell
<pango_>
!52 is large...
<bdbit>
although I'll probably learn that, too, later on
<bdbit>
yep
<mellum>
It's only 80658175170943878571660636856403766975289505440883277824000000000000.
<bdbit>
enough multiplications to be indexed
<bdbit>
at least in ruby this brought 1:5 performance
<bdbit>
^^
<mellum>
In Ocaml, int can only store numbers up to 2^30, so you would need another type, BTW.
<mellum>
Which would also eat up most of the speed gain.
<bdbit>
I know, I will be needing Bignum, Big_int or whatever it is called, in any language anyway
<mellum>
well, for some languages the default integer type has infinite precision.
<bdbit>
actually the result of the C(n,k) stuff is much smaller (up to 2.6 million) and that's the only used stuff once the table is built
<mellum>
anyway... need to go now. see you
<bdbit>
see you, have a good time
<bdbit>
i'd even get the 2.6M into a nativeint
<pango_>
only int is unboxed, however; nativeint may only be unboxed locally in registers, I think
<pango_>
so better just use ints
<pango_>
2**30 is large enough for 2.6M
<bdbit>
what does unboxed mean? :>
chessguy has joined #ocaml
katatsumuri has joined #ocaml
<oxygene>
bdbit: a plain array instead of an array of pointers, basically
<bdbit>
pango_: yah, you're right. I was missing three orders of magnitude :D
<bdbit>
oxygene: fine, that's what I am trying to achieve in the long run.
<bdbit>
but if the performance suffices, I will probably be keeping it cleanly functional anyways.
<pango_>
in the int/nativeint choice, it makes no stylistic change
<bdbit>
yeah, completely true. but the whole lookup table thing.
<pango_>
s/change/difference/
<bdbit>
i understood you.
<bdbit>
hm, I'm pretty troubled keeping my "I's" big.
<katatsumuri>
Can I access the fields of a record that is defined in a module without opening the module?
<setog3>
what is .annot file ? and how to use it ?
<pango_>
yes, recordname.Module.fieldname
<katatsumuri>
wow. a bit weird :-)
<bdbit>
that syntax really looks freaky
<pango_>
setog3: I suppose you mean what's generated using -dtypes ?
<katatsumuri>
can i do it by defining an .mli file in some way? now i just use .ml files
<pango_>
setog3: it's types inferred by the compiler, with offsets in the source... You can use them for example with emacs' tuareg-mode (caml-mode too I think) with C-c C-t
<pango_>
katatsumuri: you can see inferred .mli interface with ocaml{c,opt} -i
<setog3>
pango_: Hmm .. and vim .. to make a .annot file for my file.ml .. I need to use ocaml -dtypes ?
<pango_>
setog3: ocaml{c,opt} -dtypes, yes
<katatsumuri>
pango_: I worked fine, thanks. Will check that option out now.
<chris2>
velco: i'd use scanl1 (*) [1..]
<velco>
chris2: I'm not sure, maybe scanl1 has qudratic compexity ?
<chris2>
velco: why should it?
<velco>
hmm
<velco>
ok
<chris2>
and you dont need to unzip
<velco>
yeah
<velco>
I'm noob.
<pango_>
in OCaml you'd need let rec gen n fn = [< '(n, fn); gen (n+1) ((n+1)*fn) >] in gen 1 1 ... not as cute ;)
<chris2>
velco: map (\n -> product [1..n]) [1..] should be quadratic, but somehow still very fast
chris2 has quit ["Leaving"]
<setog3>
pango_: thx, but I need to compile with -dtypes all my file .; but it's work fine
<bdbit>
is this what functional programming is all about?
<pango_>
setog3: and what's nice, is that when compilation fails, you still get the annotations up to failure point
<pango_>
bdbit: you can use recursion in some non functional languages too
<pango_>
bdbit: but the only way to "loop" in pure functional languages is thru recursion
<bdbit>
pango_: of course, but nobody would use it to create a loop that reads in dat
<bdbit>
data
Snark has quit ["Leaving"]
<bdbit>
so, this way of reading in data is good style and doesn't cause problems? (like a stack overflow, or amassing of references to the function)
<setog3>
who is the gui who use vim here for ocaml ?
<bdbit>
I know I'm being a bit agnostic here, but I'm trying to grasp the concept :>
<pango_>
I read that some C compilers optimize tail recursion, so it's not so far fetched
<velco>
gcc does
<velco>
optimize tail calls
<velco>
not only recursive
<bluestorm>
bdbit:
<bluestorm>
[21:42:48] <bdbit> actually the result of the C(n,k) stuff is much smaller (up to 2.6 million) and that's the only used stuff once the table is built
<bluestorm>
i may be late
<bdbit>
bluestorm: it's really not.
<bluestorm>
but why do you need to calculate 52! to have C(40, 52) btw ?
<pango_>
bdbit: the example of ocaml-tutorial is a recursive function that's compiled in an iterative process for any compiler or interpreter that does tailrec optimization
<pango_>
s/compiled/translated/
<bdbit>
bluestorm: i need to calculate 52! to have C(52,0..5)
<bdbit>
pango_: oh. so it's pretty much the way functional programmers "do it"?
<bluestorm>
hm
<bdbit>
I think for now it'll be best to disregard any translation or optimization details and just be a believer. :>
<bdbit>
bluestorm: you know C(n,k)? I suppose that's why you're asking?
<bdbit>
setog3: if you manage to find him, I'd like to do OCaml with ruby, too
<bluestorm>
bdbit: i know it
<bluestorm>
and it seems me you don't need 52!
khaladan_ has joined #ocaml
<bluestorm>
C(52, 1) for example don't need 52!, does it ?
<bdbit>
bluestorm: but with C(52,2) for example i need 52! / (2! * 50!)
<bluestorm>
hehe
<bluestorm>
this is just 52 * 51 / 2
<bluestorm>
no need to compute the whole 52!
<bdbit>
bluestorm: I never thought about optimizing C(n,k), I'm too little a mathematician to even consider it
<bluestorm>
(hm, i may be wrong of course, but it seems right)
<pango_>
bdbit: that example is not purely functional either (it uses side effects on Buffers)
<bluestorm>
hm
<bdbit>
I think you're right
<bdbit>
but I don't know how to formulate it right
<bdbit>
there must be a reason the definition is n! / (k! * (n-k)!)
<bdbit>
and I hope it is not "just because it looks good"
<bluestorm>
the reason is it's easier to say than (n)(n-1)(n-2)...(n-k+1)/k!, i think
<bdbit>
yes, I think I just miss the basic functional idea ;)
<pango_>
or easier to prove properties with
khaladan- has joined #ocaml
<bluestorm>
i seems me bdbit than C(52, k) is easy when k is little, because you only have to do around k multiplications for 52!/(52-k)!, and k! is pretty quick
<bluestorm>
when k is big (more thant 26) you can revert to 52-k
<bluestorm>
so the stress point seems to be C(52, 26)
<bdbit>
I do get your point, but I'd get around this by just using a lookup table. It'll be faster than anything else, regardless of the way I choose to implement
<bdbit>
I need only n=0..52 and k=0..5 anyway
swater_ has joined #ocaml
<bluestorm>
hum
<bluestorm>
k=0..5 is pretty easy
<bdbit>
I am thinking about a function definition in OCaml for C(n,k) right now
khally has joined #ocaml
<bdbit>
but my functional understanding is this small *makes gesture with hand*
<bdbit>
pango_: I'd like to try to "get it" via cold, hard, long and tedious looking-at-it because that proved to be most imprinting long time... Or do you regard this as ill-advised?
<pango_>
I'm not sure it will work with either courses or nice books
<bdbit>
If I don't like books for any one topic, it's programming.
[1]khaladan has joined #ocaml
<pango_>
well, it teaches interesting things, like how to represent drawings with functions, etc.
<bdbit>
my thinking architecture does not allow for efficient processing of such information
<bdbit>
this is why I usually just ignore it...
<pango_>
why would it be unefficient ? cpu spend their time processing code anyway
<bdbit>
I tend to be kind of fragmentary by design
<pango_>
and functions are code, right ?
<bdbit>
pango_: inefficient in _my mind_
<bdbit>
I don't "get it" fast enough for it to be useful to me
[2]khaladan has joined #ocaml
<pango_>
better late than never
<bdbit>
of course, but there are more important things to learn first, before going into the details of representing drawings with functions, don't you agree?
<pango_>
I don't really agree
<bdbit>
It's not that I would regard it as uninteresting. But I don't seem to have any need for it right now.
[3]khaladan has joined #ocaml
<pango_>
the point is not to get into the details of representing drawings as functions, rather use it as an example of functional mindset
<pango_>
(that you'd like to learn, or so I heard)
<bdbit>
I don't know if this comes across... From experience I know that I have a troublesome time trying to understand such things, they seem like university mathematics to me
<bdbit>
If I "just do it", in the end I don't know the theoretical stuff, but I can well do without in 80% of cases
<pango_>
but functional programming is basically mathematics
<velco>
every "kind" of programming is mathematics
<pango_>
it's as close to mathematics as you can get in programming languages
<pango_>
bdbit: the missing 20% were enough to miss bluestorm's optimization...
khaladan_ has joined #ocaml
<bdbit>
pango_: I understood what he was talking about. I thought about this myself. I'm just a little narrow-minded at the moment. And I'm trying to figure out a way to put it into OCaml without ever having written a line of OCaml before :-)
<bluestorm>
would it help you if someone else showed a code to do this ?
khally has quit [Connection timed out]
<pango_>
do what ?
<bdbit>
bluestorm: I'm currently trying to figure it out myself, expecting it to be 2-4 lines.
<bdbit>
If I absolutely can't find a way to do it, I'll make sure to ask ;)
<bluestorm>
hum, code to record C(0..52, 0..5) in an array
<bluestorm>
hm
<bluestorm>
btw bdbit
<bluestorm>
never heard of Pascal Triangle ?
<bdbit>
I do know the pascal triangle
<bluestorm>
hum
<bluestorm>
it could help
[1]khaladan has quit [Success]
<bluestorm>
because i think k=0..5 restriction on such Triangle doesn't change anything
<bdbit>
give me some time to grasp the paradigm before we move on to new territory :>
<bluestorm>
^^
[2]khaladan has quit [Connection timed out]
khaladan- has joined #ocaml
<velco>
pt 0 = [1]
<velco>
pt n = 1 : (zipWith (+) prev (tail prev)) ++ [1] where prev = pt (n - 1)
<bdbit>
could we try to work it out together? I tell you what I want to do, you give me the code ^^
<bluestorm>
hum
<bluestorm>
just try and hope code will appear ^^
<bdbit>
it's probably pretty easy anyways
[3]khaladan has quit [Connection timed out]
<bdbit>
well at the moment I'm stuck with "let rec part_fact n k" and how to recurse that
<bluestorm>
(i think you could do a pretty easy implementation using Pascal Triangle : maybe no even need of functional recursive stuff)
<bdbit>
my idea is to have an anonymous function which calculates the products down to a specified number
<bdbit>
like... part_fact(n, n-k+1)
[4]khaladan has quit [Connection timed out]
<bdbit>
then use this function in another that is roughly: "let choose n k = part_fact n (n-k+1) / part_fact n k
<bdbit>
is that remotely correct?
<bluestorm>
(with parentheses around (part_fact n k) and the other in the division)
<bdbit>
sorry, the second part_fact should be n 0
<bluestorm>
hm
<bdbit>
= a normal factorial
<bdbit>
^^
<bluestorm>
you could implement it this way
<bdbit>
actually even "part_fact k 0" .....
<bluestorm>
hm
<bdbit>
"let choose n k = (part_fact n (n - (k + 1)) / (part_fact k 0)" <-- this way?
<bluestorm>
yes
<bdbit>
supposing I already have part_fact
<bdbit>
ok, how could I do part_fact recursively?
<bluestorm>
hum
<bluestorm>
do you know how to code a simple fact recursively ?
<bluestorm>
(maybe easier, and easy to change to get part_fact after that)
khaladan has quit [Connection timed out]
khaladan- is now known as khaladan
<bdbit>
I'll try my luck (keep in mind, I'm cheating a little by using google)
<bdbit>
"let rec fact n = n * (fact (n-1))"
<bluestorm>
hum
<bdbit>
I haven't understood how to take the 0 into account though
<bluestorm>
infinite loop ^^
<bdbit>
there's something with | there
<bluestorm>
hum
<bdbit>
but I didn't get that
<bluestorm>
just use if/then/else
<bdbit>
ouch
<bdbit>
;(
<bdbit>
I wanted to avoid that
<bluestorm>
why ?
_fab has quit [Read error: 110 (Connection timed out)]
<bdbit>
it seems so unfunctional ;)
<bluestorm>
if / then / else is perfectly functionnal
<bluestorm>
-n
dark_light has quit [Remote closed the connection]
<pango_>
it's functional, when if/then/else is an expression instead of a statement :)
<bdbit>
wasn't there a different notation for the if/then/else?
<bluestorm>
hum
<bluestorm>
pattern matching is some kind of very powerful condition
<bluestorm>
( the function ... | .... | ... you may have seen )
<bluestorm>
but if/then/else is better for part_fact anyway
_fab has joined #ocaml
<bdbit>
in Haskell I saw: fact 0 = 1 ; fact n = n * fact (n-1)
<bdbit>
that seemed pretty to me
<bdbit>
and, yes, bluestorm, I was referring to the | notation
<bdbit>
so it would be "let rec fact n = if n = 0 then 1 else n * fact n - 1"
<bdbit>
that's pretty ugly if you ask me
<pango_>
and incorrect (parenthesis!)
<bdbit>
duh.
<bdbit>
.oO( And I was hoping to escape that jungle by not choosing Lisp.)
<pango_>
you can use begin and end if you don't like parenthesis :)
<bdbit>
lol
<bdbit>
let rec fact n = if n = 0 then 1 else n * fact begin n - 1 end ???
Slack4020 has quit [Remote closed the connection]
<pango_>
yup, would work too
khaladan_ has quit [Connection timed out]
<bdbit>
to quote the Garfield comic: "The neighborhood get's weirder by the minute"
<pango_>
blocks are expressions too
<bdbit>
I know that from ruby. It "borrowed" it.-
<bdbit>
but I dislike it.
<bdbit>
(not blocks returning values, but the look of that function"
<bdbit>
it's a lot more beautiful in Haskell :/
<pango_>
with pattern matching you can write it as let rec fact n = match n with 0 -> 1 | n -> n * fact (n-1)
<bdbit>
can that be abbreviated? it doesn't look nice either
<pango_>
or, shorter, let rec fact = function 0 -> 1 | n -> n * fact (n-1)
<bluestorm>
hm pango_
<bdbit>
that's more appealing
<bluestorm>
hum
<bluestorm>
with part_fact
<bluestorm>
you'll need to have if/then/else
<pango_>
for nicer things, you'll have to go for Haskell ;)
<bluestorm>
or some guards on pattern matching
<bdbit>
pango_: Haskell didn't convince me in terms of syntax anywhere else I was looking at.
<bluestorm>
let rec fac n = if n = 0 then n else n * fac (n - 1)
<bluestorm>
i don't see any parenthesis jungle over here
<pango_>
bdbit: yet you liked velco's list comprehensions :)
<velco>
pt = [1] : [1 : (zipWith (+) x (tail x)) ++ [1] | x <- pt]
<velco>
someone mentiones pascal's triangle :P
<bdbit>
seems to me that velco has a pretty unhealthy obsession ^^
<velco>
heh
<bdbit>
velco, fetch! world formula in Haskell! :-)
<velco>
I'm learning Haskell ATM and take every chance to write a tiny snippet here and there ...
<bdbit>
hehe ;)
<velco>
bdbit: world = 42
<velco>
there
<bdbit>
bluestorm: it's okay, but as a one-liner it's a bit ugly
<bdbit>
that's the result, not the formula
<pango_>
*g*
<malc_>
velco: wrong
<malc_>
universe = 42
<bdbit>
bluestorm: do you have an idea for part_fact?
<bluestorm>
[23:31:35] <bluestorm> let rec fac n = if n = 0 then n else n * fac (n - 1)
<bluestorm>
just change this
<bdbit>
I'll try and look at it again.
MisterC has quit [Remote closed the connection]
<bdbit>
I'm stuck.
<bdbit>
I need the starting value of "n" which I lose with a declaration like part_fact n k
<bdbit>
I would have to compare "current n" to "static n-(k+1)" for each recursion
<bluestorm>
just add an argument
<bdbit>
bluestorm: ouch. isn't it possible without that?
<bluestorm>
hm
<bdbit>
I would very much like to have part_fact n k
<bdbit>
with an argument it's clear even to me...
<bluestorm>
yes, part_fact n k seems possible
<bluestorm>
hum
<bluestorm>
part_fact n (n-k+1), actually
<bdbit>
argh
<bdbit>
I think it's not the functional idea that's causing my trouble X_x
postalchris has quit ["Leaving."]
dibblego has joined #ocaml
<bdbit>
i suppose it works
<bdbit>
let rec part_fact n k = if n <= k then 1 else n * part_fact (n-1) k;;
<bdbit>
I don't think it's too pretty but it seems to do the job
velco has quit ["I'm outta here ..."]
<bdbit>
although it seems to contain a fencepost error
malc_ has left #ocaml []
love-pingoo has quit ["Connection reset by pear"]
<bdbit>
yeah. it works.
<bdbit>
thanks for all your pointers
<bdbit>
I gtg to bed... it's 0:20 hier
<bdbit>
here
<bdbit>
good night or good day ... whatever matches first
bdbit has quit ["leaving"]
katatsumuri has quit ["Leaving"]
delamarche has joined #ocaml
delamarche has quit [Client Quit]
delamarche has joined #ocaml
bluestorm has quit ["Konversation terminated!"]
duncanm has quit [Read error: 110 (Connection timed out)]