flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
chickenzilla has quit ["J'y trouve un goût d'pomme."]
slash_ has quit ["leaving"]
<thelema> wsmith84: probably similar, but I'm no expert on f# libraries
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
Yoric[DT] has quit ["Ex-Chat"]
_zack has joined #ocaml
Camarade_Tux has quit ["Leaving"]
jamii has joined #ocaml
_zack has left #ocaml []
Mr_Awesome has joined #ocaml
anryx has quit ["Leaving"]
AxleLonghorn has joined #ocaml
NyNix has joined #ocaml
<wsmith84> I'm reading the OReilly book right now, section on efficiency, and have a question...
<wsmith84> there is a note, this note:
<wsmith84> "Being purely functional has a cost. Partial application and using functions passed as arguments from other functions has an execution cost greater than total application of a function whose declaration is visible. Using this eminently functional feature must thus be avoided in those portions of a program where efficiency is crucial. "
<wsmith84> Now, I know how partial application is implemented in some dynamic languages
NyNix has quit [Client Quit]
<wsmith84> a new function is manufactured and the parameters captured, so you end up having two function calls for one call of the partially applied function.
NyNix_ has quit ["leaving"]
<wsmith84> But... I really thought this was optimized out at compilation in functional languages
NyNix has joined #ocaml
<wsmith84> I mean, if you partially apply with a constant, this kind of optimization should be doable, no?
<wsmith84> Ah.... no.. I realize I'm staying something silly just now.
<wsmith84> You cannot know in advance how it's been partially applied...
<wsmith84> hmm. gotta thing about this more.
<wsmith84> s/thing/think/
<jft> for the Printf.printf module a %s prints a string, is there are % something that will print (), the unit?
<thelema> wsmith84: in ocaml, partial application always produces a closure
<thelema> non-functional languages have only one case - application of a n-ary function with n arguments.
<thelema> functional languages have three cases, n-ary function, m<n arguments, m=n arguments and m>n arguments (the function returns a closure which gets applied to the remaining values)
<thelema> jft: why do you want to print ()?
<jft> i have a function that returns () because it prints something, and i need to call it in this particular spot
angerman_ has joined #ocaml
<thelema> jft: to answer your question, no - there isn't.
<jft> hmm
<jft> Printf.printf "some text" SomeFunction()
<thelema> you might be able to do something with %a
<thelema> why can't you evaluate all the arguments first, and then do the print?
<jft> i can't use imperative features
<thelema> you're using print. that's imperative.
<thelema> have the function return the string it would print, and use %s
<jft> yes, it's the only function i can use with a side effect
<jft> i think i can get it
<thelema> and let bindings aren't imperative.
<jft> because my Function( (), a, b) takes unit as a parameter so i can just put the Printf.printf() in side of that, like Function( Printf.printf(), a, b)
<thelema> I guess you could do printf "%a" (fun _ _ -> ()) my_function
<thelema> why take unit as a parameter?
jeddhaberstro has joined #ocaml
Hadaka has quit [Read error: 60 (Operation timed out)]
<thelema> There's reasons to take it as your last (or only) parameter, but as the first parameter?
<jft> i send Printf.printf() to the function with a () parameter
<thelema> that will execute the printf first
<jft> allows for the side effect and doesn't need it to be called inside the function
<jft> yes, thats what i need
<jft> it's a bit strange
* thelema doesn't understand the silly logic of asking for a program that does IO but allowing no imperative features.
<jft> it's an assignment on purely function programming, but in order to print the information we are allowed to use Printf.printf
<jft> it's hard for me to explain, i don't know enough about ocaml, i was just told to use printf as a side effect
<thelema> you still need some sort of sequencing operation, and it's quite poor style to make extra function arguments just so you can do void functions.
<thelema> If I were you, I'd use [<code>; Printf ... ; <other code>]
<jft> is that code executing in a list?
<wsmith84> thelema: yes, I understand. I have this bias about ML to imagine that compilation does so much more, but I should think of it at the same level as LISP.
<wsmith84> thx
<wsmith84> Another question about closures:
<wsmith84> in the OReily book, here:
<wsmith84> there is a figure. The figure seems to imply that each of the two returned functions has a separate copy of the environment.
<wsmith84> i.e., the are two of them containing the binding "c", but which shares the contents.
<wsmith84> I don't see why they could not share the environment itself (it's immutable, isn't it?)
<wsmith84> (I suppose that's an important detail and the implementation of the compiler.)
<wsmith84> Any idea?
Demitar has quit [calvino.freenode.net irc.freenode.net]
mishok13 has quit [calvino.freenode.net irc.freenode.net]
<thelema> IIRC, it has something to do with space efficiency
Demitar has joined #ocaml
mishok13 has joined #ocaml
<thelema> for this particular example they could share the environment
Naked has joined #ocaml
Naked is now known as Hadaka
<wsmith84> I guess the bottom line is whether the environment is mutable or not.
<thelema> but if they used different parts of the environment, they'd need two environments
<thelema> if the closure captured the whole environment, nothing from that environment would be able to be GC'd until that function left scope
<wsmith84> Not sure I understand your comment. They're using the same environment, and the environment is presumed immutable, no reason to have two copies.
<wsmith84> (Same argument about the fact strings should be immutable as well...)
<thelema> when you make a closure, it captures a minimal slice of the environment
<wsmith84> Ah I see,right
<wsmith84> of course.
<wsmith84> That's it.
<wsmith84> Thanks man, it's obvious now.
<thelema> ok.
<wsmith84> If they used two bindings in the example it would have been made obvious. A poor choice of example, that one.
<jft> @thelema: when you said code could be executed in the list, can you do something like [Printf.printf(); Printf.printf()]?
<wsmith84> Man this is so much fun.
<brendan> let _ = Printf ... in
<sbok> fun, except when you can't install OCaml on one of the the machines for your CS dept :-(. I guess I'll just do that project in C++ now (an interpreter for a small functional language)
<wsmith84> sbok: doesn't everyone in school work from their laptops now anyway?
<thelema> jft: no, but that would work too. Watch out for the right-to-left evaluation of arguments
<wsmith84> sbok: can't you jsut do a local install in your ~
<sbok> wsmith84: Yes, but one of the requirements is that the grader is able to run it from one of the dept machines. (ridiculous). And combined with draconian policies in place by the sysadmins, our /home quotas are super low (think 75MB). Plus, I thinK I waited until it was too late to ask for extra space (it's due in a week)
<sbok> And htis is a graduate course >.<
<wsmith84> sbok: wow. I didn't know things hadn't evolved... reminds me of old times in uni.
<sbok> Yeah, I'm pretty sure the rules haven't changed since the early 90s, :-)
<wsmith84> ouf... you have to get chummy chummy with the sysadmin man, this is how you'll survive in this environment :-)
<jft> any of yall ever use Citrix products?
<wsmith84> sbok: just hand him a native binary ;-)
<thelema> wsmith84: you beat me to it
<sbok> wsmith84: I'm actually able to do that -- but I guess they want to compile the source themselves to make sure that you haven't cheated
<wsmith84> sbok: statically linked, it should run. And get pedantic about the rules when they complain... haha
<sbok> Yeah, it does run.
<thelema> give them the source and a binary, and if they can't compile it... or read it...
<thelema> I don't see how having the source means you didn't cheat.
<sbok> I'm not sure, but they require a makefile, etc... and I already asked if just submitting a binary and source was okay, but apparently not. It's okay though, it'll give me an excuse to learn C++ :-)
<wsmith84> ouf
<sbok> which i'll be using this summer, so i might as well get more experience with it.
* wsmith84 wonders if he'd have spent years fiddling with C++ if he had know ML or Python beforehand
<wsmith84> likely not.
<sbok> For personal stuff, I use Python, C, and OCaml
<sbok> but enough of my complaining... it's not that bad. could be worse :P
<wsmith84> What's the course?
<thelema> compilers, I bet
<wsmith84> haha
<sbok> Similar.
<thelema> !! you could write it in itself.
<sbok> "Programming Language Principles", with an emphasis on functional languages, sort of.
<sbok> I took the grad version instead of undergrad because it has a focus on FP
<wsmith84> In a way it makes perhaps a little sense you should have to bootstrap it in C.
<wsmith84> Allright, l8r ML hackers, dinner time; thelema: thx for your continued and persistent assistance.
<thelema> you say 'small functional language' - big enough to write a compiler in?
<thelema> s/compiler/interpreter
<sbok> http://rpal.sourceforge.net/ the language in question
<thelema> you already have an interpreter for the language - you don't even have to deal with bootstrapping.
<thelema> okay, maybe it's too minimal
<sbok> oh, the goal is not to write the language with itself
<thelema> but if you did, that would satisfy the grader, as they
<thelema> 'd be able to run your source code.
hkBst has quit [Remote closed the connection]
angerman_ is now known as angerman
<gildor> ertai_: I find (and almost fix the problem), it comes from win32unix (Unix) module, the function WSACleanup takes almost 3 seconds, which means that foreach ocamlfind invocation (I use ocamlfind in ocambuild) takes 3 seconds
<gildor> ertai_: in the end I compile my 50 files in 5 minutes due to all the WSACleanup call
<gildor> ertai_: this is a huge time gain for all application that use Unix module, without using its network part
<thelema> WSACleanup terminates the use of winsock2 dll. 3 seconds!
<thelema> okay, so you need to ... only use WSAStartup when you need it?
<gildor> thelema: yep
wsmith84 has quit [Read error: 113 (No route to host)]
<gildor> thelema: just need to implement a global variable + init/cleanup function conditional to this variable
<gildor> it even makes my own program faster (for short living program this really make a difference)
xah_lee has joined #ocaml
<xah_lee> is there a typeof function?
<thelema> xah_lee: no - types don't exist at runtime.
* gildor happy to have found and almost solve a bug, decide to go to bed
<xah_lee> thelema: ic. For teaching or learning purposes, is there a way to print a value's type then?
<xah_lee> other than using the interactive interpreter
<thelema> toplevel is the way.
<thelema> at runtime, there's no way to distinguish between the number 0 and the boolean false.
<xah_lee> thelema: umm.... k. thx.
<thelema> but since ocaml is statically typed, if it's a boolean, only boolean functions can use it.
<xah_lee> if i have this: type t1 = X;;
<xah_lee> X;;
<xah_lee> what would be the value of X?
<thelema> same as 0 and false.
<xah_lee> btw, i'm a beginner.
jeddhaberstro has quit []
<xah_lee> humm.. k.
<thelema> its runtime representation is the same as 0 and false.
<xah_lee> ic.
<thelema> # open Obj;;
<thelema> # magic(0) = None;;
<thelema> - : bool = true
<thelema> # type t1 = X;;
<thelema> type t1 = X
<thelema> # magic(0) = X;;
<thelema> - : bool = true
<thelema> # (magic(X) :> int);;
<thelema> - : int = 0
<thelema> # (magic([]) :> int);;
<thelema> - : int = 0
<thelema> (same as the empty list)
<xah_lee> what dose the op :> do?
<thelema> not an operator, a syntactic construct - nothing happens at runtime, (foo :> type1) casts the value foo into the type type1. (needed in rare occasions)
<xah_lee> ic
<thelema> There's no change to representation, so I'm just demonstrating that at runtime, 0 == false == None == []
<thelema> I need Obj.magic to keep ocaml from complaining. normally this isn't useful.
<AxleLonghorn> when is magic useful?
<thelema> when you want your program to segfault.
<thelema> it's very difficult to replicate the segfault feature of C/C++ without it.
ched_ has joined #ocaml
ched__ has quit [Read error: 110 (Connection timed out)]
<AxleLonghorn> heh
<xah_lee> so in type t1 = X;; the X is called constructor?
<xah_lee> * type constructor.
<AxleLonghorn> yes
<xah_lee> kk
<AxleLonghorn> it doesn't really look like a constructor unless you have a "type t1 = X of string;;"
<xah_lee> is there a name just for the X?
<AxleLonghorn> as far as I know it's called a type constructor
<xah_lee> as in type testResult = PassTest | FailTest | Undecided;;
<xah_lee> kk.
bohanlon has quit ["I fear that I must depart for now."]
<AxleLonghorn> though I guess if you were going to use it like that you might as well call it an enum
<AxleLonghorn> is there a better way to handle the awkward "module Set = Set.Make(Ord);; include Set"
bohanlon has joined #ocaml
<AxleLonghorn> I want to return the same thing that Set.Make(Ord) does save for the additional lexico_compare function
wsmith84 has joined #ocaml
alexyk has joined #ocaml
<alexyk> I need to create a list from an array slice (left,right); how efficient is Array.sub -- does it create a new array? And if I do for i = left to right, how'd I assemble the list -- with a ref?
xah_lee has quit ["banned in #emacs by johnsu01 (john sullivan)"]
<AxleLonghorn> yes, Array.sub produces a new array
<AxleLonghorn> the documentation says "Array.sub a start len returns a fresh array of length len"
<wsmith84> in the source also, it's not an external, it calls create
* alexyk mutters omg I just missed xah_lee, the living legend
<alexyk> so OK, Array.sub is out; what I have is a huge dataframe I represent as array of rows. I need to select a column from each row in a segment. The simplest is for i = left to right..., but how do I assemble a list? The row is a record type so the column is just e.c
<AxleLonghorn> well, you can be wasteful and do things the functional way. for example: Array.fold_right (build_list) (Array.sub ...)
<AxleLonghorn> actually, nevermind
<AxleLonghorn> you don't have to use a reference when not using Array.sub
<AxleLonghorn> use Array.iteri
<AxleLonghorn> let build_list list index aval = ...
m3ga has joined #ocaml
<AxleLonghorn> Array.iteri (build_list []) e.c
<alexyk> iteri goes through the whole array; in my case millions of rows; won't do
<alexyk> I heed a segment only
<AxleLonghorn> here's the entirety of iteri: "let iteri f a = for i = 0 to length a - 1 do f i (unsafe_get a i) done"
<alexyk> need that is... so access with for i works best
<alexyk> wow, iteri was fast
<alexyk> but build_list will be unit here and needs to return the list
<AxleLonghorn> yeah... I dunno what to tell you, looks like you'll have to use a reference
<AxleLonghorn> On this page: http://www.ocaml-tutorial.org/if_statements,_loops_and_recursion, it says that for loops are syntactic sugar for "let i = 1 in do_next_job(); let i=2 in..."
<AxleLonghorn> is this true?
<alexyk> AxleLonghorn: that's what I'm trying to get :)
<thelema> AxleLonghorn: true enough. It's probably more like [let i = i + 1] instead of [let i = 2], and there's some overhead of testing to see if the loop is done.
<alexyk> thelema: but how do you pass variables across let's? i.e. to grow a list
<alexyk> from the array slice?
<thelema> ?? pass variables?
<thelema> If you want to accumulate a value in a for loop, use a ref
<thelema> let a = ref [] in for i = 1 to 10 do a := i :: !a; done
<AxleLonghorn> thelema: would you mind taking a look at this? http://pastebin.com/d38b2f3ee
<AxleLonghorn> is there a better way to handle the awkward "module Set = Set.Make(Ord);; include Set"?
<thelema> well, that's not the usual way to define lexicographic orderings...
<thelema> Since you [include Set], you don't need to do things like [Set.is_empty]
<thelema> [is_empty] suffices.
<thelema> But yes, that's the standard way to make a child module - extending a module with additional values
<AxleLonghorn> thanks
<alexyk> thelema: that's what I feared... oh well... for goes with a ref I guess...
<AxleLonghorn> I'm using ocamlgraph in a project. It's hard to get used to functors and module stuff
<thelema> AxleLonghorn: ocamlgraph needs a module with a lexico_compare function?
<AxleLonghorn> no, a graph visualization algorithm I intend to make does
<AxleLonghorn> I mention ocamlgraph because it's the only real reason I've had to learn functors, thus the question, because I have a minimal understanding of what I'm doing
<thelema> ok.
<AxleLonghorn> coffman-graham layering, if you're interested
<thelema> well, it looks correctly implemented
<alexyk> AxleLonghorn: funny I'm writing a fun to help in ocamlgraph too
<wsmith84> I want to define an abstract type, but for now the defn contains only an integer.
<AxleLonghorn> cool, thanks thelema, what's the fun alexyk?
<wsmith84> I can use an algebraic data type, e.g. type decimal = Decimal of int;;
<wsmith84> ... with a single constructor.
<alexyk> Axle: just filling the graph from trajectories of people walking a sensor network...
<thelema> If you need more efficiency, maybe batteries' conversion function [enum_backwards] will let you compare enums instead of deleting elements from trees
<wsmith84> Now, however, it means whenever I use it or expect it in a function, I need to match .. with blablabla... everywhere, with a single type.
<thelema> i.e. walking the tree instead of mutating it.
<wsmith84> Isn't there a shortcut? Or perhaps another way of doing this?
<wsmith84> Eventually the definition of my type will change.
<thelema> wsmith84: private type abbreviations might work for you
<AxleLonghorn> wsmith64: if you want to keep the type constructor part, you can say "let foo (Decimal i) = ..."
<thelema> [type decimal = private int] - outside the module that defines this, decimals are read-only
<AxleLonghorn> *84
<wsmith84> thx Axle, this is what I'm looking for.
<wsmith84> It doesn't support overloads though, right? I could not do let foo (float i) = ... somewhere else, right?
<wsmith84> like you would in LISP.
<wsmith84> I'll just try it, never mind.
seafood has joined #ocaml
<thelema> no overloading in ocaml
<AxleLonghorn> why is that?
<wsmith84> thelema: will there be a way to hide the constructor later on when I export my module?
* wsmith84 should finish reading the manual before hacking
<thelema> That's exactly what module signatures do - hide things
jft has left #ocaml []
<wsmith84> Wow.. the printf module, interesting.
<wsmith84> I'm trying to figure out how to "sprintf fmt ... " with a computed fmt.
<wsmith84> A bit of continuation magic in there...
<wsmith84> How do you normally do that? e.g. I've done let fmt = ... in sprintf fmt ... ;;
<wsmith84> compiler not happy, I suppose I need to figure out the continuation to pass to ksprintf?
<thelema> wsmith84: how do you not have a fixed type to pass in to sprintf?
<wsmith84> I'm computing the format string at runtime.
<wsmith84> However, in this case it's only for the padding number, e.g.
<wsmith84> I create a string like "%d.%08d"
<wsmith84> so there number and types of parameters *is* fixed.
<wsmith84> How does the compiler normally figure out the required types for printf?
<thelema> magic at compile time. printf only works with string literals
<wsmith84> Doesn't look like magic in the source; looks like a function is manufactured which expects the right argumetns.
<wsmith84> well, an elegant form of magic :-)
* wsmith84 is mesmerized by printf.ml
<thelema> yes, it's very elegant.
<wsmith84> Oh yes, Obj.magic
<wsmith84> external magic : 'a -> 'b = "%identity"
<wsmith84> hmmm.
<wsmith84> so, thelema: how do I solve that then?
<thelema> the string literal is understood by the compiler as a [format6]. This can be converted to a string, but conversions the other way... dangerous.
<wsmith84> Is there a recipe for this?
<thelema> not using printf.
<wsmith84> I mean, this is a very common idiom...
<thelema> in your world, maybe. in ocaml, not so much.
<wsmith84> Well I suppose my world is starting to include ocaml :-)
<thelema> Of course there's other ways - convert to string and pad the string.
<thelema> rather, convert to string and blit into String.create " " n
<wsmith84> I just need to format as %08d, where "8" is variable, you're saying I should rewrite manually the code that does that.
<thelema> s/" "/' '/
m3ga has left #ocaml []
<thelema> You might be able to get away with Obj.magic, but I'd write it out to avoid magic.
<wsmith84> How about creating a sprintf variant that accepts a list instead? Oops, can't do that, homogeneous lists.
<thelema> the types on *printf functions are... magical, and a bit hard to manipulate.
<thelema> it wouldn't be difficult to write a function to pad an int
<wsmith84> Actually, not so magic, I think I just discovered somethign for myself, check this out:
<wsmith84> let myspf fmt =
<wsmith84> let f x y = (fmt, x, y) in f;;
<wsmith84> myspf "%s %s" 2 3 ;;
<wsmith84> the last line, the call... it seems like it takes the right number of parameters (it knows how much), calls the function, and then applies the result on whatever remains.
<wsmith84> Wow, that's quite nice, but ... perhaps a bit implicit.
<wsmith84> actually, that makes sense, since it knows all the types at compile time, I guess this is just a side effect of having currying capability throughout.
* wsmith84 is more and more mesmerized...
<thelema> it takes one parameter for myspf, gets a result, and applies the remaining values to that function
<thelema> it's like (myspf "%s %s") 2 3
<thelema> let f x y = (fmt,x,y) in f;; (syntactic sugar for:) let f = fun x -> fun y -> (fmt, x, y) in f ==> fun x -> fun y -> (fmt, x, y)
<wsmith84> This is truly wonderful. I mean, I'm not kidding, I feel my brain expanding in a strange new dimension.
<wsmith84> ;-)
<thelema> welcome to the world of functional programming
<wsmith84> I admit, this is one of the things that I don't see as much of in LISP.
funebre has joined #ocaml
seafood has quit []
<thelema> good night all
<NyNix> can anyone answer a very basic question for a new guy?
<wsmith84> good night thelema
<wsmith84> NyNix: I can try (but I'm a new guy too)
<NyNix> 84: thanks, this is really easy I am sure.
<NyNix> I am looping over a list, and would like to output each iteration to a new list-
<wsmith84> when you say "output each iteration" what do you mean exactly?
<NyNix> I am used to things like python, where you can do something like: for i in list : newlist.add i
<wsmith84> you mean "newlist.append(i)"
<NyNix> (yes)
<wsmith84> I think in this case it's better for you to convert it into a map.
<wsmith84> IF you output as many elements as the input list.
<wsmith84> If not, then you'll wnat to create a recursive function which takes the list that you want to add to (an accumulator).
<AxleLonghorn> or if you're just filtering things out, List.filter
<NyNix> I do- here is the whole issue- I am trying to loop over the list, and find the greatest product of 5 consecutive integers in it.
<wsmith84> Oh that sounds like a recursion conversion job :-)
<wsmith84> BTW you do have filter in list.ml
<NyNix> probably not
* NyNix doens't know how to check...
<wsmith84> but in your case, I think if you want to implement this one efficietnly you'd want to decompose the math a bit and build a recursive function with partial products
funebre has quit []
<NyNix> I can almost picture doing this in python, but I *cant* do it python. I would take the product of the 1st 5 and save as "a", then the next 5 and save as "b", then compare them, keep the larger one. etc.
<wsmith84> Or if you want to do this less effiiciently I imagine you could create your own version of map, e.g. map5, which would call a function for each consecutive quintuple, and then take the max of that. But it's not very elegant a solution.
<wsmith84> Yes, but then again, you're doing a lot of redundant products.
<NyNix> but this is my 1st foray into Ocaml.
<AxleLonghorn> I think, you'll want to do this with a fold
<wsmith84> e.g. a1 * a2 * a3 * a4 * a5 vs a2 * a3 * a4 * a5 * a6 contain a large common term.
<thelema> let rec loop = function e1 :: (e2 :: e3 :: e4 :: e5 :: _) as t -> found_max := max (e1*e2*e3*e4*e5) !found_max; loop t | _ -> !max_found
<AxleLonghorn> what thelema said
<thelema> wsmith84: multiplication is *cheap*
<brendan> boo, refs
<wsmith84> ahh come on
<NyNix> IC
<NyNix> (I think)
<thelema> if you want a second parameter, you could do it that way too.
<wsmith84> thelema: come on, generalize to n... ;-)
<AxleLonghorn> lol
<wsmith84> this is actually like a nice textbook exercise
<thelema> NyNix: homework?
<NyNix> My goal is to have it a) work ;) , b) be as *real* as possible and not too clumsy, and c) get me started on using ocaml for real problems.
<NyNix> basically
<NyNix> but not quite
<thelema> projecteuler?
<NyNix> I am too old to be in schoool anymore (unfortunately)
<NyNix> it's for a j-o-b prospect
<wsmith84> hehe
<NyNix> and they asked me for some code samples in other languages, and after that wanted to see something is ocaml.
<wsmith84> interviews coming up?
<NyNix> well, I have had them already, and I guess they thought they'd see how I did with something that I *hadn't* worked with before.
<NyNix> so I did my usual, and hopped on freenode or similar :)
<wsmith84> I'll try this one now.
<wsmith84> Good exercise for me too.
<NyNix> link to follow:
<NyNix> anyway- I am not trying to get "the answer" from you all, but have scratched my head alittle, and thought I wouldn't be breaking rules by asking for guidance...
<NyNix> so it is appreciated.
<thelema> NyNix: I thought I recognized the problem. Have fun with the code I provided. to be honest, I've forgotten how I solved that one, but my solution is in batteries' git tree if you look for it.
<NyNix> ok
<NyNix> thanks thelema
<NyNix> it's the sort of thing, if given time, I would try to solve once and then again another way, etc. etc. so I will check out your hints, and see what I can get out of that. It's hard to switch from thinking in 'loops'.
<NyNix> so thanks again.
<thelema> what I wrote is a loop. Just as you can convert the found_max from a ref into a parameter, you can make the list a ref too, and mutate it. You end up with a while loop.
<NyNix> ok,
<thelema> many recursive functions are just loops in disguise.
<wsmith84> I agree with Axle fold would be the better way to solve this.
<thelema> good night for real this time.
<NyNix> thelema: thanks again, and good night.
<NyNix> I was looking at fold, but was having an issue making it work. I don't have a good understanding of what is happening with List.iter, List.map, List.fold I guess.
<wsmith84> Try to implement the max of two elements first, with fold, and then crank it up to 5?
<NyNix> I can't find any examples of the usage of List.fold , I found one for List.iter but that only prints my results and I don't know how to get them into another list or a form I can use.. can you suggest a place where there might be a few examples of usage?
<wsmith84> list.ml
<NyNix> ok
<wsmith84> /usr/lib/caml/VERSION/list.ml
<NyNix> many thanks, I am so used to looking 'out' that I forgot to look in /usr/*
<wsmith84> Perso, I found the Graham Hutton book on Haskell is an excellent book for an introduction to that stuff.
<NyNix> I have the book by didier remy, but it's pretty theory laden.
<NyNix> (I think that 's who it is)
* NyNix reads over list.ml and feels relieved.
<wsmith84> Here's how to generate some test digits:
<wsmith84> let rec repeat f n = match n with
<wsmith84> 0 -> [] | _ -> f () :: repeat f (n-1);;
<wsmith84> let l1 = repeat (fun _ -> Random.int 10) 1000 in
<wsmith84> l1;;
<AxleLonghorn> so, when I said looks like a good problem for a fold, I didn't mean the library fold
<NyNix> Axle : you meant List.fold yea??
<AxleLonghorn> the List.fold expects a function that takes two values
<AxleLonghorn> that wont work for you
<AxleLonghorn> I was meaning something along the lines of what thelema wrote
<NyNix> alright. I will get working on it and see what I turn up.
<wsmith84> Axle: he could cook his own version of fold that's appropriate for that.
<AxleLonghorn> right
<AxleLonghorn> which was what I was thinking, but that's only if you really want to make a fold_right_5
<NyNix> My kitchen is not exactly stocked with supplies if you get my drift...
seafood has joined #ocaml
<wsmith84> Axle: actually, I think it may be doable with regular List.fold.
<wsmith84> hint: the result is a list of length 5.
<wsmith84> Iniital element: something like [1; 0; 0; 0; 0].
<wsmith84> I'll try it now.
<wsmith84> The trivial way would be to manufacture map5 and then compute the product of five shifted lists (tails of the original), and then take the max of that, but then again, wasting common products.
<brendan> I would be impressed if you got a speed gain on this problem by saving common products
<AxleLonghorn> lol, I made a fold_right_5 and got a stack_overflow using a list of the first line of digits in the project euler
<AxleLonghorn> problem
vitriol has joined #ocaml
kaustuv_ has quit [Read error: 113 (No route to host)]
angerman has quit []
vitriol has left #ocaml []
<wsmith84> brendan: it's obvious that depending on n at some point saving on common products will become faster.
<wsmith84> n = 100, certainly.
<brendan> at some point. I'm not sure it's 100
<wsmith84> brendan: why not just do the elegant thing anyway? Isn't that part of the beauty of recursion?
<brendan> the elegant thing doesn't look for common factors :)
<brendan> products that is
<AxleLonghorn> turns out the reason I got a stack_overflow is because there was something wrong with thelema's pattern matching.
<wsmith84> I beg to differ. (the code will speak for itself)
<NyNix> If I have a simple for loop, how can I output the value obtained at each loop into a new list? I have :
<AxleLonghorn> my fold5 version: http://pastebin.com/d29abe24b
<NyNix> for i = 0 to 100 do print_int List.nth i (basically) done;
<NyNix> how can I set up " do list.append(i) done or similar?
<AxleLonghorn> it's not easy
<NyNix> man
<NyNix> of course!
<AxleLonghorn> basically, you're going to want to say "let newlist = ref [];;"
<AxleLonghorn> "for i = 0 to 100 do newlist := i::(!newlist) done
<AxleLonghorn> trying again: "for i = 0 to 100 do newlist := i :: (!newlist) done"
<wsmith84> urg imperative ;-)
<AxleLonghorn> yar
Yoric[DT] has joined #ocaml
<AxleLonghorn> there's a reason it looks ugly in ocaml
* wsmith84 is being arrogant on purpose to set the bar higher and make sure he doesn't crap out and go to bed before solving this one ;-)
angerman has joined #ocaml
<AxleLonghorn> well, night all, it's been fun. good luck on the problem NyNix.
AxleLonghorn has left #ocaml []
jamii has quit [Read error: 104 (Connection reset by peer)]
<NyNix> I am going to head out too. Thanks for your help all. Speak to you all soon.
NyNix has quit ["Goodnight"]
seafood has quit []
Yoric[DT] has quit ["Ex-Chat"]
<wsmith84> I got it.
seafood has joined #ocaml
<wsmith84> It's VERY elegant.
<brendan> ok, what is it?
<wsmith84> (* Multiply the n first elements of a given list by y. *)
<wsmith84> let rec multhead n y l =
<wsmith84> if n = 0 then
<wsmith84> l (* Return the rest unchanged. *)
<wsmith84> else
<wsmith84> match l with
<wsmith84> [] -> []
<wsmith84> | x::xs -> y*x :: multhead (n-1) y xs;;
<wsmith84> (* Compute the maximum product of n values in the list l. *)
<wsmith84> let maxprod n l =
<wsmith84> let maximums =
<wsmith84> List.fold_left (fun acc x -> x :: multhead (n-1) x acc) [] l
<wsmith84> in
<wsmith84> List.fold_left max 0 maximums;;
<wsmith84> voila.
<wsmith84> here:
<wsmith84> oops
<wsmith84> full program.
<wsmith84> ya like it? :-)
<wsmith84> two simple folds: one to compute a list of maximum values for each set of fives, and one to reduce into the one maximum.
<brendan> shorter than mine :)
<brendan> though I do like my prodn
<wsmith84> (looking at it now)
<wsmith84> Oops just realizing I may be missing a List.rev or two.
<wsmith84> brendan: why do you bother checking the length of the list in prodn1?
<brendan> because firstn would raise an exception at the end of the list
<wsmith84> I'm not sure I understand... you call prodn with 5, and then you fold on the 5 firtst elements only?
<brendan> yeah
<wsmith84> but... you're not reusing the internal products?
<brendan> no
<wsmith84> I see.
<brendan> I decided int would overflow before it could make a difference :)
<wsmith84> thx for sharing your solution, I like to read other's code.
<brendan> thanks for yours too
seafood has quit [Read error: 110 (Connection timed out)]
<wsmith84> It isn't perfect either, I end up create O(4*n) cons cells.
<wsmith84> It would be more efficient with an array.
<wsmith84> This is fun, I love these little puzzles.
<wsmith84> Actually, I think it matters to try
<wsmith84> to reuse the internal products. On large input, this is the stuff that makes a difference.
<wsmith84> We used to do that kind of calculation reorganization for matrix computations when I worked with CG algos.
<wsmith84> It's just... so much more elegant in this high-level language.
<wsmith84> I'm excited.
<wsmith84> Oh well.
<wsmith84> It's 3am, time for sleep. l8r,
<brendan> night
wsmith84 has quit [""nighty night""]
<brendan> for fun, here's a python version:
<brendan> def prodn(n, str):
<brendan> return [reduce(int.__mul__, [int(i) for i in tgt[i:i+n]], 1)
<brendan> for i in range(len(tgt) - (n - 1))]
<brendan> print reduce(max, prodn(5, tgt))
<brendan> :)
<brendan> rats, should have been:
<brendan> def maxprodn(n, str):
<brendan> return reduce(max, [reduce(int.__mul__, [int(i) for i in tgt[i:i+n]], 1)
<brendan> for i in range(len(tgt) - (n - 1))])
verte has joined #ocaml
Alpounet has joined #ocaml
seafood has joined #ocaml
seafood has quit [Read error: 110 (Connection timed out)]
filp has joined #ocaml
s4tan has joined #ocaml
Associat0r has joined #ocaml
mfp has quit [Read error: 104 (Connection reset by peer)]
ilor has quit [Read error: 110 (Connection timed out)]
seafood has joined #ocaml
mfp has joined #ocaml
ilor has joined #ocaml
Camarade_Tux has joined #ocaml
Associat0r has quit []
seafood has quit [Read error: 110 (Connection timed out)]
angerman has quit []
filp has quit [Read error: 104 (Connection reset by peer)]
ilor has quit [Read error: 113 (No route to host)]
tombom has joined #ocaml
ilor has joined #ocaml
m3ga has joined #ocaml
hkBst has joined #ocaml
ttamttam has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
ilor has quit [Read error: 104 (Connection reset by peer)]
ilor has joined #ocaml
_zack has joined #ocaml
Camarade_Tux has quit ["Quitte"]
ilor_ has joined #ocaml
ilor has quit [Read error: 104 (Connection reset by peer)]
Camarade_Tux has joined #ocaml
ilor_ has quit [Read error: 110 (Connection timed out)]
authentic has quit [Read error: 110 (Connection timed out)]
_zack has quit ["Leaving."]
Alpounet has quit ["Ex-Chat"]
th5 has joined #ocaml
authentic has joined #ocaml
^authentic has joined #ocaml
angerman has joined #ocaml
^authentic has left #ocaml []
authentic has left #ocaml []
authentic has joined #ocaml
seafood has joined #ocaml
mlh has quit ["brb"]
seafood_ has joined #ocaml
_zack has joined #ocaml
seafood has quit [Read error: 110 (Connection timed out)]
joelr1 has joined #ocaml
<joelr1> good day folks
joelr1 has quit []
thelema has quit [Read error: 60 (Operation timed out)]
th5 has quit [Read error: 104 (Connection reset by peer)]
th5 has joined #ocaml
willb has joined #ocaml
kmkaplan has left #ocaml []
kmkaplan has joined #ocaml
mrvn has quit [Read error: 104 (Connection reset by peer)]
mrvn has joined #ocaml
verte has quit ["http://coyotos.org/"]
filp has joined #ocaml
Demitar has quit [Read error: 145 (Connection timed out)]
seafood_ has quit [Read error: 110 (Connection timed out)]
Demitar has joined #ocaml
seafood has joined #ocaml
chickenzilla has joined #ocaml
seafood_ has joined #ocaml
_zack has quit ["Leaving."]
wsmith84 has joined #ocaml
_zack has joined #ocaml
seafood has quit [Read error: 110 (Connection timed out)]
seafood has joined #ocaml
alexyk has quit []
seafood_ has quit [Read error: 110 (Connection timed out)]
seafood_ has joined #ocaml
thelema has joined #ocaml
seafood has quit [Connection timed out]
alexyk has joined #ocaml
seafood_ has quit [Read error: 110 (Connection timed out)]
_zack has quit ["Leaving."]
Camarade_Tux has quit ["Leaving"]
alexyk has quit []
notdoghotdog has joined #ocaml
alexyk has joined #ocaml
alexyk has quit [Client Quit]
Yoric[DT] has joined #ocaml
kaustuv_ has joined #ocaml
s4tan has quit [Read error: 60 (Operation timed out)]
ttamttam has left #ocaml []
ilor has joined #ocaml
alexyk has joined #ocaml
mfp has quit [Connection reset by peer]
alexyk has quit []
<th5> How should I choose between using list and Stream ? I've been messing around with Stream (via camlp4 [<>] syntax).
<th5> I was right about to write a version of map : ( 'a -> 'b ) -> 'a list -> 'b Stream. Should I just be using list for everything?
<Yoric[DT]> Use enumerations :)
<Yoric[DT]> More seriously: use a list if you know it's going to be short and/or you need to reuse the same data several times.
<Yoric[DT]> Use a stream if you know it's going to be large (of infinite) and you only need to use the data once.
<Yoric[DT]> (and Batteries' version of streams has map)
<th5> thanks
<Yoric[DT]> np
* Yoric[DT] has to go, though.
<th5> yeah i looked up the batteries Stream.map
<th5> see you
mfp has joined #ocaml
prime2 has joined #ocaml
filp has quit ["Bye"]
th5 has quit []
slash_ has joined #ocaml
<mrvn> Is that Stream.map : (Stream.elt -> Stream.elt) -> Stream.t -> Stream.t?
wsmith84 has quit [Read error: 145 (Connection timed out)]
angerman has quit []
chickenzilla` has joined #ocaml
alexyk has joined #ocaml
chickenzilla has quit [Nick collision from services.]
chickenzilla` is now known as chickenzilla
kaustuv_ has quit [Read error: 60 (Operation timed out)]
alexyk_ has joined #ocaml
wsmith84 has joined #ocaml
mfp has quit [Read error: 104 (Connection reset by peer)]
alexyk_ has quit []
alexyk has quit [Read error: 110 (Connection timed out)]
chickenzilla` has joined #ocaml
chickenzilla has quit [Nick collision from services.]
chickenzilla` is now known as chickenzilla
tombom has quit ["Peace and Protection 4.22.2"]
mfp has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
ilor has quit [Read error: 148 (No route to host)]
ilor has joined #ocaml
alexyk has joined #ocaml
Asmadeus has quit ["Lost terminal"]
Asmadeus has joined #ocaml
OChameau has quit [Read error: 113 (No route to host)]
Alpounet has joined #ocaml
alexyk has quit []
<kaustuv> Yoric[DT] or thelema: http://pastebin.com/m29e06f76 (trivial patch fixing a typo)
alexyk has joined #ocaml
<Yoric[DT]> kaustuv: weird, it seemed to work as is.
<kaustuv> It works but throws a warning that ocamlbuild helpfully does not display. I only saw it because I compile with [make OCAMLBUILD="ocamlbuild -classic-display"]
<Yoric[DT]> I mean, at run-time, it works.
* Yoric[DT] will try with the patch.
<kaustuv> it works because ocaml preserves \ sequences it doesn't understand
<Yoric[DT]> ok
prime2 has quit ["leaving"]
<Yoric[DT]> Applied, thanks.
<flux> ocamlbuild hides warnings?
alexyk_ has joined #ocaml
<kaustuv> No it doesn't. I was wrong there.
alexyk has quit [Read error: 110 (Connection timed out)]
<kaustuv> I wonder what ocamlforge expects will ever make it into this category: http://forge.ocamlcore.org/softwaremap/trove_list.php?form_cat=132
<olegfink> kaustuv: tuareg-mode?
<flux> :)
<flux> for example a bible study program could make it. some pops up every now and then on freshmeat.net..
<flux> not in ocaml, mind you (I think atleast)
<flux> but, off to sleep
<mfp> flux: text editors?
jeddhaberstro has joined #ocaml
alexyk_ has quit []
Alpounet has quit [Remote closed the connection]
thelema has quit [Read error: 104 (Connection reset by peer)]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
alexyk has joined #ocaml
mbana has joined #ocaml
<mbana> what are a must-read ocaml documents? so far i've seen the official manual by Xavier, the book by Jason H., are there any more I should short list?
<bjorkintosh> mbana, i don't have any ocaml books, but i just got 'ml for the working programmer' in the mail ... and i'm going to read that with okasaki's 'purely functional data structures' and the little MLer.
<bjorkintosh> later on i'll see if i can translate what i learn into ocaml.
_zack has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
schmx has quit ["leaving"]
_zack has quit ["Leaving."]
willb has quit [Read error: 110 (Connection timed out)]