# My Weblog

## ZeroMQ for distributed computing.

This post is influenced by ØMQ – The Guide By Pieter Hintjens and translation of codes in Haskell. I suggest you to read The Guide By Pieter Hintjens and if you are interested in Haskell code then you see these codes.

The client sends “Accept hello from Client. ” to the server, which replies with “I got you.”. This Haskell server opens a ØMQ socket on port 5555, reads requests on it, and replies with “I got you” to each request.The REQ-REP socket pair is in lockstep. The client issues send and then receive, in a loop (or once if that’s all it needs). Doing any other sequence (e.g., sending two messages in a row) will result in a return code of -1 from the send or receive call.


import System.ZMQ3
import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy.Internal as BL
import Data.IORef
main = do
c <- context
s <- socket c Rep
bind s "tcp://127.0.0.1:5555"
counter <- newIORef 0
forever $do t <- readIORef counter res <- receive s print res send' s [] ( BL.packChars$ "I got you. " ++ show t )
modifyIORef counter ( +1 )
close s
destroy c
return ()



Client

import System.ZMQ3
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Internal as BL
import Data.IORef

main = do
c <- context
s <- socket c Req
connect s "tcp://127.0.0.1:5555"
counter <- newIORef 0
forever $do t <- readIORef counter send' s [] ( BL.packChars$ "Accept hello from Client. " ++ show t )
print msg
modifyIORef counter ( +1 )
return ()



Running a server with two clients.


Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$./ZeroMqServer "Accept hello from Client. 0" "Accept hello from Client. 1" "Accept hello from Client. 2" "Accept hello from Client. 3" "Accept hello from Client. 4" "Accept hello from Client. 5" "Accept hello from Client. 6" "Accept hello from Client. 7" "Accept hello from Client. 8" "Accept hello from Client. 9" "Accept hello from Client. 10" "Accept hello from Client. 11" "Accept hello from Client. 12" "Accept hello from Client. 13" "Accept hello from Client. 14" "Accept hello from Client. 15" "Accept hello from Client. 0" "Accept hello from Client. 228" "Accept hello from Client. 1" "Accept hello from Client. 229" "Accept hello from Client. 2" "Accept hello from Client. 230" "Accept hello from Client. 3" "Accept hello from Client. 231" "Accept hello from Client. 4" "Accept hello from Client. 232" First client. Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$ ./ZeroMqClient
"I got you. 0"
"I got you. 1"
"I got you. 2"
"I got you. 3"
"I got you. 4"
"I got you. 5"
"I got you. 6"
"I got you. 7"
"I got you. 8"
"I got you. 9"
"I got you. 10"
"I got you. 11"
"I got you. 12"

Second client
Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$./ZeroMqClient "I got you. 228" "I got you. 230" "I got you. 232" "I got you. 234" "I got you. 236" "I got you. 238" "I got you. 240" "I got you. 242" "I got you. 244" "I got you. 246" "I got you. 248" "I got you. 250" "I got you. 252" "I got you. 254" "I got you. 256" "I got you. 258" "I got you. 260" "I got you. 262" "I got you. 264" "I got you. 266"  ### Publish-Subscribe Data publishing server which publishes weather data for zip codes in range 500 and 2000. import System.ZMQ3 import Control.Monad import qualified Data.ByteString.Char8 as BS hiding ( putStrLn ) import qualified Data.ByteString.Lazy.Internal as BL import Control.Concurrent ( threadDelay ) import System.Random main = do c <- context publisher <- socket c Pub bind publisher "tcp://127.0.0.1:5556" bind publisher "ipc://weather.ipc" forever$ do
zipcode <- randomRIO ( ( 500 , 2000 ) ::  ( Int , Int ) )
temp <- randomRIO ( 10 , 45 ) :: IO Int
relhum <- randomRIO ( 0 , 100 ) :: IO Int
putStrLn $show zipcode ++ " " ++ show temp ++ " " ++ show relhum send' publisher [] ( BL.packChars$ show zipcode ++ " " ++ show temp ++
" " ++  show relhum )
close publisher
destroy c
return ()


Client who is only interested in two zip codes.

import System.ZMQ3
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Internal as BL
import System.Random

