Mail from Kamlesh Verma

Today I received mail from kamlesh verma and its really hilarious which tempted me to post here. Great prediction for kanya rashi.

मेष
इस साल आपका विवाह योग बन रहा है मगर ज़्यादा खुश होने की ज़रूरत नहीं है क्योंकि आप पहले से शादीशुदा हैं। गणेशा कहते हैं कि इस आफत के लिए आप खुद ज़िम्मेदार हैं। टाइमपास करने के चक्कर में ऑफिस में जिस लड़की से आपने फ्लर्ट करना शुरू किया था, उसे लेकर आप अब सीरियस होने लगे हैं। आपके प्यार में वो लड़की भी इतना आगे जा चुकी है कि आपका तलाक तक करवा सकती है वैसे भी वो घर उजाड़ने के मिशन पर निकली है।
जब-जब आप ऑफिस में होते हैं तो बीवी को धोखा देने के लिए मन में गिल्ट होता है मगर घर पहुंचते ही बीवी की कर्कश आवाज़ सुन, आप सोचते हैं कि ये यही डिज़र्व करती है। बावजूद इसके गणेशा सलाह देंगे कि इन चक्करों में मत पड़िए। ये उम्र आपकी सैटिंग करने की नहीं, कन्यादान करने की है। ज़रा नज़र उठाकर देखिए, आपकी बेटी जवान हो गई है।
सलाह-पांच शनिवार छह कौओं को शहद चटाइए, इससे आपकी बीवी की कर्कशता चली जाएगी।
लाल रंग की गिलहरी को बूंदी का रायता खिलाएं
वृष
31 दिसम्बर की शाम पतले होने का जो resolution आपने लिया था, वो दो जनवरी की सुबह आलू के परांठे खाने के साथ टूट जाएगा। तीन जनवरी की शाम दोस्त के साथ टहलते हुए आप उसके कहने पर मोमो खा लेंगे। पहला मोमो मुंह मे लेते ही पतले होने का आपका resolution आपको धिक्कारेगा मगर उसे इग्नोर कर आप एक और प्लेट का ऑर्डर देंगे। दस जनवरी की शाम बीवी आपको बताएगी कि रनिंग के लिए आपने जो नया ट्रैक सूट खरीदा था, बिना एक बार भी पहने उसे चूहा काट गया है।
बीवी पर लापरवाही का इल्ज़ाम लगाते हुए आप उससे झगड़ा करेंगे, जिस पर बीवी के हाथों आपकी उन स्पोर्ट्स शूज़ से पिटाई हो जाएगी जिन्हें आपने ट्रेक सूट के साथ खरीदा था।
सलाह-किसी गरीब आदमी को रा वन और रामगोपाल वर्मा की आग की डीवीडी भेंट करें, उसे देखने के बाद वो आपको इतनी बद्दुआएँ देगा कि आप खुद-ब-खुद पतले हो जाएँगे।
मिथुन
बाकी सालों की तरह इस साल भी आप कुछ ख़ास नहीं उखाड़ पाएंगे। ऑफिस में आपको बॉस से डांट खानी पड़ेगी और घर पर बीवी से। न तो रिश्तेदार आपको भाव देंगे और न ही मांगने पर बच्चे पानी का गिलास। जून आते-आते आपका पालतू कुत्ता भी आपको देखकर पूंछ हिलाना बंद कर देगा। इस सबसे तंग आकर आप आत्महत्या करना चाहेंगे और जान देने के लिए एक दिन टीवी पर ‘मौसम’ की डीवीडी लगाएंगे। मगर प्रिंट ख़राब होने के कारण वो चल नहीं पाएगी। गुस्से में आप अपने हाथ की बनी चाय पिएंगे मगर उससे भी आप मरेंगे नहीं बस मुंह से झाग निकलने के बाद बेहोश होंगे।
सलाह-सात मंगलवार किसी लाल गिलहरी को बूंदी वाला रायता खिलाएं, लाभ मिलेगा।
कर्क
पिछले साल की तरह ये साल भी आप फेसबुक पर बैठ कर बर्बाद कर देंगे। दूसरों की वॉल से अच्छे-अच्छे स्टेटस चोरी करने, उन स्टेटस पर आने वाले लाइक का घंटों इंतज़ार करने, हर फोटो में दोस्तों को टैग करने, स्कूल में साथ पढ़ी लड़कियों के प्रोफाइल ढूंढने और एक्सेप्ट न किए जाने की उम्मीद के बावजूद उन्हें फ्रेंड रिक्वेस्ट भेजने में आप अपनी ज़िंदगी का एक और साल तबाह कर देंगे।
फेसबुक पर बैठे रहने के चक्कर में आप पूरी सर्दी बिना नहाए गुज़ार देंगे। इसी चक्कर में मां-बाप से गालियां खाएंगे मगर आप इतने ढीठ हो चुके हैं कि इन गालियों का आप पर कोई फर्क नहीं पड़ेगा। सारी गालियां एक कान से होते हुए बिना दिमाग में घुसे दूसरे कान से चुपचाप निकल जाएंगी।
सलाह-आप जैसे ढीठ आदमी को सलाह देने का कोई फायदा नहीं है।
सिंह
नौकरीपेशा लोगों के लिए ये साल काफी फलदायक रहेगा। सरकारी नौकरी में हैं तो दो नम्बर का पैसा बनाने का अच्छा मौका मिलेगा। प्राइवेट में हैं तो बॉस की लगातार चमचागिरी करने के चलते आपकी भारी तरक्की होगी। आपकी सैलरी बाकी लोगों से ज़्यादा बढ़ाई जाएगी। आपको ऐसे काम में लगाया जाएगा जिसके लिए न्यूनतम बुद्धि की आवश्यकता होगी। आपका काम बाकी लोगों की बॉस से चुगली करना है और वो आप पूरी ईमानदारी से करते रहें।
गणेशा सलाह देते हैं कि जून के बाद आप थोड़ा सतर्क हो जाएं क्योंकि इस दौरान बॉस का एक और सिफारिशी टट्टू ऑफिस में ज्वॉइन करेगा। तब आपको नए सिरे से खुद को प्रूव करना होगा। मगर घबराएं नहीं, खुद पर विश्वास रखें। हर आदमी के पास गिफ्टिड टेलेंट होता है। बॉस के सामने दूसरों की चुगली करने के लिए नए आदमी को एफर्ट करना होगा जबकि ऐसा करने का आपमें पैदाइशी गुण है।
सलाह- ‘लगाई-बुझाई’ की अपनी प्रतिभा को निखारने के लिए रोज़ाना तीन हिंदी सीरियल देखें।
कन्या
आपकी राशि भले ही कन्या हो मगर आपकी ज़िंदगी में कोई कन्या आती दिखाई नहीं दे रही। मगर इसमें किसी का कोई कसूर नहीं है, सिवाए आपके। करियर सेट करने की उम्र में आप लड़कियां सेट करते रहे और जब बारी लड़की सेट करने की आई तो आप करियर सेट करने में लगे हैं। आपकी अरेंज मैरिज हो सके ऐसी आपकी इमेज नहीं है और आप लव मैरिज कर सकें, ऐसी आपकी शक्ल नहीं। गणेशा कहते हैं कि ये स्थिति अभी कुछ और वक्त तक बनी रहेगी और 2017 के बाद जाकर आपका विवाह होगा मगर तब भी कन्या मनुष्य जाति से होगी या नहीं, इसकी गारंटी गणेशा नहीं लेते।
सलाह-इक्कीस सोमवार सुबह-शाम खुद को दस-दस थप्पड़ लगाएं, इससे उन लड़कियों के मन को शांति मिलेगी जो कभी आपको पीटना चाहती थीं।

