Related
consider a function, which rates the level of 'visual similarity' between two numbers: 666666 and 666166 would be very similar, unlike 666666 and 111111
type N = Int
type Rate = Int
similar :: N -> N -> Rate
similar a b = length . filter id . zipWith (==) a' $ b'
where a' = show a
b' = show b
similar 666666 666166
--> 5
-- high rate : very similar
similar 666666 111111
--> 0
-- low rate : not similar
There will be more sophisticated implementations for this, however this serves the purpose.
The intention is to find a function that sorts a given list of N's, so that each item is the most similar one to it's preceding item. Since the first item does not have a predecessor, there must be a given first N.
similarSort :: N -> [N] -> [N]
Let's look at some sample data: They don't need to have the same arity but it makes it easier to reason about it.
sample :: [N]
sample = [2234, 8881, 1222, 8888, 8822, 2221, 5428]
one could be tempted to implement the function like so:
similarSortWrong x xs = reverse . sortWith (similar x) $ xs
but this would lead to a wrong result:
similarSortWrong 2222 sample
--> [2221,1222,8822,2234,5428,8888,8881]
In the beginning it looks correct, but it's obvious that 8822 should rather be followed by 8881, since it's more similar that 2234.
So here's the implementation I came up with:
similarSort _ [] = []
similarSort x xs = x : similarSort a as
where (a:as) = reverse . sortWith (similar x) $ xs
similarSort 2222 sample
--> [2222,2221,2234,1222,8822,8888,8881]
It seems to work. but it also seems to do lot more more work than necessary. Every step the whole rest is sorted again, just to pick up the first element. Usually lazyness should allow this, but reverse might break this again. I'd be keen to hear, if someone know if there's a common abstraction for this problem.
It's relatively straightforward to implement the greedy algorithm you ask for. Let's start with some boilerplate; we'll use the these package for a zip-like that hands us the "unused" tail ends of zipped-together lists:
import Data.Align
import Data.These
sampleStart = "2222"
sampleNeighbors = ["2234", "8881", "1222", "8888", "8822", "2221", "5428"]
Instead of using numbers, I'll use lists of digits -- just so we don't have to litter the code with conversions between the form that's convenient for the user and the form that's convenient for the algorithm. You've been a bit fuzzy about how to rate the similarity of two digit strings, so let's make it as concrete as possible: any digits that differ cost 1, and if the digit strings vary in length we have to pay 1 for each extension to the right. Thus:
distance :: Eq a => [a] -> [a] -> Int
distance l r = sum $ alignWith elemDistance l r where
elemDistance (These l r) | l == r = 0
elemDistance _ = 1
A handy helper function will pick the smallest element of some list (by a user-specified measure) and return the rest of the list in some implementation-defined order.
minRestOn :: Ord b => (a -> b) -> [a] -> Maybe (a, [a])
minRestOn f [] = Nothing
minRestOn f (x:xs) = Just (go x [] xs) where
go min rest [] = (min, rest)
go min rest (x:xs) = if f x < f min
then go x (min:rest) xs
else go min (x:rest) xs
Now the greedy algorithm almost writes itself:
greedy :: Eq a => [a] -> [[a]] -> [[a]]
greedy here neighbors = here : case minRestOn (distance here) neighbors of
Nothing -> []
Just (min, rest) -> greedy min rest
We can try it out on your sample:
> greedy sampleStart sampleNeighbors
["2222","1222","2221","2234","5428","8888","8881","8822"]
Just eyeballing it, that seems to do okay. However, as with many greedy algorithms, this one only minimizes the local cost of each edge in the path. If you want to minimize the total cost of the path found, you need to use another algorithm. For example, we can pull in the astar package. For simplicity, I'm going to do everything in a very inefficient way, but it's not too hard to do it "right". We'll need a fair chunk more imports:
import Data.Graph.AStar
import Data.Hashable
import Data.List
import Data.Maybe
import qualified Data.HashSet as HS
Unlike before, where we only wanted the nearest neighbor, we'll now want all the neighbors. (Actually, we could probably implement the previous use of minRestOn using the following function and minimumOn or something. Give it a try if you're interested!)
neighbors :: (a, [a]) -> [(a, [a])]
neighbors (_, xs) = go [] xs where
go ls [] = []
go ls (r:rs) = (r, ls ++ rs) : go (r:ls) rs
We can now call the aStar search method with appropriate parameters. We'll use ([a], [[a]]) -- representing the current list of digits and the remaining lists that we can choose from -- as our node type. The arguments to aStar are then, in order: the function for finding neighboring nodes, the function for computing distance between neighboring nodes, the heuristic for how far we have left to go (we'll just say 1 for each unique element in the list), whether we've reached a goal node, and the initial node to start the search from. We'll call fromJust, but it should be okay: all nodes have at least one path to a goal node, just by choosing the remaining lists of digits in order.
optimal :: (Eq a, Ord a, Hashable a) => [a] -> [[a]] -> [[a]]
optimal here elsewhere = (here:) . map fst . fromJust $ aStar
(HS.fromList . neighbors)
(\(x, _) (y, _) -> distance x y)
(\(x, xs) -> HS.size (HS.fromList (x:xs)) - 1)
(\(_, xs) -> null xs)
(here, elsewhere)
Let's see it run in ghci:
> optimal sampleStart sampleNeighbors
["2222","1222","8822","8881","8888","5428","2221","2234"]
We can see that it's done better this time by adding a pathLength function that computes all the distances between neighbors in a result.
pathLength :: Eq a => [[a]] -> Int
pathLength xs = sum [distance x y | x:y:_ <- tails xs]
In ghci:
> pathLength (greedy sampleStart sampleNeighbors)
15
> pathLength (optimal sampleStart sampleNeighbors)
14
In this particular example, I think the greedy algorithm could have found the optimal path if it had made the "right" choices whenever there were ties for minimal next step; but I expect it is not too hard to cook up an example where the greedy algorithm is forced into bad early choices.
I have two programs to find prime numbers (just an exercise, I'm learning Haskell). "primes" is about 10X faster than "primes2", once compiled with ghc (with flag -O). However, in "primes2", I thought it would consider only prime numbers for the divisor test, which should be faster than considering odd numbers in "isPrime", right? What am I missing?
isqrt :: Integral a => a -> a
isqrt = floor . sqrt . fromIntegral
isPrime :: Integral a => a -> Bool
isPrime n = length [i | i <- [1,3..(isqrt n)], mod n i == 0] == 1
primes :: Integral a => a -> [a]
primes n = [2,3,5,7,11,13] ++ (filter (isPrime) [15,17..n])
primes2 :: Integral a => a -> [a]
primes2 n = 2 : [i | i <- [3,5..n], all ((/= 0) . mod i) (primes2 (isqrt i))]
I think what's happening here is that isPrime is a simple loop, whereas primes2 is calling itself recursively — and its recursion pattern looks exponential to me.
Searching through my old source code, I found this code:
primes :: [Integer]
primes = 2 : filter isPrime [3,5..]
isPrime :: Integer -> Bool
isPrime x = all (\n -> x `mod` n /= 0) $
takeWhile (\n -> n * n <= x) primes
This tests each possible prime x only against the primes below sqrt(x), using the already generated list of primes. So it probably doesn't test any given prime more than once.
Memoization in Haskell:
Memoization in Haskell is generally explicit, not implicit. The compiler won't "do the right thing" but it will only do what you tell it to. When you call primes2,
*Main> primes2 5
[2,3,5]
*Main> primes2 10
[2,3,5,7]
Each time you call the function it calculates all of its results all over again. It has to. Why? Because 1) You didn't make it save its results, and 2) the answer is different each time you call it.
In the sample code I gave above, primes is a constant (i.e. it has arity zero) so there's only one copy of it in memory, and its parts only get evaluated once.
If you want memoization, you need to have a value with arity zero somewhere in your code.
I like what Dietrich has done with the memoization, but I think theres a data structure issue here too. Lists are just not the ideal data structure for this. They are, by necessity, lisp style cons cells with no random access. Set seems better suited to me.
import qualified Data.Set as S
sieve :: (Integral a) => a -> S.Set a
sieve top = let l = S.fromList (2:3:([5,11..top]++[7,13..top]))
iter s c
| cur > (div (S.findMax s) 2) = s
| otherwise = iter (s S.\\ (S.fromList [2*cur,3*cur..top])) (S.deleteMin c)
where cur = S.findMin c
in iter l (l S.\\ (S.fromList [2,3]))
I know its kind of ugly, and not too declarative, but it runs rather quickly. Im looking into a way to make this nicer looking using Set.fold and Set.union over the composites. Any other ideas for neatening this up would be appreciated.
PS - see how (2:3:([5,11..top]++[7,13..top])) avoids unnecessary multiples of 3 such as the 15 in your primes. Unfortunately, this ruins your ordering if you work with lists and you sign up for a sorting, but for sets thats not an issue.
Given this definition and a test matrix:
data (Eq a, Show a) => QT a = C a | Q (QT a) (QT a) (QT a) (QT a)
deriving (Eq, Show)
data (Eq a, Num a, Show a) => Mat a = Mat {nexp :: Int, mat :: QT a}
deriving (Eq, Show)
-- test matrix, exponent is 2, that is matrix is 4 x 4
test = Mat 2 (Q (C 5) (C 6) (Q (C 1) (C 0) (C 2) (C 1)) (C 3))
| | |
| 5 | 6 |
| | |
-------------
|1 | 0| |
|--|--| 3 |
|2 | 1| |
I'm trying to write a function that will output a list of columns sum, like: [13, 11, 18, 18]. The base idea is to sum each sub-quadtree:
If quadtree is (C c), then output the a repeating 2 ^ (n - 1) times the value c * 2 ^ (n - 1). Example: first quadtree is (C 5) so we repeat 5 * 2^(2 - 1) = 10, 2 ^ (n - 1) = 2 times, obtaining [5, 5].
Otherwise, given (Q a b c d), we zipWith the colsum of a and c (and b and d).
Of course this is not working (not even compiling) because after some recursion we have:
zipWith (+) [[10, 10], [12, 12]] [zipWith (+) [[1], [0]] [[2], [1]], [6, 6]]
Because I'm beginning with Haskell I feel I'm missing something, need some advice on function I can use. Not working colsum definition is:
colsum :: (Eq a, Show a, Num a) => Mat a -> [a]
colsum m = csum (mat m)
where
n = nexp m
csum (C c) = take (2 ^ n) $ repeat (c * 2 ^ n)
csum (Q a b c d) = zipWith (+) [colsum $ submat a, colsum $ submat b]
[colsum $ submat c, colsum $ submat d]
submat q = Mat (n - 1) q
Any ideas would be great and much appreciated...
Probably "someone" should have explained to who is worried about the depth of the QuadTree that the nexp field in the Matrix type is exactly meant to be used to determine the real size of a (C _).
About the solution presented in the first answer, ok it works. However it is quite useless to construct and deconstruct Mat, this could be easily avoided. Moreover the call to fromIntegral to "bypass" the type checking problem coming from the use of replicate can be solved without forcing to first going to Integral and then coming back, like
let m = 2^n; k=2^n in replicate k (m*x)
Anyway, the challenge here is to avoid the quadratical behavior due to the ++, that is what I would expect.
Cheers,
Let's consider your colsum:
colsum :: (Eq a, Show a, Num a) => Mat a -> [a]
colsum m = csum (mat m)
where
n = nexp m
csum (C c) = take (2 ^ n) $ repeat (c * 2 ^ n)
csum (Q a b c d) = zipWith (+) [colsum $ submat a, colsum $ submat b]
[colsum $ submat c, colsum $ submat d]
submat q = Mat (n - 1) q
It is almost correct, except the line where you define csum (Q a b c d) = ....
Let think about types. colsum returns a list of numbers. ZipWith (+) sums two lists elementwise:
ghci> :t zipWith (+)
zipWith (+) :: Num a => [a] -> [a] -> [a]
This means that you need to pass two lists of numbers to zipWith (+). Instead you create two lists of lists of numbers, like this:
[colsum $ submat a, colsum $ submat b]
The type of this expression is [[a]], not [a] as you need.
What you need to do is to concatenate two lists of numbers to obtain a single list of numbers (and this is, probably, what you intended to do):
((colsum $ submat a) ++ (colsum $ submat b))
Similarly, you concatenate lists of partial sums for c and d then your function should start working.
Let's go more general, and come back to the goal at hand.
Consider how we would project a quadtree into a 2n×2n matrix. We may not need to create this projection in order to calculate its column sums, but it's a useful notion to work with.
If our quadtree is a single cell, then we'd just fill the entire matrix with that cell's value.
Otherwise, if n ≥ 1, we can divide the matrix up into quadrants, and let the subquadtrees each fill one quadrant (that is, have each subquadtree fill a 2n-1×2n-1 matrix).
Note that there's still a case remaining. What if n = 0 (that is, we have a 1×1 matrix) and the quadtree isn't a single cell? We need to specify some behaviour for this case - maybe we just let one of the subquadtrees populate the entire matrix, or we fill the matrix with some default value.
Now consider the column sums of such a projection.
If our quadtree was a single cell, then the 2n column sums will all be 2n
times the value stored in that cell.
(hint: look at replicate and genericReplicate on hoogle).
Otherwise, if n ≥ 1, then each column overlaps two distinct quadrants.
Half of our columns will be completely determined by the western quadrants,
and the other half by the eastern quadrants, The sum for a particular column
can be defined as the sum of the contribution to that column
from its northern half (that is, the column sum for that column in the northern quadrant),
and its southern half (likewise).
(hint: We'll need to append the western column sums to the eastern column sums
to get all the column sums, and combien the northern and southern demi-column sums
to get the actual sums for each column).
Again, we have a third case, and the column sum here depends on how
you project four subquadtrees onto a 1×1 matrix. Fortunately, a 1×1 matrix means
only a single column sum!
Now, we only care about a particular projection - the projection onto a matrix of size 2dd×2d
where d is the depth of our quadtree. So you'll need to figure the depth too. Since a
single cell fits "naturally" into a matrix of size 1×1, that implies that it has a
depth of 0. A quadbranch must have depth great enough to allow each of its subquads to fit
into their quadrant of the matrix.
I've spent almost all competition time(3 h) for solving this problem. In vain :( Maybe you could help me to find the solution.
A group of Facebook employees just had a very successful product launch. To celebrate, they have decided to go wine tasting. At the vineyard, they decide to play a game. One person is given some glasses of wine, each containing a different wine. Every glass of wine is labelled to indicate the kind of wine the glass contains. After tasting each of the wines, the labelled glasses are removed and the same person is given glasses containing the same wines, but unlabelled. The person then needs to determine which of the unlabelled glasses contains which wine. Sadly, nobody in the group can tell wines apart, so they just guess randomly. They will always guess a different type of wine for each glass. If they get enough right, they win the game. You must find the number of ways that the person can win, modulo 1051962371.
Input
The first line of the input is the number of test cases, N. The next N lines each contain a test case, which consists of two integers, G and C, separated by a single space. G is the total number of glasses of wine and C is the minimum number that the person must correctly identify to win.
Constraints
N = 20
1 ≤ G ≤ 100
1 ≤ C ≤ G
Output
For each test case, output a line containing a single integer, the number of ways that the person can win the game modulo 1051962371.
Example input
5
1 1
4 2
5 5
13 10
14 1
Example output
1
7
1
651
405146859
Here's the one that doesn't need the prior knowledge of Rencontres numbers. (Well, it's basically the proof a formula from the wiki but I thought I'd share it anyway.)
First find f(n): the number of permutations of n elements that don't have a fixed point. It's simple by inclusion-exclusion formula: the number of permutations that fix k given points is (n-k)!, and these k points can be chosen in C(n,k) ways. So, f(n) = n! - C(n,1)(n-1)! + C(n,2)(n-2)! - C(n,3)(n-3)! + ...
Now find the number of permutations that have exactly k fixed points. These points can be chosen in C(n,k) ways and the rest n-k points can be rearranged in f(n-k) ways. So, it's C(n,k)f(n-k).
Finally, the answer to the problem is the sum of C(g,k)f(g-k) over k = c, c+1, ..., g.
My solution involved the use of Rencontres Numbers.
A Rencontres Number D(n,k) is the number of permutations of n elements where exactly k elements are in their original places. The problem asks for at least k elemenets, so I just took the sum over k, k+1,...,n.
Here's my Python submission (after cleaning up):
from sys import stdin, stderr, setrecursionlimit as recdepth
from math import factorial as fact
recdepth(100000)
MOD=1051962371
cache=[[-1 for i in xrange(101)] for j in xrange(101)]
def ncr(n,k):
return fact(n)/fact(k)/fact(n-k)
def D(n,k):
if cache[n][k]==-1:
if k==0:
if n==0:
cache[n][k]=1
elif n==1:
cache[n][k]=0
else:
cache[n][k]= (n-1)*(D(n-1,0)+D(n-2,0))
else:
cache[n][k]=ncr(n,k)*D(n-k,0)
return cache[n][k]
return cache[n][k]
def answer(total, match):
return sum(D(total,i) for i in xrange(match,total+1))%MOD
if __name__=='__main__':
cases=int(stdin.readline())
for case in xrange(cases):
stderr.write("case %d:\n"%case)
G,C=map(int,stdin.readline().split())
print answer(G,C)
from sys import stdin, stderr, setrecursionlimit as recdepth
from math import factorial as fact
recdepth(100000)
MOD=1051962371
cache=[[-1 for i in xrange(101)] for j in xrange(101)]
def ncr(n,k):
return fact(n)/fact(k)/fact(n-k)
def D(n,k):
if cache[n][k]==-1:
if k==0:
if n==0:
cache[n][k]=1
elif n==1:
cache[n][k]=0
else:
cache[n][k]= (n-1)*(D(n-1,0)+D(n-2,0))
else:
cache[n][k]=ncr(n,k)*D(n-k,0)
return cache[n][k]
return cache[n][k]
def answer(total, match):
return sum(D(total,i) for i in xrange(match,total+1))%MOD
if __name__=='__main__':
cases=int(stdin.readline())
for case in xrange(cases):
stderr.write("case %d:\n"%case)
G,C=map(int,stdin.readline().split())
print answer(G,C)
Like everyone else, I computed the function that I now know is Rencontres Numbers, but I derived the recursive equation myself in the contest. Without loss of generality, we simply assume the correct labels of wines are 1, 2, .., g, i.e., not permuted at all.
Let's denote the function as f(g,c). Given g glasses, we look at the first glass, and we could either label it right, or label it wrong.
If we label it right, we reduce the problem to getting c-1 right out of g-1 glasses, i.e., f(g-1, c-1).
If we label it wrong, we have g-1 choices for the first glass. For the remaining g-1 glasses, we must get c glasses correct, but this subproblem is different from the f we're computing, because out of the g-1 glasses, there's already a mismatching glass. To be more precise, for the first glass, our answer is j instead of the correct label 1. Let's assume there's another function h that computes it for us.
So we have f(g,c) = f(g-1,c-1) + (g-1) * h(g-1, c).
Now to compute h(g,c), we need to consider two cases at the jth glass.
If we label it 1, we reduce the problem to f(g-1,c).
If we label it k, we have g-1 choices, and the problem is reduced to h(g-1,c).
So we have h(g,c) = f(g-1,c) + (g-1) * h(g-1,c).
Here's the complete program in Haskell, with memoization and some debugging support.
import Control.Monad
import Data.MemoTrie
--import Debug.Trace
trace = flip const
add a b = mod (a+b) 1051962371
mul a b = mod (a*b) 1051962371
main = do
(_:input) <- liftM words getContents
let map' f [] = []
map' f (a:c:xs) = f (read a) (read c) : map' f xs
mapM print $ map' ans input
ans :: Integer -> Integer -> Integer
ans g c = foldr add 0 $ map (f g) [c..g]
memoF = memo2 f
memoH = memo2 h
-- Exactly c correct in g
f :: Integer -> Integer -> Integer
f g c = trace ("f " ++ show (g,c) ++ " = " ++ show x) x
where x = if c < 0 || g < c then 0
else if g == c then 1
else add (memoF (g-1) (c-1)) (mul (g-1) (memoH (g-1) c))
-- There's one mismatching position in g positions
h :: Integer -> Integer -> Integer
h g c = trace ("h " ++ show (g,c) ++ " = " ++ show x) x
where x = if c < 0 || g < c then 0
else add (memoF (g-1) c) (mul (g-1) (memoH (g-1) c))
I'm a beginner to functional languages, and I'm trying to get the whole thing down in Haskell. Here's a quick-and-dirty function that finds all the factors of a number:
factors :: (Integral a) => a -> [a]
factors x = filter (\z -> x `mod` z == 0) [2..x `div` 2]
Works fine, but I found it to be unbearably slow for large numbers. So I made myself a better one:
factorcalc :: (Integral a) => a -> a -> [a] -> [a]
factorcalc x y z
| y `elem` z = sort z
| x `mod` y == 0 = factorcalc x (y+1) (z ++ [y] ++ [(x `div` y)])
| otherwise = factorcalc x (y+1) z
But here's my problem: Even though the code works, and can cut literally hours off the execution time of my programs, it's hideous!
It reeks of ugly imperative thinking: It constantly updates a counter and a data structure in a loop until it finishes. Since you can't change state in purely functional programming, I cheated by holding the data in the parameters, which the function simply passes to itself over and over again.
I may be wrong, but there simply must be a better way of doing the same thing...
Note that the original question asked for all the factors, not for only the prime factors. There being many fewer prime factors, they can probably be found more quickly. Perhaps that's what the OQ wanted. Perhaps not. But let's solve the original problem and put the "fun" back in "functional"!
Some observations:
The two functions don't produce the same output---if x is a perfect square, the second function includes the square root twice.
The first function enumerates checks a number of potential factors proportional to the size of x; the second function checks only proportional to the square root of x, then stops (with the bug noted above).
The first function (factors) allocates a list of all integers from 2 to n div 2, where the second function never allocates a list but instead visits fewer integers one at a time in a parameter. I ran the optimizer with -O and looked at the output with -ddump-simpl, and GHC just isn't smart enough to optimize away those allocations.
factorcalc is tail-recursive, which means it compiles into a tight machine-code loop; filter is not and does not.
Some experiments show that the square root is the killer:
Here's a sample function that produces the factors of x from z down to 2:
factors_from x 1 = []
factors_from x z
| x `mod` z == 0 = z : factors_from x (z-1)
| otherwise = factors_from x (z-1)
factors'' x = factors_from x (x `div` 2)
It's a bit faster because it doesn't allocate, but it's still not tail-recursive.
Here's a tail-recursive version that is more faithful to the original:
factors_from' x 1 l = l
factors_from' x z l
| x `mod` z == 0 = factors_from' x (z-1) (z:l)
| otherwise = factors_from' x (z-1) l
factors''' x = factors_from x (x `div` 2)
This is still slower than factorcalc because it enumerates all the integers from 2 to x div 2, whereas factorcalc stops at the square root.
Armed with this knowledge, we can now create a more functional version of factorcalc which replicates both its speed and its bug:
factors'''' x = sort $ uncurry (++) $ unzip $ takeWhile (uncurry (<=)) $
[ (z, x `div` z) | z <- [2..x], x `mod` z == 0 ]
I didn't time it exactly, but given 100 million as an input, both it and factorcalc terminate instantaneously, where the others all take a number of seconds.
How and why the function works is left as an exercise for the reader :-)
ADDENDUM: OK, to mitigate the eyeball bleeding, here's a slightly saner version (and without the bug):
saneFactors x = sort $ concat $ takeWhile small $
[ pair z | z <- [2..], x `mod` z == 0 ]
where pair z = if z * z == x then [z] else [z, x `div` z]
small [z, z'] = z < z'
small [z] = True
Okay, take a deep breath. It'll be all right.
First of all, why is your first attempt slow? How is it spending its time?
Can you think of a recursive definition for the prime factorization that doesn't have that property?
(Hint.)
Firstly, although factorcalc is "ugly", you could add a wrapper function factors' x = factorscalc x 2 [], add a comment, and move on.
If you want to make a 'beautiful' factors fast, you need to find out why it is slow. Looking at your two functions, factors walks the list about n/2 elements long, but factorcalc stops after around sqrt n iterations.
Here is another factors that also stops after about sqrt n iterations, but uses a fold instead of explicit iteration. It also breaks the problem into three parts: finding the factors (factor); stopping at the square root of x (small) and then computing pairs of factors (factorize):
factors' :: (Integral a) => a -> [a]
factors' x = sort (foldl factorize [] (takeWhile small (filter factor [2..])))
where
factor z = x `mod` z == 0
small z = z <= (x `div` z)
factorize acc z = z : (if z == y then acc else y : acc)
where y = x `div` z
This is marginally faster than factorscalc on my machine. You can fuse factor and factorize and it is about twice as fast as factorscalc.
The Profiling and Optimization chapter of Real World Haskell is a good guide to the GHC suite's performance tools for tackling tougher performance problems.
By the way, I have a minor style nitpick with factorscalc: it is much more efficient to prepend single elements to the front of a list O(1) than it is to append to the end of a list of length n O(n). The lists of factors are typically small, so it is not such a big deal, but factorcalc should probably be something like:
factorcalc :: (Integral a) => a -> a -> [a] -> [a]
factorcalc x y z
| y `elem` z = sort z
| x `mod` y == 0 = factorcalc x (y+1) (y : (x `div` y) : z)
| otherwise = factorcalc x (y+1) z
Since you can't change state in purely
functional programming, I cheated by
holding the data in the parameters,
which the function simply passes to
itself over and over again.
Actually, this is not cheating; this is a—no, make that the—standard technique! That sort of parameter is usually known as an "accumulator," and it's generally hidden within a helper function that does the actual recursion after being set up by the function you're calling.
A common case is when you're doing list operations that depend on the previous data in the list. The two problems you need to solve are, where do you get the data about previous iterations, and how do you deal with the fact that your "working area of interest" for any particular iteration is actually at the tail of the result list you're building. For both of these, the accumulator comes to the rescue. For example, to generate a list where each element is the sum of all of the elements of the input list up to that point:
sums :: Num a => [a] -> [a]
sums inp = helper inp []
where
helper [] acc = reverse acc
helper (x:xs) [] = helper xs [x]
helper (x:xs) acc#(h:_) = helper xs (x+h : acc)
Note that we flip the direction of the accumulator, so we can operate on the head of that, which is much more efficient (as Dominic mentions), and then we just reverse the final output.
By the way, I found reading The Little Schemer to be a useful introduction and offer good practice in thinking recursively.
This seemed like an interesting problem, and I hadn't coded any real Haskell in a while, so I gave it a crack. I've run both it and Norman's factors'''' against the same values, and it feels like mine's faster, though they're both so close that it's hard to tell.
factors :: Int -> [Int]
factors n = firstFactors ++ reverse [ n `div` i | i <- firstFactors ]
where
firstFactors = filter (\i -> n `mod` i == 0) (takeWhile ( \i -> i * i <= n ) [2..n])
Factors can be paired up into those that are greater than sqrt n, and those that are less than or equal to (for simplicity's sake, the exact square root, if n is a perfect square, falls into this category. So if we just take the ones that are less than or equal to, we can calculate the others later by doing div n i. They'll be in reverse order, so we can either reverse firstFactors first or reverse the result later. It doesn't really matter.
This is my "functional" approach to the problem. ("Functional" in quotes, because I'd approach this problem the same way even in non-functional languages, but maybe that's because I've been tainted by Haskell.)
{-# LANGUAGE PatternGuards #-}
factors :: (Integral a) => a -> [a]
factors = multiplyFactors . primeFactors primes 0 [] . abs where
multiplyFactors [] = [1]
multiplyFactors ((p, n) : factors) =
[ pn * x
| pn <- take (succ n) $ iterate (* p) 1
, x <- multiplyFactors factors ]
primeFactors _ _ _ 0 = error "Can't factor 0"
primeFactors (p:primes) n list x
| (x', 0) <- x `divMod` p
= primeFactors (p:primes) (succ n) list x'
primeFactors _ 0 list 1 = list
primeFactors (_:primes) 0 list x = primeFactors primes 0 list x
primeFactors (p:primes) n list x
= primeFactors primes 0 ((p, n) : list) x
primes = sieve [2..]
sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p /= 0]
primes is the naive Sieve of Eratothenes. There's better, but this is the shortest method.
sieve [2..]
=> 2 : sieve [x | x <- [3..], x `mod` 2 /= 0]
=> 2 : 3 : sieve [x | x <- [4..], x `mod` 2 /= 0, x `mod` 3 /= 0]
=> 2 : 3 : sieve [x | x <- [5..], x `mod` 2 /= 0, x `mod` 3 /= 0]
=> 2 : 3 : 5 : ...
primeFactors is the simple repeated trial-division algorithm: it walks through the list of primes, and tries dividing the given number by each, recording the factors as it goes.
primeFactors (2:_) 0 [] 50
=> primeFactors (2:_) 1 [] 25
=> primeFactors (3:_) 0 [(2, 1)] 25
=> primeFactors (5:_) 0 [(2, 1)] 25
=> primeFactors (5:_) 1 [(2, 1)] 5
=> primeFactors (5:_) 2 [(2, 1)] 1
=> primeFactors _ 0 [(5, 2), (2, 1)] 1
=> [(5, 2), (2, 1)]
multiplyPrimes takes a list of primes and powers, and explodes it back out to a full list of factors.
multiplyPrimes [(5, 2), (2, 1)]
=> [ pn * x
| pn <- take (succ 2) $ iterate (* 5) 1
, x <- multiplyPrimes [(2, 1)] ]
=> [ pn * x | pn <- [1, 5, 25], x <- [1, 2] ]
=> [1, 2, 5, 10, 25, 50]
factors just strings these two functions together, along with an abs to prevent infinite recursion in case the input is negative.
I don't know much about Haskell, but somehow I think this link is appropriate:
http://www.willamette.edu/~fruehr/haskell/evolution.html
Edit: I'm not entirely sure why people are so aggressive about the downvoting on this. The original poster's real problem was that the code was ugly; while it's funny, the point of the linked article is, to some extent, that advanced Haskell code is, in fact, ugly; the more you learn, the uglier your code gets, to some extent. The point of this answer was to point out to the OP that apparently, the ugliness of the code that he was lamenting is not uncommon.