main = do
c <- context
subscriber <- socket c Sub
connect subscriber "tcp://127.0.0.1:5556"
subscribe subscriber ( BS.pack "1000" )
subscribe subscriber ( BS.pack "1010" )
forever $do update <- receive subscriber print update close subscriber destroy c  Our server is publishing lot of data but client is only interested in two zip codes.  Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$ ./ZeroMqWeatherPubServer
1568 27 85
924 41 46
1461 15 46
1867 44 28
1013 23 100
1052 13 6
1720 45 6
1480 12 94
1852 33 4
1295 20 6
925 18 77
935 37 94
1670 11 6
1285 39 38
1613 44 99
1888 26 62
1011 21 45
993 45 45
1402 26 86
1639 13 65
1285 18 40
1960 38 18
1160 27 39
1374 16 59
665 25 22

Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$./ZeroMqWeatherClient "1000 34 89" "1010 19 70" "1010 15 86" "1000 38 57" "1010 12 42" "1000 25 1" "1000 28 78" "1000 25 16" "1000 28 82" "1010 28 98" "1000 12 77" "1010 11 16" "1010 44 14" "1010 12 89" "1000 32 8" "1010 37 55" "1010 17 21" "1000 13 96" "1000 18 51" "1010 16 38" "1000 18 21" "1010 37 60" "1010 17 25" "1000 33 43" "1000 34 44" "1010 33 78" "1010 35 63" "1000 39 50" "1000 45 70" "1000 26 3" "1010 34 12" "1010 26 3" "1000 32 75" "1010 14 68" "1000 44 75" "1010 27 54" "1000 21 39" "1010 12 65" "1010 43 29" "1010 25 60"  ### Divide and Conquer For this problem we will calculate the number of primes less than $10^{7}$. Our ventilator will push the task to workers and they will perform the task. After finishing the job, they will send the result back to sink. Ventilator import System.ZMQ3 import Control.Monad import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy.Internal as BL import Data.IORef import Control.Concurrent ( threadDelay ) main = do c <- context sender <- socket c Push bind sender "tcp://127.0.0.1:5557" sink <- socket c Push connect sink "tcp://127.0.0.1:5558" putStrLn "Press enter when workers are ready." _ <- getChar putStrLn "Sending the task to workers.\n" send' sink [] ( BL.packChars . show$ 0 )

forM_ [ 0..9999 ] $\ i -> do putStrLn$ "Sending the range [ " ++ show ( 1000 * i + 1 ) ++ " .. " ++ show  ( 1000 * i + 1 + 999 ) ++ "] to worker for primality testing."
send' sender [] ( BL.packChars . show $1000 * i + 1 ) close sink close sender destroy c  Worker for computing the prime number. import System.ZMQ3 import Control.Monad import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Internal as BL import Data.IORef import Control.Concurrent ( threadDelay ) import Data.Bits powM :: Integer -> Integer -> Integer -> Integer powM a d n = powM' a d n where 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 -> ( Integer , Integer ) calSd n = ( s , d ) where s = until ( \x -> testBit ( n - 1) ( fromIntegral x ) ) ( +1 ) 0 d = div ( n - 1 ) ( shiftL 1 ( fromIntegral s ) ) rabinMiller::Integer->Integer->Integer->Integer-> Bool rabinMiller n s d a | n == a = True | otherwise = case x == 1 of True -> True _ -> any ( == pred n ) . take ( fromIntegral s ) . iterate (\e -> mod ( e^2 ) n )$ x
where
x = powM a d n

isPrime::Integer-> Bool
isPrime n
| n <= 1 = False
| n == 2 = True
| even n = False
| otherwise  = all ( == True ) . map ( rabinMiller n s d ) $[ 2 , 3 , 5 , 7 , 11 , 13 , 17 ] where ( s , d ) = calSd n primeRange :: Integer -> Integer -> [ Bool ] primeRange m n = map isPrime [ m .. n ] main = do c <- context receiver <- socket c Pull connect receiver "tcp://127.0.0.1:5557" sender <- socket c Push connect sender "tcp://127.0.0.1:5558" forever$ do
let n = read . BS.unpack $num :: Integer let len = length . filter ( == True ) . primeRange n$  n + 999
putStrLn $"Received range [ " ++ show n ++ " .. " ++ show ( n + 999 ) ++ " and number of primes in this range is " ++ show len send' sender [] ( BL.packChars . show$ len  )

close sender
destroy c



Sink for collecting the results.

import System.ZMQ3
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Internal as BL
import Data.IORef

main = do
c <- context

print m
sum <- newIORef  0
forM_ [ 1.. 10000 ] $\i -> do num <- receive receiver let n = read . BS.unpack$ num :: Integer
putStrLn $"Received a number " ++ show n ++ " from one of worker" modifyIORef sum ( + n ) t <- readIORef sum putStrLn$ "Total number of primes in the range is " ++ show t
destroy c


