<reltuk>
the other one is a tail recursive product_of_list function that doesn't perform *any* multiplications if there's a 0 in the list
<Smerdyakov>
That is too!
<mrvn>
let rec power = function [] -> [] | x::xs -> let l = power xs in (List.map (fun y -> x::y) l) @ l
<Smerdyakov>
WTF?
<Smerdyakov>
mrvn, did you just answer someone's homework question?
<Slackwarrior>
omg!!!!
<Slackwarrior>
i've never seen so much power :)
<Smerdyakov>
mrvn, someone at my old uni could fail a class for just seeing that answer. (He shouldn't have said the problem, of course.)
<mrvn>
Nah, thats just a first sketch. Now one has to make it tailrecursive
<mrvn>
That probably stops working for lists of size 10 or something already.
<Smerdyakov>
He didn't say it has to be tail recursive.
<mrvn>
It hast to to be functioning.
<mrvn>
reltuk: For the other problem: What other way is there than to first look for a 0 in the list and otherwise fold_left multiply it?
* Smerdyakov
pronounces sourly that reltuk should look at more examples if he finds these problems hard.
<reltuk>
I could simply go through the list, but I think it's supposed to be o(n)
<Smerdyakov>
reltuk, that's impossible.
<reltuk>
it's impossible to be o(n)?
<Smerdyakov>
reltuk, yes. You'd have to skip some inputs. Do you mean O(n)?
<Slackwarrior>
a syntax error??? oh no!
<reltuk>
yes...O(n)...sorry for not capitalizing
<Slackwarrior>
i got (as always)
<Slackwarrior>
type term = Const of int | Var of string | Term of string * term list;;
<Smerdyakov>
reltuk, you do know that both have formal meanings, right?
<Smerdyakov>
(Both O() and o())
<Slackwarrior>
and i did a pattern matching like this:
<Slackwarrior>
|Term s l -> applysubst sigma l
<reltuk>
oh...I've never seen o()...sorry for the confusion
<Slackwarrior>
i get a syntax error on the l
<Slackwarrior>
why
<Smerdyakov>
reltuk, roughly speaking, o() means "better than," while O() means "as good as or better than"
<reltuk>
anyway, I think it's supposed to be O(n), but nothing says is, so maybe I'm just making it too hard on myself
<Smerdyakov>
Slackwarrior, because you need to go ask your teacher.
<mrvn>
reltuk: Thats O(n)
<Smerdyakov>
reltuk, you would have to make an *effort* to get a solution worse than that.
<Slackwarrior>
Smerdyakov: my teacher is unreachable
<Smerdyakov>
Slackwarrior, I'm sure it's your fault for not planning ahead to get help.
<mrvn>
No matter what you do, simply just allways multiplying is the best O() you can get.
<reltuk>
and short circuiting at 0...I could do that no problem...
<reltuk>
but not performing any multiplications and making it tail-recursive eludes me for the time being
<Slackwarrior>
Smerdyakov: you're wrong. My teacher explained ocaml in two weeks and after that gave us a homework to do in 6 days
<mrvn>
reltuk: why should you? more work short circuting and theorecticaly the same.
<Slackwarrior>
Smerdyakov: believe me, my teacher is a bastard
<Smerdyakov>
Slackwarrior, 6 days includes chances to ask for help.
<Slackwarrior>
Smerdyakov: in these 6 days my teacher is unreachable
<mrvn>
Slackwarrior: than read the tutorial so long till you understand it
<Smerdyakov>
Then punch him out.
<Slackwarrior>
i was thinking of that solution....
<mrvn>
You already wrote some code so you can#t be that dumb that you won't get it.
<Slackwarrior>
mrvn: ocaml gives me the weirdest errors
<mrvn>
If in doubt specify types for your bindings.
<Smerdyakov>
And compile as often as possible!
<mrvn>
And use the ocamlp4 parser
<Slackwarrior>
and the interpreter still gives me error even when i correct the source, then i launch it once again and it all correct
<reltuk>
let rec listprod list acc = match lst with [] -> acc | (x::xs) -> if x = 0 then 0 else (listprod xs (x*acc));;
<mrvn>
Slackwarrior: use the compiler.
<reltuk>
that's the best I can get :-p
<Slackwarrior>
ok
<Smerdyakov>
Slackwarrior, you're not redefining your datatype and then trying to use values defined with the old type, right??
<mrvn>
reltuk: Thats doing multiplications even if there is a 0 in there.
<Smerdyakov>
Slackwarrior, even if you give the same definition of the type, it creates a new version.
<reltuk>
mrvn : yeah, I know...that's why I can't solve it :-p
<mrvn>
reltuk: lookup List.mem
<Slackwarrior>
what have i to do
<Smerdyakov>
I doubt it's not OK for reltuk to do multiplications....
<reltuk>
mrvn : that'd make it O(n^2)...wouldn't it?
<mrvn>
reltuk: There is no better way then to first just look at every element for 0 and if none is found multiplay in a second loop.
<mrvn>
reltuk: no O(2n) == O(n)
<reltuk>
ahh, right...
<Riastradh>
mrvn, but his solution is better than using mem, because he only traverses the list once even if there are zeros in it.
<reltuk>
O(2n) = O(n) anyway
<mrvn>
or rather O(3n) cause your looking at every element 2 and multiplying once.
<Smerdyakov>
Slackwarrior, when you redefine a datatype, stop using old values of the old types.
<mrvn>
Riastradh: sure, but not the homework.
<Slackwarrior>
ok
<reltuk>
ok, I thought there was a better way, but yeah, this is really trivial
<mrvn>
Slackwarrior: write the code into a file and compile it anew after every change. That way you won#t have those freak probelsm with old bindings.
<Smerdyakov>
But interactive environments are THE BEST!
<mrvn>
reltuk: The homework would suggest there is, because as it is its plain stupid.
<mrvn>
Smerdyakov: not if your unable to paste the right amount of code each time.
<Slackwarrior>
how can i avoid that the mattern matching on a list considers [] ?
<Smerdyakov>
mrvn, in SML, you use the source code each time.
<Smerdyakov>
mrvn, meaning the standard 'use' function.
<Slackwarrior>
mrvn: ok ill use ocamlc
<mrvn>
Slackwarrior: you can't.
<Slackwarrior>
shit...
<mrvn>
[] -> assert false
<mrvn>
or ignore the warning
<Slackwarrior>
whats assert
<mrvn>
assert throws an exception if the parameter is false
<Slackwarrior>
ah ok
<Slackwarrior>
a function cant be void, can it?
<mrvn>
nearest thing to void is <something> -> 'a
<mrvn>
where 'a doesn#t appear in <something>
<mrvn>
like exit
<Riastradh>
Where C programmers would use void, OCaml programmers will generally use unit.
<reltuk>
I thought nearest thing to void was ()
<mrvn>
depending on what you call void.
<Slackwarrior>
ok
<mrvn>
ocaml doesn't have procedures. everything returns some value.
<Slackwarrior>
well i got something like
<Slackwarrior>
let rec applysubst sigma t = match t with
<Slackwarrior>
......
<Slackwarrior>
| Term(s,l) -> do applysubst sigma (each element of l)
<Slackwarrior>
ooops
<Slackwarrior>
without do
<Slackwarrior>
l is a list
<mrvn>
don't you want to return the term with sigma applied to l?
<Slackwarrior>
no
<mrvn>
Then whats the point of applying it?
<Slackwarrior>
i need it
<Slackwarrior>
or maybe i have to rewrite the function from scratch
<mrvn>
Lets make an analogy: Your buying a car. You have it custom build for you, your paying for it but your never picking it up. Whats the point of buying that car?
<Slackwarrior>
i have to rewrite the function from scratch...
<mrvn>
no you don#t
<mrvn>
You just have to return the results of your work.
<mrvn>
Because otherwise there is no point of doing the apply in the first place.
<Slackwarrior>
i have to do
<Slackwarrior>
| Term(s,l) -> for each element x of the l list do applysubst sigma x
<Riastradh>
Grumble, is there still no Cocoa binding for OCaml?
<Slackwarrior>
it's impossible i think
<mrvn>
applysubst should be sigma -> term -> term, right?
<Riastradh>
Slackwarrior, uh, no, that's quite easy.
<Slackwarrior>
but in this way in the case of Term(s,l) i get no return value
<mrvn>
But you should have.
<Slackwarrior>
mrvn can you look at my code? i think it's just crap....
<mrvn>
you will want to return some Term (s, l2) where l2 is the list where each element is the element of l after applysubst
<mrvn>
From past expecience I say its 99% done but your just shuting down your brain because your lazy.
<Slackwarrior>
im not lazy, i just have no idea on how to do it
<mrvn>
Ever though of getting a study budy? helps to get over dead points in your thought process.
<Slackwarrior>
lol i think noone will do this homework
<mrvn>
Then why do you?
<Riastradh>
Why are you taking the class if you have no desire to do any work?
<Slackwarrior>
im trying to do it, i have ideas but i dont know how to bring them in ocaml
<mrvn>
Slackwarrior: and I already told you exactly what you need to do. You just have to translate english to ocaml.
<Slackwarrior>
ehmmm... im italian :P
<Slackwarrior>
ok ok
<Slackwarrior>
do you remember the substitution thing?
<Slackwarrior>
i got a term and i apply this substitution
<Slackwarrior>
now i have to do that apply function
<Slackwarrior>
but it's a mess
<Slackwarrior>
so the substitution is a list of couples (string * term) list
<Slackwarrior>
i have to check if there's a Var x so that x is equal to the first element of the couple
<Slackwarrior>
and i have to replace it
<Slackwarrior>
it's a mess
<Slackwarrior>
applysubst must be then (string * term) list -> term -> term
<Slackwarrior>
hello?
<Riastradh>
Hi.
nudedude is now known as docelic|sleepo
* mrvn
wonders where Slackwarrior gets the idea from that exception Not_found takes a string argument.
<reltuk>
ok...powerset works...
<reltuk>
now to order it like they have in the assignment :-p
<reltuk>
hmm...this order isn't coming out correctly
<reltuk>
anyone care to tell if htere's a better way to calculate a powerset than what I'm doing
<reltuk>
let rec powerset p = let rec powaux p acc = match p with
<reltuk>
[] -> acc | (x::xs) -> (psaux xs (acc @ (prepend x ([]::acc)))) in []::(psaux p []);;
<reltuk>
prepend takes a list of lists and puts x on the front of all of them
<reltuk>
the homework just says "if you're doing it correctly, matching our order shouldn't be hard"...
<reltuk>
but my waay doesn't like their order apparently
foxster has quit [Read error: 104 (Connection reset by peer)]
lament has joined #ocaml
<mrvn>
psaux?
<mrvn>
and why manually add [] to the result?
<reltuk>
that should be powaux...
<reltuk>
I manually add it because it's not there at the end
<mrvn>
but all others are?
<reltuk>
I used to pass in [[]] for the seed acc, and that worked, but I was messing with the ordering
<reltuk>
yeah, it generates valid power sets, just not in the right order :-p
<mrvn>
and the @ is evil
<mrvn>
What oder do you need?
<reltuk>
I know @ is evil...is there a way around it?
<reltuk>
the order I get is like powerset [1;2] -> [[]; [1]; [2]; [2;1]];;
<reltuk>
so it's just like...backwards or something :-p
<reltuk>
maybe they want non-tail-recursive
<reltuk>
the real version at this point is:
<reltuk>
let rec powerset p = let rec psaux p acc = match p with
<reltuk>
[] -> acc | (x::xs) -> (psaux xs (acc @ (prepend x (acc)))) in
<reltuk>
psaux p [[]]
Riastradh has quit [Killed (NickServ (Ghost: _Riastradh!~riastradh@pool-141-154-203-144.bos.east.verizon.net))]
Riastradh has joined #ocaml
<reltuk>
wb Riastradh
Kinners has joined #ocaml
<mrvn>
let pow p = let rec aux acc = function [] -> []::acc | x::xs -> aux ([x]::(List.fold_left (fun acc y -> y::(x::y)::acc) [] acc)) xs in aux [] p;;
<mrvn>
val pow : 'a list -> 'a list list = <fun>
<mrvn>
How about that?
<async>
that looks disgusing :(
<async>
disgusting*
Smerdyakov has quit ["sleep"]
docelic_ has joined #ocaml
foxster has joined #ocaml
docelic|sleepo has quit [Read error: 110 (Connection timed out)]
__DL__ has quit [Read error: 54 (Connection reset by peer)]
<mrvn>
let pow p = let rec aux acc = function [] -> acc | x::xs -> aux (List.fold_left (fun acc y -> y::(x::y)::acc) [] acc) xs in aux [[]] p;;
<mrvn>
That any better?
foxen has joined #ocaml
__DL__ has joined #ocaml
Kinners has left #ocaml []
foxster has quit [Connection timed out]
<reltuk>
heh, I was afk for a while, sorry
<reltuk>
I can't use any auxillary functions like fold_left...I guess I could write it locally I think
<reltuk>
is fold_left tailcall or is fold_right? I forget...
<mrvn>
left is
<mrvn>
let ref fold_left f accu = function [] -> accu | x::xs -> fold_left f ((f x)::accu) xs
<mrvn>
you can inline that of cause.
<reltuk>
yeah...your way is really clever :)\
wax has quit [Remote closed the connection]
wax has joined #ocaml
jhy has quit [Read error: 104 (Connection reset by peer)]
mrvn_ has joined #ocaml
mattam has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
gene9 has joined #ocaml
<gene9>
Yurik: hi
lament has quit ["I WILL NOT TEASE FATTY"]
reltuk has quit [Read error: 104 (Connection reset by peer)]
gene9 has quit [Read error: 104 (Connection reset by peer)]
Verbed has joined #ocaml
Verbed has quit [Remote closed the connection]
docelic_ is now known as docelic
Yurik has quit [asimov.freenode.net irc.freenode.net]
Yurik has joined #ocaml
reltuk has joined #ocaml
noss has joined #ocaml
noss has quit [Client Quit]
__DL__ has quit [Remote closed the connection]
rhil is now known as rhil_zzz
CrAcSoFt has joined #ocaml
CrAcSoFt has left #ocaml []
<Slackwarrior>
how can i force a variable to be of a certain type?
<mattam>
type it: (myvar : thetype)
<Slackwarrior>
ah ok thanks
<Slackwarrior>
and i have a mutual recursion but only one of the two functions is recursive
<Slackwarrior>
can i do let...... and rec...... ?
<mattam>
no
<mattam>
you must writ let rec f ... and g
<mattam>
write...
<Slackwarrior>
ah ok
docelic is now known as docelic|away
<Slackwarrior>
ppl the interpreter is giving me weird types
<Slackwarrior>
look at this:
<Slackwarrior>
type term = Const of int | Var of string | Term of string * term list;;
<Slackwarrior>
let rec applylist sigma x = match sigma with
<Slackwarrior>
[] -> Var x
<Slackwarrior>
| (sx,sy)::tl when sx=x -> sy
<Slackwarrior>
| _::tl -> applylist tl x;;
<Slackwarrior>
let rec applysubst sigma t = match t with
<Slackwarrior>
Var x -> applylist sigma x
<Slackwarrior>
| Const x -> Const x
<Slackwarrior>
| Term (f,l) -> Term(f,(applyargs sigma l))
<Slackwarrior>
and applyargs sigma l = match l with