gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
<dark> "let b equal one in b + 5", i think it's easier to spot thinking in the let in mathematics @.@
<doodo> i see
<doodo> fuuuu to much to laern
<doodo> and spell apparently
<dark> i try to reduce my program's length to a minimum possible
<dark> or the minimum possible
<doodo> well i am used to non functional languages and for the most part if it works i am happy
<dark> i begun to learn with non-functional languages
<doodo> writing shorter code?
<dark> no, programming in general
<dark> but now i find that non-functional is, erm, less fun
<doodo> i think all programming is not fun anymore :(
<dark> ? what?
<dark> so why do you program?
<doodo> parts are ok i guess. its fun writing in java
<doodo> or c# is ok
<dark> uhm o.o
<dark> for me it is the opposite
<doodo> its also depends on what i am coding
<dark> java is a bit boring, maybe because i lack the skill to write short code there
<doodo> Java code i just easier to manage imo
<doodo> *is
<dark> if not ocaml or haskell, i would say the fun lies in ruby and shell script
<dark> shell script and friends, like awk and sed
<dark> curiously i can't find fun at perl
<doodo> i work mostly on 3D applications so C++ and python are what i use most of the time
<dark> uhm
<dark> i think that easiness depends on what you are used to
<doodo> yeah true
<doodo> but i just don't like c++ even though i use it all th time
<dark> i find ocaml code much easier to manage than java, but maybe eclipse could change that? all java i did was in emacs and vim
<doodo> yeah java + eclipse = magical code writing fun time
<doodo> makes it easy to debug, write unit tests
<dark> any language + emacs = magical code writing fun time. well except java it seems (but i can try again later)
<dark> at emacs i can do this C-x C-e and send current function to the interpreter
<dark> or C-c C-b and send whole program
<dark> but i can't find a java repl interpreter :)
<doodo> in any case i don't see the point of learning a functional language for my area of interest.
<dark> i want to do some opengl thing in ocaml o.o
<dark> i haven't found terribly good libraries, but what i want to do is simple
surikator has joined #ocaml
<doodo> converting my opengl particle system would probably be near impossible to do in ocaml
<dark> uhm
<doodo> they most logical way to do particle physics would be hard to do in a functional language
<doodo> though on second thought its probably not impossible
<dark> but ocaml isn't just functional
<dark> it can do imperative programming just fine
fraggle_ has quit [Remote host closed the connection]
<dark> functional vs. imperative will manifest when you want to update the data structure. if you update in place, your code is imperative; if you rebuild a new data structure (sharing unchanged data with the old, maybe) your code is functional
fraggle_ has joined #ocaml
boscop__ has quit [Ping timeout: 240 seconds]
Associat0r has quit [Quit: Associat0r]
<doodo> well as far as graphics are concerned, you don't want to rebuild data structures all th time
<doodo> though it would be interesting to implement by bvh file player
<doodo> because its basically tree recursion
<doodo> would probably cut the code length significantly
<dark> if you have a quadtree (or whatever) with geometric forms, rebuilding it to add a new object wouldn't mean to rebuild the member objects
<dark> in fact you don't need to touch the unchanged parts of the tree
<dark> just the root and all sub-trees that changed, and even that, just adjusting pointers
<thelema> yup, usually log(n) work
<dark> the problem i usually hear about those so-called 'functional data structures' is that they thrash the cache
<dark> because you are effectively following pointers to random memory locations
<dark> (in C you could pack your objects in an array and make your pointers point there, so that accessing one object would bring other objects to the cache. and do other kinds of memory management tricks)
<thelema> yes, although the GC thrashes more
Edward__ has quit []
<dark> why? because it keeps moving objects?
<thelema> because it scans all memory
<dark> oh o.o
doodo has quit [Ping timeout: 265 seconds]
drunK has quit [Remote host closed the connection]
doodo has joined #ocaml
LeNsTR|away has quit [Read error: Connection reset by peer]
<doodo> i am lost on this. This is my function: let rec addoddpos s = rec split lis = match lis with [] -> [] | [x] -> [x] | x::y::xs -> let lis2 = split xs in y::list2 i don't know where to go from here
LeNsTR|away has joined #ocaml
<doodo> this function is supposed to return a list that is the odd positions of the input list
<doodo> but how to i nest another function to add the sun?
<doodo> *sum?
<thelema> do you have to nest functions, or can you chain them?
<doodo> i can chain them i guess
<doodo> i don't understand what syntax i am supposed to use
<doodo> i have a sum function that takes a list and returns the sum
<doodo> how do i invoke this function
<doodo> from inside the other fucntion
<thelema> don't invoke it from wihtin the other function, invoke it *after*
LeNsTR|away has quit [Read error: Connection reset by peer]
<doodo> that doesn't make sense to me
<thelema> let add_odd_pos l = let odd,even = split l in add odd
LeNsTR|away has joined #ocaml
<doodo> this has to be a nested function
surikator_ has joined #ocaml
surikator has quit [Ping timeout: 250 seconds]
<doodo> so it needs to contain a function to split, then a function to add
<doodo> so let addoddpos .....let split.....let add
<thelema> let add_odd_pos l = let split l = ... in let add l = ... in split l |> fst |> add
myu2 has joined #ocaml
<thelema> I like my fold solution better
<doodo> none of it makes sense to me
<doodo> :(
<thelema> fair enough - it's a bit tricky.
<doodo> This is for hw, and i don't want to just right out ask the hw question
<doodo> I am trying to understand things, but nothing helps
<thelema> doodo: ask question
<doodo> Write concat odd : string list -> string that concatenates the elements in odd positionsof the input list, returning "" on the empty input
<doodo> but i want to use this: let rec split lis = match lis with([] ,[]) <- []| [x] -> ([x], [])| (x::y::xs) -> let (lis1, lis2) = split xsin (x::lis1, y::lis2 because its an example from class
<thelema> okay, let's go over each case - what should addoddpos [] return?
<doodo> []
<thelema> no, you don't want to return a list from addoddpos
<thelema> what type should addoddpos have?
<doodo> hold on for a second. This is what i have so far for the function and i understand everything that is here: let rec concat_odd l = let rec split lis = match lis with([] ,[]) <- []| [x] -> ([x], [])| (x::y::xs) -> let (lis1, lis2) = split xsin (x::lis1, y::lis2)
<dark> with([] ,[]) <- []| [x] ?
<dark> i can't understand this <- syntax
<dark> also you seem to have inner let without "in" keyword
<thelema> I think you have that backwards [] -> ([], [])
<dark> what is the output of concat_odd?
accel has joined #ocaml
<doodo> a string is the output
<doodo> so given a list of strings, concatenated the ones that are in the odd positions into a single string and that is the output
surikator_ has quit [Quit: surikator_]
surikator has joined #ocaml
<thelema> yes, so what do you want to return if concat_odd is called?
<doodo> a string
<thelema> what string?
<doodo> so if the input of conc_odd is ["a"; "b"; "c";"d"] concat_odd should return "bd"
<thelema> yes, I understand that. what should "concat_odd []" return?
joewilliams_away is now known as joewilliams
<doodo> oh. not sure. the empty string?
<doodo> do they have that in ocaml?
<thelema> yes, that's what your assiignment says.
<thelema> and what should concat_odd ["a"] return?
<thelema> yes, "" is the empty string
surikator has quit [Ping timeout: 265 seconds]
<dark> the function i wrote about adding odd members is nearly equal concatenating odd members
<dark> you probably can lift it to a high order function if this isn't too confusing
<thelema> dark: I bet it is.
<thelema> dark: think simple
lamawithonel has joined #ocaml
<dark> doodo, did you saw let rec add_odd = function [] -> 0 | a::[] -> a | a::b::r -> a + add_odd r ?
<dark> the other function you want has the same structure
<dark> just that the base case is not 0 but the empty string, ""
<doodo> right
<dark> and the folding operating is not + but ^ (string concatenation)
<dark> btw let a = function .. is let a parameter = match parameter with ..
<dark> folding operation*
<doodo> thelema: wait you found my assignment? you in the class or a ta or something? or the prof? o_O
<dark> you have 3 cases to consider: what to do if you encounter an empty list, a list with one element, and a list with at least two elements
<dark> doodo, lol
<dark> i think that for a list with at least two elements, you get the first, skip the second, and concatenate with the result of the rest
lamawithonel has quit [Ping timeout: 264 seconds]
<doodo> ok i think i understand dark let me trying coding this up real quick
<dark> thelema, i think that to do this with a fold one could use a function that first does a map, then a fold
<dark> in order to put the bool on each element
<dark> but uhm it isn't exactly a map
<thelema> dark: not needed.
<thelema> let sum_odds l = List.fold_left (fun x (o,a) -> if o then (false, x+a) else (true,a)) (true,0) l |> snd
<dark> oh your flag isn't in the list elements but in the accumulator
<thelema> exactly.
<thelema> that's where the state needs to go.
<dark> so for any operator like that (like taking the elements divisible by 3, etc) i could use an additional int, and calculate the next with something that (my_int + 1) mod 3
<dark> something like
<dark> so it seems that taking [1; 2; 3; 4] and doing 1 - 2 + 3 - 4 is a fold, after all
<dark> or other arbitrary but cyclic operations
<thelema> of course. Everything ordered many -> one is a fold.
<thelema> even on trees, there's natural folds
<dark> yes i always build things like pre-order folds on my trees
<doodo> success!
<dark> now see a high-order approach: let rec do_things_to_odd initial_value operation = function [] -> initial_value | a::[] -> a | a::b::r -> operation a (do_things_to_odd initial_value operation r)
<dark> with that you can do let add_odd = do_things_to_odd 0 (+)
<dark> and let concat_odd = do_things_to_odd "" (^)
<dark> if you get used to that a lot of other ocaml things feels more natural
<doodo> what does the function keyword do exactly
<thelema> "function" is like "fun x -> match x with"
<dark> of course you can write let add_odd list = do_things_to_odd 0 (+) list
<dark> but it is less fun
<dark> doodo, let f x = match x with <something> is let f = function <something>
<dark> that is let f = fun x -> match x with <something>
<dark> (because let f x = k is let f = fun x -> k)
<dark> just a shorthand
<doodo> ahh ok
<doodo> thelema: you didn't answer my question: did you find my assignment googling or are you somehow associated with the course? o_o
<thelema> doodo: didn't you paste it into the channel?
<thelema> no, I'm not associated with your course.
<doodo> lol fail on my part
<doodo> i thought it would be cool if the staff was on here
<dark> i can attest that it was kind of obvious that you were following an assignment :P
<dark> i only had doubt because you said you also had experience on 3D and c++, maybe you would be doing this just for your own learning
<thelema> doodo: UIUC, right?
<doodo> yeah
<doodo> its a required course which i don't really want to take but i want a good grade in it
<doodo> we are going to write a compiler as part of the course.
<thelema> well, ocaml is a great language to write a compiler in
<thelema> I'm surprised you're not more comfortable with recursion.
<dark> we here have ocaml as our first language
<doodo> Im fine with recursion. I done plenty of dynamic programming even
<dark> then interpreters and compilers in haskell
<dark> but in a very low-integration fashion
<dark> (like; no monads in haskell; etc)
<thelema> then it's the pattern-matching way of writing functions?
<doodo> yeah that an not having explicit data structures
<dark> but no, ocaml has plenty of explicit data structures
<doodo> and no loops
<dark> ocaml has while and for loops, but they are nearly useless
<doodo> yeah exactly. i think in while loops
<dark> you define explicit data structures with type
<dark> but ocaml works greatly without defining your types too
<doodo> but i mean, it would have been pointless for this assignment
<thelema> dark: while foo do bar done == let rec loop () = if foo then bar; loop else ()
<dark> doodo, you can substitute every use of while in ocaml with a tail recursion; the generated code for tail recursions are as efficient as while/for loops
<thelema> s/; loop/;loop ()/
<doodo> Does ocaml do automatic memoization ?
<dark> doodo, no
<thelema> no, but it's not hard to write a function that memoizes any other function
<dark> that loop() has a tail call
<dark> (to itself), it is not translated to a function call
<doodo> i see
aj2009 has joined #ocaml
aj2009 has quit [Quit: Leaving]
<doodo> what is wrong with this syntax? is_sorted l = match l with []-> false | [a]->true | a::b::xs if a < b then is_sorted xs else false;;
<dark> isn't it lacking a let?
<dark> also you can't match to [a] i think
<dark> but you can match a::[]
<dark> but uhm
<thelema> I prefer [a]
<doodo> its has a let. it doesn't like the last matching
<dark> can ocaml match [a]?
<dark> oh
<dark> ah
<dark> you need a ->
<thelema> ->
<dark> a::b::xs -> if a < b then is_sorted xs else false;;
<dark> oh ocaml can match [a] o.o'
LeNsTR has quit [Quit: LeNsTR]
<thelema> dark: ocaml can match [1;2;(x,{y=5})]
<doodo> aww man incorrect output :(
<dark> also { x } for { x = x }
<thelema> doodo: if a < b then is_sorted (b::xs)
<doodo> doh
<doodo> thx
<dark> but why you prefer to write match .. with instead of function ? to make the code bigger?
<dark> or it feels clearer?
<doodo> can you do matching with multiple inputs?
<dark> yes, you turn them into tuples
<dark> like match first_input, second_input with [], [] -> both empty | ..
<dark> first_input, second_input is a pair (a tuple with 2 elements)
<dark> actually (first, second) but you can omit ( ) sometimes
<dark> thelema, batteries has some functions that operate in two lists that i find less useful because they throw a exception on different sizes, instead of ignoring the rest of the list
<dark> thelema, (like the haskell equivalents do)
<doodo> so i can do this: let rec dotproduct l1 l2 = match (l1, l2) with ....
<dark> doodo, yes
<doodo> sweet
<dark> in fact, you could do this: let rec dotproduct twolists = match twolists with ..
<doodo> i see
<dark> and then call dotproduct(a, b) instead of dotproduct a b
<dark> so this becomes: let rec dotproduct = function ..
<doodo> ahh ok i see
<dark> the act of calling dotproduct a b when the internal representation uses (a, b) is called "currying"
<dark> so dotproduct a b is the curried form of dotproduct (a, b)
<doodo> yeah curried vs uncurried
Amorphous has quit [Ping timeout: 272 seconds]
<dark> in haskell there is a function that turns the curried form into un-curried form, if the function has two parameters
<dark> it helps writing functions that does pattern matching in the two parameters uncurried, then curry it after that
<doodo> ill keep that in mind thx
<doodo> dark: are you like, a pro programmers
<dark> let curry f = fun a b -> f (a, b)
<dark> let uncurry f = fun (a, b) -> f a b
<dark> doodo, no, i'm just a student
<doodo> undergrad or grad?
<dark> undergrad, but i hope to be grad student u.u
<dark> thelema, i wouldn't use, in my right mind, those functions (that throw exceptions when the two lists aren't the same size), unless i want the program to fail in this case
<dark> catching exceptions is the least thing i want to do if i want to use a library to help cleaning my code
<dark> maybe that functions were added because they are useful at jane street?
Amorphous has joined #ocaml
tnguyen has joined #ocaml
<accel> why does ocaml care about janestreet?
<dark> it seems that tuareg mode is now maintained by jane street
<dark> so i guess that they must also be a great contributor to batteries
<orbitz> jane st? i dobut it
<dark> or uhm actually i think they have their own stdlib
<orbitz> yes they do
<orbitz> it's called Core
<dark> oh uhm
<dark> anyway ocaml needs no new exception-happy interfaces imo
<orbitz> I don't quite get teh question, "why does ocaml care about jane st"? DO you mean INRIA? AFAIK INRIA doesn't reallyc are abotu jane st
<dark> it must be defeated like a plague
<orbitz> what is an exception-happy interfaces?
<dark> uhm. what about a function that throws exceptions that you must catch in order to reasonably use it?
<orbitz> What do you mean?
<dark> <dark> thelema, i wouldn't use, in my right mind, those functions (that throw exceptions when the two lists aren't the same size), unless i want the program to fail in this case
<orbitz> are you asking for 'checked' exceptions liek in Java?
<dark> no
<dark> haskell has those functions, but it discards the rest of the largest function
<dark> i'm talking about things like 'a list * 'b list -> ('a, 'b) list
<dark> oh
<orbitz> like zip?
<dark> ('a * 'b) list
<dark> yes
<orbitz> ok. so are you saying that you wish ocaml functions were more like haskell functions?
<dark> in general, yes.
<dark> batteries has an 'exceptionless'
<orbitz> what is inherently suprior to the haskell way?
<dark> oh
<dark> it's not the haskell way but the functional way. catching exceptions is annoying
myu2 has quit [Remote host closed the connection]
<orbitz> so is it the usage of exceptions or that ocaml devs decided that soem operation of lists of idfferent lengs was invalid?
<dark> but then you need something like >>=
<dark> orbitz, hmm
<dark> i found out that code with a lot of exceptions, in practice, turns to a big mess
<orbitz> that is not what i asked
<dark> raising an exception when the lists has different lengths is just an example
<orbitz> but that is not what i asked
<dark> but it is an example introduced by batteries, that is supposed to be cleaner
<dark> uhm
<dark> it is the usage of exceptions :P
<orbitz> ok
<dark> exceptions are a cool feature but i don't know how to use them a lot and don't have a mess
<dark> i think that in order to be not messy, they shouldn't be catched often
<orbitz> if you want things to be invalid your choices are A) use some type decorator like 'option' or 'either' everywhere, or B) use exceptions
<dark> like, be really really exceptional maybe
<orbitz> i think exceptions are the lesser of two evils in some cases
<dark> A), plus monadic combination, lets you to write code that disregard the exception
<dark> and still have it signaled in the type
<orbitz> Jane St Core provides both. they have List.hd : 'a list -> 'a option and List.hd_exn : 'a list -> 'a
<dark> the problem with ocaml's 'a option is that you need to unpack it whenever you want to access the non-error condition
<dark> instead of using something like >>=, that unpacks for free
<orbitz> you can quite easily wrote with_option : 'a option -> ('a -> 'b) -> 'b option
<dark> (the real problem is that ocaml has no mechanism for generic programming that is like haskell typeclasses. ocaml OO could help, but it isn't used..)
<orbitz> and you can easily bind somethign lie >>= to with_option
<dark> but the problem is, option isn't the sole type where this happens
<orbitz> dark: Some would argue Ocaml's module system is superior to typeclasses
<dark> >>= works with a lot of different types
<orbitz> Indeed
<dark> orbitz, how to make a bind that works with many different types?
<dark> I know only the row types approach of ocaml object orientation
<orbitz> ask Oleg, i'm sure he's figured it out
<orbitz> Ocaml 3.12 has first-class modules
<dark> uhm
<orbitz> which give you type-classes, albeit explicit typeclasses
<dark> o.o
<orbitz> there is also pa_monad
<dark> the problem then is, most ocaml code doesn't use and will not use it .-.
<orbitz> which simply require yoru oduel to implement some interface
<orbitz> and it has --> instead of >>= i think
<dark> because all of this _can_ be done with classes
<orbitz> dark: i see very ltitle ocaml code that uses classes
<dark> yes =[
<dark> ocaml object system is beautiful, but i have no use for it
<orbitz> I'm not quite sure what oyu're lamenting at this point then
<orbitz> sound slike you just want to use Haskell....so use Haskell?
<dark> and it annoyed me when i tried to use (mostly because the inference there isn't complete, so i needed annotations)
<dark> oh
<dark> uhmm
<dark> i tried haskell some times, and will try again
<dark> fact is, i'm too comfortable with ocaml
<dark> haskell has some foreign things .-.
ccasin has quit [Quit: Leaving]
<dark> orbitz, saying that language A has a good feature that language B doesn't have isn't the same thing as saying that one would rather use A
<orbitz> sure it isn't, but that seems like a valid inference based on what you'v ebeen saying
<dark> the effects discipline of haskell makes it hard for me to write code
<dark> it would be more effective to write my code in haskell, if i could get used to that
<doodo> why doesn't this work? let rec total_dist pts = match pts with [] -> 0 | [(a,b)] -> 0 | (a.b)::(c,d) ::xs -> a +. b +. total_dist (c,d)::xs
<doodo> given that the input is a list of tuples that are floats
<orbitz> is (a.b) a typo?
<doodo> it is a typo on here, but not in my code
<orbitz> why don't you put your actual code on a pastebin wiht a description of the problem
<orbitz> can't debug code that doesn't even refelct what you wrote
<doodo> ok hold on
<doodo> Write total dist: (float * float) list -> float that calculates the total distance from the first point in the list to the last; if the list has fewer than two elements, then the distance is zero. I have access to a function that calculates the distance between two points
<doodo> so if the points in the list are a,b,c, it should return dist(a,b) + dist(b,a) = total distance
<doodo> sorry
<doodo> the total distance is dist(a,b) + dist(b,c) = total distance
<orbitz> let rec path_dist = function | [] | [_] -> 0 | d1::d2::ds -> dist d1 d2 + path_dist (d2::ds)
<doodo> i pretty much had exactly that and it didn't work. then i changed the 0 to 0.0 and it worked.
<doodo> time for a cookie
<dark> 0 is int, 0.0 is float
<doodo> well you can do like double a = 0 sometimes
<orbitz> dark: not in ocaml
<orbitz> doodo*
<doodo> i guess not :(
lamawithonel has joined #ocaml
<doodo> how do you hd with a list
<doodo> like to get the first element in a list
<dark> List.hd list
eye-scuzzy has quit [Ping timeout: 260 seconds]
<dark> if you want to write it, it's like let hd = function [] -> raise Failure "taking first element of an empty list" | a::_ -> a
<dark> it throws an exception if the list is empty (both List.hd and this hd function)
lamawithonel has quit [Ping timeout: 255 seconds]
<doodo> damn then i can't use that
<dark> why?
<dark> you can do something like let hd = function [] -> None | a::_ -> Some a
<doodo> given a list of lists, i need to create a new list consisting of the fist members of each sublist
<dark> it returns an 'a option
<dark> uhm
<doodo> and some of the sub lists will be empty
<dark> you can't use List.map right?
<doodo> nope
<dark> well what to do if you encounter an empty list?
<doodo> this is what i tried:
<dark> it just isn't included?
<doodo> just don't add anything to the final list
<doodo> right
<dark> oh
<dark> it seems you need to write a recursion inside a recursion. can you at least define auxiliary functions?
<doodo> yeah
<doodo> you mean using the and operator
<dark> and can you do things with 'a option?
<doodo> no i don't think so
<dark> i think you won't need mutually recursive functions
<doodo> can you handle exceptions some how
<dark> you raise exceptions with the raise keyword
<dark> and catch them with try .. with
<dark> but in this case an exception isn't advised
eye-scuzzy has joined #ocaml
<doodo> yeah. i can't use List.hd anyway
<dark> I upgraded tuareg-mode just to see it has a regression at some indentation thing =(
<doodo> idk what that means o_O
<dark> an emacs mode
<doodo> ah
<dark> let rec firsts = function [] -> [] | t::r -> (match t with [] -> firsts r | a::_ -> a :: firsts r)
<dark> actually not a recursion inside another, but a pattern match inside another
<doodo> ah, i didn't know you could nest matching
<dark> but without () ocaml often get confused
<doodo> yeah i learn that the hard way
<doodo> so do you ocaml from on your own or from school?
<dark> i had an ocaml class for one semester, it was my first class at university
<dark> but after that i used ocaml on my own
<dark> practice on functional programming, past of this level of writing little functions for assignments, was on my own. (but i haven't got much beyond that, i still struggle understanding lots of haskell code)
<doodo> they taught a whole class just on ocaml? My class is on compilers and the expect us to learn ocaml in like a week or two
<dark> yes, the class was "concepts and techniques of programming" but it was mostly a class about ocaml
<dark> an introductory class; after that, "algorithms and data structures" followed; the practice was done in C++, but the professor expected us to learn C++ on our own
<dark> doodo, if you are going to study compilers you probably should take a look at http://caml.inria.fr/pub/docs/manual-ocaml/manual003.html#toc7
<dark> specially variants
<doodo> i had a separate class for algorithms and it was all proofs. no programming at all.
<dark> the class for algorithms was broke in two: one theoretical, another practical
<doodo> thanks ill check it out
<dark> the practical one was mostly: implement a list, a stack, a tree, etc
<dark> and in the end we had to do a compressor (using run-length encoding, then huffman encoding)
<dark> doodo, do you know the ocaml books available to read online? one is http://caml.inria.fr/pub/docs/oreilly-book/
<doodo> thats good you did some practical stuff. my course is the hardest course basically in the curriculum and the exam averages are always in the 50% range
<doodo> there is no point in making a class so hard that if they went by raw scores everyone would fail
<dark> i had a professor that was maniacal about proving stuff, but students wouldn't understand him
<dark> actually her
<dark> but she proved a lot of stuff about different graph algorithms, algorithms on b-trees, red-black trees.. (i don't remember what exactly)
<dark> (i think she proved something very interesting about kruskal algorithm)
<doodo> did you have to learn reductions?
<doodo> for like, proving np completeness
<dark> no. there is a course here about computability, but computer engineering doesn't have it at the curriculum
<doodo> ah i see
<doodo> sweet
<dark> you want to pay attention to things like http://caml.inria.fr/pub/docs/oreilly-book/html/book-ora016.html#toc17
joewilliams is now known as joewilliams_away
<dark> doodo, actually i was doing a few days ago some code that receives a string like x+x, parses it, transforms into 2x, and prints 2x (or receives 1+1 and prints 2, etc). i think it is the kind of code that one would write in a compiler class
<dark> i used a parser from the ocaml manual (it was an example there :P) because i struggled to make my own (it uses camlp4)
<dark> I do heavy pattern matching on variant types, i think that it is what you are going to do
<doodo> yeah grammar stuff basically
<dark> actually mrvn code is simpler and doesn't require batteries: http://paste.debian.net/105302/
<dark> an earlier version http://paste.debian.net/105287/
<doodo> interesting
<dark> my own code would be http://codepad.org/JFDfrEBS
<dark> that [< .. >] is a syntactical extension for building parsers
<dark> that looks like pattern matching
<dark> look that loop() function, it is just a while true in disguise
<dark> (my code was modeled after mrvn's code. i was trying another approach but it wasn't very successful :P)
<doodo> still pretty cool though
<dark> it can understand that x*(x+1) is x^2 + x
<doodo> i had to do something like that once
<doodo> but we used some kind of tree or something
<dark> i was going to add let bindings and other things (like, saying that x is 1, so x*(x+1) would reduce to 2)
<dark> doodo, maybe you will need to handle things with ocamllex and ocamlyacc
<doodo> maybe
<dark> instead of putting the lexer and parser in the code
myu2 has joined #ocaml
<doodo> can seem to get this to word: let rec firstelts lis = function [] -> [] | t :: r -> (match t with []-> firstelts r | a::b -> a ::(firstelts r));; it says that is is not the expected type b list list -> c list
<doodo> *can'
<doodo> * can't seem to get this to work i mean
<dark> drop that lis
<dark> at the parameter
<dark> let rec a = function .. is let rec a parameter = match parameter with ..
<dark> so the = function puts a parameter there, without giving it a name :P
<dark> I will downgrade tuareg-mode just because of function mis-indentation u.u
<dark> let x = function
<dark> this won't indent the next line as a match
<dark> (but it indented with previous version)
<doodo> nvm. i just omitted function and changed to match with
<dark> oh
<doodo> so the grader grades it right
<dark> uhn, really?
<dark> if he expects you to learn ocaml on your own, it can't expect you to be just with what he taught
<dark> right?
<doodo> well i guess i works either way lol wow i fail
<doodo> he didn't teach us how to use function i don't think
<dark> it would be silly to reject a common ocaml idiom just because he haven't mentioned it
<dark> any ocaml book has it
<dark> even example code on the official documentation
<doodo> nope not in lectures. we don't have a required book for this course
<doodo> i think they expect most people are just going to google everything
<dark> google also has this construct :P
<doodo> for my algorithms class we were allowed to use internet sources and half the time you can find solutions from other universities
<doodo> but even then most of the problems were hard
<doodo> well thx for all your help dark, thelema. im turning if for the night. later.
<dark> bye
doodo has quit [Quit: Page closed]
ikaros has joined #ocaml
Yoric has joined #ocaml
middayc_ has joined #ocaml
middayc has quit [Ping timeout: 240 seconds]
Snark has joined #ocaml
accel has quit [Quit: leaving]
LeNsTR has joined #ocaml
tnguyen has quit [Remote host closed the connection]
LeNsTR is now known as iLeNsTR
iLeNsTR has quit [Quit: iLeNsTR]
LeNsTR_ has joined #ocaml
LeNsTR_ has quit [Client Quit]
accel has joined #ocaml
Yoric has quit [Quit: Yoric]
LeNsTR|away has quit [Remote host closed the connection]
dark has quit [Ping timeout: 260 seconds]
<kaustuv> thelema: there are some more cut-and-paste errors in batDeque.mli -- the comments for the iter/iteri functions refer to mapi/map.
<accel> is there a way to associate a line in blah.ml to a line in blah.dsl?
<accel> i.e. I have "my-converter blah.dsl -> blah.ml"; and I want to bea ble to associate a line in blah.ml with a line in blah.dsl
boscop__ has joined #ocaml
decaf has joined #ocaml
<kaustuv> accel: ocaml accepts C preprocessor line directives. Eg.
<kaustuv> # 10 "blah.dsl"
<accel> cool
<accel> thanks
<accel> is there _any_ way to control low layout memory layout in ocaml? I realize there's bigarray for float & int's
<accel> but say I want to allocate 100 elements
<accel> where each element is: double, int, int;
<accel> is there a way to do that in ocaml?
<kaustuv> No, OCaml does not support heterogeneous unboxed structures
mike_mcclurg has joined #ocaml
<accel> even with library extensons?
<flux> you could do it in C and provide accessors, but..
<kaustuv> accel: Not even with them. It's a GC issue.
Associat0r has joined #ocaml
<accel> oh, because if I have 100 elements of { double, int, int
<accel> }
<accel> then maybe somethign can point into the array?
<accel> wait, bigarray would ahve this same problem?
<accel> yeah; why does bigarray work
<accel> yet my proprosal not?
<accel> how do they differ?
<kaustuv> Bigarray support is hardcoded in the compiler
<kaustuv> And they are homogeneous in any case
<accel> why does homogeneous/heterogeous change the gc?
<flux> in principle, perhaps it would be possible to lie to the gc?
<accel> in fact, why isn't there a primitive that says:
<flux> but you'd still need C to do it, I think
<kaustuv> It's the way the GC was designed. It's *way* simpler to handle uniform memory layout than to support heterogeneous unboxed structures
<accel> allocate me a big chunk of bytes
<flux> but, off to bus
<accel> i mean, have a primitive that allows the allocation of big chunk of bytes
<accel> and functions for writing/reading bytes
<accel> and don't give a dman whetehr tis' floats, ints, or whatevers
<kaustuv> let malloc n = Bigarray.Array1.create Bigarray.int8_unsigned Bigarray.c_layout n ;;
<kaustuv> But you can't write floats to/from that array using pure OCaml.
<kaustuv> (or even ints >255 for that matter...)
<kaustuv> Well, I take that back. You can always write your own (de)serialization functions. OCaml's stdlib just doesn't provide them for you.
<accel> given that, as long as I can calculate
<accel> sizeof { double, int, int }
<accel> then I can abstract 'structs' over it
<accel> I like I like
<flux> kaustuv, maybe you could even do your ocaml access with Obj-module and good insight?
<flux> you would need to encode floats manually, perhaps
<flux> I would much prefer the c-code though :)
<accel> flux, kaustuv : between the two of you, can you guys figure it out, package it nicely, and submit it to ocaml so it gets in by 3.13? kthxbye
ikaros has quit [Remote host closed the connection]
ftrvxmtrx has quit [Ping timeout: 260 seconds]
<kaustuv> It's far too much of a niche issue to interest the OCaml devs. Plus, I believe there are already libraries that will let you efficiently (de)serialize some OCaml structs. (bin-prot?)
<kaustuv> http://www.ocaml.info/home/ocaml_sources.html (search for bin-prot in that page)
seafood has joined #ocaml
Yoric has joined #ocaml
ftrvxmtrx has joined #ocaml
decaf has quit [Ping timeout: 276 seconds]
seafood has quit [Ping timeout: 240 seconds]
_andre has joined #ocaml
seafood has joined #ocaml
seafood has quit [Quit: seafood]
ttamttam has joined #ocaml
Associat0r has quit [Quit: Associat0r]
surikator has joined #ocaml
seafood has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 264 seconds]
cyanure has joined #ocaml
seafood has quit [Quit: seafood]
myu2 has quit [Remote host closed the connection]
thelema has quit [Remote host closed the connection]
thelema has joined #ocaml
<surikator> hi guys... sorry if this is only loosely related to ocaml, but is there anyone here using git in ocamlforge? i can't find the git url for developers to commit to projects. thanks!
<flux> surikator, gildor is
<surikator> @flux... gildor is... what?
<surikator> ah
<surikator> gildor is a nickname ;-)
<surikator> thanks flux
rks has quit [Quit: .]
<gildor> surikator: yes, it is a known bug
<gildor> surikator: but I thought you want to use svn for surikata
rks has joined #ocaml
<gildor> surikator: dev access should be ssh://scm.ocamlcore.org/gitroot/surikata/surikata.git
<surikator> gildor: yes, i've found that thread. But's fine that it doesn't show there. I just need to know where to link to. Yes, started with svn, but am now looking into git. Thanks for the URL.
<gildor> surikator: ok, ping me if you need help
<gildor> BTW, I think OCaml Forge question on this channel are generally inside topic
<surikator> gildor: thanks a lot
<surikator> ok, good to know then.
<surikator> gildor: so, just to make sure... is the full command: git clone ssh://USER@//scm.ocamlcore.org/gitroot/surikata/surikata.git
<gildor> git clone ssh://USER@scm.ocamlcore.org/gitroot/surikata/surikata.git
<surikator> yes, sorry, that's what I meant. but i get "ssh_exchange_identification: Connection closed by remote host
<surikator> fatal: The remote end hung up unexpectedly"
<gildor> surikator: but beware, you must have a valid SSH key
<surikator> ah
<surikator> ok
<gildor> did you try a lot of time ?
<surikator> how do i get that?
<surikator> three to four times
<gildor> the ssh box is secured and will ban you 1 or 2 hour if you failed 3 time in a row
<surikator> lol
<surikator> ok =)
<surikator> nice... =)
<surikator> yeah, probably am banned, i'd say
<surikator> ok, don't worry, will try in a couple of hours then
<gildor> and ping me, I will reset the ban and update the SSH key on disk, so that you can login quickly
<gildor> (the restriction on SSH for this box, allow to defeat almost all dictionnary attack -- and there are a lot of them)
<gildor> surikator: ^^^
ftrvxmtrx has joined #ocaml
<surikator> ok... cool. I'm adding the SSH key... newbie question: by "ping me" you mean actually doing "/ping gildor" is that it?
<gildor> gildor: ping
<gildor> is enough!
<surikator> gildor: ok, i've added the keys
as has joined #ocaml
as has quit [Client Quit]
accel has quit [Ping timeout: 260 seconds]
accel has joined #ocaml
<gildor> surikator: you can try login
<surikator> gildor: ok, thanks!
* gildor lunch time
<surikator> gildor: i still get the same ssh_exchange_identification thing.... enjoy your lunch.
myu2 has joined #ocaml
decaf has joined #ocaml
ftrvxmtrx has quit [Remote host closed the connection]
decaf has left #ocaml []
ftrvxmtrx has joined #ocaml
middayc has joined #ocaml
jado has joined #ocaml
middayc_ has quit [Ping timeout: 264 seconds]
<jado> hello, is there a way to display a graph created with the module ConcreteBidirectionalLabeled? http://ocamlgraph.lri.fr/doc/Persistent.Digraph.html
<kaustuv> jado: should be fairly easy to write one using folds and the functions in the Graphviz module, in case there isn't already a function that does it
<jado> there is a function "display_with_gv" in the Pack module but it's not for the right class :/
accel has quit [Quit: leaving]
<kaustuv> jado: module GD = Graphviz.Dot(ConcreteBidirectionalLabeled)
<kaustuv> let show g = let f = open_out "file.dot" in GD.output_graph f g ; Sys.command "dot -Tps -ofile.ps file.dot" ; Sys.command "gv file.ps"
<cyanure> would it by any chance could work for Imperative.Digraph.Abstract
<jado> yes it should
<jado> thanks :)
derdon has joined #ocaml
ftrvxmtrx has quit [Remote host closed the connection]
accel has joined #ocaml
<accel> why can haskel's type system do that ocaml's can't?
ftrvxmtrx has joined #ocaml
<jado> kaustuv: it seems that you can't give this module to Graphviz.Dot: http://pastebin.com/RFjMZp1R
<jado> oh maybe i have to give G where module G = ConcreteBidirectionalLabeled(Vertex)(Label)
<surikator> gildor: it's working fine now... i just don't seem to have a git HEAD on the remote server. How can I initialise one?
<jado> kaustuv: if i give G, i get that this fields are not defined :/ http://pastebin.com/RGpVwSZi
<jado> these*
<surikator> gildor: forget my question. it's working fine! thanks a lot!
<thelema> accel: type classes
<accel> so i've heard of these haskell type classes
<accel> where's agood tutorial on something trivial to do with haskell type classes
<accel> but non trivial to do with ocaml?
<thelema> well, ocaml has objects, whch you can use to emulate type classes. but the stdlib isn't oo-based, unlike haskell's stdlib which definitely uses type classes
<kaustuv> jado: the docs for Graphviz.Dot say that it should take a Sig.G, so I am surprised it doesn't.
<kaustuv> Checking...
<accel> is type classes basically like generics? it says "this type can handle a message of the form XYZ" ?
<jado> kaustuv: it takes a Sig.G, with additionnal fields "Graph, vertex and edge attributes" :/
<thelema> accel: something like that, yes.
<accel> thelema: http://book.realworldhaskell.org/read/using-typeclasses.html ; looks simple enough; what's the best technique for emulating this in ocaml?
<kaustuv> jado: hmm, I suppose you have to provide some attributes then. Can you try just plugging in Nones and []s to see what happens?
surikator has quit [Quit: surikator]
<jado> i can't see that working :D they seem essential for printing; but i'll try
<thelema> accel: the usual way to do this is to functorize the code that needs functions on types - i.e. the stdlib's Map.Make
<accel> thelema: can you point me to a link? :-)
<accel> module Set (Elt:Ordered) : S =
<jado> kaustuv: it compiles but i don't really have examples to test it with
<accel> basically tht's ocaml's way of saying: type Set is of typeclasses Elt, Ordred ?
<thelema> accel: type set is parameterized by a value "Elt" of type Ordered
surikator has joined #ocaml
<jado> vertex_name seems important
<kaustuv> gildor: I'm trying to build oasis 0.2 from source, and it depends on ocamlify. When I try to install ocamlify, it tries to write to /usr/local even though ocaml itself is installed in /home/kaustuv/soft/stow/ocaml-godi (and I don't have root). What's an obvious fix?
<kaustuv> Ah, -configure --prefix
accel has quit [Quit: leaving]
avsm has joined #ocaml
<gildor> kaustuv: indeed
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
<kaustuv> gildor: I think prefix should not default to /usr/local but should instead be determined from ocamlc -where
<gildor> kaustuv: this would conflict with --prefix as defined by autoconf
<gildor> kaustuv: and I think you mean Filename.dirname (FileUtil.which "ocamlc")
<kaustuv> never mind that, I have another problem. I already have all my source files in the src/ directory and a suitable myocamlbuild.ml, Makefile, and META. I just want oasis to use those instead of adding whole lists of modules to the Library section and getting rid of the src/ subdir. Can I do this?
<kaustuv> I am fine with getting rid of the Makefile and the META, but it would be pretty difficult to get rid of my myocamlbuild.ml
jm_ocaml has joined #ocaml
Associat0r has joined #ocaml
<gildor> kaustuv: you have nothing to do
<gildor> kaustuv: it would just stat that there is not OASIS_START/STOP section, so no place to put his stuff
<gildor> kaustuv: but if you use your own build system, I recommend to use the "custom" build plugin, to invoke the precise target to build your libraries/program
<jado> kaustuv: the dot file which is created looks like this: http://pastebin.com/g2sKtUBG; but dot doesn't accept it because of a syntax error line 2
<jado> adding quotes helped :)
<kaustuv> gildor: OK, time to digest the user manual about plugins...
lamawithonel has joined #ocaml
LeNsTR has joined #ocaml
LeNsTR has quit [Changing host]
LeNsTR has joined #ocaml
ymasory has quit [Remote host closed the connection]
LeNsTR has quit [Read error: Connection reset by peer]
LeNsTR has joined #ocaml
LeNsTR has quit [Changing host]
LeNsTR has joined #ocaml
joewilliams_away is now known as joewilliams
avsm has quit [Quit: Leaving.]
jado has quit [Remote host closed the connection]
avsm has joined #ocaml
LeNsTR has quit [Read error: Connection reset by peer]
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
ikaros has joined #ocaml
myu2 has quit [Remote host closed the connection]
jonafan_ is now known as jonafan
surikator_ has joined #ocaml
surikator has quit [Quit: surikator]
surikator_ has quit [Client Quit]
<hcarty> adrien: mlpost looks very nice
middayc_ has joined #ocaml
<hcarty> adrien: Not wanting to write code to make plots if part of why I wrote a Quick_plot module for PLplot - usually one line to display/save a plot.
<hcarty> adrien: It doesn't work for everything, but for the items it supports it's quite handy
<adrien> mlpost's biggest issue is probably that's horribly hard to code it :P
<adrien> hcarty: yeah, and quickplot is quite nice :-)
middayc has quit [Ping timeout: 240 seconds]
<hcarty> adrien: I'm glad someone else has found it useful :-)
jm_ocaml has quit [Quit: Konversation terminated!]
jm_ocaml has joined #ocaml
oriba has joined #ocaml
cyanure has quit [Remote host closed the connection]
myu2 has joined #ocaml
<jonafan> batteries 1.1 vs batteries 1.2, big differences?
Yoric has quit [Quit: Yoric]
<hcarty> jonafan: More awesome. Mosty of the changes I've seen are filling in missing features/functions.
<jonafan> i ask because 1.1 is in my ubuntu repo, but i can set up godi just as easily
<jonafan> i suppose if i'm trying things out, i should try out the latest
<jonafan> oh wait, there's a ppa
ulfdoz has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
myu2 has quit [Remote host closed the connection]
ttamttam has quit [Remote host closed the connection]
<thelema> jonafan: best to get git, especially if you're using 3.12
<jonafan> 3.11.2
<jonafan> The version in this ppa is 1.2.2
<thelema> there's nothing too impoetant you're missing.
<thelema> I'll have to get 1.3 out soon.
Edward has joined #ocaml
<thelema> release 1.3 branch pushed to github - please test so we can bugfix and release
<jonafan> ah hah, sorely needed binary file functions
<thelema> you mean read/write int32/int64/float
<jonafan> yes
jm_ocaml has quit [Quit: Konversation terminated!]
<jonafan> i felt i was crossing the rubicon when i realized there was no way to read a 4 byte float
jm_ocaml has joined #ocaml
<jonafan> but here it is, we have it now!
<thelema> it's not hard to write, it just needed to be written once and shared
<jonafan> is there ntohl somewhere?
<jonafan> in fact, what about sockets
<jonafan> oh i see, you can create any kind of input
<jonafan> oh nice, BatUnix takes care of it for you
<thelema> yes, inputs are pretty generalized, although they're not seekable at the moment
<thelema> and there's one other thing that we lost from the stdlib - being able to tell the length of an input
<jonafan> can we do nonblocking sockets?
<thelema> nonblocking writes - not so difficult, within BatIO's infrastructure, I think. Nonblocking reads OTOH don't seem to fit.
<jonafan> i'm going to miss select, but i suppose you could rig up something equivalent with BatUnix.establish_server
<jonafan> uh oh, new processes
<thelema> There is Unix.select still, but I don't know how well that'll play with batteries IO infrastructure
<jonafan> i guess you'd have to handle the socket part yourself, then you can use the BatIO functions on inputs/outputs made from strings
Yoric has joined #ocaml
_andre has quit [Quit: leaving]
<thelema> The only way I've solved this problem before is with a forking server.
<jonafan> well, consider an irc server
<jonafan> there are a ton of sockets active, and clients can send data that must immediately be sent to other sockets
<jonafan> either you're dealing with a mess of threads and blocking sockets, or you're going to use nonblocking sockets and select handles the hard stuff for you
<thelema> yup, for an irc server, you'd definitely want a single-process solution with nonblocking
<thelema> aren't there other solutions than select - poll? aio?
ftrvxmtrx has joined #ocaml
<thelema> epoll?
<mfp> ... or let libev abstract epoll/kqueue/select for you... iow. recent Lwt ;)
kaustuv_ has joined #ocaml
<thelema> mfp: that's be worth looking over - interfacing Lwt with batteries IO.
<thelema> except neither project is likely to depend on the other
<mfp> thelema: even looked into lwt_io.ml? it's built on top of a single perform_io function (vs. read_char and input in BatIO) does its own buffering
<thelema> mfp: I'm tempted to get rid of the read_char part of BatIO
<mfp> so it can give direct access to the buffer
<thelema> let me guess the type of perform_io : string -> int -> int -> int
<thelema> or at a higher level: substring -> int
<mfp> almost, it's Lwt_bytes.t -> int -> int -> int Lwt.t
<mfp> where Lwt_bytes.t used to be string, but has been replaced by a bigarray-based buffer
<mfp> it also uses mmap when possible internally, falling back to open when needed
<mfp> so there's only 1 copy being done, vs. the usual 2 in Pervasives functions and 3 in Batteries
<thelema> speaking of bigarray and mmap, I wish bitstring had a mode where it could be produced from an mmaped bigarray
<thelema> batteries IO doesn't claim any efficiency, just ease of use.
<mfp> fair enough
<thelema> are you sure it's 3 copies for batIO?
<kaustuv_> thelema: one tiny fix for batDeque.mli: http://www.lix.polytechnique.fr/~kaustuv/uncat/batDeque-fixes.patch
<mfp> OTOH hmm the only thing Batteries's output channels do which Lwt_io.output don't is returning a value on close
<thelema> kaustuv_: committed to release-1.3 and pushed
<mfp> thelema: I think so, it's 1 for the copy to a C char* allocated on the stack IIRC, then another to copy to the actual OCaml string destination when read(2) returns, then another copy when you do extract a part with input
<kaustuv_> thelema: is 1.3 frozen now?
<thelema> kaustuv_: I'm going to try to keep to bugfixes only, but you're welcome to change my mind
<kaustuv_> no, that sounds good to me.
<thelema> mfp: and lwt avoids the first two by... ?
<kaustuv_> thelema: I was proposing to contribute this at some point: http://www.lix.polytechnique.fr/~kaustuv/uncat/bigmarshal/html/BigMarshal.html
<kaustuv_> Probably to be added to BatBigarray. However, it requires a tiny bit of C to work. I'll contribute patches against master.
<mfp> thelema: it uses a mmap'ed area instead of a C buffer which has got to be copied to the OCaml buffer
<mfp> so it can just blit directly from the mmap'ed area to the final buffer
<thelema> kaustuv_: interesting... marshalling directly to and from a bigarray (assumedly mmapped?)
<kaustuv_> thelema: yes, directly to the bigarray, without going via strings. mmap'd or not depends on how the bigarray was constructed
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
<thelema> kaustuv_: of course.
<kaustuv_> http://www.lix.polytechnique.fr/~kaustuv/uncat/bigmarshal-0.0.1.tar.gz is the implementation as a separate library, if you are curious
Modius has joined #ocaml
<thelema> kaustuv_: pretty much what I expected
drunK has joined #ocaml
middayc_ has quit [Ping timeout: 276 seconds]
vk0 has quit [Ping timeout: 255 seconds]
vk0 has joined #ocaml
mike_mcclurg has quit [Ping timeout: 240 seconds]
kaustuv_ has quit [Remote host closed the connection]
snarkyboojum has quit [Ping timeout: 250 seconds]
Julien_T is now known as Julien_T_away
Snark has quit [Quit: Ex-Chat]
vk0 has quit [Ping timeout: 240 seconds]
<jonafan> okay, i'm intrigued by LWT
<thelema> wish I could help - all I'm doing with LWT is using their toplevel extension (and that only briefly)
snarkyboojum has joined #ocaml
vk0 has joined #ocaml
<hcarty> thelema: The toplevel extension on its own makes keeping Lwt around worth while :-)
<hcarty> In my experience at least. Sadly, it's not very well documented.
mike_mcclurg has joined #ocaml
jm_ocaml has quit [Ping timeout: 240 seconds]
avsm1 has joined #ocaml
avsm has quit [Read error: Connection reset by peer]
doodo has joined #ocaml
Julien_T_away is now known as Julien_T
<doodo> i have having trouble understanding how to do recursion within recursion in ocaml. The problem i am trying to solve is this: I have a list of elements such as [1;1;1;2;2;3;4] and I want to return a list of lists [[1;1;1],[2;2], [3], [4]] where consecutive elements that are the same are grouped together
<doodo> so i am starting like this: let rec group l = match l with[] -> []|[a] -> [[a]]| a::b::xs -> let rec comp g with[] -> []| [d] -> [d]| x::y::xs -> when x = y -> x::y::(comp (y::xs))igroup l = match l with
<doodo> but i don't understand how to do the recursion within recursion
<orbitz> what is different about recursion if you're alrady in a recursive block?
<orbitz> (and really you can do this all with 1 loop)
<doodo> well do you recurse to find all the consecutive elements?
<doodo> that is what i don't understand. can i pass a value to that and have it recursve in let rec comp g
<doodo> until it finds a consecutive elmenet that is not the same
eelte has quit [Ping timeout: 276 seconds]
<doodo> and then it goes in group ....
<orbitz> sure why couldn't you? almost all ocaml is just recursive loop in recursive loop
<orbitz> but you don't need 2 loops to do this
<orbitz> just store the last element you saw and if it matches append to list, when different create a new list
<doodo> you can't store stuff i thought
<orbitz> what?
<orbitz> let x = 2;; what does that do?
<doodo> you can't change it though
<orbitz> so? you are recursive so you're calling a function, you can specify whateer value you want
<doodo> i understand recursion, i can't get my head around doing it in ocaml :|
<orbitz> let rec group g gs acc = function | x::xs when x = g -> group g (x::gs) acc xs | x::xs -> group x [] (gs::acc) | [] when gs = [] -> List.rev acc | [] -> List.rev (gs::acc)
<orbitz> doodo: what about doing it in ocaml is different htan anywhere else/
<orbitz> you can call that as let group_list = function | [] -> [] | x::xs -> group x [x] xs []
<doodo> it makes more sense to do this as loop
<orbitz> recursion isa loop
<orbitz> do you mean iteratively?
<doodo> yeah iteratively
<orbitz> yeah, if you're used to iteration it likely makes more sense
<orbitz> my recursive solution is really not mcuh different form iterative solution
<doodo> why do you have g gs acc
<doodo> I can only have let group g = as my function
<orbitz> you are restricted?
mike_mcclurg has quit [Ping timeout: 240 seconds]
<doodo> yeah
<thelema> orbitz: assignment
<orbitz> ah
<orbitz> where do you apss teh list to 'group'?
<orbitz> is g you rlist?
<doodo> # group [1;1;2;3;1;4;5;5;6];; - : int list list = [[1; 1]; [2]; [3]; [1]; [4]; [5; 5]; [6]]
<orbitz> then your 'group' function is equivalen tot my 'group_list' funciton
<orbitz> nothing changes
<orbitz> but since this is an assignment i'm ruining your fun of figuring this out by helping significantly
<doodo> yeah i want to do things the way i understand it and yours makes no sense ot me
<orbitz> doodo: well tak ea minut eto reformat it
<orbitz> and then work it out with a pen and paper
Yoric has quit [Quit: Yoric]
jonafan has quit [Quit: Leaving]
<doodo> why is your function the same when mine is let rec group g and yours is let rec group g gs acc? that doesn't make sense
<orbitz> 17:07 < orbitz> then your 'group' function is equivalen tot my 'group_list' funciton
<orbitz> doodo: http://ideone.com/mkzBX
<orbitz> there is at least one mistake in there, which should be easy to find if you play with the code a bit
<doodo> yeah i have no idea what is doing because i didnt write it
<orbitz> i think all bugs are fixed
<orbitz> doodo: What does the 'group' finction i provided do/
<doodo> it just calls the other function
derdon has quit [Ping timeout: 255 seconds]
<doodo> i don't understand what that other function is doing
<orbitz> no
<orbitz> try again
<orbitz> it doesn't just call the other functin
<thelema> orbitz: probably better to lead him to a solution without an accumulator
<doodo> i don't understand. its calling its self but with 4 parameters
<orbitz> doodo: d'oh, another bug, silly me
<thelema> orbitz: probably something straightforward, like nested loops (only nested recursion)
<orbitz> thelema: you thinkt aht would be simpler?
<doodo> i am trying to do nested recursion
<orbitz> the accumulator version 'makes sense' to me
ulfdoz has quit [Read error: Operation timed out]
<doodo> like using this: http://ideone.com/yaQfU
<orbitz> doodo: http://ideone.com/2ZECZ fixed typo you just poitned out ot me
<thelema> orbitz: yes, nested version would be simpler, despite accumulator being more straightforward when they're grokked.
<thelema> doodo: drop line 4, and enter your second recursion when you have a single element
<thelema> have your second recursion return a list of equal elements and... well, you could call your outer function to group the rest
<doodo> thelema: a single element of l? How do you enter the second recursion? That is what i don't understand
<doodo> yeah that is along the lines of what i was thinking
<doodo> but i can't get my head around the syntax
<mrvn> doodo: | a::b::xs -> let rec comp g = ... in comp something
<thelema> | a :: xs -> let rec find_eq_a l = ... b = a ... in find_eq_x (a::xs)
<doodo> ok let me try that
<mrvn> I also often move the inner function before the match so it isn't indented so deep and the match is shorter and easier to read.
<thelema> I'm thinking two mutually recursive functions would work nicely here too
<thelema> but if you're not allowed that...
<doodo> no thats allowed
<thelema> let group g = ... and take_eq a xs = ...
<doodo> what is wrong with this
<thelema> you're matching too much in find_same, and you can pull it outside group at the cost of passing a to it.
<thelema> remove the -> before "when"
coucou747 has joined #ocaml
jonafan has joined #ocaml
<thelema> well, maybe you can match as much as you are in find_same
<thelema> but you'll need to tell ocaml what to do if a != b
<doodo> if they are not equal they should be in to different lists
<doodo> but i can't just return 2 lits, because what if b is supposed to be a part of another list
<thelema> and you'll have some type errors, because find_same needs to return a list of lists, and you're pushing a and b on the front of what you return.
<doodo> so basically I have no idea what i am doing and everything doesn't work
<thelema> doodo: process b::xs using group
<doodo> what does that do
<thelema> group joins adjacent equal values into a list.
<doodo> i haven't defined where it does that though
<thelema> once find_same works, you have.
<thelema> take a step back for a second, can you write a function that returns a list of equal values at the front of its input (and throws the rest away)?
<thelema> i.e. f 1 [1;1;2;3] = [1;1]
<thelema> f 2 [1;1;2;3] = []
<doodo> let me try
<mrvn> doodo: start fresh and do this simple recursive. In each outter step you insert one element into the result. In the inner (the inserting) you recurse through the list list to find the right one. If none found return a new list list, if found grow that list and return the list list. On the way back you put the list list back together.
<jonafan> i was trying to get lwt's socket calls to mesh with BatIO and I conclude that I don't know how to do it.
<mrvn> # let g = group [1;1;2;3;1;4;5;5;6];;
<mrvn> val g : int list list = [[6]; [4]; [2]; [1; 1; 1]; [3]; [5; 5]]
<mrvn> Should it be sorted?
<thelema> mrvn: no
<doodo> can't change the order
<mrvn> doodo: Is the input sorted?
<mrvn> never mind. the example isn't already.
<thelema> mrvn: just group runs of the same value
<doodo> its not sorted, but the order can't change
<doodo> its just grouping consecutive elements that are the same
<mrvn> doodo: oh, so it should be [[1; 1]; [2]; [3]; [1]; .. then? my bad.
<doodo> yerp
<doodo> let group l = match l with[] -> []|a::b::xs -> a::b
<doodo> doesnt that do : group [1;1;2] -> [1;1]?
<thelema> doodo: f 1 [1;1;1;2] = [1;1;1]
<thelema> doodo: no, a and b are both elements, you can't do a::b, the right side of :: needs to be a list
<thelema> and you shoudl do this whole assignment using only | a::xs , and no | a::b::xs
<doodo> how so? Don't you need to see if a and b are equal?
<thelema> not if you already know the value you're scanning for duplicates of
<thelema> the function I'm asking you to write is a helper function
<thelema> helper a xs = ...
<thelema> helper 1 [1;2] = [1]
<thelema> helper 1 [1;1;2;1] = [1;1]
<thelema> helper 1 [1;1;1;2;1] = [1;1;1]
<thelema> helper 2 [1;1;1;2;1] = []
<doodo> i think helper 2 should be [1,1,1,] right? what is it []?
<thelema> because [1;1;1;2;1] doesn't start with 2
<thelema> helper 2 [2;1] = [2]
<thelema> helper 2 [1;2] = []
<thelema> let's not drop teh extra elements, let's keep them
<thelema> helper 2 [2;1] = [2], [1]
<thelema> helper 2 [1;2] = [], [1;2]
<thelema> maybe this will make more sense to you
<doodo> i am still completely lost. I can't think how how to scan the list
<thelema> hmm, maybe you need an accumulator to do things this way...
<thelema> okay, helper 2 [1;2] [3] = [3], [1;2]
<mrvn> First draft: http://paste.debian.net/105581/ (if you want to spoil the fun)
<thelema> helper 2 [2;1] [x] = [2;x], [1]
<doodo> mrvn: tempting, but ill bookmark it for later
<thelema> mrvn: nicely done, I forgot about doing that to avoid the accumulator.
<mrvn> thelema: next step: make it tail recursive
<thelema> It's been a long time since I've wanted to avoid the accumulator
<doodo> i can't use loops either
<mrvn> doodo: In your find_same you already have an outer "a". you should find all the following values that are == a.
<mrvn> (and please paste what you have now. I guess you changed a bit since the last paste)
<doodo> i erased what i had because it was garbage
<thelema> n/m the last two, let's stay with just two arguments to helper.
<thelema> and we can go back to just returning the matching elements for the moment.
ikaros has quit [Quit: Leave the magic to Houdini]
<thelema> we can add returning the non-matching elements
<mrvn> tail recirsive: http://paste.debian.net/105582/
julm has quit [Ping timeout: 250 seconds]
<thelema> mrvn: yes, it becomes easier to use accumulators than to avoid them.
<doodo> I don't see how i am expected to know how to do this after 1 lecture. What about using mutal recursion?
<mrvn> fully tail recursive, the inner loop continues the outer loop: http://paste.debian.net/105584/
<mrvn> doodo: purely an opimization.
<mrvn> doodo: shall we do this step by step from the start?
<thelema> mrvn: that's the solution I had in mind, it's a nice one, eh?
<doodo> mrvn: if you dont' mind
<mrvn> doodo: Lets see how a human would do this. You look at the first element '1', then you count the number of '1's to create cout first group and then you repeat with the rest.
<mrvn> So we need a helper that takes the first element, a list and splits that into all the matching elements and the rest.
<mrvn> split 1 [1;1;2;3;1;4;5;5;6] ==> ([1;1], [2;3;1;4;5;5;6]
<jonafan> my idea is frying my brain
<mrvn> doodo: you think you can write that?
<doodo> mrvn: splitting into a tuple you mean? yeah i think so
<doodo> http://ideone.com/GlXsH this splits a list exactly in half, but i am not sure how to do the split that i need to do
<mrvn> doodo: start with let rec split x list =
<mrvn> or let rec split x = function
<mrvn> Then you have 2 cases to consider: The list continues with 'x' or it doesn't.
<mrvn> How do you check if the list continues with x?
<doodo> you mean like, iterating through the list until the first element is not equal to x?
<mrvn> doodo: no. just checking the first element.
<mrvn> just the match expression
<jonafan> okay my solution works
<jonafan> this is an idiotic way to accomplish this
<mrvn> jonafan: continuation passing style. tricky
boscop__ has quit [Ping timeout: 240 seconds]
Edward has quit []
<mrvn> doodo: hint: you need a 'when'
<jonafan> yeah i definitely like the accumulator version more
<doodo> mrvn: i am not really following :( with let rec split x = ... what is x? why do you bring x down?
<doodo> i don't think I am ever going to understand this :\
<mrvn> x is the element we want to split off from the list. As many leating elements as are equal to x.
<mrvn> leading even
<mrvn> so how do you check if the leading element of a list is equal to x?
<doodo> so | t1::t2 when t1 = x do ......
<mrvn> nearly, | t1::t2 when t1 = x ->
<doodo> jonafan: so wait, you like the jonas brothers? o_O
<jonafan> >:(
<doodo> jk jk
<jonafan> jonathan was taken
<mrvn> let rec split x = function | t1::t2 when t1 = x -> ... So we know t1 = x, now we need to repeat with 2.
<jonafan> some jerkoff somewhere has my name
<doodo> mrvn: so let rec split x = function | t1::t2 when t1 = x -> split x t2 ?
<mrvn> doodo: yes, lets try that. Now we only covered the case when the list continues with x, lets write the other case where it doesn't. | ... -> ...
<mrvn> What should split 1 [2;3] return?
<doodo> my gut says [] because 2 and 3 don't match 1 or is that wrong
<mrvn> doodo: that is half of it. split also has to return the remainder of the list that didn't match.
<mrvn> doodo: split has to return a tuple, remember
<doodo> so it has to return ([], t2)
<doodo> or ([], rest of list)?
<mrvn> | t1::t2 -> ([], t2)? What happenes to t1?
<mrvn> rest of list is better: | list -> ([], list])
<mrvn> | list -> ([], list)
<mrvn> # split 1 [2;3];;
<mrvn> - : 'a list * int list = ([], [2; 3])
<mrvn> # split 1 [1;1;2;3];;
<mrvn> - : 'a list * int list = ([], [2; 3])
<doodo> that is only the second care right?
<mrvn> So something is wrong with the "continues with x" branch. Can you spot it?
<doodo> *case
<mrvn> We now have: let rec split x = function | t1::t2 when t1 = x -> split x t2 | list -> ([], list);;
<doodo> what is the contunies with x branch? you mean where it says split x t2?
<mrvn> yes.
<doodo> shouldn't we do something with t1?
<mrvn> yep.
<doodo> do we want to append to x or something? i am looking at this and i am not sure
<mrvn> doodo: we want to add it to the [] split returns.
<doodo> how do you do that? is it a seperate match case?
<mrvn> doodo: you have to bind it to a variable and then return the new result.
<mrvn> let (same, rest) = split x t2 in ....
<mrvn> short form of let t = split x t2 in match t with (same, rest) ->
<doodo> and that is somehow nested in the split function?
<mrvn> yes
eaburns has left #ocaml []
<doodo> bah i don't know what in does. I am hopeless. I appreciate all your help but I don't think I am going to understand this anytime soon.
<mrvn> doodo: it binds a variable
<doodo> i thought let did that
<mrvn> let ... in ... actually.
<thelema> match also does that, as well as fun
<mrvn> Means you can use the variables from the first ... in the second ...
<jonafan> so with lwt, you don't actually create your threads do you? you just bind and join and stuff?
<mrvn> It just gives the result of the recursive split call a name you can work with
<mrvn> jonafan: afaik lwt are purely coroutines.
<thelema> "in" just indicates the end of saying what "x="
<doodo> I think i am just going to go to office hours and see what is exactly expected of me for this. i really appreciate all your guy's help but probably should just go to office hours
<mrvn> Is this the first exercise you've got?
<thelema> I don't think we're leading you past what's expected on this assignment (well, ignore jonafan's solution)
<thelema> if you've seen mutual recursion, then you got your preparation for this assignment
<jonafan> yes. ignore it, it's madness
<doodo> yeah its the first exerscise with 1 lecture on ocaml that covered jack sh*t
<thelema> well, maybe he's planning on covering more before it's due.
<doodo> all i got was how to do matching and that is about it
<doodo> its due tonight
<thelema> :(
<doodo> like like 5 hours
<jonafan> seems a bit involved for the first exercise.
<doodo> *in
<doodo> well they don't cut us any slack i guess
<mrvn> yeah. Normaly first you do factorial, binomi numbers, list reversal, counting the length of a list and such stuff
<doodo> and looks like office hours ended. son of a b
<thelema> jonafan: there are pretty simple solutions, it's just that you have to understand the problem in the right way
<doodo> I could do this in java or c easily
<doodo> even recursively
<doodo> me + recursion = bffs
<doodo> and this only really happened after i learned dynamic programming
<mrvn> to understand recursion you have to first understand recursion
<thelema> mrvn: :)
<doodo> i love computer science jokes
<mrvn> doodo: Lets try something simpler. How do you computer the length of a list?
<doodo> isnt there a function for that
<mrvn> doodo: sure, but now you write that.
<mrvn> let length = function ...?
<mrvn> +rec
<thelema> let length l = match l with ...
<thelema> +rec
<mrvn> hehe
* thelema wouldn't mind if rec was removed
<mrvn> doodo: you do know that "let rec length l = match l with ..." can be shortened to "let rec length = function ...", right?
<doodo> let rec length l = match l with []->0 | [a] -> 1 | x::dx -> 1 + length xs
<thelema> mrvn: he's seen this, but is more comfortable with the first
<jonafan> middle case is not needed
<mrvn> doodo: Ok. some simplification: x::dx already matches a::[] == [a].
<doodo> oh ok. but is mine still correct?
<thelema> doodo: your solution works correctly, you just don't need three cases, the first and last are sufficient
<mrvn> doodo: yes.
<doodo> ah ok
<mrvn> let rec length l = match l with []->0 | x::dx -> 1 + length xs
<mrvn> Or: let rec length l = match l with []->0 | x::dx -> let t = length xs in t + 1
<thelema> s/dx/xs/
<mrvn> Ups, yeah. Do you see what I did there with the "t"?
<doodo> so t is like the return value?
<doodo> which can be used later because its a variable essentially?
<thelema> yes, t is the return value of length xs
<mrvn> doodo: In C you would call it a temporary variable.
<thelema> yes, it's like a const variable
<mrvn> In functional languages you say: t is bound to the result of (length xs).