Running Ventilator, 3 workers and sink

Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$./TaskVent Sending the range [ 9992001 .. 9993000] to worker for primality testing. Sending the range [ 9993001 .. 9994000] to worker for primality testing. Sending the range [ 9994001 .. 9995000] to worker for primality testing. Sending the range [ 9995001 .. 9996000] to worker for primality testing. Sending the range [ 9996001 .. 9997000] to worker for primality testing. Sending the range [ 9997001 .. 9998000] to worker for primality testing. Sending the range [ 9998001 .. 9999000] to worker for primality testing. Sending the range [ 9999001 .. 10000000] to worker for primality testing. Task worker - 1 Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$ ./TaskWorkder
Received range [ 9978001 .. 9979000  and number of primes in this range is 60
Received range [ 9981001 .. 9982000  and number of primes in this range is 49
Received range [ 9984001 .. 9985000  and number of primes in this range is 69
Received range [ 9987001 .. 9988000  and number of primes in this range is 57
Received range [ 9990001 .. 9991000  and number of primes in this range is 60
Received range [ 9993001 .. 9994000  and number of primes in this range is 71
Received range [ 9996001 .. 9997000  and number of primes in this range is 58
Received range [ 9999001 .. 10000000  and number of primes in this range is 53

Mukeshs-MacBook-Pro:ZMQ mukeshtiwari$./TaskWorkder Received range [ 9982001 .. 9983000 and number of primes in this range is 69 Received range [ 9985001 .. 9986000 and number of primes in this range is 62 Received range [ 9988001 .. 9989000 and number of primes in this range is 58 Received range [ 9991001 .. 9992000 and number of primes in this range is 57 Received range [ 9994001 .. 9995000 and number of primes in this range is 64 Received range [ 9997001 .. 9998000 and number of primes in this range is 67 Task Worker - 3 Received range [ 9986001 .. 9987000 and number of primes in this range is 59 Received range [ 9989001 .. 9990000 and number of primes in this range is 58 Received range [ 9992001 .. 9993000 and number of primes in this range is 58 Received range [ 9995001 .. 9996000 and number of primes in this range is 62 Received range [ 9998001 .. 9999000 and number of primes in this range is 64 Sink Received a number 53 from one of worker Received a number 67 from one of worker Received a number 64 from one of worker Received a number 52 from one of worker Received a number 59 from one of worker Received a number 58 from one of worker Received a number 58 from one of worker Received a number 62 from one of worker Received a number 64 from one of worker Total number of primes in the range is 664579  First start all the workers and sink and then run ventilator. See more about distributed computing in Haskell Eden and distributed-process. If you have any suggestion then please let me know. Some of the contents and images are taken from Pieter Hintjens‘s tutorial by his permission. May 13, 2013 ## Missionaries and cannibals problem In the missionaries and cannibals problem, three missionaries and three cannibals must cross a river using a boat which can carry at most two people, under the constraint that, for both banks, if there are missionaries present on the bank, they cannot be outnumbered by cannibals (if they were, the cannibals would eat the missionaries.) The boat cannot cross the river by itself with no people on board. We can solve this problem using depth first search. Representing the states as number of missionaries, cannibals and boat location in following way.  data Side = Side { missionaries :: Int , cannibals :: Int } deriving ( Show , Eq ) data Loc = L | R deriving ( Show , Eq ) data State = State { left :: Side , right :: Side , bloc :: Loc } deriving ( Show , Eq )  Target is to move every missionaries and cannibals from left to right so our initial state is initialState and final state is finalState.  initialState = State { left = Side 3 3 , right = Side 0 0 , bloc = L } finalState = State { left = Side 0 0 , right = Side 3 3 , bloc = R }  Possible movements 1. move ( 2 , 0 ) 2. move ( 1 , 0 ) 3. move ( 1 , 1 ) 4. move ( 0 , 1 ) 5. move ( 0 , 2 ) where move ( M , C ) is movement of M missionaries and C cannibals from one side to other side depending on boat location. If boat location is left then move ( M , C ) is moving M missionaries and C cannibals from left to right and vice versa. Using depth first search, we can explore every possible movement path :: [ State ] -> [ State ] -> [ State ] path [] vis = reverse vis path ( x : xs ) vis | x == finalState = reverse ( x : vis ) | elem x vis = path xs vis | otherwise = path xs' vis' where vis' = x : vis xs' = ( filter isLegal ( move x ) ) ++ xs  Encoding the moves and testing the legality  move :: State -> [ State ] move ( State ( Side ml cl ) ( Side mr cr ) L ) = [ State ( Side ( ml - 2 ) cl ) ( Side ( mr + 2 ) cr ) R , State ( Side ( ml - 1 ) cl ) ( Side ( mr + 1 ) cr ) R , State ( Side ( ml - 1 ) ( cl - 1 ) ) ( Side ( mr + 1 ) ( cr + 1 ) ) R , State ( Side ml ( cl - 2 ) ) ( Side mr ( cr + 2 ) ) R , State ( Side ml ( cl - 1 ) ) ( Side mr ( cr + 1 ) ) R ] move ( State ( Side ml cl ) ( Side mr cr ) R ) = [ State ( Side ( ml + 2 ) cl ) ( Side ( mr - 2 ) cr ) L , State ( Side ( ml + 1 ) cl ) ( Side ( mr - 1 ) cr ) L , State ( Side ( ml + 1 ) ( cl + 1 ) ) ( Side ( mr - 1 ) ( cr - 1 ) ) L , State ( Side ml ( cl + 2 ) ) ( Side mr ( cr - 2 ) ) L , State ( Side ml ( cl + 1 ) ) ( Side mr ( cr - 1 ) ) L ] isLegal :: State -> Bool isLegal ( State ( Side ml cl ) ( Side mr cr ) y ) | ml == 0 = mr >= cr && cr >= 0 | mr == 0 = ml >= cl && cl >= 0 | otherwise = ml >= cl && mr >= cr && cl >= 0 && cr >= 0  Complete source code ( In case if you are lazy ) import Data.List data Side = Side { missionaries :: Int , cannibals :: Int } deriving ( Show , Eq ) data Loc = L | R deriving ( Show , Eq ) data State = State { left :: Side , right :: Side , bloc :: Loc } deriving ( Show , Eq ) initialState = State { left = Side 3 3 , right = Side 0 0 , bloc = L } finalState = State { left = Side 0 0 , right = Side 3 3 , bloc = R } path :: [ State ] -> [ State ] -> [ State ] path [] vis = reverse vis path ( x : xs ) vis | x == finalState = reverse ( x : vis ) | elem x vis = path xs vis | otherwise = path xs' vis' where vis' = x : vis xs' = ( filter isLegal ( move x ) ) ++ xs move :: State -> [ State ] move ( State ( Side ml cl ) ( Side mr cr ) L ) = [ State ( Side ( ml - 2 ) cl ) ( Side ( mr + 2 ) cr ) R , State ( Side ( ml - 1 ) cl ) ( Side ( mr + 1 ) cr ) R , State ( Side ( ml - 1 ) ( cl - 1 ) ) ( Side ( mr + 1 ) ( cr + 1 ) ) R , State ( Side ml ( cl - 2 ) ) ( Side mr ( cr + 2 ) ) R , State ( Side ml ( cl - 1 ) ) ( Side mr ( cr + 1 ) ) R ] move ( State ( Side ml cl ) ( Side mr cr ) R ) = [ State ( Side ( ml + 2 ) cl ) ( Side ( mr - 2 ) cr ) L , State ( Side ( ml + 1 ) cl ) ( Side ( mr - 1 ) cr ) L , State ( Side ( ml + 1 ) ( cl + 1 ) ) ( Side ( mr - 1 ) ( cr - 1 ) ) L , State ( Side ml ( cl + 2 ) ) ( Side mr ( cr - 2 ) ) L , State ( Side ml ( cl + 1 ) ) ( Side mr ( cr - 1 ) ) L ] isLegal :: State -> Bool isLegal ( State ( Side ml cl ) ( Side mr cr ) y ) | ml == 0 = mr >= cr && cr >= 0 | mr == 0 = ml >= cl && cl >= 0 | otherwise = ml >= cl && mr >= cr && cl >= 0 && cr >= 0   Main> path [ initialState ] [] [State {left = Side {missionaries = 3, cannibals = 3}, right = Side {missionaries = 0, cannibals = 0}, bloc = L},State {left = Side {missionaries = 2, cannibals = 2}, right = Side {missionaries = 1, cannibals = 1}, bloc = R},State {left = Side {missionaries = 3, cannibals = 2}, right = Side {missionaries = 0, cannibals = 1}, bloc = L},State {left = Side {missionaries = 3, cannibals = 0}, right = Side {missionaries = 0, cannibals = 3}, bloc = R},State {left = Side {missionaries = 3, cannibals = 1}, right = Side {missionaries = 0, cannibals = 2}, bloc = L},State {left = Side {missionaries = 1, cannibals = 1}, right = Side {missionaries = 2, cannibals = 2}, bloc = R},State {left = Side {missionaries = 2, cannibals = 2}, right = Side {missionaries = 1, cannibals = 1}, bloc = L},State {left = Side {missionaries = 0, cannibals = 2}, right = Side {missionaries = 3, cannibals = 1}, bloc = R},State {left = Side {missionaries = 0, cannibals = 3}, right = Side {missionaries = 3, cannibals = 0}, bloc = L},State {left = Side {missionaries = 0, cannibals = 1}, right = Side {missionaries = 3, cannibals = 2}, bloc = R},State {left = Side {missionaries = 1, cannibals = 1}, right = Side {missionaries = 2, cannibals = 2}, bloc = L},State {left = Side {missionaries = 0, cannibals = 0}, right = Side {missionaries = 3, cannibals = 3}, bloc = R}] *Main> map bloc . path [ initialState ]$ [] [L,R,L,R,L,R,L,R,L,R,L,R] 
If you have any suggestion or comment then please let me know.

April 19, 2013

## SPOJ Pell (Mid pelling)

Pell (Mid pelling) is related to Pell’s equation. It is similar to Project Euler 66 and SPOJ EQU2. I just wrote the quick solution from mathworld but I found Chakravala method very interesting. Accepted Haskell code.

import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Maybe ( fromJust )

continuedFraction :: Integer -> [ Integer ]
continuedFraction n = map ( \ ( a , _ , _ ) -> a ) . iterate fun $( d , 0 , 1 ) where d = truncate . sqrt . fromIntegral$ n
fun ( a0 , p0 , q0 ) = ( a1 , p1 , q1 ) where
p1 = a0 * q0 - p0
q1 = div ( n - p1 ^ 2 ) q0
a1 = div ( d + p1 ) q1

pellSolver :: Integer -> BS.ByteString
pellSolver n
| perfectSqr n = BS.pack. show $( -1 ) | otherwise = ( BS.pack . show$ p ) BS.append ( BS.pack " " )
BS.append ( BS.pack.show $q ) where d = truncate . sqrt . fromIntegral$ n
lst = takeWhile ( /= 2 * d ) . continuedFraction $n len = length lst r@( x : y : xs ) = take ( if even len then len else 2 * len ) . continuedFraction$ n
( p0 , p1 , q0 , q1 ) = ( x , x * y + 1 , 1 , y )
( p , _ ) = foldl' compute ( p1 , p0 ) $xs ( q , _ ) = foldl' compute ( q1 , q0 )$ xs
compute :: ( Integer , Integer ) -> Integer -> ( Integer , Integer )
compute ( p1 , p0 ) a = ( a * p1 + p0 , p1 )

perfectSqr :: Integer -> Bool
perfectSqr n = d * d == n where
d = truncate . sqrt . fromIntegral $n readI :: BS.ByteString -> Integer readI = fst . fromJust . BS.readInteger main = BS.interact$  BS.unlines . map ( pellSolver . readI ) . tail . BS.lines


March 23, 2013

## Parsing Email ID

Now a days I am exploring one of the most awesome feature of Haskell, parsing. There are lot of parsing libraries but Parsec is the popular one. This parsing code is written for SPOJ EMAIL ID problem ( Unfortunately it’s getting time limit exceed. I have seen couple of python solution accepted so I am hopeful that there must be another algorithm probably using regular expressions to solve the problem ) but you can build more sophisticated email-id parser by adding more functionality. Tony Morris excellent parsing tutorial is must read.

import Data.List
import qualified Text.Parsec.ByteString as PB
import Text.Parsec.Prim
import Text.Parsec.Char
import Text.Parsec.Combinator
import qualified Data.ByteString.Char8 as BS
import Control.Applicative hiding ( ( <|> ) , many )

validChars :: PB.Parser Char
validChars  = alphaNum <|> oneOf "._"

dontCare :: PB.Parser Char
dontCare = oneOf "~!@#$%^&*()<>?,." {-- emailAddress :: PB.Parser String emailAddress = do _ <- many dontCare fi <- alphaNum se <- validChars th <- validChars fo <- validChars ft <- validChars restAddr <- many validChars let addr = fi : se : th : fo : ft : restAddr char '@' dom <- many1 alphaNum rest <- try ( string ".com" <|> string ".org" <|> string ".edu" ) <|> try ( string ".co.in" ) _ <- many dontCare return$  addr ++ (  '@': dom ++ rest )

--}

emailAddress = conCatfun <$> ( many dontCare *> alphaNum ) <*> validChars <*> validChars <*> validChars <*> validChars <*> many alphaNum <*> ( char '@' *> many1 alphaNum ) <*> ( try ( string ".com" <|> string ".org" <|> string ".edu" ) <|> try ( string ".co.in" ) <* many dontCare ) where conCatfun a b c d e f dom rest = ( a : b : c : d : e : f ) ++ ( '@' : dom ) ++ rest collectEmail :: BS.ByteString -> String collectEmail email = case parse emailAddress "" email of Right addr -> addr Left err -> "" process :: ( Int , [ String ] ) -> BS.ByteString process ( k , xs ) = ( BS.pack "Case " ) BS.append ( BS.pack . show$ k )
BS.append ( BS.pack ": " ) BS.append ( BS.pack . show . length $xs ) BS.append ( BS.pack "\n" ) BS.append ( BS.pack ( unlines . filter ( not . null )$  xs ) )

main = BS.interact $BS.concat . map process . zip [ 1.. ] . map ( map collectEmail . BS.words ) . tail . BS.lines  Mukeshs-MacBook-Pro:Haskell mukeshtiwari$ cat t.txt
2
svm11@gmail.com
svm11@gmail.com svm12@gmail.co.in  ~!@#$%^&*()<>?svm12@gmail.co.in~!@#$%^&*()
Mukeshs-MacBook-Pro:Haskell mukeshtiwari$./Spoj_11105 < t.txt Case 1: 1 svm11@gmail.com Case 2: 2 svm11@gmail.com svm12@gmail.co.in svm12@gmail.co.in  #### Update I tried again to solve this problem using regular expression. Following the tutorial, I wrote this code but I got compiler error because of old version of ghc on SPOJ ( GHC-6.10.4 ). It’s working fine on my system but I still have to test if it is correct and fast enough to get accepted. import Data.List import Text.Regex.Posix import qualified Data.ByteString.Char8 as BS pat :: BS.ByteString pat = BS.pack "[^~!@#$%^&*()<>?,.]*[a-zA-Z0-9][a-zA-Z0-9._][a-zA-Z0-9._][a-zA-Z0-9._][a-zA-Z0-9._][a-zA-Z0-9._]*@[a-zA-Z0-9]+.(com|edu|org|co.in)[^~!@#$%^&*()<>?,.a-zA-Z0-9]*" collectEmail :: BS.ByteString -> BS.ByteString collectEmail email = ( =~ ) email pat process :: ( Int , [ BS.ByteString ] ) -> BS.ByteString process ( k , xs ) = ( BS.pack "Case " ) BS.append ( BS.pack . show$ k )
BS.append ( BS.pack ": " ) BS.append ( BS.pack . show . length $xs ) BS.append ( BS.pack "\n" ) BS.append ( BS.unlines xs ) main = BS.interact$ BS.concat .  map process . zip [ 1 .. ] .
map ( filter ( not . BS.null ) . map collectEmail . BS.words ) .
tail . BS.lines

Mukeshs-MacBook-Pro:SPOJ mukeshtiwari$cat t.txt 2 svm11@gmail.com svm11@gmail.com svm12@gmail.co.in %&^%&%&%&%&^%&^%&^%&^mukeshtiwari.iiitm@gmail.com%&%^&^%&%&%&%&^%&%&^%&^%&^% %$%$#%#%#%#%$#%&%&%&tiwa@gmail.com
Mukeshs-MacBook-Pro:SPOJ mukeshtiwari$./Spoj_11105 < t.txt Case 1: 1 svm11@gmail.com Case 2: 3 svm11@gmail.com svm12@gmail.co.in mukeshtiwari.iiitm@gmail.com  March 8, 2013 ## Generating primes in parallel We can use Miller-Rabin primality testing to test a number is prime or not with certain probability. We can use this method on chunk of data to get the primes in parallel. I wrote this code to see how it goes and it’s quite interesting. My other post about data parallelism and Don Stewart answer regarding different options to improve parallelism. The crux of this code is primeRange :: Integer -> Integer -> [ Bool ] primeRange m n = ( map isPrime [ m .. n ] ) using parListChunk 10000 rdeepseq  For parallelism in Haskell , see Haskell-for-multicores and Real World Haskell. Code on github. import Data.Bits import Control.Parallel.Strategies powM :: Integer -> Integer -> Integer -> Integer powM a d n = powM' a d n where 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 -> ( Integer , Integer ) calSd n = ( s , d ) where s = until ( \x -> testBit ( n - 1) ( fromIntegral x ) ) ( +1 ) 0 d = div ( n - 1 ) ( shiftL 1 ( fromIntegral s ) ) rabinMiller::Integer->Integer->Integer->Integer-> Bool rabinMiller n s d a | n == a = True | otherwise = case x == 1 of True -> True _ -> any ( == pred n ) . take ( fromIntegral s ) . iterate (\e -> mod ( e^2 ) n )$ x
where
x = powM a d n

isPrime::Integer-> Bool
isPrime n
| n <= 1 = False
| n == 2 = True
| even n = False
| otherwise	= all ( == True ) . map ( rabinMiller n s d ) $[ 2 , 3 , 5 , 7 , 11 , 13 , 17 ] where ( s , d ) = calSd n primeRange :: Integer -> Integer -> [ Bool ] primeRange m n = ( map isPrime [ m .. n ] ) using parListChunk 10000 rdeepseq main = do let t = filter ( == True ) . primeRange 2$ 10 ^ 6
print . length $t Mukeshs-MacBook-Pro:Haskell mukeshtiwari$ ghc -O2 -rtsopts --make RabinMiller.hs -threaded  -fforce-recomp
[1 of 1] Compiling Main             ( RabinMiller.hs, RabinMiller.o )
Mukeshs-MacBook-Pro:Haskell mukeshtiwari$time ./RabinMiller +RTS -N1 78498 real 0m4.841s user 0m4.695s sys 0m0.075s Mukeshs-MacBook-Pro:Haskell mukeshtiwari$ time ./RabinMiller +RTS -N2
78498

real	0m3.115s
user	0m5.969s
sys	0m0.215s
Mukeshs-MacBook-Pro:Haskell mukeshtiwari$time ./RabinMiller +RTS -N3 78498 real 0m2.687s user 0m7.556s sys 0m0.415s  I am no expert in parallelism or Haskell so if you have any comment or suggestion then please let me know. February 5, 2013 ## Parsing with Applicative Functors While reading Write Yourself a Scheme in 48 Hours, I thought of converting the monadic codes of parsing into applicative style. Learn you a Haskell for Great Good has excellent explanation about functors and applicative functors. Real World Haskell has excellent chapter on using applicative functors for parsing. Below is my attempt to convert the monadic codes of parsing into applicative style for Scheme parsing. On parsing note, see the excellent tutorial of Tony Morris and Albert Y. C. Lie. import Control.Applicative hiding ( many , ( <|> ) ) import Text.ParserCombinators.Parsec hiding ( spaces ) symbol :: Parser Char symbol = oneOf "!$%&|+-*/:<=?>@^_~#"

spaces :: Parser ()
spaces = skipMany space

parseString :: Parser LispVal
parseString = String <$> ( char '"' *> x <* char '"' ) where x = many ( noneOf "\"" ) --This is not completely applicative style because I have to take the result for testing conditions. parseAtom :: Parser LispVal parseAtom = do atom <- ( : ) <$> ( letter <|> symbol ) <*> many ( letter <|> digit <|> symbol )
return $case atom of "#t" -> Bool True "#f" -> Bool False _ -> Atom atom parseNumber :: Parser LispVal parseNumber = Number . read <$> many1 digit

parseList :: Parser LispVal
parseList = List <$> sepBy parseExpr space parseDottedList :: Parser LispVal parseDottedList = DottedList <$> ( endBy parseExpr space ) <*> ( char '.' *> spaces *> parseExpr )

parseQuoted :: Parser LispVal

main = BS.interact $BS.unlines . map ( BS.pack . ( printf "%.6f" :: Double -> String ) . evalFun . map readD ) . filter ( not.null ) . map BS.words . tail . BS.lines  Changing the initial approximation of $\frac{C}{A}$ and 50 iteration improves the time by 0.60 seconds ( from 0.80 to 0.22 ). January 4, 2013 ## Threading in C and Haskell As soon as main starts executing ( it’s process ), it sees that we are creating threads and operating system creates them for us. When we run this code, it produces the different results every time ( Make the task bit bigger to feel the inconsistency. Probably executing more than processor switching time I guess ). Its because lets say first thread starts incrementing the count variable and before finishing the whole loop, processor switch to second or third thread and they start modifying the inconsistent count variable. In the mean time processor keeps switching to all threads. How to avoid this ? If we are executing some critical code ( some data manipulation ) then we have to put lock on that critical code so if processor switch to other thread and they try to access it then denied because the critical code is locked by some other thread and he is not finished yet. We get the lock by pthread_mutex_t , initialise it and destroy it when we are done. Lock the critical code pthread_mutex_lock and unlock it using pthread_mutex_unlock passing the address of lock. A excellent tutorial on C thread programming. #include<stdio.h> #include<pthread.h> pthread_t tid[2]; pthread_mutex_t lock; //comment all the functions related to lock to see the race condition. void* coun_incr(void* arg ) { int i; //printf("Thread identifier = %d\n", pthread_self() ); //going to lock this critical code pthread_mutex_lock ( &lock ); int* count = ( int* ) arg; for( i = 0 ; i < 1000000 ; i++ ) *count += 10; //release the lock because we have finished the whole iteration pthread_mutex_unlock ( &lock ); return NULL; } int main() { //initialize the lock pthread_mutex_init ( &lock , NULL ); int count = 0 ; pthread_create( &tid[0] , NULL , coun_incr , &count ) ; pthread_create( &tid[1] , NULL , coun_incr , &count ) ; pthread_create( &tid[2] , NULL , coun_incr , &count ) ; //wait for thread to finish otherwise main will finish and terminate all the three threads. pthread_join ( tid[0] , NULL ); pthread_join ( tid[1] , NULL ); pthread_join ( tid[2] , NULL ); printf("%d\n", count ); //destroy the lock pthread_mutex_destroy ( &lock ); } Some results in inconsistent state. Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ gcc -lpthread Thread_1.c
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./a.out 13482740 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./a.out
21974930
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./a.out 24638680 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./a.out
17794120

Using locks on critical code.
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$gcc -lpthread Thread_1.c Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./a.out
30000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./a.out 30000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./a.out
30000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./a.out 30000000  The almost same code in Haskell using mvar. import Control.Concurrent import Control.Monad import GHC.IORef incr_count :: MVar () -> MVar Int -> IO () incr_count m n = ( forM_ [ 1..10000 ]$ \_ -> modifyMVar_ n ( return . ( + 10 ) ) ) >> putMVar m ()

main :: IO()
main = do
count <- newMVar 0
list <- forM [1..10] $\_ -> newEmptyMVar forM_ list$ \var -> forkIO . incr_count var $count forM_ list$ \var ->  takeMVar var
val <- takeMVar count
print val

ghci>main
1000000
ghci>main
1000000
ghci>main
1000000


We can create race condition using IORef. We are creating a mutable variable count of type IORef and 10 parallel threads are modifying it.

import Control.Concurrent
import Data.IORef

incr_count :: MVar () -> IORef Int  -> IO ()
incr_count m n = ( forM_ [ 1 .. 10000 ] $\_ -> modifyIORef' n ( + 10 )) >> putMVar m () main :: IO () main = do count <- newIORef 0 list <- forM [1..10]$ \_ -> newEmptyMVar
forM_ list $\var -> forkIO . incr_count var$ count
forM_ list $\var -> takeMVar var val <- readIORef count print val Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1  +RTS -N2
619360
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 +RTS -N2 614090 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1  +RTS -N2
521930
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 500010 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 +RTS -N2 597710  We can use software transactional memory ( STM ) to run whole update as single unit without interference of other threads. The only use of MVar is to finish all the threads before main. We can remove MVar and use threadDelay function but I believe that MVar solution is more reliable than using random thread delay. From wikipedia “Unlike the locking techniques used in most modern multithreaded applications, STM is very optimistic: a thread completes modifications to shared memory without regard for what other threads might be doing, recording every read and write that it is performing in a log. Instead of placing the onus on the writer to make sure it does not adversely affect other operations in progress, it is placed on the reader, who after completing an entire transaction verifies that other threads have not concurrently made changes to memory that it accessed in the past. This final operation, in which the changes of a transaction are validated and, if validation is successful, made permanent, is called a commit. A transaction may also abort at any time, causing all of its prior changes to be rolled back or undone. If a transaction cannot be committed due to conflicting changes, it is typically aborted and re-executed from the beginning until it succeeds.” import Control.Concurrent import Control.Concurrent.STM import Control.Monad import Data.IORef incr_count :: TVar Int -> STM () incr_count m = forM_ [ 1 .. 10000 ]$ \_ -> modifyTVar' m ( + 10 )

main = do
count <- newTVarIO  0
list <- forM [1..10] $\_ -> newEmptyMVar forM_ list$ \var -> forkIO (  ( atomically . incr_count $count ) >> putMVar var () ) forM_ list$ \var ->  takeMVar var
print val
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1 +RTS -N2
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 +RTS -N2 1000000 Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$ ./Thread_1 +RTS -N4
1000000
Mukeshs-MacBook-Pro:GitRepo mukeshtiwari$./Thread_1 +RTS -N4 1000000  I am no expert in C or Haskell and still learning. If you have feedback or comment then please let me know. December 18, 2012 ## SPOJ Aritho-geometric Series (AGS) AGS is rather simple problem. Write down couple of terms $a , a + d , ar + dr , ar + dr + d , ar^2 + dr^2 + dr$. You can see 1. n is even $a*r^{\frac{n-1}{2}} + d*( 1 + r + r^2 \cdots + r^{\frac{n-1}{2}})$ 2. n is odd $a*r^{\frac{n-1}{2}} + d*( 1 + r + r^2 \cdots + r^{\frac{n-1}{2}}) - d$ Accepted Haskell code. import qualified Data.ByteString.Lazy.Char8 as BS powM :: Integer -> Integer -> Integer -> Integer powM a n m -- a^n mod m | n == 0 = 1 | n == 1 = mod a m | even n = ret | otherwise = mod ( a * ret ) m where ret = mod ( powM ( mod ( a ^ 2 ) m ) ( div n 2 ) m ) m geoSum :: Integer -> Integer -> Integer -> Integer geoSum r n m | n == 0 = mod 1 m | n == 1 = mod ( 1 + r ) m | odd n = mod ( ( 1 + powM r ( div ( n + 1 ) 2 ) m ) * mod ( geoSum r ( div ( n - 1 ) 2 ) m ) m ) m | otherwise = mod ( ( 1 + powM r ( div n 2 ) m ) * mod ( geoSum r ( div ( n - 1 ) 2 ) m ) m + powM r n m ) m solve :: [ Integer ] -> [ BS.ByteString ] solve [] = [] solve ( a : d : r : n : m : xs ) | even n = ( BS.pack . show$ ret )  :  solve xs
| otherwise = (  BS.pack . show $( mod ( ret - d + m ) m ) ) : solve xs where ret = mod ( mod ( a * powM r ( div ( n - 1 ) 2 ) m ) m + mod ( d * geoSum r ( div ( n - 1 ) 2 ) m ) m ) m readD :: BS.ByteString -> Integer readD = fst . fromJust. BS.readInteger main = BS.interact$   BS.unlines . solve . map readD . concat . map BS.words . tail . BS.lines


December 12, 2012 Posted by | Haskell, Programming | , , | 1 Comment

## SPOJ DIE HARD

DIEHARD I tried to find out greedy solution but could not come up so trying every possibility and memoization of each state. See more about dynamic programming. The basic idea is that you have to always go to air to increase your chance for survival because its increase the health and armor. We start in air with health increased by 3 and armor increased by 2. After that we have to find out which one, going to water or fire gives maximum survival. A simple Haskell recursive solution which works for small values. We start from funsolve_Air after that we chose the maxiumum value of two functions respectively for water and fire.

funsolve_WF :: Int -> Int -> Int -> Int
funsolve_WF h a cnt
| h <= 0 || a <= 0 = cnt
| otherwise = funsolve_Air h a ( cnt + 1 )

funsolve_Air :: Int -> Int -> Int -> Int
funsolve_Air h a cnt = max ( funsolve_WF ( h + 3 - 5 ) ( a + 2 - 10 ) cnt' ) ( funsolve_WF ( h + 3  - 20 )  ( a + 2  + 5 )  cnt' ) where
cnt' = cnt + 1

*Main> funsolve_Air 20 8 0
5
*Main> funsolve_Air 2 10 0
1
*Main> funsolve_Air 4 4  0
1


Accepted source code in C++.

#include<cstdio>
#include<iostream>
#include<cstring>
using namespace std;

int memo[1100][1100] ;

int recurse( int h , int a , int cnt , bool flag )
{
if ( h <= 0 || a <= 0 ) return cnt ;
if ( memo[h][a] ) return memo[h][a] ;
if ( flag ) memo[h][a] = max ( memo[h][a] , recurse ( h + 3 , a + 2 , cnt + 1 , !flag ) ) ;
else
memo[h][a] = max ( memo[h][a] ,  max ( recurse ( h - 5 , a - 10 , cnt + 1 , !flag ) , recurse ( h - 20 , a + 5 , cnt + 1 , !flag ) ) ) ;

return memo[h][a];
}

int main()
{
int n , a , b ;
scanf( "%d", &n );
for(int i = 0 ; i < n ; i++)
{
memset ( memo , 0 , sizeof memo ) ;
scanf("%d%d", &a , &b );
printf("%d\n" , recurse( a , b , -1 ,  1 ));
if( i != ( n - 1 ) ) printf("\n");
}

}



December 11, 2012