Hello hugs-bugs-request, Sunday, March 23, 2003, 4:25:54 AM, you wrote: The following program: ------------------------------------ module StringSolver( fixedp, freep, connstr, solvestrings ) where -- start end length needed data ConnStr = ConnStr Int Int Double type V3 = (Double,Double,Double) data Point = FixedP V3 -- point that cannot move | FreeP V3 -- point that we compute. deriving Show connstr = ConnStr fixedp = FixedP freep = FreeP step = 0.01 deltasq = d*d where d = step verysmall = 0.000000000000001 sub3v (x,y,z) (x',y',z') = (x-x',y-y',z-z') add3v (x,y,z) (x',y',z') = (x+x',y+y',z+z') mul3vsc (x,y,z) sc = (x*sc,y*sc,z*sc) inprod (x,y,z) (x',y',z') = x*x'+y*y'+z*z' distsq a b = let d=sub3v a b in inprod d d dist a b = sqrt $ distsq a b lenv3 = dist (0,0,0) normv3 a = let d = lenv3 a n = 1/sqrt(d) in if d<verysmall then a else mul3vsc a n normv3step a = mul3vsc (normv3 a) (2*step) -- We simply calculate force vectors, normalize them -- into step length and then just add computed displacement. -- if for all points offset is less than delta we stop -- and return given points. otherwise we proceed further. solvestrings points strings = let (points',forces,deltas) = displace points strings dists = map lenv3 deltas smalldists = map (<=deltasq) dists close = and smalldists in (points,points',forces,smalldists): if close then [] else solvestrings points' strings displace points strings = let sforces = stringforces strings points deltas = force points 0 sforces in (zipWith disppoint points deltas,sforces,deltas) disppoint p@(FixedP c) delta = p disppoint (FreeP c) delta = FreeP (add3v c delta) pointtov3 (FixedP c) = c pointtov3 (FreeP c) = c stringforces [] _ = [] stringforces ((ConnStr start end needlen):ss) points = let sp = pointtov3 $ points !! start ep = pointtov3 $ points !! end len = dist sp ep -- force vector is from start point to end point v = sub3v ep sp vlen = lenv3 v normmul = (vlen-needlen)/needlen force = mul3vsc (normv3step v) normmul in (start,end,force):stringforces ss points force [] _ _ = [] force (p:ps) n sforces = let forces [] = [] forces ((start,end,v):sfs) | start==n = v:forces sfs | end==n = (mul3vsc v (-1)):forces sfs | otherwise = forces sfs f = foldl add3v (0,0,0) (forces sforces) in f:force ps (n+1) sforces a = 10.0 tpoints = [ fixedp (a,0,0), fixedp (0,a,0), fixedp (-a,0,0), fixedp (0,-a,0), freep (a,a,1) ] tstrlen = a*sqrt 2 tstrings = [ connstr 0 1 tstrlen, connstr 1 2 tstrlen, connstr 2 3 tstrlen, connstr 3 0 tstrlen, connstr 0 4 tstrlen, connstr 1 4 tstrlen, connstr 2 4 tstrlen, connstr 3 4 tstrlen ] test = ptest $ solvestrings tpoints tstrings ptest [] = return () ptest (p:ps) = do putStrLn $ show p ptest ps ------------------------------------ gives "Garbage collection fails to reclaim sufficient space." when loaded into Hugs Nov 2002 and asked to run "test". I think it shouldn't do that. -- Best regards, Serguey thesz na mail tochka ru (na == at, tochka == dot)