तुला
वक्त आ गया है कि तुला राशि वाले अपनेआप को लेकर ग़लतफहमी पालना बंद कर दें और थोड़ा व्यावहारिक हो जाएं। सिर्फ आपके ये मानने से कि मैं बहुत होशियार हूं और ज़िंदगी में बहुत अच्छा डिज़र्व करता हूं, दुनिया को घंटा फर्क नहीं पड़ता। टीवी डिस्कशन्स में आने वाले गेस्ट को मूर्ख मानने से आप खुद होशियार नहीं हो जाते। दसवीं पास दोस्तों को अपने अल्पज्ञान से आतंकित करने से कुछ पल्ले नहीं पड़ने वाला। अब भी वक्त है, संभल जाइए। आपके दोस्तों के दो-दो बच्चे हो गए और आपकी अभी शादी तक नहीं हुई, ये बात अलग है कि बच्चे आपके भी दो हो चुके हैं जिनमें से एक की तो खुद आपको भी जानकारी नहीं है।
सलाह- खुद के कमाए पैसों से एक अंडरवियर खरीदने बाज़ार जाएं, अपनेआप अक्ल ठिकाने आ जाएगी।
दही में तीन चम्मच चाय पत्ती मिलाकर पंडित जी को पिलाएँ
वृश्चिक
वृश्चिक राशि वालों का इस साल भाग्य खूब साथ देगा। खरीदारी करने बाज़ार जाएंगे तो सेल में कुछ सस्ते स्वेटर मिल जाएंगे, बुक करवाने के दो दिन बाद सिलेंडर की डिलिवरी हो जाएगी, फुटपाथ से खरीदी पाइरेटिड सीडी का प्रिंट अच्छा निकलेगा, आटे की थैली में साबुनदानी का मुफ्त स्टैंड निकलेगा, जिस गाड़ी में सफर करेंगे उसमें सुंदर लड़कियां दिखेंगी, पड़ौसी मंगलू के दसवीं में अच्छे नम्बर आएंगे, उसकी बुआ की लड़की अपने मायके से आपके लिए नया पजामा लाएगी और और तो और आपकी भैंस माया भी इस साल बाकी सालों के मुकाबले ज़्यादा दूध देगी।
सलाह-अपनी गली के आठ आवारा कुत्तों की नसबंदी करवाएं, इससे आपका भाग्य और चमकेगा।
धनु
धनु राशि वालों की किस्मत इस साल बिलुकल साथ नहीं देगी। ऑफिस जाने की जल्दी होगी तो रास्ते में स्कूटर पंचर हो जाएगा, मेहमान आए होंगे तो सिलेंडर ख़त्म हो जाएगा, ज़रूरत पड़ेगी तो नेट काम नहीं करेगा, बीवी बीमार होगी तो कामवाली छुट्टी ले लेगी, सहवाग की बैटिंग के वक्त लाइट चली जाएगी, लाइट आने पर मिमोह चक्रवर्ती की फिल्म चल रही होगी और तो और जब-जब चाय में डुबोकर खाने के लिए ग्लूकोज़ का बिस्किट उसके अंदर डालेंगे, वो उसी में डूब जाएगा!
सलाह- बिस्किट चाय में न डूबे इसके लिए ज़रूरी है कि उसे लाइफ जैकेट पहनाएं।
मकर
टीवी देखने के लिहाज़ से ये साल महिलाओं के लिए काफी अच्छा है। मार्च के आसपास आप सोनी टीवी पर दो नए सीरियल देखने शुरू करेंगी और अपनी दृढ़ इच्छाशक्ति के दम पर बिना नागा उसे पूरा साल देखेंगी। इस दौरान रिमोट के लिए कई दफा आपका अपने पति से झगड़ा होगा मगर सीरियल्स की साजिश रचने वाली बहुओं की तरह आप भी हार नहीं मानेंगी।
वहीं दूसरी ओर रिएलिटी शोज़ के हिसाब से ये साल आपके लिए उतना अच्छा नहीं है। आप जिस-जिस कंटेस्टेंट को सपोर्ट करेंगी वो फाइनल तक तो पहुंचेगा मगर जीत नहीं पाएगा जिसे लेकर आपको भारी दुख होगा। रात-रात भर कमरा बंद कर फूल की कढ़ाई वाला तकिया मुंह में ले रोएंगी और हो सकता है इस बीच डिप्रेशन की शिकार भी हो जाएं।
सलाह- पति के सोते ही उसके मोबाइल से अपने चहेते प्रतिभागी को ढेरों वोट करें। इससे पति भले ही डेंजर ज़ोन में चला जाए, मगर आपका पसंदीदा गवैया बच जाएगा।
कुंभ
कुंभ राशि वाले अपना ये साल पंडितों के चक्कर में बर्बाद कर देंगे। आपके लिए ये समझना बहुत ज़रूरी है कि अगर आपकी ज़िंदगी में कुछ नया नहीं हो रहा तो उसकी वजह आपकी ख़राब किस्मत नहीं, आपका आलस हैं। ऑफिस से घर आने के बाद आपका सारा दिन पड़े रहने में बीतता है और यही वजह है कि आप दस साल से एक ही ऑफिस में पड़े हुए हैं। आपके पड़े-पड़े आपके बच्चे बड़े हो गए मगर आप अपने करियर में कहीं नहीं बढ़े। गणेशा सलाह देते हैं कि यूं दिनभर भेजे के कुकर में ख्याली पुलाव पकाते रहने और बॉस के घर की महिला सदस्यों को याद कर उसे गाली देने का कोई फायदा नहीं है।
लिहाज़ा बिना कुछ किए हालात सुधरने की उम्मीद में चार अख़बारों में राशियां पढ़ने और हाथ की अंगुलियों से लेकर पैर के अंगूठे तक में अंगूठियां पहनने के बजाए रजाई से निकलिए…गैस पर पानी गर्म कर नहाइए, नहीं नहाना तो मुंह-हाथ ही धोइए और स्कूटर स्टार्ट कर कहीं बाहर जाइए।
सलाह- एक पाव दही में तीन चम्मच चाय पत्ती डालने के साथ उसमें रात की बची एक कटोरी दाल डालिए और इसमें आधा गिलास फिनाइल मिक्स कर, उस पंडित को पिलाइए जो खुद आपको अब तक ऐसे उल्टे-सीधे उपाय बताता आ रहा था।
मीन
जहां तक बारगेनिंग या मोलभाव का सवाल है, मीन राशि की महिलाओं के लिए ये साल काफी शुभ हैं। दुकान से सूट का कपड़ा खरीदने से लेकर गली में सब्ज़ी वाले से लड़-झगड़कर पैसे कम करवाने में आपको व्यापक सफलता मिलेगी। आपकी ख्याति मौहल्ले में ही नहीं, देशभर में फैलेगी। और तो और अंतर्राष्ट्रीय स्तर पर हथियार खरीदते समय भारत सरकार दूसरे देशों से मोलभाव के लिए आपको बुलावा भेजेगी। फ्रांस जैसे देशों से मिसाइल खरीद के समय आप ये कहते हुए रेट कम करवाएंगी…जाओ भइया जाओ…पचास में पीछे जापान वाले दे ही रहे थे या फिर ‘हम तो हमेशा आप ही के यहां से खरीदते हैं’, कहकर उन्हें इमोशनली ब्लैकमेल करेंगी।
सलाह- कॉलेज में आप भाव खाती रही हैं और अब मोलभाव कर रही हैं। हमारी गुज़ारिश है कि यही हाव-भाव बनाए रखें।

