Difference between revisions of "Euler problems/181 to 190"
Jump to navigation
Jump to search
Line 2: | Line 2: | ||
Investigating in how many ways objects of two different colours can be grouped. |
Investigating in how many ways objects of two different colours can be grouped. |
||
+ | Solution: This was my code, published here without my permission nor any attribution, shame on whoever put it here. [[User:Daniel.is.fischer|Daniel.is.fischer]] |
||
− | Solution: |
||
− | <haskell> |
||
− | import Data.Map ((!),Map) |
||
− | import qualified Data.Map as M |
||
− | import Data.List |
||
− | import Control.Monad |
||
− | |||
− | main :: IO () |
||
− | main = do |
||
− | let es = [40,60] |
||
− | dg = sum es |
||
− | mon = Mon dg es |
||
− | Poly mp = partitionPol mon |
||
− | print $ mp!mon |
||
− | |||
− | data Monomial |
||
− | = Mon |
||
− | { degree :: !Int |
||
− | , expos :: [Int] |
||
− | } |
||
− | |||
− | infixl 7 <*>, *> |
||
− | |||
− | (<*>) :: Monomial -> Monomial -> Monomial |
||
− | (Mon d1 e1) <*> (Mon d2 e2) |
||
− | = Mon (d1+d2) (zipWithZ (+) e1 e2) |
||
− | |||
− | unit :: Monomial |
||
− | unit = Mon 0 [] |
||
− | |||
− | (<<) :: Monomial -> Monomial -> Bool |
||
− | (Mon d1 e1) << (Mon d2 e2) |
||
− | = d1 <= d2 && and (zipWithZ (<=) e1 e2) |
||
− | |||
− | upTo :: Monomial -> [Monomial] |
||
− | upTo (Mon 0 _) = [unit] |
||
− | upTo (Mon d es) = |
||
− | sort $ go 0 [] es |
||
− | where |
||
− | go dg acc [] = return (Mon dg $ reverse acc) |
||
− | go dg acc (n:ns) = do |
||
− | k <- [0 .. n] |
||
− | go (dg+k) (k:acc) ns |
||
− | |||
− | newtype Polynomial = |
||
− | Poly { mapping :: (Map Monomial Integer) } |
||
− | deriving (Eq, Ord) |
||
− | |||
− | (*>) :: Integer -> Monomial -> Polynomial |
||
− | n *> m = Poly $ M.singleton m n |
||
− | |||
− | ---------------------------------------------------------------------------- |
||
− | -- The hard stuff -- |
||
− | ---------------------------------------------------------------------------- |
||
− | |||
− | one :: Map Monomial Integer |
||
− | one = M.singleton unit 1 |
||
− | |||
− | reciprocal :: Monomial -> Polynomial |
||
− | reciprocal m = |
||
− | Poly . foldl' extend one . reverse . drop 1 . upTo $ m |
||
− | where |
||
− | extend mp mon = |
||
− | M.filter (/= 0) $ |
||
− | foldl' (flip (uncurry $ M.insertWith' (+))) mp list |
||
− | where |
||
− | list = filter ((<< m) . fst) [(mon <*> mn, -c) | |
||
− | (mn,c) <- M.assocs mp] |
||
− | |||
− | partitionPol :: Monomial -> Polynomial |
||
− | partitionPol m = |
||
− | Poly . foldl' update one $ sliced m |
||
− | where |
||
− | Poly rec = reciprocal m |
||
− | sliced mon = sortBy (comparing expos) . drop 1 $ upTo mon |
||
− | comparing f x y = compare (f x) (f y) |
||
− | update mp mon@(Mon d es) |
||
− | | es /= ses = M.insert mon (mp!(Mon d ses)) mp |
||
− | | otherwise = M.insert mon (negate clc) mp |
||
− | where |
||
− | ses = sort es |
||
− | clc = sum $ do |
||
− | mn@(Mon dg xs) <- sliced mon |
||
− | let cmn = Mon (d-dg) (zipWithZ (-) es xs) |
||
− | case M.lookup mn rec of |
||
− | Nothing -> [] |
||
− | Just c -> return $ c*(mp!(Mon (d-dg) |
||
− | (zipWithZ (-) es xs))) |
||
− | |||
− | ---------------------------------------------------------------------------- |
||
− | -- Auxiliary Functions -- |
||
− | ---------------------------------------------------------------------------- |
||
− | |||
− | zipWithZ :: (Int -> Int -> a) -> [Int] -> [Int] -> [a] |
||
− | zipWithZ _ [] [] = [] |
||
− | zipWithZ f [] ys = map (f 0) ys |
||
− | zipWithZ f xs [] = map (flip f 0) xs |
||
− | zipWithZ f (x:xs) (y:ys) = f x y:zipWithZ f xs ys |
||
− | |||
− | unknowns :: [String] |
||
− | unknowns = ['X':show i | i <- [1 .. ]] |
||
− | |||
− | instance Show Monomial where |
||
− | showsPrec _ (Mon 0 _) = showString "1" |
||
− | showsPrec _ (Mon _ es) = foldr (.) id $ intersperse (showString "*") us |
||
− | where |
||
− | ps = filter ((/= 0) . snd) $ zip unknowns es |
||
− | us = map (\(s,e) -> showString s . showString "^" |
||
− | . showParen (e < 0) (shows e)) ps |
||
− | |||
− | instance Eq Monomial where |
||
− | (Mon d1 e1) == (Mon d2 e2) |
||
− | = d1 == d2 && (d1 == 0 || e1 == e2) |
||
− | |||
− | instance Ord Monomial where |
||
− | compare (Mon d1 e1) (Mon d2 e2) |
||
− | = case compare d1 d2 of |
||
− | EQ | d1 == 0 -> EQ |
||
− | | otherwise -> compare e2 e1 |
||
− | other -> other |
||
− | |||
− | instance Show Polynomial where |
||
− | showsPrec p (Poly m) |
||
− | = showP p . filter ((/= 0) . snd) $ M.assocs m |
||
− | |||
− | showP :: Int -> [(Monomial,Integer)] -> ShowS |
||
− | showP _ [] = showString "0" |
||
− | showP p cs = |
||
− | showParen (p > 6) showL |
||
− | where |
||
− | showL = foldr (.) id $ intersperse (showString " + ") ms |
||
− | ms = map (\(m,c) -> showParen (c < 0) (shows c) |
||
− | . showString "*" . shows m) cs |
||
− | |||
− | instance Num Polynomial where |
||
− | (Poly m1) + (Poly m2) = Poly (M.filter (/= 0) $ addM m1 m2) |
||
− | p1 - p2 = p1 + (negate p2) |
||
− | (Poly m1) * (Poly m2) = Poly (mulM (M.assocs m1) (M.assocs m2)) |
||
− | negate (Poly m) = Poly $ M.map negate m |
||
− | abs = id |
||
− | signum = id |
||
− | fromInteger n |
||
− | | n == 0 = Poly (M.empty) |
||
− | | otherwise = Poly (M.singleton unit n) |
||
− | |||
− | addM :: Map Monomial Integer -> Map Monomial Integer -> Map Monomial Integer |
||
− | addM p1 p2 = |
||
− | foldl' (flip (uncurry (M.insertWith' (+)))) p1 $ |
||
− | M.assocs p2 |
||
− | |||
− | mulM :: [(Monomial,Integer)] -> [(Monomial,Integer)] -> Map Monomial Integer |
||
− | mulM p1 p2 = |
||
− | M.filter (/= 0) . |
||
− | foldl' (flip (uncurry (M.insertWith' (+)))) M.empty $ |
||
− | liftM2 (\(e1,c1) (e2,c2) -> (e1 <*> e2,c1*c2)) p1 p2 |
||
− | problem_181 = main |
||
− | </haskell> |
||
== [http://projecteuler.net/index.php?section=problems&id=182 Problem 182] == |
== [http://projecteuler.net/index.php?section=problems&id=182 Problem 182] == |
Revision as of 23:09, 23 February 2008
Problem 181
Investigating in how many ways objects of two different colours can be grouped.
Solution: This was my code, published here without my permission nor any attribution, shame on whoever put it here. Daniel.is.fischer
Problem 182
RSA encryption.
Solution:
fun a1 b1 =
sum [ e |
e <- [2..a*b-1],
gcd e (a*b) == 1,
gcd (e-1) a == 2,
gcd (e-1) b == 2
]
where
a=a1-1
b=b1-1
problem_182=fun 1009 3643
Problem 183
Maximum product of parts.
Solution:
pmax x a=a*(log x-log a)
tofloat x=encodeFloat x 0
fun x=
div n1 $gcd n1 x
where
e=exp 1
n=floor(fromInteger x/e)
n1=snd.maximum$[(b,a)|a<-[n..n+1],let b=pmax (tofloat x) (tofloat a)]
n `splitWith` p = doSplitWith 0 n
where doSplitWith s t
| p `divides` t = doSplitWith (s+1) (t `div` p)
| otherwise = (s, t)
d `divides` n = n `mod` d == 0
funD x
|is25 k=(-x)
|otherwise =x
where
k=fun x
is25 x
|s==1=True
|otherwise=False
where
s=snd(splitWith (snd (splitWith x 2)) 5)
problem_183 =sum[funD a|a<- [5..10000]]