lamawithonel_ has quit [Ping timeout: 244 seconds]
<thelema>
What is the type of to_string and what is the type of IntShallow2.null?
<mrvn>
thelema: see second paste
<thelema>
They're the same. Try `module IntShallow2 = Shallow.Make(struct include Int end)
<mrvn>
thelema: That works (as in fails) but then you aren't instantiating the functor with the same module.
hiptobecubic has quit [Ping timeout: 260 seconds]
<mrvn>
thelema: module IntShallow2 = (Shallow.Make(Int) : Shallow.SHALLOW) makes it fail too.
BiDOrD_ has joined #ocaml
<mrvn>
Which I find odd because: module Make : functor (Type : TYPE) -> SHALLOW
<thelema>
mrvn: yes, someone decided it'd be useful to add some magic to the result type of functor application so that module I1 = Set.Make(Int) and module I2 = Set.Make(Int) are compatible
<mrvn>
probably because there is no syntax to manually specify the type of a functor that way.
BiDOrD has quit [Ping timeout: 276 seconds]
<mrvn>
module Make = functor (Type : TYPE) -> struct type -'a t = 'a Make(Type).t ... isn't allowed.
<thelema>
It has to do with nominal typing of values in modules = Foo.a is the same type as Bar.a iff Foo == Bar
<mrvn>
thelema: sure, if the signatures match and types aren't abstract. The problem I see is that I can't make the functor output an abstract type.
<thelema>
even for abstract types
<mrvn>
thelema: with abstract types only if Foo == Bar. Without abstract types with Foo = Bar, which is the case here.
<thelema>
for types with a concrete implementation, the normal structural comparison is done
<thelema>
but for abstract types, only this nominal rule exists
<mrvn>
Unless you are saying that Shallow.Make(type) == Shallow.Make(type)
<thelema>
based on the module path. Which is why it's possible to have a type that's accessible via two different module paths not compare as identical with itself
<thelema>
only when Type is a module with a name
<thelema>
Shallow.Make(Int) != Shallow.Make(struct include Int end)
<mrvn>
if Shallow.Make(Int) and Shallow.Make(Int) are considered identical then why does it generete the code for it twice?
<thelema>
but for any module Foo and functor Bar, Bar(Foo) == Bar(Foo)
<thelema>
they're identical only on the type level
<thelema>
the code could be generated in different parent modules
<thelema>
and would need to be in both modules for linking purposes
<mrvn>
thelema: could be, isn't the case. ocaml should create the symbols as weak so only one copy ends up in the binary.
<thelema>
ocaml avoids optimizing for uncommon cases
mononofu has quit [Remote host closed the connection]
<mrvn>
thelema: can I write the functor in a way that it first creates a local module and then returns the result of calling a second functor with that internal module?
mattrepl has joined #ocaml
Kakadu has joined #ocaml
<thelema>
Just add an extra parameter to the functor that's an empty module and alway pass in (struct end)
<mrvn>
# module M = struct let module L = List in include L end;;
<mrvn>
Error: Syntax error (on the include) :(
<mrvn>
thelema: That isn't exactly type save.
<thelema>
yes, you can't include inside a 'let module'
hiptobecubic has joined #ocaml
<thelema>
module L' = struct include L end
Hodapp has left #ocaml []
<mrvn>
thelema: can't use module ... inside a functor
<thelema>
module F(X:X_t) = struct module X' = struct include X end type t = X'.t end
<thelema>
umm, I'm sure you can use `module` in a functor
<mrvn>
I can (stupid typo) but doesn't help: module Make = functor (Type : TYPE) -> struct module T = struct include Type end module M = Make_real(T) include M end
<mrvn>
module IntShallow : sig type 'a t = 'a Shallow.Make(Int).t ...
lamawithonel has joined #ocaml
<mrvn>
The output type still remains magically concret.
lamawithonel__ has quit [Ping timeout: 276 seconds]
<mrvn>
If I had GADTs I could construct an type specific null value from a GADT so instances made from the same type get the same null. Then everything would be ok.
<thelema>
what's the problem with Make(X:sig end)(Type:TYPE) = ...?
<mrvn>
thelema: module Bad = struct end module S1 = Make(Bad)(Int) module S2 = Make(Bad)(Int)
<thelema>
so put in big notes that this functor parameter has to be satisfied by a new empty module each time
<thelema>
IIRC, this was part of the solution for bounded arrays
<flux>
how about if you provide your own module for that instatiation purposes that has something abstract, would that work?
<thelema>
s/bounded/range-check free/
<thelema>
flux: no, it would have a fixed module type.
<thelema>
err, fixed module path
<mrvn>
flux: no. anything with a name results in bad behaviour
<thelema>
(read the notes from frisch at the bottom)
<flux>
can someone point be to an optimization library? ie. I give it an arbitrary goal function, possibly a derivate function, starting values and it gives me back the optimal values. does facile do that?
<thelema>
flux: how many dimensions and do you have gradient/derivatives?
<flux>
I have a bitmap and I want to fit a line to it
<flux>
so derivatives or gradients would be numerical estimations
<flux>
I have a good starting orientation
<flux>
so my dimensions could be as little as two: offset from starting point, rotation around starting point (the lines themselves are infinite)
<thelema>
Troestler has some good 1d optimization code, but for 2d, you'll want something better.
<flux>
I suppose I need to whip something up. I went through the stanford machine learning set last year, maybe I need to review the material :-).
<thelema>
just do the simplest gradient descent you can think of
<mrvn>
thelema: I like that little trick to add the length of the array to the functor. Having the branding work on any array of the right length is neat.
<flux>
it has initial guesses overlaid, so from those lines I would optimize the best four lines
<thelema>
given the background, you want to determine the lines?
<flux>
yes
<flux>
and actually once I've done it, I have more images but the angles of the lines are roughly the same, but their location varies
mononofu has joined #ocaml
<thelema>
curious. I assume you have a metric for a single line, but the best 2 lines is not necessarily the two lines with best metric
<thelema>
s/metric/fitness/
<flux>
yeah, I would like to find four distinct lines
<flux>
but if I don't find it from that image, I have others
<flux>
it should be more stable to find the lines when I know their angles
<thelema>
so you have many tiles that have had the same four lines drawn on them
<flux>
yes
<thelema>
but the position of a line in two different tiles isn't the same
<thelema>
of course
<thelema>
so given angle information in one tile, you can use that in another tile to winnow things down?
<flux>
yep
<thelema>
Sounds like a 1d optimization when you have the angle already.
<thelema>
determine the offset that gives the best fit for a given angle
<flux>
right. but I first need to find the angle as well.
<thelema>
do your other tiles have fewer candidate lines?
<flux>
well, I was thinking I don't even try to find candidate lines, but try the previous ones first and optimize from there. there should be little change between two consecutive images.
<thelema>
so the images are over the same space, just at different times?
<thelema>
I was imagining the images being over different areas
<flux>
they are over the same space
<thelema>
maybe your reference frame has shifted from one image to another?
<thelema>
why would the offset be different?
<flux>
actually what I'm doing is that I have a 3d printer I'm trying to level
<flux>
I'm beaming two cross lasers to the surface
<flux>
I should be able to determine surface height from how to beams move on it
<flux>
(to->the)
<flux>
the height variance is minute, in any case less than 1 millimeter and it varies only a little when I move my printing device over the surface
<mrvn>
flux: sure the plane is flat? Otherwise your lines won't be lines.
<flux>
that is correct, but I hope there won't be big errors due to that
<flux>
the plane is a glass plate, so it's reasonably flat
<flux>
I can always move the printing head in Z to find the original intersection image, but I hope to avoid that because that would be slower
<mrvn>
and the difference in height still produces a noticeable deviation from horizontal/vertical?
<flux>
yes, the lasers come in a relatively small angle and the image from the camera is zoomed very close
<mrvn>
can't you just locate the laser line at the top and bottom of the image?
<thelema>
mrvn: I assume that's what he's doing to get the existing lines
<thelema>
but as you can tell in the lower left, it's imperfect
<flux>
yeah, I do that for all edges
<flux>
yeah, I should actually handle the edges as a one single looping vector, but I haven't done that yet
<thelema>
looping vector?
<mrvn>
flux: can you post an image. I think I'm not seeing the problem.
<mrvn>
s/./?/
<thelema>
I assume you're treating the edge pixels as a 1d function and finding maxima
<mrvn>
flux: the cross pattern, is it like + or #?
<mrvn>
so one laser does a horizontal line and one a vertical, right?
<thelema>
ok, so your two lasers project a +, and you lined the center of the + at the same point (roughly), and you want to compute slopes so that you can untilt the target?
<flux>
thelema, correct
<flux>
mrvn, both lasers project +
<flux>
mrvn, so that results in the four lines in the picture
<mrvn>
ok, that explains the 4 lines in the image.
<mrvn>
how much slope does that image have? The + look awfully distorted.
<flux>
hmm, I haven't really tried to calculate that. they are quite distorted, but should be relatively straight anyway.
<mrvn>
Too bad the lasers are the same color.
<thelema>
flux: from each edge point, you want to identify the slope that best matches the image color, yes?
<thelema>
And then you'll have too many lines, but you can remove lines with too similar paths (whose path overlaps too much)
<flux>
mrvn, yes, I thought of that as well.. too bad dealextreme delivers so slow :)
<flux>
thelema, yes. I was actually thinking that perhaps I could just start optimizing each line and then remove resulting duplicates.
<mrvn>
flux: can you pulse the lasers seperately?
<flux>
mrvn, unfortunately not unless I add more electronics, I'd rather not :)
<mrvn>
flux: does the image get better if you put a sheat of paper on the glass?
<flux>
mrvn, maybe it does, but that affects the height already and I would need to make the paper completely level as well
<mrvn>
flux: so you could point one outside the image. :)
<thelema>
flux: it may help ro have two crosses on your image instead of one 8-way *
<thelema>
*to
<mrvn>
flux: oehm, that is awfully unsharp.
<flux>
mrvn, yes, the sharp area is very very small :)
<mrvn>
flux: so how do the laser look on a paper instead of glass?
fraggle_ has quit [Read error: Connection reset by peer]
<mrvn>
flux: I wanted to see how much the glass distorts the image.
lamawithonel_ has quit [Ping timeout: 276 seconds]
<edrx>
a VERY beginner-ish question... I'm on debian here, and I can run the default ocaml (3.11.2) with just "ocaml" and ocaml 3.12.1 with "withgodi ocaml", where withgodi is this script: http://angg.twu.net/bin/withgodi.html
<edrx>
how do I install camlp5 on godi? I need camlp5 to start to play with HOL Zero...
<edrx>
aaw, sorry, found it, please ignore my question =\
<thelema>
you found godi's camlp5 package, I assume
<flux>
(only one laser there)
ggherdov has quit [Ping timeout: 240 seconds]
fraggle_ has joined #ocaml
<edrx>
thelema: yep, building it now
<mrvn>
% ocaml Objective Caml version 3.12.1
<mrvn>
it helps to run testing/unstable. :)
<mrvn>
flux: I think you have zoomed in too much. If you take a larger region the lasers will be thinner and diverge more making it easier to recognize each.
edrx has left #ocaml []
lamawithonel_ has quit [Ping timeout: 240 seconds]
lamawithonel_ has joined #ocaml
<flux>
mrvn, true, but I want to see the slightest variations as well
<flux>
and my webcam only does 640x480
<flux>
(and I patched it so that it can even focus so close)
<mrvn>
flux: with more distance from the midpoint the displacement is bigger too. You would have to do the math but does zooming gain you any angular resolution?
<flux>
mrvn, how do you mean the displacement is bigger? the only thing that affects displacement factor is the angle it arrives to the platform
<thelema>
flux: why do you think you'll get better results from a zoomed in photo?
<mrvn>
flux: displacement = sin(alpha) * r
<mrvn>
flux: if you zoom out r gets bigger with the pixels.
<mrvn>
flux: I think if you zoom out the displacement in pixels remains constant.
<flux>
mrvn, no. let's say I zoomed so much that I can see a meter by meter area. if I then move the head by 10 mm, I would probably see no difference in my 640x480 pixel view.
<flux>
if I zoomed so that I have at perfect focus a 1 mm by 1 mm area, I would probably see changes as small as 0.001 millimeters
<flux>
I can now visually see that I can at least see variations of 0.01 millimeters
<mrvn>
flux: I was talking about angular resolution. If you tilt your plate the laser will move 1mm in your zoomed in but 100mm in a 1m by 1m
<mrvn>
And with the beams being thinner you can pinpoint it better in the image.
<flux>
mrvn, are you basically saying that if I look at the laser from further away, I can see small changes better than if I look right next to it?
<mrvn>
flux: no. I'm saing for detecting the angle the distance is irelevant.
<flux>
mrvn, but angle isn't the only thing I'm interested in, I'm more interested how the line moves back and forth
<mrvn>
flux: for position a zoomed in view is better, up to a point.
<mrvn>
even for position I think you went to far. Even I have problems drawing in the lines in your image because it is so blury and lasers overlap.
<mrvn>
Maybe just try different zooms and see which gives the best results.
<flux>
and unfortunately I don't have any options regarding the zoom factor :)
<flux>
well, unless someone can point me at cheap, small webcams that can do macro photography
Cyanure has joined #ocaml
lamawithonel_ has quit [Ping timeout: 276 seconds]
lamawithonel_ has joined #ocaml
Xizor has joined #ocaml
lamawithonel__ has joined #ocaml
lamawithonel_ has quit [Ping timeout: 276 seconds]
letrec has quit [Ping timeout: 276 seconds]
<mrvn>
Anyone experienced with implementing swarm behaviour? Say I have 50 carriers idling around in a clump and now a soldier barrels through them on its way to somewhere. I want for them to move out the way and disperse naturally in some way.
<mrvn>
i.e. the one directly blocking the soldiers moves, that brings it to near others so they move causing a ripple effect in some form.
<pippijn>
37jyeah
<mrvn>
I'm just not sure how to implement that without checking every unit every tick if it has to move.
cyphase has quit [Read error: Connection reset by peer]
oriba has joined #ocaml
cyphase has joined #ocaml
<flux>
mrvn, I suppose you need to use some spatial data structure?
<flux>
to rapidly retrieve which units are near which points
<mrvn>
flux: I have a matrix of tiles with a unit option.
<flux>
well, in that case you should just set that neighbouring tiles should check if they need to move, and this information fills the area in a flood-fill manner?
struktured has joined #ocaml
lamawithonel has joined #ocaml
lamawithonel__ has quit [Ping timeout: 256 seconds]
<mrvn>
I need to add some reaction time in there so units start to move with some delay. Otherwise all of them start to move at the same time instead of a ripple effect.
mattrepl has quit [Read error: No route to host]
struktured has quit [Ping timeout: 244 seconds]
<flux>
it's great to bump into a problem and realize that you've solved at least a subproblem earlier and have code for doing it somewhere (and you can find it as well ;))
<flux>
like line clipping..
<mrvn>
flux: and I hate it when you end up with let rec foo = ... and bar = ... and baz = ... and blub = ... and blubber = ...
<flux>
mrvn, I hope that doesn't happen often :)
<flux>
mrvn, maybe you should have a game clock for the units so that the units can schedule actions to occur at some later point of time?
<mrvn>
flux: unit_set_action time unit actions
<mrvn>
I have a priority queue for future events.
struktured has joined #ocaml
<mrvn>
Array.iter (fun (dx, dy) -> let tile = world.(x + dx).(y + dy) in match tile.Tile.unit with | None -> () | Some unit -> if unit.Unit.actions = [] then unit_set_action (time + Global.startle_delay) unit [Startle]) directions
<mrvn>
But now units move out of the way with a delay. So the approaching units runs into them and has to stop. So I need to add a sleep state and wake them back up when the neighbouring units actualy leaves its tile.
<mrvn>
foo, bar, baz, buzz, blub, blubber, grugle, ....
<mrvn>
those cyclic recursive functions get longer and longer.
<flux>
yeah, state machines can end up with many recursrive functions
<mrvn>
what do you do with if x then (if y then exp1) else (if z then exp2)? Use ()? Use begin end? Use if y then exp1 else ()?
<flux>
depends, I rarely use begin/end though. sometimes I use match () with | _ when .. -> .. | _ when .. -> ..
<mrvn>
flux: yeah, I was to lazy to open the unix module
emmanuel__ has joined #ocaml
mfp has quit [Read error: Connection reset by peer]
mfp has joined #ocaml
host47 has quit [Quit: leaving]
roha has quit [Ping timeout: 265 seconds]
lamawithonel__ has quit [Ping timeout: 276 seconds]
lamawithonel__ has joined #ocaml
hiptobecubic has quit [Ping timeout: 272 seconds]
roha has joined #ocaml
NaCl has quit [Ping timeout: 245 seconds]
<mrvn>
Ok, now units move out of the way: 5 files changed, 303 insertions(+), 73 deletions(-)
<mrvn>
I'm not happy with where they move to though. Currently they just pick a random neighbouring tile that isn't taken (or destination of a moving unit) already.
ggherdov has joined #ocaml
Guest04564 has joined #ocaml
TDJACR has quit [Quit: leaving]
TDJACR has joined #ocaml
Snark has quit [Quit: Quitte]
lamawithonel has joined #ocaml
roha has quit [Ping timeout: 248 seconds]
TDJACR has quit [Quit: leaving]
lamawithonel__ has quit [Ping timeout: 276 seconds]