Yurik changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml| Early releases of OCamlBDB and OCamlGettext are available
Kinners has joined #ocaml
polin8 has quit ["Now _that's_ a good cup of coffee."]
polin8 has joined #ocaml
seth has joined #ocaml
<seth> anybody home?
<Riastradh> <--
<docelic> <-- free beer here.
<seth> I'm somewhat new to ocaml and I could use some help figuring out what the manual is telling me in a few places.
<seth> for example, I'm look at the docs for Module Arg. The first line says: module Arg: sig end is "sig end" a type?
<Riastradh> It's a module type, yes.
<seth> where is that type defined?
<seth> or is it a build in type?
<Riastradh> It isn't 'defined' -- 'sig <signature elements> end' is how you write signature types.
<Riastradh> Much like 'foo * bar * baz' is how you write tuple types.
<seth> oh, ok, I read about signatures but didn't associate it with this.
<seth> OK, now for the argument to Arg.parse, it specified a list of (string * spec * string). The middle type (spec) has constructors, one of which is Int. How would I write the triplet for an Int argument? the first string is the argument key and the third is a doc string.
<Riastradh> ("foo", Int bar, "baz")
<seth> and that defines a new value bar?
<Riastradh> It doesn't define it; bar is just any value acceptable to pass to Int.
<seth> I'm not clear then about how the access the value of the argument after I run Arg.parse
<seth> I've done a lot of Haskell but I'm somewhat rusty on functional syntax.
<seth> is bar a dummy?
<seth> a related question, can I find more example programs anywhere? I looked on the site but I didn't see examples of core and standard libraries. There are some with the distribution, but are there others available?
<seth> Ah, I found some examples using Arg in some of the provided utilities. :)
* Riastradh personally prefers Haskell to OCaml.
<seth> I don't know enough about OCaml yet to say. I do like Haskell a lot.
<seth> why does this work: let load_path = ref [""] but this doesn't let port = ref [""]
<seth> never mind, there is a syntax error on the following line.
TimFreeman has joined #ocaml
TimFreeman has left #ocaml []
docelic is now known as docelic|sleepo
<seth> How do I display a value? Printf.printf? If so can you show me an example?
<whee> there's some print_* functions in Pervasives for basic values, and the Printf module is of course there for more complex formatting
<whee> you'd go and Printf.printf "some format string" bunch of arguments
<whee> like Printf.printf "%d %d %f\n" 10 20 30.3
Kinners has left #ocaml []
lament has joined #ocaml
Jimzy has joined #ocaml
<seth> whee: is layout significant in ocaml, as in Haskell?
<mrvn> layout? indentaition style?
<mrvn> no way. Write everything in one line and your still fine.
<seth> mrvn: do statements need to end with a semicolon?
<mrvn> semicolons are for sequenzes, lists, arrays and streams.
<seth> is there an emacs mode for ocaml?
<mrvn> two, look for tuareg
Riastrad1 has joined #ocaml
Riastradh has quit [Connection reset by peer]
<seth> found it, thanks.
lowks has joined #ocaml
<lowks> ummm i am having problems installing ocaml labltk
<lowks> fails
<lowks> what version of tk / tcl does it need ?
<lowks> version-3.0.6
lament_ has joined #ocaml
lament has quit [Killed (NickServ (Ghost: lament_!~lament@h24-78-145-92.vc.shawcable.net))]
lament_ is now known as lament
<lowks> ?
mattam has joined #ocaml
TimFreeman has joined #ocaml
<mrvn> apt-get install ocaml
<mrvn> life can be so easy.
<lowks> mrvn: i am writing a spell for sorcerr
lament is now known as mal-2
mal-2 has quit ["Support Darwin Awards! Join the military!"]
K_music is now known as Krystof
systems has joined #ocaml
<systems> slut
<systems> ooops
<systems> salut
<systems> :P
<pattern_> !
docelic|sleepo is now known as docelic
docelic has quit ["brb"]
docelic has joined #ocaml
docelic has quit [Read error: 104 (Connection reset by peer)]
systems has quit [Read error: 110 (Connection timed out)]
docelic has joined #ocaml
thedark has joined #ocaml
<thedark> he, i need some help on a function...
<thedark> let test (a:big_int) (k:big_int) (n:big_int) =
<thedark> 1;;
<thedark> when i try test 5 0 5 (or something else) it's not giving me again the #prompt.... it just hangs ...
thedark has left #ocaml []
<mrvn> of cause, why should it?
<mrvn> and it doesn't hang. It just waits for you to input
thedark has joined #ocaml
<thedark> how do i print "hello world" in caml?
<mrvn> print_string "Hello world\n";;
<pattern_> print_endline "Hello world";;
<pattern_> ;)
gene9 has joined #ocaml
Riastrad1 is now known as Riastradh
<thedark> ok pattern_, i'll try this
<pattern_> go all out, thedark! ;)
<pattern_> you write the best damn hello world program ever :)
<thedark> well i'm writing a program to test if a big int is a prime number, and it's not that easy ....when you dont know the ocaml langage
<mrvn> Do it with ints first.
<thedark> well it's almost done with big_ints
<thedark> i'm testing it now ...
<thedark> i get the message Exception: Failure "equal: abstract value". : i know what it means, but how can i know where in my program the error did occured ?
<mrvn> add some prints
<thedark> no other way to do that?
<mrvn> I sometimes hate that exceptions aren't part of a functions type.
<mrvn> In C++ you can specify what exception a function can throw.
<thedark> same in java
<mellum> In practise, that leads to more problenms than it solves
<thedark> isnt there something like a camel debugger so i can know where the error did occur?
<mrvn> One wouldn't get exceptions thrown out of the blue.
<mrvn> thedark: there is but i don#t think it helps.
<mrvn> Haven't seen a debugger yet that gets it when there is an uncaught exception before the program terminates with it.
<thedark> and how do i print something into a function ?
gene9 has quit []
<thedark> ... nobody can tell me how to print something in a function ?
<mellum> print_string "something"
<thedark> well i'm in trouble with this
<thedark> if i do this :
<thedark> let rabin_test (n:big_int)(k:big_int) =
<thedark> print_string "something"
<thedark> rabin_test2 n 4;;
<thedark> it tells me : This function is applied to too many arguments
<pattern_> print_string "something" ;
<mellum> Well, it is. You need to mark the end of the arguments to print_string with a ';'
<thedark> ok
<pattern_> where semicolons go is the most confusing thing about ocaml syntax, imo
<thedark> is the output buffered? i mean is it possible that i dont see something printed BEFORE an error cause of the buffer?
<mellum> thedark: yes
<thedark> how do i flush the buffer so?
<mellum> although a program dying should flush all buffers
<mellum> maybe you didn't ptint a newline?
<thedark> with print_endline ?
<thedark> ocaml said this :
<thedark> 1 2 4 Exception: Failure "equal: abstract value".
<thedark> and the code is
<thedark> let decompose (n:big_int) =
<thedark> print_string " 4 ";
<thedark> decompose2 (sub_big_int n unit_big_int);;
<thedark> (and some other code before) i cant understand where's the faulty equal in this function
systems has joined #ocaml
TimFreeman has left #ocaml []
shea has quit [Read error: 113 (No route to host)]
systems has quit ["Client Exiting"]
mellum has quit [Read error: 60 (Operation timed out)]
TimFreeman has joined #ocaml
TimFreeman has left #ocaml []
mellum has joined #ocaml
Krystof has left #ocaml []
sproctor has joined #ocaml
<sproctor> hi
<sproctor> is there anyway to refer to functions in functions defined before them?
<asqui> No, you have to define any functions your function uses before the funcrion definitioon OR use the rec keyword
<sproctor> how come?
<sproctor> can I use prototypes?
<emu> isn't there an 'and' keyword
shea has joined #ocaml
TachYon has joined #ocaml
mrvn_ has joined #ocaml
mrvn has quit [Read error: 60 (Operation timed out)]
TachYon has quit [Remote closed the connection]
docelic has quit ["need 15 mins of games or I'll go crazy"]
sproctor has quit [Read error: 60 (Operation timed out)]
dskippy has joined #ocaml
seth has quit [Killed (NickServ (Ghost: seth_!~seth@p3EE28124.dip.t-dialin.net))]
seth_ has joined #ocaml
dskippy has quit [Read error: 110 (Connection timed out)]
Vincenz has joined #ocaml
<Vincenz> hello
<Vincenz> anyone listening, I have a small question
<mellum> Vincenz: feel free
<Vincenz> ah :)
<Vincenz> well...
<Vincenz> I have this multiplicative type
<Vincenz> Letter char*bool*list
<Vincenz> and I want to get the parameters out of it
<Vincenz> (inside a function
<Vincenz> do I need to use match to get the params out of it?
<Vincenz> or is there a better way?
<mellum> let Letter(a, b, c) = letter in... but that will give you a warning
<Vincenz> well it gets passed into a function..
<Vincenz> can I just do
<Vincenz> function Letter(a,b,c)?
<mellum> that should be possible, too.
<Vincenz> ah thanx :)
<Vincenz> doesn't work :/
<Vincenz> mind if I paste 12 lines?
<mellum> Well, can't you cut it down a bit? I only have 8 lines scrollback :)
<Vincenz> it's a twelve line function..
<Vincenz> 9 lines..
<Vincenz> let exists node word =
<Vincenz> let rec sub_exists Letter(letter, fin, subnodes) i =
<Vincenz> if i == (String.length word) - 1 then
<Vincenz> fin && (letter == word.[i])
<Vincenz> else if letter == word.[i] then
<Vincenz> (List.exists (fun x -> sub_exists x (i + 1)) subnodes)
<Vincenz> else false in
<Vincenz> sub_exists node 0;;
<Vincenz> it gives me an error on 0;;
<mellum> first, you shouldn't use ==
<Vincenz> oh
<Vincenz> I wasn't sure anymore
<mellum> It does pointer comparison, which is rarely what you need
* Vincenz nods
<mellum> it doesn't matter for int, but if you change to int64 for example, weird things will happen
<Vincenz> alright, thanx :)
<mellum> then, what does the type of node look like?
<Vincenz> type lex_node = Letter of char * bool * lex_tree
<Vincenz> and lex_tree = lex_node list;;
<Vincenz> it's to create a tries (an exercise in this oreilly book on Ocaml)
<Vincenz> lexical trees
<Vincenz> it worked with match
<mellum> let rec sub_exists (Letter(letter, fin, subnodes)) i = ...
<Vincenz> oh!
<Vincenz> I still haven't gotten smoe of the () rules in OCaml
<mellum> You should probably get used to writing a space after a constructor's name... that helped me to avoid such errors
<Vincenz> ok
<Vincenz> still gives me an error on the 0;; tho
<mellum> Hm, it compiles like that for me :)
<Vincenz> not for me :(
<Vincenz> oh never mind
<Vincenz> stupid me
<Vincenz> I had this half-finished function above it :P
<Vincenz> :)
<Vincenz> is that function well-written or is there a better approach >?
<Vincenz> (I'm new to Ocaml and new to FP)
<Vincenz> ?
<mellum> Looks good to me
<Vincenz> still have a problem though, with this system, a tree can only be built of words that start with 1 specific letter
<Vincenz> part 2: insert a new word into the tree
<mellum> well, you should probably pass lex_trees to the functions, not lex_nodes
<Vincenz> yeah
<Vincenz> oh doh!!!
<Vincenz> you're right!
<Vincenz> I misread the assignments
<Vincenz> easy enough for exists
<Vincenz> just replace the last line with the List.exists line and replace (i + 1) by 0
<Vincenz> I feel dumb now, I'm so much better in other languages
<mellum> I think that was already pretty good if you're new to FP
<Vincenz> hmm, stupid question:
<Vincenz> if I have
<Vincenz> somefunc (Letter(letter, fin, subnodes))
<Vincenz> how do I return that whole thing?
<Vincenz> (I want to use List.map for insert)
<mellum> let somefunc ((Letter (letter, fin, subnodes)) as x) = x;;
<Vincenz> ah alright :)
<mellum> that what you meant?
<Vincenz> yup :)
<Vincenz> can you do partial eval on functions?
<Vincenz> like...
<Vincenz> somefunc x y
<Vincenz> (somefunc 0)
TachYon has joined #ocaml
<mellum> Vincenz: yes
<Vincenz> thought so, wasn't sure as it's crashing again
<mellum> Vincenz: it's a very powerful tool sometimes
<Vincenz> yup :)
<Vincenz> woo !
<Vincenz> let's see if insert works
<thedark> i need to write a function that generates a random big_int lower than another big_int (as let i= Random.int j in) but for the bigints ...
<thedark> can someone help me on that.. i dont know how to do:(
<Vincenz> thedark: easiest solution
<Vincenz> let's say your high_val....
<Vincenz> then...
<Vincenz> generate enough ints that the max is bigger than high_val
<Vincenz> add it and mod high_val
<Vincenz> though statistically speaking it's not exactly correct
<Vincenz> (more of a guassian curve, plus some nonlinearity through the modding)
<Vincenz> better
<Vincenz> :
<thedark> i've thought on this way to generate it but i need a "better" way...it's for testing some prime numbers so i need a "real" random number, although it wont be really random with a computer
<Vincenz> let's say your number's closest power of 2 bigger than a certain number
<Vincenz> has x bits
<Vincenz> divide x by 30
<Vincenz> generate that many numbers of 30 bits
<Vincenz> put them after each other
<Vincenz> (by multiplying/shifting and then adding)
<Vincenz> and then mod it the high_val
<Vincenz> you remove the gaussian effect
<Vincenz> but some values will still have a higher probability if high_val isn't an exact power of 2
<Vincenz> (because of the wrapping effect of mod)
<thedark> i guess i'll just put some 0s and 1s together and wait till it reach my high_val ...
<Vincenz> that's what I said
<Vincenz> except I do it 30 bit at a time
<thedark> well... why do u need a mod ?
<Vincenz> (30 bits of randomnumber1).(30 bits of randomnumber 2).....(remaing bits to get it to the smallest power of 2 > high_val)
<Vincenz> because the number generated will be a random number between
<Vincenz> 0
<Vincenz> and 2^n - 1
TachYon has quit [Remote closed the connection]
<Vincenz> where 2^n is the smallest number bigger than highval
<thedark> ok
<thedark> i'll try to write such a fonction.....
<thedark> how do i print a big_int on the screen ?
<thedark> what a strange idea to write a prime number testing program in a langage that i dont know :(
<Vincenz> hmm...when matching a list can you do something like the following
<Vincenz> | Letter(a, b, c)::moreletters ->
<Vincenz> or is that too complex?
<Vincenz> thedark: best way to learn :)
<thedark> Vincenz: thats why i'm doing it :)
<Vincenz> heh, me too, learning Ocaml :)
polin8 has quit [Read error: 104 (Connection reset by peer)]
<Vincenz> woo!!!
<Vincenz> it works :)))
<Vincenz> anyone care to review my code?
<Vincenz> perhaps there's way better ways to do it
<Vincenz> (cause in this chapter they taught about List.map, but I didn't have to use it...)
<thedark> how do i make a remark in ocaml?
<Vincenz> (* someremark *)
<Vincenz> multiline and nestable IIRC
dskippy has joined #ocaml
<thedark> ok
<Vincenz> anyone care to take a look at my code and see how it could be done better?
<Vincenz> (it's not a lot)
<thedark> well it would have been a pleasure, but i'm sure u'r more advanced than i am :)
<Vincenz> not really :P
<Vincenz> hmm
<Vincenz> let funcname some param = function
<Vincenz> | bla..
<Vincenz> do I need to add the function?
<Vincenz> can't it be
<Vincenz> let funcname some param
<Vincenz> | bla
<thedark> u can do :
<thedark> let funcname some param =
<thedark> | bla ;;
<thedark> another question: i want to test my program with some big_ints.. but how can i give ocaml such a big_int ? (of course functionname (big_int_of_int foo);; wont test the program on something bigger than an int ...
<Vincenz> never worked with big_ints sorry
<emu> doesn't it suck to have shitty support for numbers
<emu> should pester the ocaml maintainers about that
polin8 has joined #ocaml
<seth_> I'm compiling a program using the Unix module and getting "Reference to undefined global Unix." Do I need to explicitly link to a library?
<mattam> yes
<emu> you need to eunuchs yourself
<emu> get with the program--it's global
<seth_> mattam: what's the syntax?
<emu> 5%
<Vincenz> #load "Unix.cma" or something like that
<seth_> OK. I was trying open
<mattam> smthing like -custom -ccopt -lunix for native code
<seth_> no, that doesn't work. I'm compiling, not using the interactive interpreter.
<seth_> mattam: ok, I"ll try that.
<mattam> using OCamlMakefile could ease the process though
<seth_> mattam: is OCamlMakefile a separate package? I don't see it in the distribution.
<mattam> yes, it's just one file you can include to get a bunch of targets like byte-code, profiling and debugging
<mattam> I can send it to you if you want
<mattam> it has also threads and libs support, even camlp4
<Vincenz> how do I turn a char into a string?
<emu> magic wand
<Vincenz> ..
* Vincenz sighs
<Vincenz> I'm sorta stuck on a problem
<mattam> String.make 1 char ?
dskippy has quit [Read error: 60 (Operation timed out)]
<Vincenz> oh
<Vincenz> neat :)
<Vincenz> Anyone care to gimme a hand with some code?
<mellum> Not me, I need to go to bed :)
<Riastradh> How long is it?
<Vincenz> the function that isn't working about 8 lines
<Riastradh> OK, paste it here...I may be able to help.
<Vincenz> let select tree length =
<Vincenz> let rec select_sub i subtree =
<Vincenz> if i = 1 then
<Vincenz> List.map (fun (Letter (letter, _, _)) -> (String.make 1 letter)) (List.find_all (fun (Letter (_, fin, _)) -> fin) subtree)
<Vincenz> else
<Vincenz> List.flatten (List.map (fun (Letter (letter, _, atree)) -> List.map (fun word -> (String.make 1 letter) ^ word) (select_sub (length - 1) atree)) subtree)
<Vincenz> in
<Vincenz> select_sub length tree;;
<Vincenz> subtree is of type lex_tree
<Vincenz> type lex_node = Letter of char * bool * lex_tree
<Vincenz> and lex_tree = lex_node list;;
<Vincenz> bool signifies the end of a word in a dictionary tree
<Vincenz> hmm, I could safely remove the inner function, that's redundant
<Vincenz> wasn't sure in the beginning, cause I didn't know how I'd tackle it
<Riastradh> Er, what's it supposed to do, and what doesn't work about it?
<Vincenz> ewll...
<Vincenz> you give it a dictionary tree
<Vincenz> and it's supposed to give you all the words of a given length
<Riastradh> A 'dictionary' tree?
<Vincenz> yes
<Vincenz> each node in the lex_tree list
<Vincenz> has a character, a boolean depicting it the end of a word
<Vincenz> and a list of further character
<Riastradh> OK, maybe I can't help you...sorry...
<Vincenz> it's not that hard, it's the exercises for the first chapter in this book on ocaml (a pdf)
<Vincenz> the oreilly book
<Vincenz> doh!
<Vincenz> woo, it works!!!
<Vincenz> :))))
docelic has joined #ocaml
mattam has quit ["zZz"]
<Vincenz> hmm
<Vincenz> ('a * 'a list) list
<Vincenz> should that be read as a ;
<Vincenz> list of a product of a and a list of a?
<Vincenz> or more like
<Vincenz> a list of a list of a product of a and a
<Riastradh> No, a list of a tuple of 'a and a list of 'a.
<Riastradh> int * int * int is the type of (1,2,3)
<seth_> if I have a function that returns a tuple, say int * int, how do I write the call? Do I say (a,b) = whatever... ?
_BT has joined #ocaml
sproctor has joined #ocaml
<thedark> yes seth_: let (a,b) = ...
<seth_> that's what I thought but the compiler doesn't like it. Maybe I have something wrong in the rest of the line.
_BT has quit [Client Quit]
<Vincenz> seth_: how long is it?
<Vincenz> you could paste it
<seth_> it's only one line. I'll paste it.
_BT has joined #ocaml
<seth_> let (infd, outfd) = Unix.open_connection Unix.ADDR_INET(Unix.inet_addr_of_string("192.168.1.14"),15000);
* Vincenz is working on his second set of exercises, graph traversal :)
<Vincenz> try ()?
<Vincenz> that's my usual solution, in fact my ocaml code looks a lot like lisp :P
<seth_> that might be a good idea but it shouldn't be mandatory.
<seth_> for example, this line is OK:
<Vincenz> I can never tell :(
<seth_> Unix.establish_server handleConnection (Unix.ADDR_INET(Unix.inet_addr_of_string("192.168.1.14"),15000));
<seth_> the main difference is that open_connection returns the tuple, and handle_connection returns nothing.
<Vincenz> ah
<Vincenz> odd
<Vincenz> maybe an extra ; at the end?
<seth_> tried...
<Vincenz> hmm
<Vincenz> odd odd
<seth_> I must be missing something, probably something simple but I can't find it.
<Vincenz> ah!
<Vincenz> found it
<Vincenz> you need to put () around the constructor of Unix.ADDR_INET
<Vincenz> (I hate that about constructors, and I fail to see the reason)
<seth_> I had tried that, but I'll try it again.
<seth_> that moves the error.
<seth_> so that is probably relevant.
<Vincenz> it works here
<Vincenz> when I add the ()
<Vincenz> eventually it times out
<Vincenz> let (infd, outfd) = Unix.open_connection (Unix.ADDR_INET(Unix.inet_addr_of_string("192.168.1.14"),15000));;
<seth_> you must be using the interpreter. I'm compiling
<Vincenz> oh!
<Vincenz> what's it say/
<Vincenz> ?
<Vincenz> maybe you need to link in the unix module somehow?
<seth_> syntax error on the ;; line at the end of the function
<Vincenz> odd
<seth_> Vincenz: no, I'm not getting that far. with a syntax error it doesn't try to link.
<Vincenz> perhaps an open brace on the previuos line
<Vincenz> or open (, [ ...
<seth_> and the server side program links, so my statement is OK.
<Vincenz> check the code above to see everything is closed properly
<seth_> No, I would think the server program would also be broken if it were something like that.
<Vincenz> then I can't help you sorry :(
<seth_> you only need the open for the interpreter, I think.
<Vincenz> no idea then :/
<seth_> this is interesting. If I move the statement outside of a function, the compiler accepts it.
<Vincenz> probably something open somewhere
<Vincenz> check the surrounding syntax :)
<seth_> I'll put stuff back in little by little and see where it starts complaining.
<Vincenz> how do I insert an item into a list ONLY if it's not in that list
<Vincenz> like
<Vincenz> 1::l
<Vincenz> but only when l doesn't contain 1
<seth_> you can search for the value in the list. I'm not sure whether there is a method predefined to do that for you.
<Vincenz> oh ok
<mrvn_> better use a set
mrvn_ is now known as mrvn
sproctor has left #ocaml []
<Vincenz> no can do
<thedark> can someone have a look at my function "is_fermat_witness" .. its 3 lines long and i cant understand where my error is :(
<Vincenz> anyone have a vim setup for ocaml so that when you type a (, it types the ) and puts the cursor in between ?
<Vincenz> and when you type a ) it skips the cursor to past the next )
<Vincenz> (plus possibly highlighting the two () you're in)
<thedark> i think ocaml support is better using emacs ...
<Vincenz> (is that even possible in vim/)
<Vincenz> I'm emacs-impaired
<thedark> :)
<thedark> if one day u want to try, xemacs21 has built in ocaml mode, and there's also the "tuareg" mode
<thedark> google on tuareg, maybe they have scripts for vim too...
<Vincenz> only syntax highlighting
<Vincenz> besides I can't use xemacs, I have windows (i have emacs installed to test it)
<thedark> shit... i cant understand why my fermat fonction doesnt work :(
<seth_> thedark: paste it. I _might_ be able to help a little.
<thedark> let is_fermat_witness (n:big_int) (p:big_int) =
<thedark> if eq_big_int (expt_mod n (sub_big_int p unit_big_int) p ) unit_big_int then false
<thedark> else true;;
<seth_> thedark: and what does it do wrong?
<thedark> do u know what a fermat witness is?
<seth_> I did about 25 years ago when I was in college. :)
<seth_> briefly?
<thedark> if n is a prime number, a^n = 1 (mod n-1)
<thedark> so if u can find a "a" so that it's untrue, it's an evidence n is not a prime number
<Vincenz> ugh my coding is so bad
<Vincenz> let has_edges_from graph vtx =
<Vincenz> List.map (fun (avtx,_) -> avtx) (List.find_all (fun (_,vtxs) -> (List.fold_left (fun truth bvtx -> truth || (bvtx = vtx)) false vtxs)) graph)
<Vincenz> looks more like lisp than anything else :(
<Riastradh> What's wrong with it looking like Lisp?
<Vincenz> I thought that Ocaml would give me clean code
<Vincenz> not Lisp-crap
<Riastradh> What do you have against 'Lisp-crap?'
<Vincenz> do ocaml people split code up more into functions?
<Vincenz> or would people do it terse like above?
<Vincenz> Riastradh: I'm lost in silly parentheses
<seth_> thedark: I don't see how the code line maps to that equation.
<Riastradh> Vincenz - That's why you use a paren-highlighting editor.
<Vincenz> In a nutshell, Vimacs is Vim emulating Emacs
<Vincenz> LOL!
<Riastradh> And I don't think you're going to get much syntactical paradise in OCaml, either.
<thedark> seth expt_mod a b c returns a^b (mod c) ...
<seth_> thedark: yes, but your equation only has two variables
<thedark> seth_: yes, here b = c + 1
<seth_> thedark: ok, you could just code it that way, but it shouldn't break it. :)
<Vincenz> Riastradh: oh well :)
<thedark> (hum the equation i pasted is wrong, its a^(n-1) = 1 (mod n ) ..... but my function is still suposed to work)
<seth_> thedark: let me look again.
<seth_> thedark: from what you just wrote (a^(n-1)), aren't b and c reversed?
<thedark> yes they are...
<thedark> my brain is a big mess, it's 3 in the morning here ... lol:)
<thedark> well for me , eq_big_int (expt_mod m (sub_big_int n unit_big_int) n ) unit_big_int is exactly like " m^(n-1) =1 (mod n) ...
<seth_> thedark: I still don't see it. I don't see you dividing by (mod n)
<thedark> seth_: the function expt_mod is doing it ....
<seth_> thedark: you said it multiplies by (mod c)
<thedark> nope ... i saud m^(n-1) -1 multiplies by c ...
<thedark> said
<seth_> thedark: you said: expt_mod a b c returns a^b (mod c)
<thedark> yes
<seth_> so if you are comparing something to 1, you have to divide that something by mod c, don't you? Or am I reading it wrong?
<thedark> oh :) well (mod c) just means modulo c
<thedark> its not a multiplication
<thedark> a = b (mod c ) means that there is a n so that a -b = c*n
<seth_> then what is it doing there?
<seth_> looks like a multiplication to me
<Vincenz> thedark: that's math snytax
<Vincenz> in programming it'd be
<Vincenz> (a mode c) = (b mod c)
<Vincenz> s/mode/mod/g
<thedark> i agree, but what's ur point?
<thedark> (i mean, 1 mod c is still 1 , whatever c is )
<Vincenz> thedark you don't know about modulo fields?
<Vincenz> 2 mod 5 = 7 mod 5
<thedark> sure
<Vincenz> 2 and 7 are mapped to the same number in a mod5-number system
<Vincenz> they're congruent in mod 5
<thedark> i know that...
<Vincenz> so?
<Vincenz> 1 mod 5 = 1
<Vincenz> but so is 6 mod 5...
<thedark> yes ... whats ur point?
<mrvn> 1 mod 1 should be 0
<thedark> well with mod 1 there is only one number left and that's 0 ...
<thedark> but here, whats wrong about doing a^(n-1) = 1 (mod n)
<thedark> what my program is doing is calculing a^(n-1) (mod n) and comparing it with 1 .... is it wrong??
<mrvn> no
<mrvn> actually for big n you want to do ((a*a)mod n) * a) mod n....
<mrvn> keep all intermediates modulo n
<thedark> well it's related to the expt_mod function.. do u want me to paste it?
<Vincenz> mrvn: exactly
<thedark> here's the code :
<thedark> let rec expt_mod (a:big_int) (k:big_int) (n:big_int) =
<thedark> if eq_big_int k zero_big_int then unit_big_int else
<thedark> if eq_big_int (mod_big_int k ( big_int_of_int 2)) zero_big_int
<thedark> then
<thedark> let p = expt_mod a (div_big_int k (big_int_of_int 2)) n in
<thedark> mod_big_int (mult_big_int p p) n
<thedark> else
<thedark> let p = expt_mod a (div_big_int (sub_big_int k unit_big_int ) (big_int_of_int 2)) n in
<thedark> mod_big_int (mult_big_int a (mult_big_int p p)) n;;
<Vincenz> bad way to do it
<Vincenz> use a recursive multiplication like mrvn said
<Vincenz> keeps your nummbers small
<thedark> this way is better for big numbers
<thedark> the complexity is O(log k) instead of O(k)
<Vincenz> thedark: with big nums I doubt complexity is the problem
<Vincenz> besides bigger numbers also means bigger complexity I'd assume with big_ints
<thedark> Vincenz: well if u want to do a^k and that k =0 (mod2) its a good idea to do (a^k/2)^2 ...
<thedark> thats what this function is implementing (and it works)
<Vincenz> alright
<Vincenz> oh yeah, that'll do :)
<Vincenz> sorry, I misread your code
<Vincenz> you're still modding each time
<thedark> np
<thedark> yes