{-# 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"


-}