SPOJ 10186. Divisor Digits

SPOJ 10186. Divisor Digits is easy problem in my opinion but I haven’t solve this problem so I may be wrong and read it further at you own risk . What I understood is , we have to count all the individual digits which divides the given number. Wiki page for divisibility.This problem is not allowed in Haskell so I am not sure if this solutions is correct as well fast enough to get accepted ( I requested problem setter to allow Haskell or move the same copy of problem in tutorial section with increased time limit ). All the divisibility rules are simple except seven [ Just iterated through the number and taking mod 7. We can also do mod ( fst . fromJust . BS.readInteger $ s ) 7 ) ]. Haskell code for this problem.

import Data.List 
import Data.Char
import Data.Maybe ( fromJust ) 
import qualified Data.IntMap as M 
import qualified Data.ByteString.Lazy.Char8 as BS

byteSum :: BS.ByteString -> Integer 
byteSum s = BS.foldr ( \x y -> y + ( fromIntegral . digitToInt $ x )  ) 0 s 


{--
testSeven :: BS.ByteString -> Integer 
testSeven s = sum. BS.zipWith (\x y -> fromIntegral $ digitToInt x * digitToInt y )  s . BS.pack. concatMap show .  concat. repeat 
                           $ [ 1 , 3 , 2 , 6 , 4 , 5 ]

--}

