<dark>
also, for some reason i think the program logic is not ocaml-ish. that if a = b then exit 0 else ..
<sc30317>
bluestorm, then it says that lr_matrix is an unbound value when I clearly have it defined earlier
<sc30317>
whats up dark?
<bluestorm>
hm, where did you declare lr_matrix ?
<sc30317>
duh
<sc30317>
lr_vecctor
pimmhogeling has joined #ocaml
<bluestorm>
you know
<bluestorm>
when the ocaml compiler reports an error
<bluestorm>
you're usually the one wrong
<bluestorm>
:-p
<sc30317>
haha thats true
<dark>
hahahaha
* dark
usually don't understand 'up', 'out', .. expressions, such as 'whats up'
<sc30317>
whats up = how are you doing
<sc30317>
going out = going to bars/clubs/etc
<dark>
i'm fine :-P
<sc30317>
bluestorm, now it seems to be working
<dark>
someone once tried to explain me the general meaning of <something> up, <something> out, <something> off.. it seems to be somewhat random
<sc30317>
except for the fact that it says current_class within the finish loop is unused
<bluestorm>
well, it is unused
<sc30317>
well how do I make is_finished use that as a parameter?
<bluestorm>
it is not the same current_class variable you're referring to
<sc30317>
so I have 2 current_class es?
<bluestorm>
is_finished use the current_class variable defined after the "CREATE THE CURRENT CLASS" comment
<dark>
sc30317, when pasting snippets of code, try to paste something semantically closed, i mean, something that can be ran without external dependencies. it's hard to tell what your code does if someone don't know what compare_vc_current_class does
<sc30317>
sorry dark
pimmhogeling has quit [Ping timeout: 256 seconds]
<bluestorm>
your "let current_class = cur_class ..." in the finish () declaration does not overwrite that definition
<sc30317>
it doesn't?
<bluestorm>
it creates a new current_class variable wich can be used in a further expression
<bluestorm>
in your case, the "finish ()" expression just after that declaration
<sc30317>
is there a way I can get it to overwrite that definition?
<bluestorm>
you could use references
<bluestorm>
but you don't need to here
<sc30317>
ok
<bluestorm>
you just need to pass current_class and w_current as parameters to the "finish" recursive function
<bluestorm>
let rec finish current_class w_current = ... in finish current_class w_current
<sc30317>
I think that worked
<sc30317>
but now I get this
<sc30317>
let current_class = cur_class_vect trainData w_current in
<sc30317>
Error: This expression has type unit but an expression was expected of type
<sc30317>
float list
<sc30317>
is this what I need to fix with the
<sc30317>
if finish() = [] then failwith "no"
<sc30317>
else .....
<sc30317>
?
ski_ has joined #ocaml
rbancrof1 has joined #ocaml
<dark>
it looks like finish will not accept an ()
<dark>
but instead 3 arguments of unknown (for me) type
<dark>
is the first argument an ()? [that's pointless]
patronus_ has joined #ocaml
<sc30317>
not anymore
<dark>
if yes, the result can't be a list
<dark>
ah
<bluestorm>
you have to fix your "finish" declaration so that it really returns a list
<sc30317>
yes, how do I do that?
<bluestorm>
and you probably shouldn't test for finish returning a [], just return its result directly
<bluestorm>
hm
<sc30317>
how would I go about doing so?
<dark>
sc30317, [] is a float list, ok?
<sc30317>
ok
<dark>
it's an 'a list for all 'a
<sc30317>
excuse me?
<sc30317>
bluestorm, how would I return its result directly instead of testing for a []
<bluestorm>
well
<bluestorm>
just write the expression "finish current_class w_current"
<bluestorm>
after the declaration of the "finish" function
<bluestorm>
that expression will call the finish function with those two parameters, and return its value
<bluestorm>
(if it looks stangely simple, it's because it is)
<sc30317>
haha ok
karuza has quit [Quit: ...]
<sc30317>
hold on, ill test this
ski has quit [*.net *.split]
rbancroft has quit [*.net *.split]
patronus has quit [*.net *.split]
<drewbert>
bluestorm: do you have an example of concatenating a list of lists somewhere?
<sc30317>
bluestorm, what should I put instead of the exit 0?
<dark>
List.flatten?
<bluestorm>
sc30317: you should put the value you want to return
<sc30317>
drewbert, just do it once and do a List.map
<dark>
drewbert, can you use some library functions? or just bare recursion?
<drewbert>
no library functions
<drewbert>
we have a version of map and fold available to us
<dark>
a clever way of cheating is writing fold as an .. wow
<dark>
flatten is very nice with fold
<dark>
fold = create an arbitrary data structure from a list
<drewbert>
i started off with fold, confused myself, switched to map, confused myself, switched to basic recursion, confused myself and threw the temper tantrum you see before you
<dark>
aahahhahahahaha
<dark>
map will not do the job afaik
<dark>
drewbert, you concat does not really need to be efficient, right? i think that a simple fold, maybe with a "reverse list" (you can write it as an auxiliary function).. will do the job nicely
<dark>
can you use @?
<dark>
or you must concatenate two lists manually?
<drewbert>
I think manually
<drewbert>
I've yet to see a @ in lecture.
<dark>
let concat_lists list_of_lists = List.fold_left (fun acc el -> acc @ el) [] list_of_lists
<dark>
do this works?
Yoric has quit [Quit: Yoric]
<dark>
if yes, you need to use your own fold, and reimplement the @ as an auxiliary function
<drewbert>
let me see
<dark>
you know that fold receives an accumulator and the top of the list, and return an accumulator, right?
<drewbert>
we covered fold, but in the "here's how you add up all the numbers in a list" sense
<dark>
this accumulator is a "temporary" variable to hold the "current" concatenation of the first N lists.. its initial value is [] (passed to the fold), and it will be returned when the list_of_lists is exhausted
<dark>
... :)
<dark>
but you know that in this example of adding numbers, the first argument is holding the "sum of previous numbers", and the second is the "next number", right?
<dark>
like List.fold_left (fun previous next -> previous + next) 0 numbers
<dark>
previous accumulates the value of previous iterations
<dark>
next is the top of the current processing list, i.e the "next" value to be computed
<dark>
the return value of (fun previous next -> previous + next) is of same type as previous, because it will be passed again to this function if necessary
<dark>
but the type of next isn't necessarily equal to this; it's the type of the "first value" (i.e. 0 in this case)
<drewbert>
i see
<dark>
don't you think this is beautiful? :(
<dark>
when you finally
<dark>
understand this :( :(
<dark>
:~
<drewbert>
hrmmm
<dark>
hm
<dark>
acc @ el is wrong i think
<dark>
maybe acc @ [el] ?
<dark>
@_@'
<dark>
i don't have an ocaml interpreter here :~
<drewbert>
l::r -> l @ flatten r
<dark>
hmm yes you can do that
<dark>
i.. think
<dark>
o.O
<drewbert>
i don't totally understand what @ is
<dark>
hmm my university has a server with ssh and ocaml, hmm
<dark>
# [1; 2; 3] @ [4; 5; 6];;
<dark>
- : int list = [1; 2; 3; 4; 5; 6]
<dark>
this is @ o.o'
<dark>
# let concat_lists list_of_lists = List.fold_left (fun acc el -> acc @ el) [] list_of_lists;;
<dark>
val concat_lists : 'a list list -> 'a list = <fun>
<dark>
it works.. i'm constantly amazed with ocaml. i usually can't program in C or Java or C++ and expect it to run in the first time
<dark>
nope
<dark>
ahh
<dark>
hmm
<dark>
yeah, it's not list.concat
<drewbert>
let rec flatten = function
<drewbert>
[] -> []
<drewbert>
| l::r -> l @ flatten r
<drewbert>
let concat = flatten
<dark>
it's List.append
<dark>
Hm @.@
<dark>
it works?
<drewbert>
right out of /usr/lib/ocaml/list.ml
<dark>
hahahaha
<dark>
:)
<drewbert>
well hopefully that works, but I'm not allowed to use it
<dark>
you can steal this version... use my version with fold..
<dark>
both works
<dark>
i think after seeing the two versions, it's hard to create a different version
<dark>
maybe a tail recursive one?
<dark>
drewbert, you can de dishonest and pretend that you found the simple flatten definition by yourself
<dark>
be*
<dark>
or you can not pretend that, but state that this is the "obvious" definition since you saw it :P
<dark>
i think my version, with fold, is tail recursive as long as fold and @ is (with the stdlib, fold is, and @ is not)
<dark>
but you probably don't need to write it in this style
<drewbert>
let rec concat_lists x = fold((fun(acc, el) -> acc @ el), [], x) works
<drewbert>
you've been really helpful dark, thank you so much
<dark>
you're welcome
<dark>
i feel somewhat guilty
bmp has joined #ocaml
<drewbert>
but I need to still replace @ with something else, but I think I know how I will do it
<dark>
the real wtf here is that your fold receives a tuple
<drewbert>
hahaha, I keep getting that
<dark>
do you already know what is a tuple, but not what is currying?
<drewbert>
the project was assigned before they taught currying
<dark>
it's your professor "style"?
<drewbert>
so they just make it take tuples
<dark>
o.O
<dark>
currying is more elementary than tuple in ocaml
<drewbert>
but I guess they decided tuples were easier for people coming from java/c/ruby
<dark>
hmmm it's not an freshmen course?
<drewbert>
not, it's a 3rd year course
<dark>
hm
<dark>
3rd year and you still saw no FP?
<dark>
u.u
<drewbert>
we've seen function pointers in c, and anonymous classes in java and high order functions in ruby
<dark>
i suppose you at least can use this fold in, say, ruby (it's reduce there)
<dark>
high order functions? hmm..
<dark>
your teachers used ruby? nice :)
<drewbert>
personally i think it was a bad decision on the part of the instructor, because everywhere I look for help I have to explain it
<dark>
explain what?
<dark>
bad decision: to use ruby?
<drewbert>
explain why I'm using tuples instead of currying
<drewbert>
bad decision: tuples instead of currying
<dark>
yes i think so too. because then the "natural" functions, let f a b = .. instead of let f (a, b) = .. will look "unnatural" for the alumni
<drewbert>
ruby is not a bad decision, I had a great time with ruby. I like scripting languages.\
<dark>
int q (int a, int b); is a function that receives 2 parameters in C, but let f (a, b) = .. receives only one in ocaml (a tuple)
<dark>
i am loving ruby too, i'm learning it :)
<dark>
i know nothing about anonymous classes, but function pointers don't really make functional programming: in C, it's unnatural and undesirable (most of time) program in functional paradigm. by functional here i mean without explicit state (like mutable variables)
<drewbert>
I like C, and ruby, and with a moderate amount of shame, PHP
<dark>
hahahaha
<dark>
i liked php in past
<dark>
at about same time, mirc scripting was my favorite language on windows
<dark>
two braindead languages :( i still remember most of their quirks :(
<drewbert>
python is nice too, but I've had onlythe few scripts I had to write for work in it
<dark>
ruby has a nice functional programming support, with high order functions, closures, etc.. (without high order functions, FP is really painful, but possible), but it does not have (usually) tail call elimination
<dark>
so with some recursive functions you can easily have a stack overflow
<drewbert>
Javascript is fun until you try to support IE.
<dark>
(in ocaml, if you have "tail recursive" functions, it will be translated into a 'loop', and will not grow the stack)
<dark>
i don't know much of javascript, but it is interesting
<dark>
i like lua too :t
<drewbert>
I have no idea what lua even looks like.
sepp2k has quit [Quit: Leaving.]
<dark>
it's minimalistic. do you know scheme?
<drewbert>
I know some ada?
<dark>
it's like scheme (in minimalistic design), but with a syntax less arcane
<dark>
ada is nothing like scheme
<dark>
drewbert, with lua, there is just a data structure: hash tables. they are used to implement arrays, objects, ..
<drewbert>
ah, then no
<dark>
you can do some syntax sugar with ruby for 'feeling' some lua features
<dark>
a.b in lua is just a["b"]
<drewbert>
in javascript every variable is a hash, but it can also be a number of other things
<dark>
so object.method is really a lookup for a string in hash table object
<drewbert>
same in javascript
<dark>
hm @.@
<drewbert>
except there are prototypes
<drewbert>
there are different levels to the hash table
<dark>
in lua you can do "if a value is not found in this hash table, search this other hash table"
<dark>
i.e. inheritance
<drewbert>
and it looks first in the local hash table, and then goes up to the global scope
<dark>
;; is used only in the top level interpreter (and hmm it is needed in some ugly .ml programs)
<drewbert>
yeah, the ;; is just there so that any errors I make don't pop up in lines later on
<drewbert>
so I know where my errors are
<dark>
hmmmmmmm it really does this? o.o''
<dark>
if you don't put bare expressions in your program, then you will be fine
<dark>
i.e. instead of print_endline "a" or let a = "b" in print_endline a, something like let _ = print_endline "a" or let () = let a = "b" in print_endline a
SEcki has quit [Remote host closed the connection]
zhijie has quit [Read error: Connection reset by peer]
zhijie has joined #ocaml
zhijie has quit [Read error: Connection reset by peer]
zhijie has joined #ocaml
zhijie has quit [Read error: Connection reset by peer]
zhijie has joined #ocaml
zhijie has quit [Read error: Connection reset by peer]
maskd has quit [Quit: leaving]
zhijie has joined #ocaml
<sc30317>
dark, you here?
<dark>
yes
<sc30317>
I have this line
<sc30317>
if is_finished = true || !count = maxiterations then w_current
<sc30317>
how could I add in that I want to set count back to 0?
<sc30317>
let count = ref 0;; is what I did initially out of the loop
<sc30317>
then I called count from within the loop
<sc30317>
I tried this
<sc30317>
if is_finished = true || !count = maxiterations then begin !count = 0; w_current end
<sc30317>
but it didn't like that
<sc30317>
:(
<dark>
do you know this is not the usual ocaml style, right?
<dark>
if you want C, do this:
<dark>
let (++) c = c := !c + 1
<dark>
then, count++
<dark>
hmm
<sc30317>
ok
<dark>
++count
<sc30317>
but I just want to set it back to 0 when is_finished is true
<dark>
but anyway, you shouldn't design your system like this! :o but okay, you are still learning
<sc30317>
yea
<sc30317>
this is true :D
<dark>
having "mutable state" is "imperative programming"
<dark>
i.e., a variable you change thought your code
<sc30317>
well I want to shy away from imperitive programming
<sc30317>
how would you do this if you didn't want to use any imperitive?
<sc30317>
because you would still need something to print which iteration you are on?
<dark>
you can write all this kind of code with recursive functions
<dark>
give me the whole function and i give you a recursive version of it
<dark>
sc30317, "mutable state" = variables that you change by assignment (a := b, etc)
<dark>
how to eliminate mutable state: pass the state as a parameter to all functions that need it
<dark>
if you need to change the state, call the function again with the new state
ulfdoz has joined #ocaml
<dark>
then, you change the state in the "new" calls, but the old calls will continue to use the old state
<dark>
sc30317, why does you receive a tuple as parameter?
<sc30317>
which are you talking about?
<dark>
let a(b, c, d) = .. is not a multi parameter function
<drewbert>
can someone tell me how i can get "let pos_of_xy(x, y, s) = ((x * find_board_size(s)) + y)" to return an int?
<dark>
it receives just one parameter, a tuple (in this case, a triple)
<sc30317>
which function?
<dark>
drewbert, drewbert x * (find_board_size s) + y
<dark>
sc30317, sde3
<dark>
sc30317, why are you are using ; instead of in? o.o'
<sc30317>
because that is what I am supposed to pass to sde3
<sc30317>
and I am using ; instead of in because that's how it worked?
<dark>
a; b means do a, then do b
<drewbert>
dark, that did it, thanks, I need to remember that
<dark>
where count is defined, sc30317? it's a.. global variable?
<sc30317>
yea
<dark>
if you want to change a global variable,you are automatically programming in imperative style
<sc30317>
let count = ref 0;;
<sc30317>
oh
<dark>
in functional programming, you would just return the new value of count
<sc30317>
well I would like to avoid that
<dark>
along with other values
<sc30317>
ok
<dark>
sc30317, i guess this is really hard for someone that never studied FP before :(
<sc30317>
dark, definitely
<sc30317>
what would I have to change in my sde3 to make it functional?
<dark>
first thing, you need to design the flow of the program in a different style
<sc30317>
ok....
<dark>
instead of calling a function that will change a global var (and then checking for this var), you must call a function that will return what it usually returns, plus the new value of the external variable
<dark>
and then use this new value in the rest of program
<dark>
something like
<dark>
let new_value_of_count, other_things_returned = function_call .. in ..
<sc30317>
where would I put this in the code?
<dark>
in the code that will call sde3
<dark>
if you have let f a = (1 - a, 2 + a)
<dark>
you can do let q, w = f 2
<dark>
then q is -1, w is 0
<dark>
then f returned two things (in reality a tuple)
<sc30317>
well then how would you print out the number in the loop
<sc30317>
for example, here is what my output of the current program is
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
<dark>
also, it is usually recommended for you to make sde3 to actually receive 3 parameters (with let sde3 trainData lr maxinterations(it ought to be interactions..) wint = .. instead of the (, , ,).. unless the tuple is actually just one variable
<sc30317>
the tuple is just 1 variable (a list)
<dark>
no, not a list
<dark>
but ok, if the tuple is just one var you can use this style
<sc30317>
well l have to pass it just as shown in the pastebin
<dark>
but hey
<dark>
this count variable, is used just inside your function?!
<dark>
omg, :)
<sc30317>
yes
<dark>
finish must receive count as parameter
<sc30317>
ok
<dark>
it changes count inside it, right? instead that, you send the new value of count to finish
<sc30317>
yes, finish changes count inside it
<sc30317>
that is the only place count is used
<dark>
this is the essence of imperative programming
<sc30317>
so I could just change my finish function
<sc30317>
and make it all imperitive
<dark>
functional programming does exactly the same thing by passing the state as parameter
<sc30317>
what would I need to change in the finish function?
<dark>
well it is already too imperative for the usual ocaml practice
<dark>
then inside it, call in the recursion maybe finish w_current current_class new_mult new_vect error_vect (count+1)
<dark>
and check for count <= maxiterations to decide if you want to go thought recursion
<sc30317>
but if I call 0 in finish w_current current_class new_mult new_vect error_vect 0
<dark>
hm?
<sc30317>
then how will it know in the recursion?
<dark>
it will receive count as 0, right?
<sc30317>
I'm trying to get rid of the imperitive stuff
<dark>
then you do (count +1) for the next value of count
<dark>
this is the way of getting rid of it o.o
<sc30317>
I just want to get rid of the global var count right?
<sc30317>
I want to make my program non iterative
<dark>
you want to get rid of mutable state
<sc30317>
yes
<dark>
hmm o.o
drewbert has quit [Read error: Connection reset by peer]
<dark>
your function is tail recursive
<sc30317>
yes
<dark>
all tail recursive functions describe iterative processes
<dark>
this is how you achieve iterations with fp, so yes, you want it to be 'iterative', but functional
<sc30317>
correct
<dark>
also, if you do an let a = b in , don't increase the indentation
<sc30317>
ok, I wont
<sc30317>
so how would I do that?
<dark>
!count = maxiterations then w_current , first you change this to count = maxiterations then w_current
<dark>
incr count; then you get rid of this
<dark>
then you change finish w_current current_class new_mult new_vect error_vect count into finish w_current current_class new_mult new_vect error_vect (succ count)
<dark>
instead of succ count you can put count + 1
<dark>
then you call it as finish w_current current_class new_mult new_vect error_vect 0
<sc30317>
ok
<dark>
also, try to indent your code with 2 spaces (i sometimes use tabs when indenting ocaml code, from C... but this is contrary to all other ocaml code out there)
<dark>
i changed all "new values" of variable to variable'
<sc30317>
syntax error
<dark>
where?
<dark>
and started tracking down if you are using the new or the old value
<sc30317>
at the end
<dark>
ah
<dark>
i ommited the in ... part
<dark>
you can put it of course
<dark>
if this is the style of your code :)
zhijie has joined #ocaml
<sc30317>
that still prints all 3 iterations
<dark>
really? o.o
<sc30317>
yea
zhijie has quit [Read error: Connection reset by peer]
<dark>
ok, you probably can use something like that: a function that receives a parameter, stores it in a place, and whenever you call it with another parameter, it prints the previous value, and update it with the new value
<dark>
seems like a valid approach
<sc30317>
excuse me?
<sc30317>
what do you mean?
zhijie has joined #ocaml
<dark>
hmmm.. i mean exactly what i said, o.o i can give you a proof of concept, hold on
<sc30317>
thanks dark
zhijie has quit [Read error: Connection reset by peer]
zhijie has quit [Read error: Connection reset by peer]
<sc30317>
unbound constrictor Value
<dark>
ops
<dark>
Some value
<dark>
suppose you have a function print_my_values for printing values of type A. you can then create a delayed function, called print_my_values_in_a_delayed_fashion, like this: let print_my_values_in_a_delayed_fashion = make_delayed_printer print_my_values
<dark>
(the descriptive names are just for making it more obvious)
<sc30317>
now where would I add this delayed into my function?
<dark>
in some place, out of this sde3 function
<sc30317>
ok then where would I call it?
zhijie has joined #ocaml
<dark>
then you create a function out of sde3 function too, that will print a w_current
<dark>
the delayed printer is a hack for getting rid of the "last"
<dark>
the last will be sent to the printer, but will not be printed
<sc30317>
:D :D :D
<sc30317>
got it
<sc30317>
I <3 you dark
<dark>
... but you can't reuse the print_it_delayed for another call, right?
<dark>
you can define it as being local to sde3
<dark>
so that you build a new "delayed printer" object each call of it
<dark>
(you can define it in the top, with let print_it_delayed = make_delayed_printer print_one_entry in)
<sc30317>
how would you define it local to sde3? just add it within sde3?
<dark>
yes, but with in at the end
<dark>
it would be: let sde3(trainData, lr, maxiterations, winit)= let print_it_delayed = make_delayed_printer print_one_entry in <... rest of definition >
<dark>
with appropriate identation and line breaks etc
<sc30317>
dark, you are awesome man
<dark>
thank you
<sc30317>
no problem
<dark>
it's fun to help with such problems, but hey
<dark>
you shouldn't try to fool your boss, because he can verify some of the code wasn't from yourself
<dark>
i think
<sc30317>
definitely
<sc30317>
I will tell him I got help for sure
<dark>
that 'make_delayed_printer' is the kind of thing you would find if you searched google for ocaml snippets and such
<sc30317>
ok
<dark>
functional programming is full of such things :)
<sc30317>
gotcha
bmp has quit [Quit: bmp]
<dark>
let make_counter () = let i = ref 0 in let counter () = i := !i + 1; !i in counter
<dark>
then let c, d = make_counter(), make_counter()
<dark>
c and d are two independent counters
<dark>
c() is 1, then 2, then 3..
<dark>
[ in fact this is imperative, but it's a somewhat common style in ocaml ]
<dark>
[ it's not common with, say, c, because it does not have lexical scope ]
<sc30317>
gotcha
drewbert has joined #ocaml
<drewbert>
hey dark, this is ridiculous, it was working, then it stopped. what was your answer to getting "let pos_of_xy(x, y, s) = ((x * (find_board_size(s))) + y)" to return an int?
<dark>
o.o''
<dark>
let pos_of_xy (x, y, s) = x * (find_board_size s) + y
<dark>
don't overuse parenthesis
<drewbert>
let pos_of_xy(x, y, s) = x * (find_board_size s) + y doesn't work either
<dark>
then find_board_size s is not returning an int,
<dark>
or x is not an int
<dark>
or y is not an int
<dark>
o.o'
<dark>
also it's a (b, c) not a(b, c) in my style :P to emphasis that (b, c) is a single parameter
<drewbert>
thanks, I'll take all the style tips I can get
<dark>
^^
<dark>
check the type of find_board_size, it's something -> int?
<drewbert>
let find_board_size b = int_of_float(sqrt(float_of_int(length(b))))
<dark>
you can also paste the type error here
<dark>
@.@
<dark>
the last length(b) should be written as length b
<drewbert>
File "testPuzzle1.ml", line 19, characters 19-26:
<drewbert>
Error: This expression has type int * int * int
<drewbert>
but an expression was expected of type int * int * 'a list
<drewbert>
testpuzzle.ml line 19 is File "testPuzzle1.ml", line 19, characters 19-26:
<drewbert>
Error: This expression has type int * int * int
<drewbert>
but an expression was expected of type int * int * 'a list
<drewbert>
oops
<drewbert>
sorry
<dark>
which expression?
<dark>
is s a list?
<drewbert>
testpuzzle.ml, line 19 is "prt_int (pos_of_xy (0,0,2)) ;;"
<dark>
what is length..?
<dark>
you did open List, didn't you?
<drewbert>
let length x = fold ((fun (a,y) -> a+1), 0, x)
<dark>
ah.........
<dark>
okay, then length s will suppose that s is a list
<drewbert>
no, not allowed to use anything outside pervasives
<dark>
then you can't really call pos_of_xy (0, 0, 2)
<dark>
you need to call pos_of_xy (0, 0, a list)
<dark>
or else create another function,that does not call length on the third argument
<drewbert>
alright, dude, I'd order you a box of cookies a box of cookies if you'd let me
<dark>
hahahahaha
<drewbert>
whoah, didn't mean to type that twice
<dark>
:)
<drewbert>
my brain is in recursive mode right now I guess
<dark>
lol
<dark>
i was thinking something along those lines
<dark>
drewbert, sometimes i hang out in the undergrad lab.. because people usually call me when they got compiler errors (it's specially amusing with C++, two pages of errors and usually one needs only the line number to fix it...)
<dark>
i think it is fun =p
<dark>
hmm not 'because'
<drewbert>
c++ errors are so ridiculous. to be honest I don't really have the stomach for c++, it's too messy. c is the best lower-level language I've dealt with.
<dark>
i don't actually enjoy c++, but i will not like java either
<dark>
i like c
<dark>
i am in a phase that 'all software sucks' is starting to make sense :(
<drewbert>
hah
<drewbert>
Once you have a good framework going a project is fun for me.
<drewbert>
I don't like java simply because it's too bulky. Its behaviors for inheritance, classes, templates, and all that are great, but it is too much work to perform basic operations.
<dark>
"You'll never find a programming language that frees you from the burden of clarifying your ideas" i like this quote
<dark>
i'm enjoying sinatra currently
<dark>
i have no problem with it for web development, but well i am no web developer =p
<drewbert>
I'm desperately trying to work my way out of the web development world.
<dark>
"out"?
<dark>
you don't enjoy it?
<dark>
well, i like to make web programs for myself... my own browser, my own needs
<drewbert>
Not the aspect in which I'm involved.
<dark>
but well i like to make quick shell scripts too :P
<dark>
you mentioned IE earlier, didn't you?
<drewbert>
I did.
<dark>
*this* is not pleasurable
<dark>
i once saw a haskell lib for writing javascript.. it compiles into js. i don't know how well it performs, but the whole idea is nice: if you don't find a technology bearable, it's often productive to write tools that will automatize your contact with it
<dark>
maybe there are libs that will solve most IE quirks in a platform-agnostic way
<dark>
in fact, the challenge of writing a lib for getting rid of IE problems (maybe a template lib that will be compiled into quirked html + quirked css?) is more fun than writing <!--[if IE 6]> many times in each app your write. but it is indeed more difficult :P
<drewbert>
well there's jquery
<drewbert>
which I donated to
<drewbert>
since it made my life significantly easier
<dark>
hmm nice :)
<drewbert>
but ie still breaks stuff all the time. and it is *SO* much slower than firefox or chrome.
<drewbert>
and the biggest problem is that people refuse to upgrade. I would be annoyed with support ie8, but I have to support ie 6, 7, 8, and firefox
<drewbert>
webkit browsers are unfortunately ignored most of the time. we have a lot of code that goes if(ie) dosomethingforie(); else dosomethingforfirefox();
<dark>
hmm, but why should people upgrade? for the non-geek, computers are like tvs or freezer
<dark>
hmm yes
<drewbert>
well, those people we work with are government organizations with IT departments that work in the traffic responder sector.
<dark>
if ie still breaks stuff all the time, the "browser-agnostic" abstraction is broken. if it does not work in safari (or in lynx, or in speech-synthesizers) it's indeed broken
<dark>
drewbert, ah, you have some serious clients then
<drewbert>
and ie6 is not safe, so we shouldn't be sending people's traffic accident dta over to insecure browsers
<drewbert>
data*
<dark>
hm o.o
<dark>
you have a strong case for blocking ie6 then
<dark>
you can bring this issues to your clients
<dark>
not the compatibility part, but the security one
<drewbert>
haha we have. they refuse to upgrade for "security reasons" which I think means laziness. they are using ssh 1.0 too! for "security reasons"
<dark>
but i would say that firefox isn't much better :(
<dark>
and i'm a free software guy
<drewbert>
really? I've never had a security issue with firefox in windows or linux.
<dark>
they appear all the time, o.o
<drewbert>
other than downloading and then independently executing malicious content through it
<dark>
you didn't "had" issues, but you surely used a compromised firefox for some time, without knowing it, o.o
<drewbert>
they do appear, but people with firefox tend to update faster
<drewbert>
dark: you are correct.
<drewbert>
I cannot argue with that statement.
<dark>
but maybe my wording wasn't very good; it is somewhat better
<drewbert>
i know nobody using firefox 2.0. I know lots of people using ie6
<dark>
hmm yes. also mozilla actually solve security issues faster
<dark>
and really, to argue that security issues is preventing someone upgrading from ie6 is something i would expect to see in thedailywtf.com :P
<dark>
drewbert, are you a freelancer? and also a undergrad student?
<drewbert>
I am an undergrad. I used to freelance, but now I have two jobs and a girlfriend.
<dark>
i know a freelancer that thought in abandoning university.. but now he is back, trying to finish it quick
<dark>
wow
<drewbert>
I know, i have been on spring break for the past week, and have pulled several all-nighters during spring break trying to get everything done.
<dark>
i can hardly manage to go to sleep in the right time, and go to the classes in time too.. i have a wildly random sleep cycle :P i have time for basically nothing
<drewbert>
but you're a grad student, it's expected
<drewbert>
Once of my jobs is web application for displaying traffic data, and the other is a really cool reading images to build 3d models of things.
<dark>
well i'm a undergrad student
<drewbert>
oh you are
<dark>
hmm
<drewbert>
what university?
<dark>
ufrn (natal, brazil)
<drewbert>
I hear brazil is hopping right now.
<dark>
hopping?
<drewbert>
there is a lot going on in that country
<drewbert>
like china
<dark>
hmmm @.@ what do you mean? @.@
<dark>
where are you from? (maybe i already asked..)
<drewbert>
I am from the United States.
<dark>
curiously, i have Java and C classes this semester, but when I am back to home, or have some free time, I do small things in ruby or haskell. i really want to get rid of my current classes as quick as possible, they all suck :(
<dark>
there is a lot of things happening in USA too, o.o
<dark>
=)
<drewbert>
people are all so angry and crazy here though
<dark>
it's more common for us receiving US news than the opposite
<drewbert>
almost 20% of the country thinks barack obama is evil and trying to destroy the country
<dark>
the obama healthcare plan is news here, o.O
<dark>
20%?
<dark>
destroy with..? new healthcare system?
zhijie has quit [Quit: Leaving.]
<drewbert>
they think that socialism is the end of the world and that he is destroying capitalism.
<dark>
hmmm.. i thought he would be acclaimed as the leader that pulled up US from the recession
<drewbert>
I mean approximately 40-60% of the country is opposed to him. and that's okay. you can not like his policy. I'm not trying to make a political argument here. but there are a lot of people that really think he is crazy evil
<dark>
but to think about it, roosvelt was called communist with his 'new deal' too
<drewbert>
we are not out of the recession yet.
<dark>
i just think that more than 20% thought that bush were crazy, evil, and was trying to destroy usa
<dark>
so a) all US presidents are like that or b) it's okay and normal people to think that sort of thing
<dark>
i'd go with b), it's like this here too o.o
<drewbert>
I am young, but I think it is a relatively new thing. The country did not used to be this polarized.
zhijie has joined #ocaml
<drewbert>
but
<drewbert>
we are offtopic
<dark>
it is not off topic if nobody is watching :D
<drewbert>
You make good sense.
<dark>
drewbert, i think the presidential system is polarized, just like this. it was worse in the past maybe (lincoln, etc)
<dark>
the nation must make a definite, binary choice, when it could make a fuzzy one
<drewbert>
it was worse around the time of lincoln, but around the time of lincoln was the bloodiest war in american history. things need to be done for anything gets that bad.
<dark>
drewbert, here the public university is free
<dark>
public health is free too. in basic levels it has poor quality and is too full. but with complex things like organ transplant and the aids program, it's working very nice (in both cases, 100% free)
<dark>
but brazilian public system isn't really an example. too much corruption etc
M| has quit [Ping timeout: 246 seconds]
yakischloba has quit [Quit: Leaving.]
<drewbert>
dark: in america we have our own form of corruption, but it is called "waste"
oc13 has joined #ocaml
drewbert has left #ocaml []
zhijie has quit [Quit: Leaving.]
ygrek has joined #ocaml
tmaedaZ is now known as tmaeda
ttamttam has joined #ocaml
zhijie has joined #ocaml
|Jedai| has joined #ocaml
Jedai has quit [Ping timeout: 248 seconds]
bluestorm has joined #ocaml
slash_ has joined #ocaml
thelema_ has joined #ocaml
thelema has quit [Read error: Connection reset by peer]
dark has quit [Ping timeout: 240 seconds]
ulfdoz has quit [Ping timeout: 276 seconds]
pimmhogeling has joined #ocaml
zhijie has quit [Quit: Leaving.]
bluestorm has quit [Read error: No route to host]
ikaros has joined #ocaml
demitar has quit [Quit: ChatSpace]
findum has joined #ocaml
derdon has joined #ocaml
tmaeda is now known as tmaedaZ
ttamttam has quit [Quit: Leaving.]
sepp2k has joined #ocaml
albacker has joined #ocaml
<albacker>
is there a do.. while in ocaml?
<derdon>
nope
<derdon>
albacker: but you could write a function which acts like it ;)
<derdon>
let do_while func cond = ...
<derdon>
let do_while func args cond = ...
<Camarade_Tux>
why "args"?
<albacker>
derdon, yes of course
Leonidas_ is now known as Leonidas
<derdon>
Camarade_Tux: cuz the arguments of the function have to be known?!
<albacker>
i think it only needs a bool
<derdon>
right
<albacker>
i think i can go here without the need of a do..while, i can convert this into a while.. do..