1118 lines
44 KiB
Haskell
1118 lines
44 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
import Prelude
|
|
import Control.Applicative
|
|
import Control.Arrow
|
|
import Control.Monad
|
|
import Data.Array
|
|
import Data.Bits
|
|
import Data.Char
|
|
import Data.Ix (Ix)
|
|
import Data.List
|
|
import Data.Function
|
|
import Data.Function.Memoize
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Data.Ratio
|
|
import qualified Data.Set as S
|
|
import Math.LinearEquationSolver
|
|
import Numeric
|
|
--import Math.NumberTheory.Moduli
|
|
|
|
binsearch xs value = binsearch' xs value 0 (high' 1)
|
|
where
|
|
high' i = if xs!!i < value then high' (i*2) else i
|
|
|
|
-- binsearch' :: [Integer] -> Integer -> Integer -> Integer -> Integer -- list, value, low, high, return int
|
|
binsearch' xs value low high
|
|
| high < low = -1
|
|
| xs!!mid > value = binsearch' xs value low (mid-1)
|
|
| xs!!mid < value = binsearch' xs value (mid+1) high
|
|
| otherwise = mid
|
|
where
|
|
mid = low + ((high - low) `div` 2)
|
|
|
|
(^!) :: Num a => a -> Int -> a
|
|
(^!) x n = x^n
|
|
|
|
squareRoot :: Integer -> Integer
|
|
squareRoot 0 = 0
|
|
squareRoot 1 = 1
|
|
squareRoot n =
|
|
let
|
|
twopows = iterate (^!2) 2
|
|
(lowerRoot, lowerN) = last $ takeWhile ((n>=) . snd) $ zip (1:twopows) twopows
|
|
newtonStep x = div (x + div n x) 2
|
|
iters = iterate newtonStep (squareRoot (div n lowerN) * lowerRoot)
|
|
isRoot r = r^!2 <= n && n < (r+1)^!2
|
|
in head $ dropWhile (not . isRoot) iters
|
|
|
|
isPrime :: Integer -> Bool
|
|
isPrime n = n > 1 && foldr (\p r -> p*p > n || ((n `rem` p) /= 0 && r)) True primes
|
|
|
|
primes :: [Integer]
|
|
primes = 2 : filter isPrime [3,5..]
|
|
|
|
primeFactors :: Integer -> [Integer]
|
|
primeFactors n | n > 1 = go n primes
|
|
where
|
|
go n ps@(p:t)
|
|
| p*p > n = [n]
|
|
| r == 0 = p : go q ps
|
|
| otherwise = go n t
|
|
where
|
|
(q,r) = quotRem n p
|
|
|
|
integerLength = fromIntegral . length
|
|
|
|
list :: [Integer]
|
|
list = [37107287533902102798797998220837590246510135740250,46376937677490009712648124896970078050417018260538,74324986199524741059474233309513058123726617309629,91942213363574161572522430563301811072406154908250,23067588207539346171171980310421047513778063246676,89261670696623633820136378418383684178734361726757,28112879812849979408065481931592621691275889832738,44274228917432520321923589422876796487670272189318,47451445736001306439091167216856844588711603153276,70386486105843025439939619828917593665686757934951,62176457141856560629502157223196586755079324193331,64906352462741904929101432445813822663347944758178,92575867718337217661963751590579239728245598838407,58203565325359399008402633568948830189458628227828,80181199384826282014278194139940567587151170094390,35398664372827112653829987240784473053190104293586,86515506006295864861532075273371959191420517255829,71693888707715466499115593487603532921714970056938,54370070576826684624621495650076471787294438377604,53282654108756828443191190634694037855217779295145,36123272525000296071075082563815656710885258350721,45876576172410976447339110607218265236877223636045,17423706905851860660448207621209813287860733969412,81142660418086830619328460811191061556940512689692,51934325451728388641918047049293215058642563049483,62467221648435076201727918039944693004732956340691,15732444386908125794514089057706229429197107928209,55037687525678773091862540744969844508330393682126,18336384825330154686196124348767681297534375946515,80386287592878490201521685554828717201219257766954,78182833757993103614740356856449095527097864797581,16726320100436897842553539920931837441497806860984,48403098129077791799088218795327364475675590848030,87086987551392711854517078544161852424320693150332,59959406895756536782107074926966537676326235447210,69793950679652694742597709739166693763042633987085,41052684708299085211399427365734116182760315001271,65378607361501080857009149939512557028198746004375,35829035317434717326932123578154982629742552737307,94953759765105305946966067683156574377167401875275,88902802571733229619176668713819931811048770190271,25267680276078003013678680992525463401061632866526,36270218540497705585629946580636237993140746255962,24074486908231174977792365466257246923322810917141,91430288197103288597806669760892938638285025333403,34413065578016127815921815005561868836468420090470,23053081172816430487623791969842487255036638784583,11487696932154902810424020138335124462181441773470,63783299490636259666498587618221225225512486764533,67720186971698544312419572409913959008952310058822,95548255300263520781532296796249481641953868218774,76085327132285723110424803456124867697064507995236,37774242535411291684276865538926205024910326572967,23701913275725675285653248258265463092207058596522,29798860272258331913126375147341994889534765745501,18495701454879288984856827726077713721403798879715,38298203783031473527721580348144513491373226651381,34829543829199918180278916522431027392251122869539,40957953066405232632538044100059654939159879593635,29746152185502371307642255121183693803580388584903,41698116222072977186158236678424689157993532961922,62467957194401269043877107275048102390895523597457,23189706772547915061505504953922979530901129967519,86188088225875314529584099251203829009407770775672,11306739708304724483816533873502340845647058077308,82959174767140363198008187129011875491310547126581,97623331044818386269515456334926366572897563400500,42846280183517070527831839425882145521227251250327,55121603546981200581762165212827652751691296897789,32238195734329339946437501907836945765883352399886,75506164965184775180738168837861091527357929701337,62177842752192623401942399639168044983993173312731,32924185707147349566916674687634660915035914677504,99518671430235219628894890102423325116913619626622,73267460800591547471830798392868535206946944540724,76841822524674417161514036427982273348055556214818,97142617910342598647204516893989422179826088076852,87783646182799346313767754307809363333018982642090,10848802521674670883215120185883543223812876952786,71329612474782464538636993009049310363619763878039,62184073572399794223406235393808339651327408011116,66627891981488087797941876876144230030984490851411,60661826293682836764744779239180335110989069790714,85786944089552990653640447425576083659976645795096,66024396409905389607120198219976047599490197230297,64913982680032973156037120041377903785566085089252,16730939319872750275468906903707539413042652315011,94809377245048795150954100921645863754710598436791,78639167021187492431995700641917969777599028300699,15368713711936614952811305876380278410754449733078,40789923115535562561142322423255033685442488917353,44889911501440648020369068063960672322193204149535,41503128880339536053299340368006977710650566631954,81234880673210146739058568557934581403627822703280,82616570773948327592232845941706525094512325230608,22918802058777319719839450180888072429661980811197,77158542502016545090413245809786882778948721859617,72107838435069186155435662884062257473692284509516,20849603980134001723930671666823555245252804609722,53503534226472524250874054075591789781264330331690]
|
|
|
|
m = take 10 $ show $ foldl1 (+) list
|
|
|
|
listToInt = foldl (\temp val -> 10*temp+val) 0
|
|
|
|
--main = print $ foldl1 (\a b -> if (snd b > snd a) then b else a) $ map (\n -> (n, collatz 0 n)) [1..999999]
|
|
--main = print $ totalLength [1..1000]
|
|
|
|
--Problem 14
|
|
collatz :: Integer -> Integer -> Integer
|
|
collatz steps 1 = steps
|
|
|
|
collatz steps n
|
|
| even n = collatz (steps+1) (div n 2)
|
|
| otherwise = collatz (steps+1) (n*3+1)
|
|
|
|
--Problem 17
|
|
totalLength list = foldl1 (+) $ map (length.filterAlphabetic.n2s) list
|
|
filterAlphabetic = filter (\x -> elem x "abcdefghijklmnopqrstuvwxyz")
|
|
|
|
n2s :: Int -> String
|
|
n2s 0 = "zero"
|
|
n2s n = n2s' $ map (\c -> read [c]) $ show n
|
|
|
|
n2s' :: [Int] -> String
|
|
n2s' [1] = "one"
|
|
n2s' [2] = "two"
|
|
n2s' [3] = "three"
|
|
n2s' [4] = "four"
|
|
n2s' [5] = "five"
|
|
n2s' [6] = "six"
|
|
n2s' [7] = "seven"
|
|
n2s' [8] = "eight"
|
|
n2s' [9] = "nine"
|
|
n2s' [0,n] = n2s' [n]
|
|
n2s' [1,0] = "ten"
|
|
n2s' [1,1] = "eleven"
|
|
n2s' [1,2] = "twelve"
|
|
n2s' [1,3] = "thirteen"
|
|
n2s' [1,4] = "fourteen"
|
|
n2s' [1,5] = "fifteen"
|
|
n2s' [1,6] = "sixteen"
|
|
n2s' [1,7] = "seventeen"
|
|
n2s' [1,8] = "eighteen"
|
|
n2s' [1,9] = "nineteen"
|
|
n2s' [2,0] = "twenty"
|
|
n2s' [3,0] = "thirty"
|
|
n2s' [4,0] = "forty"
|
|
n2s' [5,0] = "fifty"
|
|
n2s' [6,0] = "sixty"
|
|
n2s' [7,0] = "seventy"
|
|
n2s' [8,0] = "eighty"
|
|
n2s' [9,0] = "ninety"
|
|
n2s' [x,i] = n2s' [x,0] ++ "-" ++ n2s' [i]
|
|
n2s' [c,0,0] = n2s' [c] ++ " hundred"
|
|
n2s' [c,x,i] = n2s' [c] ++ " hundred and " ++ n2s' [x,i]
|
|
n2s' [m,0,0,0] = n2s' [m] ++ " thousand"
|
|
n2s' [m,0,x,i] = n2s' [m] ++ " thousand and " ++ n2s' [x,i]
|
|
n2s' [m,c,x,i] = n2s' [m] ++ " thousand " ++ n2s' [c,x,i]
|
|
n2s' _ = ""
|
|
|
|
|
|
|
|
|
|
--Problem 18
|
|
triangle = [[75],[95,64],[17,47,82],[18,35,87,10],[20,04,82,47,65],[19,01,23,75,03,34],[88,02,77,73,07,63,67],[99,65,04,28,06,16,70,92],[41,41,26,56,83,40,80,70,33],[41,48,72,33,47,32,37,16,94,29],[53,71,44,65,25,43,91,52,97,51,14],[70,11,33,28,77,73,17,78,39,68,17,57],[91,71,52,38,17,14,91,43,58,50,27,29,48],[63,66,04,68,89,53,67,30,73,16,69,87,40,31],[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]
|
|
maxPath [rest] = rest
|
|
maxPath (topRow:rest) = zipWith (+) topRow (zipWith max combineRow (tail combineRow))
|
|
where combineRow = maxPath rest
|
|
|
|
|
|
--Problem 19
|
|
data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving (Eq, Show)
|
|
|
|
firstSundays = countSundays 2000 December
|
|
countSundays 1900 January = (1,0)
|
|
countSundays year month = (weekday, if (year == 1901 && month == January) then 0 else (snd previous + if (weekday == 0) then 1 else 0))
|
|
where
|
|
weekday = (fst previous + daycount previousMonth) `mod` 7
|
|
daycount January = 31
|
|
daycount February = if ((year `mod` 4 == 0 && (year `mod` 100) /= 0) || (year `mod` 400) == 0) then 29 else 28
|
|
daycount March = 31
|
|
daycount April = 30
|
|
daycount May = 31
|
|
daycount June = 30
|
|
daycount July = 31
|
|
daycount August = 31
|
|
daycount September = 30
|
|
daycount October = 31
|
|
daycount November = 30
|
|
daycount December = 31
|
|
previousMonth = case month of
|
|
January -> December
|
|
February -> January
|
|
March -> February
|
|
April -> March
|
|
May -> April
|
|
June -> May
|
|
July -> June
|
|
August -> July
|
|
September -> August
|
|
October -> September
|
|
November -> October
|
|
December -> November
|
|
previous = case month of
|
|
January -> countSundays (year-1) December
|
|
otherwise -> countSundays year previousMonth
|
|
|
|
--Problem 20
|
|
digitSum = (sum . map (read.(:[])) . show ) (product [1..100])
|
|
|
|
|
|
--Problem 21
|
|
amicableSum = (sum . filter (\n -> divisorSum !! n /= n && (divisorSum !! (divisorSum !! n)) == n)) [1..10000]
|
|
divisorSum = 0:[(sum . filter (\k -> n `mod` k == 0)) [1..max (n-1) 1] | n <- [1..]]
|
|
|
|
|
|
--Problem 22
|
|
getNameScore = fmap nameScore (readFile "p022_names.txt")
|
|
nameScore contents = sum $ map (\(num,name) -> num * sum [fromEnum c - 64 | c<-name]) $ zip [1..] $ sort $ (read::(String->[String])) ("[" ++ contents ++ "]")
|
|
|
|
--Problem 23
|
|
{- JavaScript
|
|
divisorSum = new Array(28124);
|
|
divisorSum.fill(0);
|
|
for (var i = 1; i < divisorSum.length; i++)
|
|
for (var j = i*2; j < divisorSum.length; j += i)
|
|
divisorSum[j] += i
|
|
|
|
abundant = [];
|
|
for (var i = 1; i < divisorSum.length; i++)
|
|
if (divisorSum[i] > i)
|
|
abundant.push(i);
|
|
|
|
isAbundantSummable = new Array(28124);
|
|
isAbundantSummable.fill(false);
|
|
abundant.forEach(function(a) {
|
|
abundant.forEach(function(b) {
|
|
if (a+b < isAbundantSummable.length)
|
|
isAbundantSummable[a+b] = true;
|
|
})
|
|
});
|
|
|
|
unsummableSum = 0;
|
|
for (var i = 1; i < isAbundantSummable.length; i++)
|
|
if (!isAbundantSummable[i])
|
|
unsummableSum += i;
|
|
|
|
unsummableSum
|
|
-}
|
|
|
|
--Problem 24
|
|
perms n 0 = []
|
|
perms n d = perm : perms (n+product[1..d]*perm) (d-1)
|
|
where perm = last $ takeWhile (\k -> n+product[1..d]*k < 1000000) [0..9]
|
|
|
|
takeAt n list = (head back, front ++ tail back)
|
|
where (front,back) = splitAt n list
|
|
|
|
getPerm = concat $ map show $ getPerm' (perms 0 9) [0..9]
|
|
where
|
|
getPerm' [] [digit] = [digit]
|
|
getPerm' (pos:ps) digits = digit : getPerm' ps ds
|
|
where
|
|
(digit,ds) = takeAt pos digits
|
|
|
|
euler24 = (read getPerm)::Int
|
|
|
|
--Problem 25
|
|
fib 0 = 0
|
|
fib 1 = 1
|
|
fib n
|
|
| even n = f1 * (f1 + 2 * f2)
|
|
| n `mod` 4 == 1 = (2 * f1 + f2) * (2 * f1 - f2) + 2
|
|
| otherwise = (2 * f1 + f2) * (2 * f1 - f2) - 2
|
|
where
|
|
k = n `div` 2
|
|
f1 = fib k
|
|
f2 = fib (k-1)
|
|
|
|
--approximation is 2 off
|
|
fib1000 a = (approx-a, fib $ approx - a)
|
|
where approx = (floor $ 1000*(logBase ((1+sqrt(5))/2) 10))
|
|
|
|
euler25 = fst (fib1000 2)
|
|
|
|
--Problem 26
|
|
euler26 = fst $ maxSnd [(,) n $ head [ len | (len,nine) <- nines, denominator (nine % n) == 1] | n <-[1..1000]]
|
|
where
|
|
nines = [(n,(10^n-1)*1000000000) | n <- [1..1000000]]
|
|
|
|
maxSnd = foldl1 sortSnd
|
|
where sortSnd = \a b -> if snd b > snd a then b else a
|
|
|
|
--Problem 27
|
|
euler27 = fst $ maxSnd [(a*b, length $ takeWhile isPrime [n*n+a*n+b | n <- [0..]]) | a <- [-1000..1000], b <- [0..1000]]
|
|
|
|
-- isPrime 1 = False
|
|
-- isPrime 2 = True
|
|
-- isPrime x = if x < 0 then False else not $ any divisible $ takeWhile notTooBig (2:[3,5..])
|
|
-- where
|
|
-- divisible y = x `mod`y == 0
|
|
-- notTooBig y = y*y <= x
|
|
|
|
--Problem 28
|
|
--average of 4 corners of loop k = 4k^2+k+1
|
|
euler28 = 1+sum [4*(4*k*k+k+1) | k<-[1..500]]
|
|
|
|
--Problem 29
|
|
euler29 = length $ nub [a^b | a <-[2..100], b<-[2..100]]
|
|
|
|
--Problem 30
|
|
euler30 = [a*100000+b*10000+c*1000+d*100+e*10+f | a<-[0..9], b<-[0..9], c<-[0..9], d<-[0..9], e<-[0..9], f<-[0..9], a^5+b^5+c^5+d^5+e^5+f^5 == a*100000+b*10000+c*1000+d*100+e*10+f, a*100000+b*10000+c*1000+d*100+e*10+f /= 1]
|
|
|
|
--Problem 31
|
|
euler31 = 1+length (do
|
|
p100 <- [0,100..200]
|
|
p50 <- [p100,p100+50..200]
|
|
p20 <- [p50,p50+20..200]
|
|
p10 <- [p20,p20+10..200]
|
|
p5 <- [p10,p10+5..200]
|
|
p2 <- [p5,p5+2..200]
|
|
return ()
|
|
)
|
|
|
|
--Problem 32
|
|
-- abc*de=fghi, abcd*e=fghi
|
|
euler32 = sum $ nub $ do
|
|
perm <- permutations [1..9]
|
|
alen <- [3..4]
|
|
let a = concatDigits $ take alen perm
|
|
let b = concatDigits $ take (5-alen) $ drop alen perm
|
|
let c = concatDigits $ drop 5 perm
|
|
guard (a*b==c)
|
|
return c
|
|
|
|
concatDigits :: [Integer] -> Integer
|
|
concatDigits = concat' 0
|
|
where
|
|
concat' n (d:ds) = concat' (10*n+d) ds
|
|
concat' n [] = n
|
|
|
|
--Problem 33
|
|
euler33 = do
|
|
numerator <- [11..99]
|
|
guard (numerator `mod` 10 /= 0)
|
|
denominator <- [numerator+1..99]
|
|
guard (isCurious numerator denominator)
|
|
return (numerator%denominator)
|
|
|
|
isCurious numerator denominator
|
|
| num10 == den10 && den1 /= 0 = (numerator % denominator == num1 % den1 )
|
|
| num10 == den1 && den10 /= 0 = (numerator % denominator == num1 % den10)
|
|
| num1 == den10 && den1 /= 0 = (numerator % denominator == num10 % den1 )
|
|
| num1 == den1 && den10 /= 0 = (numerator % denominator == num10 % den10)
|
|
| otherwise = False
|
|
where
|
|
num10 = numerator `div` 10
|
|
num1 = numerator `mod` 10
|
|
den10 = denominator `div` 10
|
|
den1 = denominator `mod` 10
|
|
|
|
--Problem 34
|
|
euler34 = sum $ map (concatDigits) $ filter (\ns -> length ns > 1) $ filter (\ns -> concatDigits ns == (sum $ map fac ns)) $ map (dropWhile (==0)) $ cartesianPower [0..9] 7
|
|
where
|
|
fac 0 = 1
|
|
fac n = n*fac (n-1)
|
|
|
|
cartesianPower :: [a] -> Integer -> [[a]]
|
|
cartesianPower xs 0 = [[]]
|
|
cartesianPower xs n = [x:rs | x <- xs, rs <- cartesianPower xs (n-1)]
|
|
|
|
--Problem 35
|
|
euler35 = length [n | n <- map (dropWhile (==0)) $ tail $ cartesianPower [0..9] 6, all isPrime $ map concatDigits $ rotations n]
|
|
where
|
|
rotations :: [Integer] -> [[Integer]]
|
|
rotations xs = [take (length xs) $ drop d $ cycle xs | d <- [0..length xs - 1]]
|
|
|
|
--Problem 36
|
|
showBase2 num = showIntAtBase 2 intToDigit num ""
|
|
isPalindrome str = reverse str == str
|
|
|
|
doublePalindromes = filter (\n -> isPalindrome (showBase2 n)) (filter (\n -> isPalindrome (show n)) [1,3..999999])
|
|
euler36 = sum doublePalindromes
|
|
|
|
--Problem 37
|
|
euler37 = sum $ map concatDigits $ filter rtlTrunc $ ltrTruncs
|
|
where
|
|
rtlTrunc ns = all isPrime $ map concatDigits $ tail $ inits $ ns
|
|
ltrTruncs = filter (\ns -> length ns > 1) $ concatMap (ltrTruncs'.pure) [3,5,7]
|
|
ltrTruncs' ns = if isPrime (concatDigits ns) then ns:concat [ltrTruncs' (n:ns) | n<-[1,2,3,5,7,9]] else []
|
|
|
|
--Problem 38
|
|
euler38 = foldl1 max $ map concatDigits [digits | x<-[1..10000], n <- [2..9 `div` (integerLength (numToDig x))], digits <- pure $ concatMap (numToDig . (x*)) [1..n], length digits == 9, null (digits \\ [1..9])]
|
|
|
|
numToDig :: Integer -> [Integer]
|
|
numToDig x = let (tens, units) = x `divMod` 10 in (if tens > 0 then numToDig tens else []) ++ [units]
|
|
|
|
--Problem 39
|
|
euler39 = fst $ maxSnd [(p, length [() | a<-[1..p `div` 2], b<-[a+1..(p-a) `div` 2], c<-[p-a-b], a*a+b*b==c*c]) | p <- [1..1000]]
|
|
|
|
isSquare n = sq * sq == n
|
|
where sq = floor $ sqrt $ (fromIntegral n::Double)
|
|
|
|
--Problem 40
|
|
euler40 = product $ map (digits!!) [1,10,100,1000,10000,100000,1000000]
|
|
where
|
|
digits = concatMap numToDig [0..]
|
|
|
|
--Problem 41
|
|
euler41 = foldl1 max [concatDigits perm |n<-[1..9], perm <- permutations [1..n], isPrime $ concatDigits perm]
|
|
|
|
--Problem 42
|
|
euler42 = do
|
|
f <- readFile "p042_words.txt"
|
|
return $ length $ filter isTriangle $ map wordValue $ lines f
|
|
where
|
|
wordValue word = sum $ map (\c -> fromEnum c - 64) word
|
|
isTriangle x = any (x==) $ takeWhile (x>=) [(a*(a+1)) `div` 2 | a<-[1..]]
|
|
|
|
--Problem 43
|
|
euler43 = sum $ map listToInt $ filter (\list -> all (0==) $ zipWith mod (zipWith3 zipzip (drop 1 list) (drop 2 list) (drop 3 list)) [2,3,5,7,11,13,17]) $ filter (\(d1:_) -> d1 /= 0) $ permutations $ [0..9]
|
|
where
|
|
zipzip a b c = 100*a+10*b+c
|
|
|
|
--Problem 44
|
|
euler44 = head [pd | (n,pd) <- zip [1..] pentagonal, pk <- take (3*n+1) pentagonal, isP (pd + 2*pk), isP (pd + pk)]
|
|
where
|
|
isP n = isSquare (24*n+1) && (squareRoot (24*n+1)) `mod` 6 == 5
|
|
|
|
pentagonal :: [Integer]
|
|
pentagonal = map (\n -> (n*(3*n-1)) `div` 2) [1..]
|
|
|
|
--Problem 45
|
|
euler45 = drop 2 $ do
|
|
(n,tn) <- zip triangular [0..]
|
|
let hn = binsearch hexagonal n
|
|
guard (hn /= -1)
|
|
let pn = binsearch pentagonal n
|
|
guard (pn /= -1)
|
|
return (n,tn+1,pn+1,hn+1)
|
|
|
|
triangular = map (\n -> (n*(n+1)) `div` 2) [1..]
|
|
hexagonal = map (\n -> n*(2*n-1)) [1..]
|
|
|
|
--Problem 46
|
|
euler46 = [n | n<-[3,5..], not $ isPrime n, null $ filter isPrime $ takeWhile (1<) $ map (\x->n-2*x*x) [1..]]
|
|
|
|
--Problem 47
|
|
euler47 = head $ filter (\n -> all fourDistinctFactors [n,n+1,n+2,n+3]) [2..]
|
|
where fourDistinctFactors = (4==).length.nub.primeFactors
|
|
|
|
|
|
--Problem 48
|
|
--euler48 = (`mod` 10000000000) $ sum $ map (\n -> powerModInteger n n 10000000000) [1..1000]
|
|
|
|
--Problem 49
|
|
euler49 = filter (not.null) $ map triplet $ groupBy (\pa pb -> null ((numToDig pa) \\ (numToDig pb)) && null ((numToDig pb) \\ numToDig pa) ) $ sortBy (compare `on` (sort.numToDig)) $ takeWhile (10000>) $ dropWhile (1000>) primes
|
|
where
|
|
triplet g = filter (\[a,b,c] -> c-b == b-a) $ combinations g 3
|
|
|
|
combinations xs 1 = map pure xs
|
|
combinations xs n = concatMap (\(y:ys) -> map (y:) $ combinations ys (n-1)) $ init $ tails xs
|
|
|
|
--Problem 50
|
|
euler50 = maxSnd $ filter (isPrime.fst) $ filter ((1000000>).fst) $ map (\xs -> (sum xs, length xs)) $ concatMap tails $ inits $ take 2000 $ takeWhile (1000000 `div` 20 >) primes
|
|
|
|
--Problem 51
|
|
euler51 = head [ p | p<-primes, any (\rs -> length (filter (isPrime . concatDigits) rs) >= 8) (replacements (numToDig p))]
|
|
where
|
|
replaceDigits n n' = map (\x -> if x == n then n' else x)
|
|
replacements xs = [[replaceDigits n r xs | r<-[n..9]]|n<- [0..2], n `elem` xs]
|
|
|
|
--Problem52
|
|
euler52 = [x | x<-[1..], sameDigits x (2*x), sameDigits x (3*x), sameDigits x (4*x), sameDigits x (5*x), sameDigits x (6*x)]
|
|
where
|
|
sameDigits a b = null ((numToDig a) \\ (numToDig b)) && null ((numToDig b) \\ numToDig a)
|
|
|
|
|
|
--Problem53
|
|
euler53 = sum [countLargerThanMillion n rm | n<-[1..100], rm<-take 1 $ dropWhile ((1000000>) . nCr n) [1..n `div` 2]]
|
|
where
|
|
nCr n r = product [r+1..n] `div` product [2..n-r]
|
|
countLargerThanMillion n rm = n+1 - 2*rm
|
|
|
|
|
|
|
|
--Problem54
|
|
euler54 = fmap proc $ readFile "p054_poker.txt"
|
|
where
|
|
proc file = sum $ map (compareHands . map textToCard . words) $ lines file
|
|
compareHands cards = if handValue (take 5 cards) > handValue (drop 5 cards) then 1 else 0
|
|
textToCard [value,suit] = (suit, maybe 0 (+2) $ elemIndex value "23456789TJQKA")
|
|
handValue hand = reverse $ sort $ concat [testStraightFlush, testKind, testFullHouse, testFlush, testStraight, testTwoPair]
|
|
where
|
|
testStraightFlush
|
|
| sameSuit && consecutive (head groupSuit) = [[10,firstValue groupSuit]]
|
|
| otherwise = []
|
|
testKind = map (\cards -> [kindRank $ length cards, snd $ head cards]) $ groupValue
|
|
testFullHouse
|
|
| any triplet groupValue && any pair groupValue = [[7, firstValue $ filter triplet groupValue, firstValue $ filter pair groupValue]]
|
|
| otherwise = []
|
|
testFlush
|
|
| sameSuit = [[6]]
|
|
| otherwise = []
|
|
testStraight
|
|
| consecutive $ concat groupValue = [[5, firstValue groupValue]]
|
|
| otherwise = []
|
|
testTwoPair
|
|
| length pairs == 2 = [3 : map (snd.head) (reverse pairs)]
|
|
| otherwise = []
|
|
kindRank 4 = 8
|
|
kindRank 3 = 4
|
|
kindRank n = n
|
|
sameSuit = length (groupSuit) == 1
|
|
groupSuit = map (sortBy (compare `on` snd)) $ groupBy ((==) `on` fst) $ sortBy (compare `on` fst) hand
|
|
groupValue = (map (sortBy (compare `on` fst)) $ groupBy ((==) `on` snd) $ sortBy (compare `on` snd) hand) :: [[(Char,Int)]]
|
|
consecutive = (\vals -> all (1==) $ zipWith (-) (drop 1 vals) vals) . map snd
|
|
pairs = filter ((2==).length) groupValue
|
|
firstValue = snd . head . head
|
|
triplet = hasLength 3
|
|
pair = hasLength 2
|
|
|
|
hasLength n xs = length xs == n
|
|
--Problem55
|
|
euler55 = filter (not . any (isPalindrome . numToDig) . take 51 . tail . iterate addReverse) [1..10000-1]
|
|
where
|
|
addReverse x = x + (concatDigits.reverse.numToDig) x
|
|
|
|
|
|
--Problem56
|
|
euler56 = maximum $ map (sum . numToDig) $ [a^b | a<-[2..100-1], b<-[2..100-1]]
|
|
|
|
|
|
--Problem57
|
|
euler57 = length $ filter (\r -> digits (numerator r) > digits (denominator r)) $ map (\n -> 1+1/n) $ take 1000 $ iterate (\n -> 2+(1/n)) (2%1)
|
|
where digits = length . numToDig
|
|
|
|
|
|
--Problem58
|
|
euler58 = snd $ head $ dropWhile (\(r,l) -> r >= 1%10) $ tail $ map (fmap sideLength) $ snd $ mapAccumL accPrimeCount 0 spiralnumbers
|
|
where
|
|
spiralnumbers = (1,[]) : spiralnumbers' 2
|
|
spiralnumbers' n = (n,[4*n^2 - 6*n + 3, 4*(n-1)^2 + 1, 4*n^2 - 10*n + 7]) : spiralnumbers' (n+1)
|
|
accPrimeCount primeCount (level,ns) = let primeCount' = primeCount + integerLength (filter isPrime ns) in (primeCount', (primeCount' % (level*4-3), level))
|
|
sideLength level = 2*level-1
|
|
|
|
|
|
--Problem59
|
|
euler59 = fmap proc (readFile "p059_cipher.txt")
|
|
where
|
|
proc f = (sum . map fromEnum . head) [combine c0 c1 c2 | c0<-(dec 0 f), c1<-(dec 1 f), c2<-(dec 2 f)]
|
|
combine (a:as) (b:bs) (c:cs) = a:b:c:combine as bs cs
|
|
combine (a:as) (b:bs) [] = a:b:combine as bs []
|
|
combine (a:as) [] [] = a:as
|
|
dec n f = decode (map (!!n) $ takeWhile ((n<).length) (charcodes f))
|
|
charcodes f = (map (map read . words) (lines f))::[[Int]]
|
|
decode cs = [text | c<-['a'..'z'], text<-pure $ map (toEnum . xor (fromEnum c)) cs, all isPrint text, not $ any (`elem`"$`%") text]
|
|
|
|
|
|
--Problem60
|
|
euler60 = [(s,primeSet) |s<-[790..], primeSet<-[[p1,p2,p3,p4]|
|
|
p1<-takeWhile (s`div`5>) primes,
|
|
p2<-filter (concatable [p1]) $ takeWhile ((s-p1)`div`4>) $ dropWhile (p1>=) primes,
|
|
p3<-filter (concatable [p1,p2]) $ takeWhile ((s-p1-p2)`div`3>) $ dropWhile (p2>=) primes,
|
|
p4<-filter (concatable [p1,p2,p3]) $ takeWhile ((s-p1-p2-p3)`div`2>) $ dropWhile (p3>=) primes,
|
|
p5<-pure (s-p1-p2-p3-p4),
|
|
isPrime p5, concatable [p1,p2,p3,p4] p5]]
|
|
where
|
|
concatable xs a = all (isPrime . concatNumber a) xs && all (isPrime . flip concatNumber a) xs
|
|
concatNumber a b = a*10^(length (show b))+b
|
|
|
|
|
|
--Problem61
|
|
euler61 = filter isCyclic $ [perm | p3 <- trans triangular, p4 <- trans [n*n|n<-[1..]], p5 <- trans pentagonal, p6 <- trans [n*(2*n-1)|n<-[1..]], p7 <- trans [(n*(5*n-3)) `div` 2|n<-[1..]], p8 <- trans [n*(3*n-2)|n<-[1..]], perm <- map (p8:) $ permutations [p3,p4,p5,p6,p7]]
|
|
where
|
|
trans = (map splitNumber . fourDigs)
|
|
isCyclic xs = and $ zipWith (\(_,r) (l,_) -> r==l) xs (tail $ cycle xs)
|
|
splitNumber = (`divMod` 100)
|
|
fourDigs = takeWhile (10000>) . dropWhile (1000>=)
|
|
|
|
euler61' = filter (isSquare . closingNumber) $ filter isSemiCyclic $ [perm | p3 <- trans triangular, p5 <- trans pentagonal, p6 <- trans [n*(2*n-1)|n<-[1..]], p7 <- trans [(n*(5*n-3)) `div` 2|n<-[1..]], p8 <- trans [n*(3*n-2)|n<-[1..]], perm <- permutations [p3,p5,p6,p7,p8]]
|
|
where
|
|
closingNumber ((l,_):xs) = 100*(snd $ last xs) + l
|
|
trans = (map splitNumber . fourDigs)
|
|
isSemiCyclic xs = and $ zipWith (\(_,r) (l,_) -> r==l) xs (tail xs)
|
|
splitNumber = (`divMod` 100)
|
|
fourDigs = takeWhile (10000>) . dropWhile (1000>=)
|
|
|
|
|
|
--Problem62
|
|
euler62 = fst . head . head . head . dropWhile null . map (filter ((5==) . length) . groupBy ((==) `on` snd) . sortBy (compare `on` snd)) $ groupBy((==) `on` (length.snd)) [(x^3,sort (numToDig (x^3)))|x<-[345..]]
|
|
|
|
isCube n = ((n==) . head . dropWhile (n>)) [x^3 | x<-[1..]]
|
|
|
|
--Problem63
|
|
euler63 = length [(x,p) | p<-takeWhile (\p -> 9^p >= 10^(p-1)) [1..], x<-[1..9], 10^(p-1) <= x^p]
|
|
|
|
|
|
--Problem64
|
|
euler64 = length $ filter oddPeriod [iterate (expand root) $ (floorSqrt root, -floorSqrt root, 1) | root<-[2..10000], not (isSquare root)]
|
|
where
|
|
oddPeriod (_:x:xs) = (odd . (1+) . length . takeWhile (x/=)) xs
|
|
floorSqrt = floor . sqrt . fromIntegral
|
|
expand root (_,addition,multiplier) = (units,addition',reducedDenom)
|
|
where
|
|
addition' = remainder-floorSqrt root
|
|
(units,remainder) = (floorSqrt root - addition) `divMod` reducedDenom
|
|
reducedDenom = (root-addition*addition) `div` multiplier
|
|
|
|
continuedFractionRoot n = continuedFraction ((floor . sqrt . fromIntegral) n) n
|
|
|
|
continuedFraction n nsquared = n : expand (-n) 1
|
|
where
|
|
expand addition _ | addition*addition == nsquared = []
|
|
expand addition multiplier = units : expand addition' reducedDenom
|
|
where
|
|
addition' = remainder-n
|
|
(units,remainder) = (n - addition) `divMod` reducedDenom
|
|
reducedDenom = (nsquared-addition*addition) `div` multiplier
|
|
|
|
repeatingContinuedFraction n nsquared = (n, (map (\(a,_,_)->a) . getPeriod . expand) (n, -n, 1))
|
|
where
|
|
getPeriod (x:xs) = x : (takeWhile (x/=)) xs
|
|
expand (_,addition,multiplier) = if reducedDenom == 0 then [] else (units,addition',reducedDenom) : expand (units,addition',reducedDenom)
|
|
where
|
|
addition' = remainder-n
|
|
(units,remainder) = (n - addition) `divMod` reducedDenom
|
|
reducedDenom = (nsquared-addition*addition) `div` multiplier
|
|
|
|
contFracSqrt n = repeatingContinuedFraction ((floor . sqrt . fromIntegral) n) n
|
|
|
|
|
|
--Problem65
|
|
euler65 = (sum . numToDig . numerator) approximation
|
|
where
|
|
approximation = 2 + 1 / (foldr1 (\a c -> a+1/c) . take 99) eFactors
|
|
eFactors = concatMap (\x -> map toRational [1,2*x,1]) [1..]
|
|
|
|
|
|
--Problem66
|
|
-- euler66 d = x
|
|
-- where
|
|
-- a = (fst . contFracSqrt) d : (cycle . snd . contFracSqrt) d
|
|
-- r = (length . snd . contFracSqrt) d
|
|
-- p 0 = a!!0
|
|
-- p 1 = a!!1 * a!!0 + 1
|
|
-- p n = a!!n * p (n-1) + p (n-2)
|
|
-- q 0 = 1
|
|
-- q 1 = a!!1
|
|
-- q n = a!!n * q (n-1) + q (n-2)
|
|
-- x = head [(d, p n, q n, n)| n<-[1..], (p n)^2 -d*(q n)^2 == 1]
|
|
|
|
euler66' = (fst3 . maximumBy (compare `on` snd3) . map pell . filter (not.isSquare)) [1..1000]
|
|
where
|
|
|
|
pell d = ((\(n,x,y,_)->(n,x,y)) . head . dropWhile (\(_,_,_,k) -> k /= 1) . iterate solve) (d, a0, 1, a0^2-d)
|
|
where a0 = 1+squareRoot d
|
|
solve (d,a,b,k) = (d,a',b',k')
|
|
where
|
|
scale el = el `div` (abs k)
|
|
a' = scale (a*m + d*b)
|
|
b' = scale (a+b*m)
|
|
k' = (m^2-d) `div` k
|
|
m = minimumBy (compare `on` (\m -> abs (m^2-d))) [m | m<-[squareRoot d - abs k..squareRoot d + abs k], (a+b*m) `mod` k == 0]
|
|
|
|
|
|
fst3 (a,_,_) = a
|
|
snd3 (_,b,_) = b
|
|
|
|
--Problem67
|
|
euler67 = fmap proc $ readFile "p067_triangle.txt"
|
|
where
|
|
proc = solve . map (map read . words) . lines
|
|
solve (lastrow:[]) = lastrow
|
|
solve (row:rows) = zipWith (+) (zipWith max solution (tail solution)) row
|
|
where solution = solve rows
|
|
|
|
|
|
--Problem68
|
|
euler68 = (concat . map show . maximum) [[a,f,g,b,g,h,c,h,i,d,i,j,e,j,f]| [a,b,c,d,e,f,g,h,i,j]<-permutations [1..10], all (a<) [b,c,d,e], all (a+f+g ==) [b+g+h,c+h+i,d+i+j,e+j+f], 10 `elem` [a,b,c,d,e] ]
|
|
|
|
|
|
--Problem69
|
|
euler69 = solve primes 1
|
|
where
|
|
solve (p:ps) n = if largestMultiple > p then solve ps (n*p) else n*largestMultiple
|
|
where largestMultiple = 1000000`div`n
|
|
|
|
|
|
--Problem70
|
|
euler70 = solve 2 0 (1000%1)
|
|
where
|
|
solve 10000000 bestN bestRatio = [(bestN,bestRatio)]
|
|
solve n bestN bestRatio
|
|
| ratio < bestRatio && isAnagram (show n) (show (totient n)) = (n,ratio) : solve (n+1) n ratio
|
|
| otherwise = solve (n+1) bestN bestRatio
|
|
where ratio = n % totient n
|
|
|
|
|
|
|
|
isAnagram xs ys = length xs == length ys && null (xs \\ ys)
|
|
|
|
totient n = (n `div` product factors) * product (map (subtract 1) factors)
|
|
where factors = distinctFactorize n
|
|
|
|
--distinctFactorize n = snd $ foldl' (\(last,list) f -> if f==last then (last,list) else (f,list++[f])) (1,[]) (factorize n)
|
|
distinctFactorize n = factorize' primes n
|
|
where
|
|
factorize' _ 1 = []
|
|
factorize' (p:ps) n
|
|
| p*p > n = [n]
|
|
| factorOut p n /= n = p : factorize' ps (factorOut p n)
|
|
| otherwise = factorize' ps n
|
|
factorOut = fix (\r p n -> if n `mod` p == 0 then r p (n `div` p) else n)
|
|
|
|
factorize n = factorize' n (map fromInteger primes :: [Integer])
|
|
where
|
|
factorize' 1 _ = []
|
|
factorize' n pps@(p:ps)
|
|
| p*p > n = [n]
|
|
| n `mod` p /= 0 = factorize' n ps
|
|
| otherwise = p : factorize' (n `div` p) pps
|
|
-- factorize' n ps = head ps' : factorize' (n`div` (head ps')) ps'
|
|
-- where ps' = dropWhile (\p->n `mod` p /= 0) ps
|
|
|
|
factorCount = fix (\r p n -> if n `mod` p == 0 then 1 + r p (n `div` p) else 0)
|
|
factorPower = fix (\r p n -> if n `mod` p == 0 then p * r p (n `div` p) else 1)
|
|
|
|
|
|
--Problem 71
|
|
euler71 = maximum [floor(d*3%7) % d|d<-[1..1000000],d `mod` 7 /= 0]
|
|
|
|
|
|
--Problem 72
|
|
euler72 = sum (map totient [2..1000000])
|
|
|
|
|
|
--Problem 73
|
|
euler73 = sum [length [n%d | n<-[d`div`3..d`div`2], gcd n d == 1, 3*n > d, 2*n < d]|d<-[2..12000]]
|
|
|
|
|
|
--Problem 74
|
|
euler74 = error "Unsolved"
|
|
|
|
|
|
--Problem 75
|
|
euler75 = error "See a059.cpp"
|
|
|
|
|
|
euclidSingularTriangles lmax = 12 : [l |l<-[14,16..lmax], lengthEquals 1 (tryLength l)]
|
|
where
|
|
tryLength l = [() | m<-[(squareRoot l) `div` 2..squareRoot (l `div` 2) - 1], l `mod` (2*m) == 0, let n = (l `div` (2*m))-m, n < m]
|
|
|
|
lengthEquals 0 [] = True
|
|
lengthEquals 0 (_:_) = False
|
|
lengthEquals n [] = False
|
|
lengthEquals n (_:xs) = lengthEquals (n-1) xs
|
|
|
|
|
|
--Problem 76
|
|
euler76 n = euler78' n - 1 -- solve n (n-1)
|
|
where
|
|
solve total maxn
|
|
| total == 1 || maxn == 1 = 1
|
|
| total < maxn = solve total (maxn-1)
|
|
| total == maxn = solve total (maxn-1) + 1
|
|
| total > maxn = solve total (maxn-1) + solve (total-maxn) maxn
|
|
|
|
|
|
--Problem 77
|
|
euler77 = error "Unsolved"
|
|
|
|
|
|
--Problem 78
|
|
euler78 = memo --filter (\n -> memo (n,n) `mod` divisor == 0) [1..]
|
|
where
|
|
memo = memoize step
|
|
step :: (Integer,Integer) -> Integer
|
|
step (total,maxn)
|
|
| total == 1 || maxn == 1 = 1
|
|
| total < maxn = memo (total,maxn-1)
|
|
| total == maxn = memo (total,maxn-1) + 1
|
|
| total > maxn = memo (total,maxn-1) + memo (total-maxn,maxn)
|
|
|
|
euler78' = a'
|
|
where
|
|
a' = memoize a
|
|
a :: Integer -> Integer
|
|
a 0 = 1
|
|
a 1 = 1
|
|
a 2 = 2
|
|
a n = sum [plusmin k * a' (n - gpn k) | k<-takeWhile ((n>=) . gpn) [1..]]
|
|
plusmin k = if (k-1) `mod` 4 < 2 then 1 else -1
|
|
gpn n = (((n+1)`div`2) * ((3*n+2)`div`2))`div` 2
|
|
|
|
--Problem 79
|
|
euler79 = fmap (solve . lines) $ readFile "p079_keylog.txt"
|
|
where
|
|
solve xs = (compose . sortBy (compare `on` (length.snd)) . map (liftM2 (,) (fst.head) (map snd)) . groupBy ((==)`on`fst) . sort . nub) $ xs >>= (\[a,b,c]->[(a,b),(a,c),(b,c)])
|
|
compose xs = foldl (\acc (n,_) -> n:acc) (snd (head xs)) xs
|
|
|
|
|
|
--Problem 80
|
|
euler80 = sum [(sum . take 100 . rootOf 0) n | n<-[1..100], (squareRoot n)^2 /= n]
|
|
where
|
|
rootOf p 0 = []
|
|
rootOf p c = x : rootOf (10*p+x) (100*(c-y x))
|
|
where
|
|
x = last $ takeWhile (\x->y x <= c) [0..]
|
|
y x = x*(20*p+x)
|
|
|
|
|
|
--Problem 81
|
|
euler81 = fmap (head . solve . map (\l -> read ("["++l++"]")) . lines) $ readFile "p081_matrix.txt"
|
|
where
|
|
-- solve' = memoize solve
|
|
-- solve :: [[Integer]]->Integer
|
|
-- solve [] = 0
|
|
-- solve ([]:_) = 0
|
|
-- solve mat@((cell:cs):rs) = cell + min (solve' rs) (solve' (map tail mat))
|
|
solve (last:[]) = init $ scanr (+) 0 last
|
|
solve (r:rs) = init $ scanr (\(thiscell,downcell) rightcell -> thiscell+min downcell rightcell) (last nextrow) (zip r nextrow)
|
|
where nextrow = solve rs
|
|
|
|
|
|
--Problem 82
|
|
euler82 = fmap (head . solve . map (\l -> (read::String->[Integer]) ("["++l++"]")) . lines) $ readFile "p082_matrix.txt"
|
|
where solve = const [0]
|
|
|
|
|
|
--Problem 83
|
|
euler83 = fmap (solve . readMatrix) $ readFile "p083_matrix.txt"
|
|
where
|
|
solve :: Array a Int -> Int
|
|
solve cost = solveStep zeroMatrix [(cost!(1,1),(1,1))]
|
|
where
|
|
solveStep pathCost ((c,(80,80)):_) = c
|
|
solveStep pathCost ((c,(i,j)):rest) =
|
|
zeroMatrix = listArray ((1,1),(80,80)) (repeat Nothing)
|
|
|
|
|
|
readMatrix :: Read a => [Char] -> Array (Int,Int) a
|
|
readMatrix = listArray ((1,1),(80,80)) . concatMap (\r -> read ("["++r++"]")) . lines
|
|
|
|
dijkstra :: (Functor f, Num w) => f v -> (v -> f (v,w)) -> v -> f (v,w)
|
|
dijkstra vertices edgeMap start =
|
|
step visited [] = visited
|
|
step visited (current:rest) =
|
|
|
|
--Problem 84
|
|
euler84 = do
|
|
Just [_,_,_,tripleDoubles] <- solveDTMC $ fmap2 (%4) [[3,1,0,0],[3,0,1,0],[3,0,0,1],[3,1,0,0]]
|
|
Just result <- solveDTMC $ map (elems . jailChance tripleDoubles . nextTileProbs) [GO ..]
|
|
let mostVisited = (take 3 . sortOn (negate . snd) . assocs . arrayFrom) result
|
|
return (map (fromEnum . fst) mostVisited)
|
|
where
|
|
jailChance tripleDoubles = flip (accum (+)) [(JAIL,tripleDoubles)] . fmap (*(1%1-tripleDoubles))
|
|
nextTileProbs tile = fmap (*(1%16)) $ accum (+) (arrayFrom (repeat (0%1))) $ do
|
|
d1 <- [1..4]
|
|
d2 <- [1..4]
|
|
actionsFrom (enumAdd (d1+d2) tile)
|
|
arrayFrom = listArray (minBound :: MonopolyTile, maxBound)
|
|
actionsFrom tile
|
|
| tile `elem` [CC1,CC2,CC3] = (tile,14%16) : map (\t->(t,1%16)) [GO,JAIL]
|
|
| tile `elem` [CH1,CH2,CH3] = (tile,6%16) : (nextR tile,2%16) : map (\t->(t,1%16)) [GO,JAIL,C1,E3,H2,R1, nextU tile, enumAdd (-3) tile]
|
|
| tile == G2J = [(JAIL,1%1)]
|
|
| otherwise = [(tile,1%1)]
|
|
where
|
|
nextR CH1 = R2
|
|
nextR CH2 = R3
|
|
nextR CH3 = R1
|
|
nextU CH1 = U1
|
|
nextU CH2 = U2
|
|
nextU CH3 = U1
|
|
|
|
|
|
data MonopolyTile = GO | A1 | CC1 | A2 | T1 | R1 | B1 | CH1 | B2 | B3 | JAIL | C1 | U1 | C2 | C3 | R2 | D1 | CC2 | D2 | D3 | FP | E1 | CH2 | E2 | E3 | R3 | F1 | F2 | U2 | F3 | G2J | G1 | G2 | CC3 | G3 | R4 | CH3 | H1 | T2 | H2 deriving (Enum, Ord, Ix, Bounded, Show, Eq)
|
|
|
|
arrayZipWith f a1 a2 = accum f a1 (assocs a2)
|
|
arrayApply :: Ix i => Array i e -> [(i, e->e)] -> Array i e
|
|
arrayApply = accum (flip ($))
|
|
|
|
instance Num a => Num [a] where
|
|
(+) = zipWith (+)
|
|
(*) = zipWith (*)
|
|
abs = fmap abs
|
|
signum = fmap signum
|
|
fromInteger = pure . fromInteger
|
|
negate = fmap negate
|
|
|
|
identity 0 = []
|
|
identity n = identity' `seq` (one : replicate (n-1) zero) : map (zero:) identity'
|
|
where
|
|
identity' = identity (n-1)
|
|
zero = fromInteger 0
|
|
one = fromInteger 1
|
|
|
|
solveDTMC probs = let
|
|
size = length (head probs)
|
|
ones = replicate size (fromInteger 1)
|
|
id' = identity size
|
|
eq = head id' ++ [0]
|
|
in
|
|
solveRationalLinearEqs Z3 (ones : transpose probs - id') eq
|
|
|
|
fmap2 :: (Functor f1, Functor f2) => (a->b)->f1(f2 a) -> f1(f2 b)
|
|
fmap2 = fmap . fmap
|
|
fmap3 :: (Functor f1, Functor f2, Functor f3) => (a->b)->f1(f2 (f3 a)) -> f1(f2 (f3 b))
|
|
fmap3 = fmap . fmap . fmap
|
|
fmap4 :: (Functor f1, Functor f2, Functor f3, Functor f4) => (a->b)->f1(f2 (f3(f4 a))) -> f1(f2 (f3(f4 b)))
|
|
fmap4 = fmap . fmap . fmap . fmap
|
|
|
|
enumAdd :: (Enum a, Bounded a) => Int -> a -> a
|
|
enumAdd n e = toEnum (toRange (fromEnum (minBound `asTypeOf` e)) (fromEnum (maxBound `asTypeOf` e)) (n + fromEnum e))
|
|
where toRange lower upper n = (n+upper+1) `mod` (upper+1-lower) + lower
|
|
|
|
--Problem 85
|
|
euler85 = (\(w,h,_)->w*h) $ head $ sortOn (\(_,_,x) -> abs(x-2000000)) $ do
|
|
(w,n)<-zip [1..] $ takeWhile (1414>=) triangular
|
|
let desired = 2000000`div`n
|
|
let (m1,m2) = span ((desired>).snd) $ zip [1..] triangular
|
|
(h,m)<-[last m1,head m2]
|
|
pure (w,h,n*m)
|
|
|
|
|
|
--Problem 86
|
|
euler86 = error "Unsolved"
|
|
|
|
--Problem 87
|
|
euler87 = error "Unsolved"
|
|
|
|
|
|
--Problem 88
|
|
euler88 = error "Unsolved"
|
|
|
|
|
|
--Problem 89
|
|
euler89 = fmap (sum . map getDifference . lines) $ readFile "p089_roman.txt"
|
|
where getDifference xs = length xs - length (toRomNum (fromRomNum xs))
|
|
|
|
toRomNum :: Integer -> String
|
|
toRomNum n
|
|
| n >= 1000 = 'M' : toRomNum (n-1000)
|
|
| n >= 900 = 'C' : 'M' : toRomNum (n-900)
|
|
| n >= 500 = 'D' : toRomNum (n-500)
|
|
| n >= 400 = 'C' : 'D' : toRomNum (n-400)
|
|
| n >= 100 = 'C' : toRomNum (n-100)
|
|
| n >= 90 = 'X' : 'C' : toRomNum (n-90)
|
|
| n >= 50 = 'L' : toRomNum (n-50)
|
|
| n >= 40 = 'X' : 'L' : toRomNum (n-40)
|
|
| n >= 10 = 'X' : toRomNum (n-10)
|
|
| n >= 9 = 'I' : 'X' : toRomNum (n-9)
|
|
| n >= 5 = 'V' : toRomNum (n-5)
|
|
| n >= 4 = 'I' : 'V' : toRomNum (n-4)
|
|
| otherwise = replicate (fromIntegral n) 'I'
|
|
|
|
fromRomNum :: String -> Integer
|
|
fromRomNum xs = fst $ foldl accumulate (0,1000) $ map val xs
|
|
where
|
|
accumulate (value,last) current
|
|
| last >= current = (value+current,current)
|
|
| otherwise = (value-2*last+current, current)
|
|
val 'M' = 1000
|
|
val 'D' = 500
|
|
val 'C' = 100
|
|
val 'L' = 50
|
|
val 'X' = 10
|
|
val 'V' = 5
|
|
val 'I' = 1
|
|
|
|
--Problem 90
|
|
euler90 = error "Unsolved"
|
|
|
|
|
|
--Problem 91
|
|
euler91 = error "See a091.cpp"
|
|
{-
|
|
for every primitive basis (that is, gcd(x,y) = 1)
|
|
calculate the number of lattice points in the 50x50 square and subtract the number of points on the vector itself
|
|
solved by transforming the square to the new basis and calculating the
|
|
number of lattice points using https://en.wikipedia.org/wiki/Pick's_theorem
|
|
-}
|
|
{-euler91 = fmap count basisVectors
|
|
where
|
|
basisVectors = [(x,y) | x<-[0..50], y<-[0..50], x>0||y>0, gcd (numerator x) (numerator y) == 1] :: [(Rational, Rational)]
|
|
count basis@(x,y) = (i + b - onBasis) :: Rational
|
|
where
|
|
onBasis = (toRational . floor) (50 / max x y) :: Rational
|
|
inverseBasis = inverse [[x,-y],[y,x]]
|
|
[x',y'] = (inverseBasis `mvprod` [x,y]) :: [Rational]
|
|
area' = ((50/x)^2 + (50/y)^2) :: Rational
|
|
i = (area' - b/2 + 1) ::Rational
|
|
b = 4*fromIntegral (gcd (numerator x') (numerator y')) ::Rational
|
|
-}
|
|
|
|
mvprod m v = fmap (sum . zipWith (*) v) m
|
|
|
|
inverse [[a,b],[c,d]] = fmap2 (/determinant) [[d,-b],[-c,a]]
|
|
where determinant = a*d-b*c
|
|
|
|
|
|
--Problem 92
|
|
euler92 = (\(a,b)->(S.size a,S.size b)) $ foldl solveFor (S.singleton 1,S.singleton 89) [1..10000000-1]
|
|
where
|
|
solveFor sets@(s1,s89) n
|
|
| n `S.member` s1 || n `S.member` s89 = sets
|
|
| next `S.member` s1' = (S.insert n s1',s89')
|
|
| otherwise = (s1',S.insert n s89')
|
|
where
|
|
next = sum (map (^2) (numToDig n))
|
|
(s1',s89') = solveFor (s1,s89) next
|
|
|
|
euler92' = length [()|n<-[1..10000000-1],solve n]
|
|
where
|
|
solve 1=False
|
|
solve 89=True
|
|
solve n=(solve . sum . map (^2) . numToDig) n
|
|
|
|
|
|
--Problem 94
|
|
--using Heron's formula (so sides a and b must be odd to make c and therefore a+b+c divisible by 2)
|
|
euler94 = const (error "See a094.cpp") $ sum $ do
|
|
equalSide<-[3,5..1000000000`div`3 + 1]
|
|
otherSide<-[equalSide-1,equalSide+1]
|
|
let s = equalSide + otherSide `div` 2
|
|
guard (isSquare (s*(s-otherSide)))
|
|
pure (2*s)
|
|
|
|
|
|
--Problem 97
|
|
euler97 :: Integer
|
|
euler97 = mod (28433*massivePowerMod 2 7830457 (10^10) + 1) (10^10)
|
|
|
|
massivePowerMod _ 0 _ = 1
|
|
massivePowerMod b p m
|
|
| even p = mod ((massivePowerMod b (div p 2) m)^2) m
|
|
| otherwise = mod ((massivePowerMod b (p-1) m) * b) m
|
|
|
|
|
|
--Problem 120
|
|
euler120 = [maximum [r a n | n<-[1..2*a]]| a<-[3..1000]]
|
|
where
|
|
r a n = let p b = massivePowerMod b n (a^2) in (p (a-1) + p (a+1)) `mod` (a^2)
|
|
|
|
|
|
-- Problem 144
|
|
euler144 = [v0,v1,dv,normal,dv']
|
|
where
|
|
v0@(Vec2 x0 y0) = Vec2 ((0.0+1.4)/2) ((10.1+(-9.6))/2)
|
|
dv@(Vec2 dx dy) = normalize $ Vec2 (1.4-0.0) ((-9.6)-10.1)
|
|
a = 1/5
|
|
b = 1/10
|
|
t0 = solveIntersect v0 dv
|
|
solveIntersect (Vec2 x0 y0) (Vec2 dx dy) = (-b+d)/(2*a) :: Double
|
|
where
|
|
a = 4*dx^2 + dy^2
|
|
b = 8*x0*dx + 2*y0*dy
|
|
c = y0^2 + 4*x0^2 - 100
|
|
d = sqrt(b ^2 - 4 * a * c )
|
|
v1@(Vec2 x' y') = v0 + t0 `smul` dv
|
|
getEllipseNormal a b (Vec2 x y) = normalize (Vec2 (x*b^2) (-y*a^2))
|
|
normal = getEllipseNormal a b v1
|
|
dv' = ((2 * normal `inprod` dv) `smul` normal) - dv
|
|
|
|
data Vec2 a = Vec2 a a
|
|
deriving (Show, Eq)
|
|
|
|
n `smul` v = (pure (n*)) <*> v
|
|
v1 `inprod` v2 = vsum (liftA2 (*) v1 v2)
|
|
vlen v = sqrt(v `inprod` v)
|
|
vsum (Vec2 x y) = x+y
|
|
normalize v = fmap (/vlen v) v
|
|
|
|
instance Functor Vec2 where
|
|
fmap f (Vec2 x y) = Vec2 (f x) (f y)
|
|
|
|
instance Applicative Vec2 where
|
|
pure n = Vec2 n n
|
|
(Vec2 fx fy) <*> (Vec2 x y) = Vec2 (fx x) (fy y)
|
|
|
|
instance Num a => Num (Vec2 a) where
|
|
(+) = liftA2 (+)
|
|
(*) = liftA2 (*)
|
|
abs = fmap abs
|
|
signum = fmap signum
|
|
fromInteger = pure . fromInteger
|
|
negate = fmap negate
|
|
|
|
|
|
|
|
--Problem 233
|
|
--420 = 4*3*5*7 => the multiplicities of all prime factors f = 1 (mod 4) of n must form {1,2,3},{1,45},{2,21},{3,15},{105}
|
|
circleLatticePoints n = 4+8*integerLength (filter isATriangle testCases)
|
|
where
|
|
n' = 2*n
|
|
isATriangle b = isSquare (rSquared - b^2)
|
|
rSquared = 2*n^2
|
|
testCases = [n+2,n+4..squareRoot rSquared]
|
|
|
|
circleLatticePoints' n = 4*product [2*e+1|(p,e)<-groupMultiplicities (factorize n), p `mod` 4 == 1]
|
|
|
|
s420 = [359125, 469625, 612625, 718250, 781625, 866125, 933725, 939250, 1047625, 1077375, 1119625, 1225250, 1288625, 1336625, 1366625, 1408875, 1436500, 1481125, 1542125, 1563250, 1592825, 1596725, 1732250, 1787125, 1837875, 1867450, 1878500, 1880125, 1914625, 2032225, 2049125, 2095250, 2133625, 2154750, 2203625, 2224625, 2239250, 2251925, 2302625, 2344875, 2387125, 2450500, 2513875, 2577250, 2598375, 2637125, 2673250, 2731625, 2733250, 2801175, 2817750, 2873000, 2894125, 2909125, 2911025, 2962250, 3084250, 3126500, 3142875, 3147625, 3174665, 3185650, 3193450, 3215125, 3232125, 3287375, 3316625, 3350425, 3358875, 3464500, 3504125, 3561925, 3572125, 3574250, 3648625, 3654625, 3675750, 3734900, 3757000, 3760250, 3823625, 3829250, 3865875, 3889625, 3937625, 3950375, 4009525, 4009875, 4064450, 4077125, 4082125, 4098250, 4099875, 4151485, 4161625, 4190500, 4226625, 4267250, 4288375, 4309500, 4310125, 4407250, 4443375, 4449250, 4478500, 4503850, 4544525, 4564625, 4605250, 4626375, 4689750, 4774250, 4778475, 4790175, 4837625, 4888325, 4901000, 4922125, 4949125, 4962625, 5027750, 5035825, 5091125, 5154500, 5165875, 5196750, 5274250, 5327725, 5346500, 5361375, 5382625, 5429125, 5463250, 5466500, 5471375, 5513625, 5547425, 5571625, 5602350, 5635500, 5640375]
|
|
|
|
groupMultiplicities (x:xs) = let (eqs,rest) = span (x==) xs in (x,1+integerLength eqs) : groupMultiplicities rest
|
|
groupMultiplicities [] = []
|
|
|
|
groupBy2 :: (a->a->Bool) -> [a] -> [[a]]
|
|
groupBy2 _ [] = []
|
|
groupBy2 f (x:xs) = group : groupBy2 f rest
|
|
where
|
|
(group,rest) = spanF [x] x xs
|
|
spanF acc _ [] = (acc,[])
|
|
spanF acc a (b:xs) = if f a b then spanF (acc++[b]) b xs else (acc,b:xs)
|
|
|
|
|
|
--Problem 243
|
|
euler243 = head $ dropWhile (\n -> totient n % (n-1) >= 15499%94744) $ drop 2 (inits primes) >>= (\xs -> map (product (init xs) *) [1..last xs -1])
|
|
where
|
|
incrementalBest = map (factorize . fromIntegral) $ getBest 2 2 -- is https://oeis.org/A060735
|
|
getBest best n
|
|
| cur < best = n : getBest cur (n+1)
|
|
| otherwise = getBest best (n+1)
|
|
where cur = totient n % (n-1)
|
|
|
|
|
|
--Problem 612
|
|
euler612 = friend 1 (replicate 10 0)
|
|
where
|
|
friend n friends = friendCount : friend (n+1) (zipWith (+) friends digitCount)
|
|
where
|
|
digitCount = map (flip hasDigit n) [0..9]
|
|
hasDigit _ 0 = 0
|
|
hasDigit k n
|
|
| m == k = 1
|
|
| otherwise = hasDigit k d
|
|
where (d,m) = n `divMod` 10
|
|
friendCount = sum $ zipWith (*) friends digitCount
|
|
|
|
groupEvery _ [] = []
|
|
groupEvery n xs = as : groupEvery n bs
|
|
where (as,bs) = splitAt n xs
|
|
|
|
{-
|
|
--Problem
|
|
euler = error "Unsolved"
|
|
|
|
|
|
-} |