numDiv :: Int -> BS.ByteString -> Bool 
numDiv a s
  | a == 0 = False
  | a == 1 = True 
  | a == 2 = if even . digitToInt . BS.last $ s then True else False
  | a == 3 = if mod ( byteSum s ) 3 == 0 then True else False
  | a == 4 = if mod ( fst . fromJust . BS.readInt . BS.drop k $ s ) 4 == 0 then True else False
  | a == 5 = if mod ( digitToInt . BS.last $ s ) 5 == 0 then True else False
  | a == 6 =  numDiv 2 s && numDiv 3 s 
  | a == 7 =  if BS.foldr ( \x y -> mod ( 10 * y + digitToInt x ) 7 ) 0 s == 0 then True else False 
  | a == 8 = if mod ( fst . fromJust . BS.readInt . BS.drop m $ s ) 8 == 0 then True else False
  | a == 9 = if mod ( byteSum  s ) 9 == 0 then True else False where 
	 len = BS.length s 
         k = len - 2 
         m = len - 3 


 
solve :: BS.ByteString -> BS.ByteString
solve s = BS.pack.show $  ret where 
     mp = BS.foldr ( \x y -> M.insertWith (+) ( digitToInt x ) 1 y ) M.empty s 

     key = M.keys mp 
     ret = foldr ( \x y -> if numDiv x s then y + ( fromJust . M.lookup  x $ mp )  else  y    ) 0 key


main = BS.interact $ BS.unlines . map solve . BS.lines												

SRM 524

Although i could not participate in the single round match 524 but i solved the division two problems in Haskell using gettc. For more detail , see the editorial .

ShippingCubes .

module ShippingCubes where 

minimalCost :: Int -> Int
minimalCost n = minimum  [ i + j + k | i <- [ 1 .. n ] , j <- [ 1 .. n ] , k <- [ 1 .. n ] , i * j * k == n ]

MagicDiamonds

module MagicDiamonds  where 

prime :: [ Integer ] 
prime = 2 : 3 : filter isPrime [ 2 * k + 1 | k <- [ 1 .. ] ] 

