[Haskell-beginners] Error in converting the function from let in clause to where

[mukesh tiwari]

Hello all
This is my first post on Haskell-beginner  so i am not completely aware of
protocols here  . Pardon me for my ignorance . I am trying to implement
elliptic curve prime factorisation and initially wrote
function "addPoints" using let in clause. It works fine. When i  converted
the "addPoint" using where clause then its not working and not adding the
points correctly . I run both functions from ghci and
for same point " addPoints ( Conelliptic 1222 34 5678 ) ( Conpoint 123 42567
) ( Conpoint 1234 4322222222222222) " addPoints function using where clause
return Right 2 while let in clause return Left (Conpoint 4840 4122) . Could
some one please help me to find out the bug . In case of indentation problem
, source code on http://hpaste.org/49174 .

Regards
Mukesh Tiwari

--y^2= x^3+ax+b mod n
import Random
import Control.Monad
import Data.List
import Data.Bits

data Elliptic = Conelliptic Integer Integer Integer deriving ( Eq , Show )
data Point = Conpoint Integer Integer | Identity deriving ( Eq , Show )



powM :: Integer -> Integer -> Integer -> Integer
powM a d n
 | d == 0 = 1
 | d == 1 = mod a n
 | otherwise = mod q n  where
       p = powM  ( mod ( a^2 ) n ) ( shiftR d 1 ) n
       q = if (.&.) d 1 == 1 then mod ( a * p ) n else p


calSd :: Integer -> IO ( Integer , Integer )
calSd n = return ( s , d ) where
        s = until ( \x -> testBit ( n - 1) ( fromIntegral x ) )  ( +1 ) 0
                d = div ( n - 1 ) (  shiftL 1 ( fromIntegral s )  )


isProbable::Integer->IO Bool
isProbable n
   | n <= 1 = return False
   | n == 2 = return True
   | even n = return False
   | otherwise    = calSd n >>= (\( s , d ) -> rabinMiller 0 n s d )


rabinMiller::Integer->Integer->Integer->Integer->IO Bool
rabinMiller cnt n s d
   | cnt>=5= return True
   | otherwise = randomRIO ( 2 , n - 2 ) >>=
                     (\a -> case powM a d n == 1 of
                  True  -> rabinMiller ( cnt + 1 ) n s d
                  _   -> if any ( == pred n ) . take ( fromIntegral s ) .
iterate (\e -> mod ( e^2 ) n ) $ powM a d n  then rabinMiller ( cnt + 1) n s
d
                     else return False )

