Computing a^n using binary representation of natural number in Agda
While following the Agda tutorial, I wrote this code to compute an. Not very elegant example probably because I am not expert and still learning about dependent types. Maybe after getting some more experience and knowledge, I will try to prove the correctness and complexity of this algorithm. See the post of Twan van Laarhoven about proving correctness and complexity of merge sort in Agda.
module PowerFunction where data ℕ⁺ : Set where one : ℕ⁺ double : ℕ⁺ → ℕ⁺ double⁺¹ : ℕ⁺ → ℕ⁺ add : ℕ⁺ → ℕ⁺ → ℕ⁺ add one one = double one add one ( double x ) = double⁺¹ x add one ( double⁺¹ x ) = double ( add x one ) add ( double x ) one = double⁺¹ x add ( double x ) ( double y ) = double ( add x y ) add ( double x ) ( double⁺¹ y ) = double⁺¹ ( add x y ) add ( double⁺¹ x ) one = double ( add x one ) add ( double⁺¹ x ) ( double y ) = double⁺¹ ( add x y ) add ( double⁺¹ x ) ( double⁺¹ y ) = double ( add ( add x y ) one ) mult : ℕ⁺ → ℕ⁺ → ℕ⁺ mult x one = x mult x ( double y ) = double ( mult x y ) mult x ( double⁺¹ y ) = add x ( double ( mult x y ) ) pow : ℕ⁺ → ℕ⁺ → ℕ⁺ pow one _ = one pow x one = x pow x ( double one ) = mult x x pow x ( double y ) = pow ( pow x y ) ( double one ) pow x ( double⁺¹ y ) = mult x ( pow ( pow x y ) ( double one ) )
Computing 2 ^ 6
pow ( double one ) ( double ( double⁺¹ one ))
double (double (double (double (double (double one)))))
If you have suggestion then please let me know.
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.
Request-Reply
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 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
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 )
threadDelay 10000
close s
destroy c
return ()
Client
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 )
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 )
msg <- receive s
print msg
modifyIORef counter ( +1 )
threadDelay 10000
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 Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Internal as BL
import Control.Concurrent ( threadDelay )
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 
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
num <- receive receiver
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 receiver
close sender
destroy c
Sink for collecting the results.
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 )
main = do
c <- context
receiver <- socket c Pull
bind receiver "tcp://127.0.0.1:5558"
m <- receive receiver
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
close receiver
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 Task worker - 2 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.
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.
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
SPOJ EMAIL ID
Finally solved EMAIL ID using python though it was very hard for me to switch from Haskell to python. While doing this problem, I learned quite a lot about regular expressions, found some cool site like pythontutor and problem solving with python . Accepted code in python.
import re
if __name__ == "__main__":
n = int ( raw_input() )
c = 1
while c <= n :
email = re.findall ( "[a-zA-Z0-9][a-zA-Z0-9._]{4,}@[a-zA-Z0-9]+\.(?:com|edu|org|co\.in)", raw_input() )
t = len ( email )
print 'Case #' + str ( c ) + ': ' + str ( t )
for i in xrange ( t ) : print email[i]
c += 1
My experience with online learning
I am one big confused soul who is always curious for learning. I found Coursera and Udacity very helpful. I try to take as many courses as possible but recently I took the Heterogeneous Parallel Programming by Professor Wen-mei W. Hwu and it was fun course. The video lectures were excellent and assignments were not very hard. They were designed to make us familiar with basics of cuda programming and apart from that I got certificate signed by Professor Wen-mei W. Hwu . While doing some more research about heterogeneous computing which involves CPU, GPU and FPGA all together in single system, today I found FPGA Programming for the Masses. There are two promising technologies, one from Altera and other is Liquid Metal from IBM.
Altera OpenCL-to-FPGA Framework.
Altera proposed a framework for synthesizing bitstreams from OpenCL. The framework consists of a kernel compiler, a host library, and a system integration component. The kernel compiler, based on the open source LLVM compiler infrastructure, synthesizes OpenCL kernel code into hardware. The host library provides APIs and bindings for establishing communication between the host part of the application running on the processor and the kernel part of the application running on the FPGA. The system integration component wraps the kernel code with memory controllers and a communication interface (such as PCIe)
Liquid Metal.
The Liquid Metal project at IBM aims to provide not only high-level synthesis for FPGAs,1 but also, more broadly, a single unified language for programming heterogeneous architectures. The project offers a language called Lime, which can be used to program hardware (FPGAs), as well as software running on conventional CPUs and more exotic architectures such as GPUs. The Lime language was founded on principles that eschew the complicated program analysis that plagues C-based frameworks, while also offering powerful programming models that espouse the benefits of functional and stream-oriented programming.
Heterogeneous parallel programming looks very promising but still long way to go. My certificate 
.
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 :: PB.Parser String
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
Learning Agda
Finally I am feeling bit comfortable with Agda and feeling great . I started reading Ulf Norell‘s Dependently Typed Programming in Agda. Tutorials on Agda-wiki , AgdaTutorial , papers which mention Agda , stackoverflow post, Introduction to Agda and Programming in Martin-Löf’s Type Theory. I wrote some of the codes from the paper. You can also try a similar language Idris ( See the stackoverflow post about difference between these languages ).
module Basic where
data Bool : Set where
true : Bool
false : Bool
not : Bool → Bool
not true = false
not false = true
or : Bool → Bool → Bool
or false false = false
or _ _ = true
and : Bool → Bool → Bool
and true true = true
and _ _ = false
data ℕ : Set where
zero : ℕ
suc : ℕ → ℕ
_+_ : ℕ → ℕ → ℕ
zero + m = m
suc n + m = suc ( n + m )
_⋆_ : ℕ → ℕ → ℕ
zero ⋆ m = zero
suc n ⋆ m = ( n ⋆ m ) + m
fold-ℕ : ℕ → ( ℕ → ℕ ) → ℕ → ℕ
fold-ℕ u _ zero = u
fold-ℕ u f ( suc n ) = f ( fold-ℕ u f n )
if_then_else_ : { A : Set } → Bool → A → A → A
if true then x else y = x
if false then x else y = y
data List ( A : Set ) : Set where
[] : List A
_::_ : A → List A -> List A
identity : ( A : Set ) → A → A
identity A x = x
zero′ : ℕ
zero′ = identity ℕ zero
apply : ( A : Set ) ( B : A → Set ) → ( ( x : A ) → B x ) → ( a : A ) → B a
apply A B f a = f a
identity₂ : ( A : Set ) → A → A
identity₂ = \A x → x
identity₃ : ( A : Set ) → A → A
identity₃ = \(A : Set ) ( x : A ) → x
identity₄ : ( A : Set ) → A → A
identity₄ = \ ( A : Set ) x → x
id : { A : Set } → A → A
id x = x
true′ : Bool
true′ = id true
one : ℕ
one = identity _ ( suc zero )
_∘_ : { A : Set } { B : A → Set } { C : ( x : A ) → B x → Set }
( f : { x : A } ( y : B x ) → C x y ) ( g : ( x : A ) → B x ) ( x : A )
→ C x ( g x )
( f ∘ g ) x = f ( g x )
plus-two = suc ∘ suc
plus-three = suc ∘ ( suc ∘ suc )
map : { A B : Set } → ( A → B ) → List A → List B
map f [] = []
map f ( x :: xs ) = f x :: map f xs
_++_ : { A : Set } → List A → List A → List A
[] ++ ys = ys
( x :: xs ) ++ ys = x :: ( xs ++ ys )
foldl : { A B : Set } → ( A → B → A ) → A → List B → A
foldl f val [] = val
foldl f val ( x :: xs ) = foldl f ( f val x ) xs
foldr : { A B : Set } → ( A → B → B ) → B → List A → B
foldr f val [] = val
foldr f val ( x :: xs ) = f x ( foldr f val xs )
--type of Vec A is ℕ → Set. This mean Vec A is family of types indexed by
-- natural numbers
data Vec ( A : Set ) : ℕ → Set where
[] : Vec A zero
_::_ : { n : ℕ } → A → Vec A n → Vec A ( suc n )
head : { A : Set } { n : ℕ } → Vec A ( suc n ) → A
head ( x :: xs ) = x
vmap : { A B : Set } { n : ℕ } → ( A → B ) → Vec A n → Vec B n
vmap f [] = []
vmap f ( x :: xs ) = f x :: vmap f xs
data Vec₂ ( A : Set ) : ℕ → Set where
nil : Vec₂ A zero
cons : ( n : ℕ ) → A → Vec₂ A n → Vec₂ A ( suc n )
{--
The rule for when an argument should be dotted is:
if there is a unique
type correct value for the argument it should be dotted
--}
vmap₂ : { A B : Set } ( n : ℕ ) → ( A → B ) → Vec₂ A n → Vec₂ B n
vmap₂ .zero f nil = nil
vmap₂ .( suc n ) f ( cons n x xs ) = cons n ( f x ) ( vmap₂ n f xs )
vmap₃ : { A B : Set } ( n : ℕ ) → ( A → B ) → Vec₂ A n → Vec₂ B n
vmap₃ zero f nil = nil
vmap₃ ( suc n ) f ( cons .n x xs ) = cons n ( f x ) ( vmap₃ n f xs )
pow : ℕ → ℕ → ℕ
pow _ zero = suc zero
pow a ( suc n ) = a ⋆ pow a n
t : ℕ
t = pow ( suc ( suc zero ) ) ( suc ( suc ( suc zero ) ) )
To evaluate the expression , type C-c C-n. Here is the output of t
suc (suc (suc (suc (suc (suc (suc (suc zero))))))).
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 )
Linking RabinMiller ...
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.
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
parseQuoted = f <$> ( char '\'' *> parseExpr ) where
f x = List [ Atom "quote" , x ]
parseExpr :: Parser LispVal
parseExpr = parseAtom
<|> parseString
<|> parseNumber
<|> parseQuoted
<|> ( char '(' *> spaces *> ( ( try parseList ) <|> parseDottedList ) <* spaces <* char ')' )
Complete code on github ( Apart from applicative parsing every other code is from Scheme parsing tutorial ). If you have any comments or suggestion then please let me know.
About
Hello All, My name is Mukesh Tiwari and I graduated from IIITM Gwalior in 2009. I am passionate about programming and mathematics. I love solving problems on SPOJ , UVA , Topcoder and Project Euler. I am curious about functional languages specially Haskell and it’s one the excellent language I encountered after python. I am also looking for some challenging functional programming job specially related to Haskell. You can reach me mukeshtiwariDOTiiitmATgmailDOTcom. Replace DOT with . and AT with @
Recent Comments