isPrime :: Integer -> Bool  
isPrime n 
	| n <= 1 = False 
	| otherwise =  all ( ( /= 0 ).mod n ) . takeWhile ( <= ( truncate . sqrt . fromIntegral $ n ) ) $ prime 

minimalTransfer :: Integer -> Integer
minimalTransfer n 
  | n == 3 = 3 
  | isPrime n = 2 
  | otherwise = 1 

MultiplesWithLimit. For this problem , see the post of Smart.Coder.

module MultiplesWithLimit where 
import Data.List
import qualified Data.Sequence as S
import qualified Data.IntMap as M 

minMultiples :: Int -> [Int] -> String
minMultiples n forbiddenDigits =  format ret  where 
	lst = [ ( show i , mod i n ) | i <- [ 1 .. 9 ] , notElem i  forbiddenDigits ] ;
	mp = M.fromList . zip  ( map snd lst ) $ [ 1,1..]
	ret = helpMinMultiples ( S.fromList lst )  mp where 
	 helpMinMultiples t mp' 
	   | S.null t = "IMPOSSIBLE"
	   | snd x == 0 = fst x 
	   | otherwise = helpMinMultiples xs'' mp'' where 
		( xs'' , mp'' )  = lookupfunction x xs mp' [ 0..9 ] forbiddenDigits n 
		(x S.:< xs ) = S.viewl t 

lookupfunction :: ( String , Int ) -> S.Seq ( String , Int )  -> M.IntMap Int -> [ Int ] -> [ Int ] -> Int -> 
		( S.Seq ( String , Int )  , M.IntMap Int ) 

lookupfunction _ xs mp' [] _ _ = ( xs , mp' ) 
lookupfunction x xs mp' ( y : ys )  forbid n 
 |  elem y forbid = lookupfunction x xs mp' ys forbid n 
 |  otherwise = case M.lookup ( mod (  snd x  * 10 + y ) n ) mp' of 
		 Nothing -> lookupfunction x ( xs S.|>  ( fst x ++ show y , mod (  snd x  * 10 + y ) n ) ) mp'' ys forbid n 
		 	    where mp'' = M.insert ( mod ( snd x  * 10 + y ) n ) 1 mp' 
		 _       -> lookupfunction x xs mp' ys forbid n  			

format :: String -> String 
format xs
 | xs == "IMPOSSIBLE" = "IMPOSSIBLE" 
 | length xs < 9 = xs 
 | otherwise = take 3 xs ++ "..." ++ drop  ( len  - 3 ) xs ++ "(" ++ show len ++" digits)"  where 
			len = length xs 						

SPOJ 9948. Will it ever stop

SPOJ 9948. Will it ever stop is related to cycle detection. A simple and excellent problem to understand the cycle detection algorithm. Accepted Haskell code

import Data.List
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as BS


solve :: Integer -> BS.ByteString
solve 1 =  BS.pack $ "TAK"
solve n = helpSolve n ( bCycle n ) where 
        helpSolve a b  
           | a == 1 || b == 1 =  BS.pack $ "TAK"
           | a == b =  BS.pack $ "NIE"
           | otherwise = helpSolve  ( bCycle a )  ( bCycle . bCycle $ b ) 

bCycle :: Integer -> Integer 
bCycle n 
  | even n = div n 2  
  | otherwise = 3 * n + 3 

reaD :: BS.ByteString -> Integer 
reaD = fst . fromJust . BS.readInteger 

main = BS.interact $   solve . reaD 

This solution is suggested by Hendrik.

import Data.Bits

reaD :: String -> Integer 
reaD = read 

main = interact $ (\n -> if  (.&.) n ( n - 1)== 0  then "TAK" else "NIE" ) . reaD 

Project Euler 357

Project Euler 357 is easy one. I was trying to solve problem 356 and finally ended up with solving easy problem. Nothing new just sieve of eratosthenes and couple of constraints.
Edit: Finally wrote a Haskell solution. See more discussion on Haskell-Cafe. Compile this code with ghc –make -O2 filename.hs

import Control.Monad.ST 
import Data.Array.ST 
import Data.Array.Unboxed 
import Control.Monad 
import Data.List


prime :: Int -> UArray Int Bool 
prime n = runSTUArray $ do 
    arr <- newArray ( 2 , n ) True :: ST s ( STUArray s Int Bool ) 
    forM_ ( takeWhile ( \x -> x*x <= n ) [ 2 .. n ] ) $ \i -> do 
        ai <- readArray arr i 
        when ( ai  ) $ forM_ [ i^2 , i^2 + i .. n ] $ \j -> do 
            writeArray arr j False 

    return arr 

pList :: UArray Int Bool 
pList = prime $  10 ^ 8 

divPrime :: Int -> Bool 
divPrime n = all ( \d -> if mod n d == 0 then pList ! ( d + div  n  d ) else True )  $  [ 1 .. truncate . sqrt . fromIntegral  $ n ] 