{--
--add points of elliptic curve
addPoints :: Elliptic -> Point -> Point -> Either Point Integer
addPoints _ Identity p_2 = Left p_2
addPoints _ p_1 Identity = Left p_1
addPoints ( Conelliptic a b n ) ( Conpoint x_p y_p ) ( Conpoint x_q y_q )
        | x_p /= x_q =  case ( ( Conpoint x_r y_r ) , d ) of
                              ( _ , 1 ) -> Left ( Conpoint x_r y_r )
                              ( _ , d' ) -> Right d'
                             where
                                    [ u , v , d ] = extended_gcd ( x_p - x_q
) n
                                    s = mod ( ( y_p - y_q ) * u ) n
                                    x_r = mod ( s*s - x_p - x_q ) n
                                    y_r = mod ( -y_p - s * ( x_r - x_p ) ) n

        | otherwise =   if mod ( y_p + y_q ) n == 0 then Left Identity
                         else case ( ( Conpoint x_r y_r ) , d ) of
                                    ( _ , 1 ) -> Left ( Conpoint x_r y_r )
                                    ( _ , d' ) -> Right d'
                                  where
                                    [ u , v , d ] = extended_gcd ( 2 * y_p )
n
                                    s = mod ( ( 3 * x_p * x_p + a ) * u ) n
                                    x_r = mod ( s * s - 2 * x_p ) n
                                    y_r = mod ( -y_p - s * ( x_r - x_p ) ) n


--}


--add points of elliptic curve
addPoints::Elliptic->Point->Point-> Either Point Integer
addPoints _ Identity p_2 = Left p_2
addPoints _ p_1 Identity = Left p_1
addPoints ( Conelliptic a b n ) ( Conpoint x_p y_p ) ( Conpoint x_q y_q )
    | x_p /= x_q = let
               [ u , v , d ] = extended_gcd (x_p-x_q) n
               s = mod  ( ( y_p - y_q ) * u ) n
               x_r = mod ( s * s - x_p - x_q ) n
               y_r= mod ( -y_p - s * ( x_r - x_p ) ) n
             in case ( ( Conpoint x_r y_r ) , d ) of
              ( _ , 1 ) -> Left ( Conpoint x_r y_r )
              ( _ , d' ) -> Right d'
    | otherwise = if mod ( y_p + y_q ) n == 0 then Left Identity
             else  let
                  [ u , v , d ] = extended_gcd ( 2*y_p ) n
                  s = mod  ( ( 3 * x_p * x_p + a ) * u ) n
                  x_r = mod ( s * s - 2 * x_p ) n
                  y_r = mod ( -y_p - s * ( x_r - x_p ) ) n
               in case ( ( Conpoint x_r y_r ) , d ) of
                                ( _ , 1 )-> Left (Conpoint x_r y_r)
                                ( _ , d' ) -> Right d'



extended_gcd::Integer->Integer->[Integer]
extended_gcd u v= helpGcd u v 0 [ [ 1 , 0 ] , [ 0 , 1 ] ] where
    helpGcd u v n m @ ( [ [ a , b ] , [ c , d ] ] )
      | v == 0 = if u<0 then [ - ( ( -1 ) ^ n ) * ( m !! 1 !! 1 ) , - ( ( -1
) ^ ( n + 1 ) ) * ( m !! 0 !! 1 ) , -u ]
                     else [ ( ( -1 ) ^ n ) * ( m !! 1 !! 1 ) , ( ( -1 ) ^ (
n + 1 ) ) * ( m !! 0 !! 1 ) , u ]
      | otherwise = helpGcd u' v' ( n + 1 ) m' where
        ( q , v' ) = quotRem u v
        t = [ [q , 1 ] , [ 1 , 0 ] ]
        m' = [ [ q * a + b , a ] , [ q * c + d , c ] ] --mult m t
        u' = v




multiEC :: Elliptic -> Point -> Integer -> IO ( Either Point Integer )
multiEC _ _ 0 = return $ Left Identity
multiEC ecurve point k | k>0 = return $ helpEC Identity point k
    where
      helpEC p _ 0 = Left p
      helpEC p q n =
             case (p',q') of
          ( Left p'' , Left q'' ) -> helpEC p'' q'' (div n 2)
          ( Right p'' , _ ) -> Right p''
          ( _ , Right q'' ) -> Right q''
              where
           p' =if odd n then addPoints ecurve p q else Left p
               q' =  addPoints ecurve q q


dscrmntEC a b = 4 * a * a * a + 27 * b * b


randomCurve :: Integer -> IO [Integer]
randomCurve n = randomRIO ( 1 , n ) >>= ( \a -> randomRIO ( 1 , n ) >>= ( \u
-> randomRIO (1 , n) >>= (\v -> return [a , mod ( v*v - u*u*u - a*u ) n , n
, u , v ] ) ) )


factor :: Integer -> Integer -> IO [Integer]
factor 1 _   = return []
factor n m   =
    isProbable n >>= (\x -> if x then  return [n]
                 else
                   randomCurve n >>= (\[ a , b , n , u , v ] ->
                                  multiEC ( Conelliptic a b n ) ( Conpoint u
v ) m >>=
                                   ( \p -> case p of
                                              Left p' -> factor n m
                                              Right p'->  factor ( div n p'
) m  >>= ( \x -> factor p' m  >>= (\y  -> return $ x ++ y   ) ) ) ) )




solve :: Integer -> IO [ Integer ]
solve n = factor n ( foldl lcm 1 [1..10000] )

main = liftM read getLine >>=( \n -> solve n  ) >>= print
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20110718/df660087/attachment-0001.htm>