https://wiki.haskell.org/api.php?action=feedcontributions&user=Alderz&feedformat=atomHaskellWiki - User contributions [en]2024-03-19T02:06:41ZUser contributionsMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=99_questions/Solutions/19&diff=3941799 questions/Solutions/192011-04-10T14:53:49Z<p>Alderz: </p>
<hr />
<div>(**) Rotate a list N places to the left.<br />
<br />
Hint: Use the predefined functions length and (++).<br />
<br />
<haskell><br />
rotate [] _ = []<br />
rotate l 0 = l<br />
rotate (x:xs) (n+1) = rotate (xs ++ [x]) n<br />
rotate l n = rotate l (length l + n)<br />
</haskell><br />
<br />
(Note that this solution uses [http://en.wikibooks.org/wiki/Haskell/Pattern_matching#n.2Bk_patterns n+k-patterns] which are [http://www.haskell.org/onlinereport/haskell2010/haskellli2.html#x3-5000 removed] from Haskell 2010.) <br />
<br />
There are two separate cases:<br />
* If n > 0, move the first element to the end of the list n times.<br />
* If n < 0, convert the problem to the equivalent problem for n > 0 by adding the list's length to n.<br />
<br />
or using cycle:<br />
<haskell><br />
rotate xs n = take len . drop (n `mod` len) . cycle $ xs<br />
where len = length xs<br />
</haskell><br />
<br />
or without mod:<br />
<haskell><br />
rotate xs n = take (length xs) $ drop (length xs + n) $ cycle xs<br />
</haskell><br />
<br />
or<br />
<br />
<haskell><br />
rotate xs n = if n >= 0 then<br />
drop n xs ++ take n xs<br />
else let l = ((length xs) + n) in<br />
drop l xs ++ take l xs<br />
</haskell><br />
<br />
or<br />
<br />
<haskell><br />
rotate xs n | n >= 0 = drop n xs ++ take n xs<br />
| n < 0 = drop len xs ++ take len xs<br />
where len = n+length xs<br />
</haskell><br />
<br />
<haskell><br />
rotate xs n = drop nn xs ++ take nn xs<br />
where <br />
nn = n `mod` length xs<br />
</haskell><br />
<br />
Using a simple splitAt trick<br />
<haskell><br />
rotate xs n<br />
| n < 0 = rotate xs (n+len)<br />
| n > len = rotate xs (n-len)<br />
| otherwise = let (f,s) = splitAt n xs in s ++ f<br />
where len = length xs<br />
</haskell><br />
<br />
Without using <hask>length</hask>:<br />
<haskell><br />
rotate xs n<br />
| n > 0 = (reverse . take n . reverse $ xs) ++ (reverse . drop n . reverse $ xs)<br />
| n <= 0 = (drop (negate n) xs) ++ (take (negate n) xs)<br />
</haskell></div>Alderzhttps://wiki.haskell.org/index.php?title=99_questions/Solutions/10&diff=3941499 questions/Solutions/102011-04-09T14:56:40Z<p>Alderz: </p>
<hr />
<div>(*) Run-length encoding of a list.<br />
<br />
Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E.<br />
<br />
<haskell><br />
encode xs = map (\x -> (length x,head x)) (group xs)<br />
</haskell><br />
<br />
which can also be expressed as a list comprehension:<br />
<br />
<haskell><br />
[(length x, head x) | x <- group xs]<br />
</haskell><br />
<br />
Or writing it [[Pointfree]] (Note that the type signature is essential here to avoid hitting the [[Monomorphism Restriction]]):<br />
<br />
<haskell><br />
encode :: Eq a => [a] -> [(Int, a)]<br />
encode = map (\x -> (length x, head x)) . group<br />
</haskell><br />
<br />
Or (ab)using the "&&&" arrow operator for tuples:<br />
<br />
<haskell><br />
encode :: Eq a => [a] -> [(Int, a)]<br />
encode xs = map (length &&& head) $ group xs<br />
</haskell><br />
<br />
Or with the help of foldr (''pack'' is the resulting function from P09):<br />
<br />
<haskell><br />
encode xs = (enc . pack) xs<br />
where enc = foldr (\x acc -> (length x, head x) : acc) []<br />
</haskell><br />
<br />
Or using takeWhile and dropWhile:<br />
<br />
<haskell><br />
encode [] = []<br />
encode (x:xs) = (length $ x : takeWhile (==x) xs, x) : encode (dropWhile (==x) xs)<br />
</haskell></div>Alderzhttps://wiki.haskell.org/index.php?title=Euler_problems/21_to_30&diff=37412Euler problems/21 to 302010-11-08T17:33:34Z<p>Alderz: Added a simpler solution to problem 29</p>
<hr />
<div>== [http://projecteuler.net/index.php?section=problems&id=21 Problem 21] ==<br />
Evaluate the sum of all amicable pairs under 10000.<br />
<br />
Solution: <br />
(http://www.research.att.com/~njas/sequences/A063990)<br />
<br />
This is a little slow because of the naive method used to compute the divisors.<br />
<haskell><br />
problem_21 = sum [m+n | m <- [2..9999], let n = divisorsSum ! m, amicable m n]<br />
where amicable m n = m < n && n < 10000 && divisorsSum ! n == m<br />
divisorsSum = array (1,9999)<br />
[(i, sum (divisors i)) | i <- [1..9999]]<br />
divisors n = [j | j <- [1..n `div` 2], n `mod` j == 0]<br />
</haskell><br />
<br />
Here is an alternative using a faster way of computing the sum of divisors.<br />
<haskell><br />
problem_21_v2 = sum [n | n <- [2..9999], let m = d n,<br />
m > 1, m < 10000, n == d m, d m /= d (d m)]<br />
d n = product [(p * product g - 1) `div` (p - 1) |<br />
g <- group $ primeFactors n, let p = head g<br />
] - n<br />
primeFactors = pf primes<br />
where<br />
pf ps@(p:ps') n<br />
| p * p > n = [n]<br />
| r == 0 = p : pf ps q<br />
| otherwise = pf ps' n<br />
where (q, r) = n `divMod` p<br />
primes = 2 : filter (null . tail . primeFactors) [3,5..]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=22 Problem 22] ==<br />
What is the total of all the name scores in the file of first names?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List<br />
import Data.Char<br />
problem_22 =<br />
do input <- readFile "names.txt"<br />
let names = sort $ read$"["++ input++"]"<br />
let scores = zipWith score names [1..]<br />
print . sum $ scores<br />
where score w i = (i *) . sum . map (\c -> ord c - ord 'A' + 1) $ w<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=23 Problem 23] ==<br />
Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.<br />
<br />
Solution:<br />
<haskell><br />
--http://www.research.att.com/~njas/sequences/A048242<br />
import Data.Array <br />
n = 28124<br />
abundant n = eulerTotient n - n > n<br />
abunds_array = listArray (1,n) $ map abundant [1..n]<br />
abunds = filter (abunds_array !) [1..n]<br />
<br />
rests x = map (x-) $ takeWhile (<= x `div` 2) abunds<br />
isSum = any (abunds_array !) . rests<br />
<br />
problem_23 = print . sum . filter (not . isSum) $ [1..n] <br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=24 Problem 24] ==<br />
What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?<br />
<br />
Solution:<br />
<haskell><br />
import Data.List <br />
<br />
fac 0 = 1<br />
fac n = n * fac (n - 1)<br />
perms [] _= []<br />
perms xs n= x : perms (delete x xs) (mod n m)<br />
where m = fac $ length xs - 1<br />
y = div n m<br />
x = xs!!y<br />
<br />
problem_24 = perms "0123456789" 999999<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=25 Problem 25] ==<br />
What is the first term in the Fibonacci sequence to contain 1000 digits?<br />
<br />
Solution:<br />
<haskell><br />
fibs = 0:1:(zipWith (+) fibs (tail fibs))<br />
t = 10^999<br />
<br />
problem_25 = length w<br />
where<br />
w = takeWhile (< t) fibs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=26 Problem 26] ==<br />
Find the value of d < 1000 for which 1/d contains the longest recurring cycle.<br />
<br />
Solution:<br />
<haskell><br />
problem_26 = fst $ maximumBy (comparing snd)<br />
[(n,recurringCycle n) | n <- [1..999]]<br />
where recurringCycle d = remainders d 10 []<br />
remainders d 0 rs = 0<br />
remainders d r rs = let r' = r `mod` d<br />
in case elemIndex r' rs of<br />
Just i -> i + 1<br />
Nothing -> remainders d (10*r') (r':rs)<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=27 Problem 27] ==<br />
Find a quadratic formula that produces the maximum number of primes for consecutive values of n.<br />
<br />
Solution:<br />
<haskell><br />
problem_27 = -(2*a-1)*(a^2-a+41)<br />
where n = 1000<br />
m = head $ filter (\x->x^2-x+41>n) [1..]<br />
a = m-1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=28 Problem 28] ==<br />
What is the sum of both diagonals in a 1001 by 1001 spiral?<br />
<br />
Solution:<br />
<haskell><br />
problem_28 = sum (map (\n -> 4*(n-2)^2+10*(n-1)) [3,5..1001]) + 1<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=29 Problem 29] ==<br />
How many distinct terms are in the sequence generated by a<sup>b</sup> for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?<br />
<br />
Solution:<br />
<haskell><br />
import Control.Monad<br />
problem_29 = length . group . sort $ liftM2 (^) [2..100] [2..100] <br />
</haskell><br />
<br />
We can also solve it in a more naive way, without using Monads, like this:<br />
<haskell><br />
import List<br />
problem_29 = length $ nub pr29_help<br />
where pr29_help = [z | y <- [2..100],<br />
z <- lift y]<br />
lift y = map (\x -> x^y) [2..100]<br />
</haskell><br />
<br />
Simpler:<br />
<br />
<haskell><br />
import List<br />
problem_29 = length $ nub [x^y | x <- [2..100], y <- [2..100]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=problems&id=30 Problem 30] ==<br />
Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.<br />
<br />
Solution:<br />
<haskell><br />
import Data.Char (digitToInt)<br />
<br />
limit :: Integer<br />
limit = snd $ head $ dropWhile (\(a,b) -> a > b) $ zip (map (9^5*) [1..]) (map (10^) [1..])<br />
<br />
fifth :: Integer -> Integer<br />
fifth = sum . map ((^5) . toInteger . digitToInt) . show<br />
<br />
problem_30 :: Integer<br />
problem_30 = sum $ filter (\n -> n == fifth n) [2..limit]<br />
</haskell></div>Alderz