main = putStrLn . show . sum  $ ( [ if and [ pList ! i , divPrime . pred $ i ] then ( fromIntegral . pred $ i ) else 0 | i <- [ 2 .. 10 ^ 8 ] ] :: [ Integer ] ) 

#include<cstdio>
#include<iostream>
#include<vector>
#define Lim 100000001
using namespace std;

bool prime [Lim];
vector<int> v ;

void isPrime ()
     {
		for( int i = 2 ; i * i <= Lim ; i++) 
		 if ( !prime [i]) for ( int j = i * i ; j <= Lim ; j += i ) prime [j] = 1 ; 

		for( int i = 2 ; i <= Lim ; i++) if ( ! prime[i] ) v.push_back( i ) ;
		//cout<<v.size()<<endl;
		//for(int i=0;i<10;i++) cout<<v[i]<<" ";cout<<endl;

     }


int main()
	{
		isPrime();
		int n = v.size();
		long long sum = 0;
		for(int i = 0 ; i < n ; i ++) 
		 {
			int k = v[i]-1;
			bool f = 0;
			for(int i = 1 ; i*i<= k ; i++) 
				if ( k % i == 0 && prime[ i + ( k / i ) ] )  { f=1 ; break ; }
			
			if ( !f ) sum += k;
		 }
		cout<<sum<<endl;
	}

Monad Transformer

Monad transformer is way to compose monads simultaneously.Computation of gcd using state monad but what if we want to print value of a and b for each call. Clearly we are looking to compose state monad and IO monad and our candidate for this purpose is monad transformer.

import Control.Monad.Identity
import Control.Monad.State

gcD :: StateT  ( Integer , Integer )  IO Integer        
gcD = get >>=( \( a , b ) -> case b ==0  of
                              True -> ( liftIO $ print ( a , b ) ) >> return a
                              _    -> ( liftIO $ print ( a , b ) ) >> put ( b , mod a b ) >> gcD )



main = runStateT gcD  (123 ,22)

PS.This is simple example and you can see more complex example on real world haskell .

Plagiarism detection

I was going through this plagiarism detector and thought of writing a Haskell program which will replace some of words from input text by its synonyms. I think , this problem belongs to Machine Learning and Natural Language processing because some times putting synonyms will change the context of statement. This program is quite simple and it uses dictionary for synonyms. Here is my dictionary file “dict.txt” , input file “input.txt” and output file “output.txt” looks like.
dict file

capricious  fickle
happiness ecstasy

input file

Hi how are you doing . why happiness is capricious . 

output file

 Hi how are you doing . why ecstasy is fickle .

Haskell sourcecode

import Data.List
import System.Environment
import Data.Map ( Map )
import qualified Data.Map as Map
type Dictionary = Map String  String

-- Currently replace the word in dictionary  

helpChange :: [String] -> String -> Dictionary -> String 
helpChange [] ret _ = ret
helpChange ( x : xs ) ret dict = 
	case  Map.lookup x dict of 
		Nothing  -> helpChange xs (  ret ++ " " ++ x  ) dict 
		Just str -> helpChange xs (  ret ++ " " ++ str) dict   

 
changeWord :: String -> Dictionary -> String 
changeWord str dict =  final where 
	tmpstr = words str 
	final = helpChange tmpstr "" dict 
	
				
creatDic :: String -> Dictionary
creatDic  str = finalDict where 
	list = map words $ lines str
	tmpDict = foldl ( \dict [ a , b ] -> Map.insert a b dict  ) ( Map.empty ) list
	finalDict = foldl (\dict [ a , b ] -> Map.insert b a dict ) tmpDict list 
	

main = do
	[ input , output ] <- getArgs 
	inpStr <- readFile input
	tmpdict <- readFile "dict.txt"
	let dict = creatDic  tmpdict
	let final = changeWord inpStr dict
	writeFile output final 

If you are going to run this program then make sure full stop ( . ) has initial space and final space otherwise words function will put this character with some word [ end. ] which may be present [ end ] in the dictionary but due to full stop it will return Nothing.Also see this post.

Sieve of eratosthenes using Haskell IOArray

More about Haskell array . This one is simple Haskell code for Sieve of eratosthenes and Euler’s totient function . This is first time i played with mutable array. Also posted this code on ideone.

import Data.Array
import Data.Array.IO
--start of prime

loopB :: Int -> Int -> Int ->  IOArray Int Int -> IO ( IOArray Int Int )
loopB st a b arr
        | st > b = return arr
	| otherwise = 
	    do
		writeArray arr st 0 
		loopB ( st + a ) a b arr 


