Is it bug?

[Serguey Zefirov]

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)