companion_cube changed the topic of #ocaml to: Discussions about the OCaml programming language | http://www.ocaml.org | OCaml 4.11 release notes: https://caml.inria.fr/pub/distrib/ocaml-4.11/notes/Changes | Try OCaml in your browser: http://try.ocamlpro.com | Public channel logs at http://irclog.whitequark.org/ocaml
Haudegen has quit [Ping timeout: 272 seconds]
zebrag has quit [Quit: Konversation terminated!]
zebrag has joined #ocaml
wagle has quit [Quit: http://quassel-irc.org - Chat comfortably. Anywhere.]
wagle has joined #ocaml
jmiven has quit [Quit: reboot]
jmiven has joined #ocaml
arecaceae has quit [Remote host closed the connection]
arecaceae has joined #ocaml
zebrag has quit [Quit: Konversation terminated!]
zebrag has joined #ocaml
sz0 has quit [Quit: Connection closed for inactivity]
snowpanda has joined #ocaml
ozzzloy has joined #ocaml
mfp has quit [Ping timeout: 240 seconds]
<ozzzloy> hi, i'm having trouble with ocaml.  i'm getting a type error on line 91 here https://gitlab.com/ozzloy/3d-printables/-/snippets/2080117 i'm not sure how, but [(1, 2)] is considered an 'a list but should be an int * int list
<ozzzloy> oooh, never mind, i figured out the type notation was wrong
<ozzzloy> specified a tuple of int and int list
osa1 has quit [Ping timeout: 264 seconds]
aquijoule__ has joined #ocaml
aquijoule_ has quit [Ping timeout: 265 seconds]
Ender has joined #ocaml
<Ender> -+
<Ender> hello
<Ender> Im trying to solve 3.1 and 3.2 and would appreciate any help
<Ender> I have a basic idea of the algo
<Ender> sort Input
<Ender> get input
<Ender> if any bag is empty put elem in bag
<Ender> else put elem in bag with smallest sum
<Ender> but not sure how to implement it in ocaml
<d_bot> <darrenldl> Ender: seems to be along the lines of passing set of bags across recursive calls? (pair of bags for 3.1, list of bags for 3.2) or maybe even better if you have a copy of what you have so far on pastebin/github gist
ozzzloy has quit [Quit: Connection closed]
mbuf has joined #ocaml
zebrag has quit [Quit: Konversation terminated!]
narimiran has joined #ocaml
krkini has joined #ocaml
kini has quit [Ping timeout: 264 seconds]
osa1 has joined #ocaml
krkini has quit [Ping timeout: 240 seconds]
kini has joined #ocaml
sz0 has joined #ocaml
waleee-cl has quit [Quit: Connection closed for inactivity]
_whitelogger has joined #ocaml
vicfred has quit [Quit: Leaving]
kini has quit [Quit: bye]
snowpanda has quit [Quit: Leaving...]
kini has joined #ocaml
kini has quit [Ping timeout: 264 seconds]
kini has joined #ocaml
kini has quit [Excess Flood]
kini has joined #ocaml
aquijoule__ has quit [Ping timeout: 240 seconds]
Haudegen has joined #ocaml
kini has quit [Remote host closed the connection]
kini has joined #ocaml
neiluj has joined #ocaml
neiluj has joined #ocaml
shawnw has joined #ocaml
borne has joined #ocaml
olle has joined #ocaml
olle_ has joined #ocaml
bartholin has joined #ocaml
Ender has quit [Quit: Connection closed]
mfp has joined #ocaml
ewd has joined #ocaml
bartholin has quit [Ping timeout: 265 seconds]
bartholin has joined #ocaml
neiluj has quit [Quit: leaving]
<d_bot> <Butanium> ozzloy: I get an error 404 when I try to go on your link
Haudegen has quit [Quit: Bin weg.]
runawayfive has quit [Ping timeout: 240 seconds]
nullcone has quit [Quit: Connection closed for inactivity]
runawayfive has joined #ocaml
Ender has joined #ocaml
Haudegen has joined #ocaml
oriba has joined #ocaml
<Ender> ok lets start simpler. first I want to create a list of lists. can someone tell me wat im doing wrong?
<Ender> let createBags bags n =
<Ender> let addBagToBag lst = [[]] @ lst in
<Ender> if n == 0 then bags
<Ender> else
<Ender> createBags (addBagToBag bags) (n -1)
<Ender> # createBags [] 5
<Ender> - : 'a list list = [[]; []; []]
<Ender> only 3 bags added
<Ender> ok using list.init
<Ender> let createBags bags n =
<Ender> let addBagToBags x = [] in
<Ender> List.init n addBagToBags
<Ender> works
<theblatte> (avoid using == for comparison when you mean equality and not physical equality, eg here you can use "if n = 0")
<theblatte> I think the problem is you wrote "let createBags" instead of "let rec createBags" and you have a previous definition of createBags lying around
<theblatte> "createBags [] 5" shouldn't even type check, should be "createBags [[]] 5"
<theblatte> (and unrelatedly [[]] @ lst could be "[]::lst")
<theblatte> Ender: ^
<theblatte> oh wait, createBags [] 5 is also fine, sorry, but the point remains that "let" instead of "let rec" is the issue
<Ender> thanks I rtfm'da  bit and used list.init
<Ender> since it wasn't working right
<Ender> my next task is to scan the list and find the smallest sum (empty lists ave sum 0) and append a value to it
<Ender> in another language i'd do something like
<Ender> int lowSum = int.Max;
<Ender> int index = 0;
<Ender> for i=0;i<lists.length;i++ : if(sum lists[i] < lowSum) { lowSum = sum lists[i]; index =i; }
<Ender> return index;
<Ender> I guess recursively i could just pass te previous sum to the next function
<Ender> and check to see which is lower
<Ender> let rec getSmallestBagSumIndex bags lowSum index smallestIndex =
<Ender> if index >= List.length bags then smallestIndex else
<Ender> let thisSum = sumOfBag (List.nth bags index) in
<Ender> if lowSum > thisSum then
<Ender> getSmallestBagSumIndex bags lowSum (index +1) index
<Ender> else
<Ender> getSmallestBagSumIndex bags lowSum (index +1) smallestIndex ;;
<Ender> takes the coffee kicking in to tink in recursion
<Ender> or practice
<Ender> one of the two
<Ender> yesss
<Ender> first try omg
<Ender> getSmallestBagSumIndex [[4];[3];[10];[1]] max_int 0 0;;
<Ender> *dances*
<d_bot> <Butanium> You shouldn't use List.length imo
<Ender> ?
<d_bot> <Butanium> You'll prefer a match architecture
<Ender> how would I write that
<Ender> match syntax is unfamiliar
<Ender> im a c++ programmer. i like my coffee black like my metal
<d_bot> <Butanium> But you're using Ocaml so it's better to code in Ocaml in Ocaml than to code in c++ in Ocaml right?
<Ender> correct
<Ender> how to match?
<d_bot> <Butanium> So for now your recursion is just a camouflaged for loop
<d_bot> <Butanium> the match thing is :
<d_bot> <Butanium> ```ocaml
<d_bot> <Butanium> let rec myRec myListe =
<d_bot> <Butanium> match myListe with
<d_bot> <Butanium> |[] -> (*end of your recursion : you dealt with all the items of the list*)
<d_bot> <Butanium> |x::xs -> (*x is the first element of the list and xs is the rest of the list*) (*do stuff*) myRec xs (*call the function for the rest of the list*)```
<d_bot> <Butanium> With something like that you won't use any "length" or "nth"
<d_bot> <Butanium> Because length is in complexity of the liste size and nth of the index you want :
<d_bot> <Butanium> If you want the 10000th element of a list Ocaml will have to perform 10000 operations
<Ender> nth is O(n)?
<d_bot> <Butanium> Yes
<Ender> oh
<Ender> I can see how that could be wasteful
<Ender> im gonna write the rest and circle back
<d_bot> <Butanium> Also check the array module if you didn't
<Ender> not allowed to use it :cry:
<Ender> tihs is homework
<d_bot> <Butanium> Ok
<d_bot> <Butanium> So don't use nth and length
<Ender> ill rewrite that after i get the rest figured out
<d_bot> <Butanium> Because it's what array module allow you to do
<Ender> i should be able to swap them out
<d_bot> <Butanium> In O(1)
<Ender> I think on tat one line h::t I should just beable to compare h to lowest and swap there
<Ender> but the problem is I have to iterate over the whole list to find te smallest
<Ender> then insert a value into te smallest list
<d_bot> <Butanium> Hmm
<Ender> or maybe I don't. maybe I can just return te list with the smallest value
<Ender> lemme write it this way first then optimize
<d_bot> <Butanium> If you have to insert a value in the smallest list then maybe you'll have to use nth one time
<Ender> if I return the smallest list I won't .
<d_bot> <Butanium> Also rewriting nth and length function is a good exercise
<d_bot> <Butanium> Ender: "or maybe I don't. maybe I can just return te list with the smallest value"
<d_bot> <Butanium> Don't you have to modify it inside of your list of list?
ArthurStrong has joined #ocaml
<Ender> yes
<d_bot> <Butanium> ok I got your point
<d_bot> <Butanium> you're right
<d_bot> <Butanium> I guess you already have a replace function?
<Ender> let partition lst =
<Ender> let rec bags = createBags 2 in (* create bag of bags *)
<Ender> let lst2 = List.sort descCompare lst in (* sort desc *)
<Ender> let rec handleNextValue value =
<Ender> value ::(List.nth (getSmallestBagSumIndex bags max_int 0 0)) in (* create iterator helper *)
<Ender> List.iter handleNextValue lst2;;
<Ender> here is were im hung up now
<Ender> ```ocaml
<Ender> let partition lst =
<Ender> let rec bags = createBags 2 in (* create bag of bags *)
<Ender> let lst2 = List.sort descCompare lst in (* sort desc *)
<Ender> let rec handleNextValue value =
<Ender> value ::(List.nth (getSmallestBagSumIndex bags max_int 0 0)) in (* create iterator helper *)
<Ender> List.iter handleNextValue lst2;;
<Ender> ```
<Ender> Line 6, characters 42-46:
<Ender> 6 | value ::(List.nth (getSmallestBagSumIndex bags max_int 0 0)) in
<Ender>                                               ^^^^
<Ender> Error: This expression has type int -> 'a list list
<Ender>        but an expression was expected of type int list list
<Ender> it things bags is int?
<d_bot> <Butanium> ok first for your '--' operator you don't have to pass "hi" as an argument for your recursive function
<Ender> the proff wrote that
<Ender> i was missing a param on list.nth
<Ender> but still
<Ender> let partition lst =
<Ender> let bags = createBags 2 in (* create bag of bags *)
<Ender> let lst2 = List.sort descCompare lst in (* sort desc *)
<Ender> let smallestHelper baglst = getSmallestBagSumIndex baglst max_int 0 0 in
<Ender> (* create iterator helper *)
<Ender> let handleNextValue value =
<Ender> value ::(List.nth bags (smallestHelper bags)) in
<Ender> List.iter handleNextValue lst2;;
<Ender> specifically
<Ender> let handleNextValue value =
<Ender> value ::(List.nth bags (smallestHelper bags)) in
<Ender> it's saying bags is erroring with
<Ender> Error: This expression has type int -> 'a list list
<Ender>        but an expression was expected of type 'b list
<Ender> bags is defined previously as let partition lst =
<Ender> let bags = createBags 2 in
<d_bot> <Butanium> let rec bags = createBags 2 in
<d_bot> <Butanium> why is it rec?
<Ender> i cleared all the recs
<theblatte> Ender: please use a paste service for multi-line code/errors
<Ender> not familiar enoug wit ocaml yet
<Ender> i was testing to see if it just needed rec
<d_bot> <Butanium> ok can you send me another pastbin pls
<Ender> ```ocaml
<Ender> let partition lst =
<Ender> let bags = createBags 2 in (* create bag of bags *)
<Ender> let lst2 = List.sort descCompare lst in (* sort desc *)
<Ender> let smallestHelper baglst = getSmallestBagSumIndex baglst max_int 0 0 in
<Ender> (* create iterator helper *)
<Ender> let handleNextValue value =
<Ender> value ::(List.nth bags (smallestHelper bags)) in
<Ender> List.iter handleNextValue lst2;;
<Ender> ```
<Ender> sure
<theblatte> Ender: please use a paste service for multi-line code/errors
<d_bot> <Butanium> not here x)
<Ender> plz don't fix it, just tell me wat my mistake it
<Ender> *is
<Ender> gotta learn
<d_bot> <Butanium> createBags take 2 arguments
<Ender> oh.
<Ender> durrr
<d_bot> <Butanium> also use rec only for function which need to call themselves
shawnw has quit [Ping timeout: 240 seconds]
zebrag has joined #ocaml
jlr has joined #ocaml
kafilat has joined #ocaml
<Ender> ok for te final loop I will use matc
borne has quit [Ping timeout: 240 seconds]
<Ender> but not sure ow to do a compound statement in ocaml
borne has joined #ocaml
<d_bot> <Butanium> What is and?
<d_bot> <Butanium> If you want the logic gate use &&
<d_bot> <Butanium> Also what is match bags to supposed to do?
<Ender> i rewrote it a few times
<Ender> i tink I should use list.iter but im aving oter problem
<oriba> I need an old SML with weak typing / non-static typing (about 1993) to execute old code. Any ideas where to get it from?
<companion_cube> hu, was SML ever non statically typed?!
<oriba> seems so. I think 1997 it has changed a lot.
<companion_cube> I'm quite surprised I must say
<oriba> maybe the compilers at that time were not good enough? But in 1997 at least there was a revision of the standard.
<oriba> And I have code from about 1993 that does not work with today's smlnj and gives type errors
vicfred has joined #ocaml
louisono has joined #ocaml
waleee-cl has joined #ocaml
<oriba> Is there a converter SML to OCaml?
<companion_cube> no idea
zebrag has quit [Quit: Konversation terminated!]
zebrag has joined #ocaml
tane has joined #ocaml
<Drup> pretty sure SML was statically typed since the beginning
<octachron> It could be an issue with the value restriction that was added in SML97?
<oriba> octachron: this is the error message I get: "Warning: type vars not generalized because of value restriction are instantiated to dummy types (X1,X2,...)"
<oriba> so value restriction, yes
<vsiles> I never heard of untyped sml.. I don't think that ws ever a thing
<oriba> but maybe not that strict as since 1997
<steenuil> can't you fix those errors by adding some type annotations?
<oriba> I found a SML implementation with plt-scheme/racket that does no static type checking. But it looks like it takes me very long to get that stuff running
<d_bot> <ggole> Isn't that just a warning?
<oriba> steenuil: I think I havce to rewrite some stuff, using datatype-declaration
<steenuil> hmm
<octachron> oriba, it might simpler to check if eta-expansion would fix the issue in the original code
<oriba> in the long run I had planned to write it in OCaml anew, but the old code would give the test-results I nmeed to check my new implementation
<oriba> octachron: can you elaborate that a bit more?
<octachron> https://ocaml.org/manual/polymorphism.html#s%3Aweak-polymorphism
<oriba> octachron: ok, thanks. Will explore that.
orbifx has joined #ocaml
<octachron> Basically, make sure that function are syntactically function and rewrite "let id = compose id id" into "let id x = compose id id x"
<oriba> there is "val".
<oriba> Maybe using let instead of val might help?
<oriba> there is no let at all at the line that causes the problem.
<oriba> no. does not.
<oriba> "val flat = reduce append nil;" gives "All.sml:8.5-8.29 Warning: type vars not generalized because of value restriction are instantiated to dummy types (X1,X2,...)"
<octachron> val is the toplevel variant of "let" in sml.
<octachron> and this is a typical case where eta-expanding to `val flat x = reduce append nil x` should solve the issue.
<oriba> octachron: "All.sml:8.5-8.11 Error: non-constructor applied to argument in pattern: flat"
<oriba> signatures for append and reduce:
<oriba> val append = fn : 'a list -> 'a list -> 'a list
<oriba> val reduce = fn : ('a -> 'b -> 'b) -> 'b -> 'a list -> 'b
<Armael> IIRC my SML syntax, to eta-expand "val f = e" you need to write "fun f x = e x"
<octachron> or "val f =(fn x => ?)"
<oriba> Armael: that worked :-) thanks.
Anarchos has joined #ocaml
louisono has quit [Quit: Connection closed]
louisono has joined #ocaml
mxns has quit [Quit: ZNC 1.8.2 - https://znc.in]
mxns has joined #ocaml
Anarchos has quit [Quit: need to reboot]
kafilat has quit [Quit: Connection closed for inactivity]
olle_ has quit [Ping timeout: 246 seconds]
olle has quit [Ping timeout: 246 seconds]
Anarchos has joined #ocaml
Ender has quit [Quit: Connection closed]
arecaceae has quit [Remote host closed the connection]
arecaceae has joined #ocaml
nullcone has joined #ocaml
Haudegen has quit [Quit: Bin weg.]
mbuf has quit [Quit: Leaving]
bartholin has quit [Quit: Leaving]
ArthurStrong has quit [Ping timeout: 264 seconds]
zebrag has quit [Quit: Konversation terminated!]
zebrag has joined #ocaml
borne has quit [Ping timeout: 240 seconds]
louisono has quit [Quit: Connection closed]
Haudegen has joined #ocaml
richbridger has joined #ocaml
smerdyakov99 is now known as smerdyakov
olle has joined #ocaml
oriba has quit [Quit: https://quassel-irc.org - Chat comfortably. Anywhere.]
webshinra has quit [Remote host closed the connection]
Anarchos has quit [Quit: Vision[0.10.3]: i've been blurred!]
webshinra has joined #ocaml
terrorjack has quit [Quit: The Lounge - https://thelounge.chat]
terrorjack has joined #ocaml
Tuplanolla has joined #ocaml
jlr has quit [Ping timeout: 258 seconds]
Anarchos has joined #ocaml
mxns has quit [Ping timeout: 272 seconds]
olle has quit [Ping timeout: 240 seconds]
ewd has quit [Ping timeout: 240 seconds]
jnavila has joined #ocaml
mxns has joined #ocaml
oriba has joined #ocaml
boxscape has joined #ocaml
mxns has quit [Ping timeout: 240 seconds]
mxns has joined #ocaml
ArthurStrong has joined #ocaml
borne has joined #ocaml
zmagii has joined #ocaml
<zmagii> Sup.
<zmagii> I was wondering whether OCaml is a more interesting prospect than Haskell for a mathematician working in industry.
<orbifx> zmagii: hard to answer that question with no other info. Perhaps learn both
<octachron> Both OCaml and Haskell would work for prototyping/exploration. OCaml will have more predictable perfomance, and an easier path for implementing imperative algorithm.
<zmagii> Is there nice integration with Emacs?
narimiran has quit [Ping timeout: 260 seconds]
<zmagii> octachron: Thanks.
boxscape71 has joined #ocaml
boxscape has quit [Ping timeout: 240 seconds]
tane has quit [Quit: Leaving]
mxns has quit [Ping timeout: 240 seconds]
<Anarchos> octachron i prefer vim
<Anarchos> octachron +merlin
borne has quit [Ping timeout: 260 seconds]
borne has joined #ocaml
mxns has joined #ocaml
jnavila has quit [Quit: Konversation terminated!]
mxns has quit [Ping timeout: 265 seconds]
mxns has joined #ocaml
Anarchos has quit [Ping timeout: 246 seconds]
borne has quit [Ping timeout: 258 seconds]
<d_bot> <Butanium> I love the way list comprehension are designed in Haskell, it's the same as what we write in maths
orbifx has quit [Ping timeout: 264 seconds]
<sleepydog> i would have thought mathematicians would use mathematica or matlab or something like that
<amr> sleepydog: depends on what we are trying to do
<amr> whether to use matlab appears to now be a generational divide
<sleepydog> matlab is out of fashion, is it? what's the latest and greatest? julia?
<amr> julia if you ask me
<amr> but students are at best taught python/numpy
neiluj has joined #ocaml
neiluj has quit [Changing host]
neiluj has joined #ocaml
<amr> i tried to teach my students julia.. even though they liked it they commented that post-uni life is a python world