loopA :: Int -> Int ->  IOArray Int Int -> IO ( IOArray Int Int ) 
loopA a b arr 
	| a ^ 2 > b = return arr
	| otherwise = 
	   do
		t <- readArray arr a 
		arr' <- if t /= 0 then loopB ( a ^ 2 ) a  b arr else return arr 
		loopA ( a + 1 ) b arr' 

printerA :: Int -> Int -> IOArray Int Int -> IO ( )
printerA a b arr 
	| a > b = return ()
	| otherwise = do 
		t <- readArray arr a 
		print ( a , if t == 0 then "composite" else "prime" ) 
		printerA ( a + 1 ) b arr 

--end of prime generation
--start of euler phi function

helpEuler :: Int -> Int -> IOArray Int Int -> IO ( IOArray Int Int ) 
helpEuler a b phi 
	| a > b = return phi
	| otherwise = 
	   do 
		writeArray phi a a 
		helpEuler ( a + 1 ) b phi

loopInner :: Int -> Int -> Int -> IOArray Int Int -> IO ( IOArray Int Int ) 
loopInner st a b phi 
	| st > b = return phi
	| otherwise = 
	   do 
		t <- readArray phi st 
		let k = div ( t * ( a - 1 ) ) a 
		writeArray phi st k 
		loopInner ( st + a ) a b phi

loopOuter :: Int -> Int -> IOArray Int Int -> IO ( IOArray Int Int ) 
loopOuter a b phi
	| a > b = return phi
	| otherwise = 
	   do 
	     t <- readArray phi a 
	     phi' <- if t == a then loopInner (  2 * a ) a b phi else return phi
	     loopOuter ( a + 1 ) b phi' 
 
modifyValue :: Int -> Int -> IOArray Int Int -> IO ( IOArray Int Int ) 
modifyValue a b phi 
	| a > b = return phi
	| otherwise = 
	   do 
	      t <- readArray phi a 
	      if t == a then writeArray phi a ( a - 1 ) else writeArray phi a t 
	      modifyValue ( succ a ) b phi 


printerB :: Int -> Int -> IOArray Int Int -> IO (  )
printerB a b phi
       | a > b = return ()
       | otherwise = 
	   do 
		t <- readArray phi a 
		print ( a , t ) 
		printerB ( a + 1 ) b phi

--end of euler phi function


main = do
	{-- 
	arr <- newArray ( 2 , 1000 ) 1 :: IO ( IOArray Int Int ) 
	arr' <- loopA  2 1000 arr
	printerA 2 1000 arr'
	--}
	
	phi <- newArray ( 1 , 100 ) 1 :: IO ( IOArray Int Int ) 
	tmp <- helpEuler  2 100 phi
	phi' <- loopOuter 2 100 tmp	
	phi'' <- modifyValue 2 100 phi'
	printerB 1 100 phi''
	
	{--
	a <- readArray arr 1
	writeArray arr 1 64 
	b <- readArray arr 1
	print ( a , b ) 
	--}

Couple of more compact code to compute prime , totient , divisor sum and mobius of number.

import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Control.Monad

prime :: Int -> UArray Int Int 
prime n = runSTUArray $ do 
	arr <- newArray ( 2 , n ) 1 :: ST s ( STUArray s Int Int ) 
	forM_ ( takeWhile ( \x -> x*x <= n ) [ 2 .. n ] ) $ \i -> do 
		ai <- readArray arr i 
		when ( ai == 1 ) $ forM_ [ i^2 , i^2 + i .. n ] $ \j -> do 
			writeArray arr j 0 

	return arr 

totient :: Int -> UArray Int Int 
totient n = runSTUArray $ do 
	arr <- newListArray ( 1 , n ) [ 0 .. pred n ] :: ST s (STUArray s Int Int ) 
	forM_ [ 2 .. n ] $ \i -> do 
		ai <- readArray arr i
		when ( ai == pred i ) $ forM_ [ 2*i , 3*i .. n ] $ \j -> do 
			aj <- readArray arr j 
			writeArray arr j ( aj - div aj i )
	writeArray arr 1 1  
	return arr

divisorSum :: Int -> UArray Int Int
divisorSum n = runSTUArray $ do
	arr <- newArray ( 1 , n ) 0 :: ST s ( STUArray s Int Int ) 
	forM_ [ 1 .. n ] $ \i-> do 
	  forM_ [ i , 2 * i .. n ] $ \j -> do
		aj <- readArray arr j 
		writeArray arr j ( aj + i ) 
	return arr


mobius :: Int -> UArray Int Int 
mobius n = runSTUArray $ do
	arr <- newArray ( 1 , n ) 0 :: ST s ( STUArray s Int Int ) 
	writeArray arr 1 1
	forM_ [ 1 .. n ] $ \i -> do
	  forM_ [ 2*i , 3*i .. n ] $ \j -> do
	    ai <- readArray arr i
	    aj <- readArray arr j
	    writeArray arr j ( aj - ai )
	return arr 	 


main = do
	
	print $ ( prime 100 ) ! 37
	print $ ( totient 100  ) ! 50
	print $ ( divisorSum 100 ) ! 50
	print $ ( mobius 100 ) ! 50

Converting Wikipedia html files in pdf

I want to convert html files from Wikipedia to pdf for off line reading purpose . After bit of searching , Wikipedia itself provides a link on left side [ Print/export ] of every article to convert it into pdf . After couple of clicks , we can download the pdf but I want to write Haskell script. This script generates the rendering url. Rendering url return empty tags while copy and pasting the rendering url to web browser generates the pdf file. After asking on Haskell-cafe revealed that the link is generated by javascript and i have to script an actual browser to generated pdf from this code. Technically this is still unfinished project but first time I played with some sort of web programming.

import Network.HTTP
import Text.HTML.TagSoup
import Data.Maybe
 
parseHelp :: Tag String -> Maybe String 
parseHelp ( TagOpen _ y ) = if any ( \( a , b ) -> b == "Download a PDF version of this wiki page" ) y 
                             then Just $  "http://en.wikipedia.org" ++   snd (   y !!  0 )
                              else Nothing
 
 
parse :: [ Tag String ] -> Maybe String
parse [] = Nothing 
parse ( x : xs ) 
   | isTagOpen x = case parseHelp x of 
                         Just s -> Just s 
                         Nothing -> parse xs
   | otherwise = parse xs
 
 
main = do 
        x <- getLine 
        tags_1 <-  fmap parseTags $ getResponseBody =<< simpleHTTP ( getRequest x ) --open url
        let lst =  head . sections ( ~== "<div class=portal id=p-coll-print_export>" ) $ tags_1
            url =  fromJust . parse $ lst  --rendering url
        putStrLn url
        tags_2 <-  fmap parseTags $ getResponseBody =<< simpleHTTP ( getRequest url )
        print tags_2
 

My second choice was obviously python and it finished the job perfectly . Python script for this purpose and in fact it can convert any html file to pdf. Its like opening a html file in web browser and printing it to pdf file.

import sys
from PyQt4.QtCore import *
from PyQt4.QtGui import *
from PyQt4.QtWebKit import *

#http://www.rkblog.rk.edu.pl/w/p/webkit-pyqt-rendering-web-pages/
#http://pastebin.com/xunfQ959
#http://bharatikunal.wordpress.com/2010/01/31/converting-html-to-pdf-with-python-and-qt/
#http://www.riverbankcomputing.com/pipermail/pyqt/2009-January/021592.html

def convertFile( ):
                web.print_( printer )
                print "done"
                QApplication.exit()


if __name__=="__main__":
        url = raw_input("enter url:")
        filename = raw_input("enter file name:")
        app = QApplication( sys.argv )
        web = QWebView()
        web.load(QUrl( url ))
        #web.show()
        printer = QPrinter( QPrinter.HighResolution )
        printer.setPageSize( QPrinter.A4 )
        printer.setOutputFormat( QPrinter.PdfFormat )
        printer.setOutputFileName(  filename + ".pdf" )
        QObject.connect( web ,  SIGNAL("loadFinished(bool)"), convertFile  )
        sys.exit(app.exec_())
~                              

SRM 385 – Division II, Level Three

Gettc is excellent software for practicing topcoder problems offline and specially in Haskell. I just wrote solution for SRM 385 Problem [ requires registration but its worth and excellent place for programmers ]. You can see the editorial for SRM 385. Haskell source code.

module SummingArithmeticProgressions where  

canRep :: Int -> Int -> Int -> Bool 
canRep a b n = canRephelp 1 a b n where 
	canRephelp x a b n 
	  | x > b = False
	  | n <= a * x = False
	  | mod ( n - a * x ) b == 0 = True
	  | otherwise = canRephelp  ( succ x ) a b n 


howMany :: Int -> Int -> Int -> Int
howMany left right k =  ans   where 
	a = k 
	b = div ( k * ( k - 1 ) ) 2
	d = gcd a b
	a' = div a d 
	b' = div b d
	left' = div ( left + d - 1 ) d 
	right' = div right d 
	ans = helphowMany a' b' left' right'  0
	

helphowMany :: Int -> Int -> Int -> Int -> Int -> Int
helphowMany a b left right cnt
	| and [ left <= right , left < 2 * a * b ] = if canRep a b left 
						      then helphowMany a b ( succ left ) right ( succ cnt )  
						       else helphowMany a b ( succ left ) right cnt 
	| otherwise = cnt + right - left + 1