I am having a little trouble with Haskell. I am doing an implemenation of Kaprekar's routine (http://en.wikipedia.org/wiki/6174_%28number%29) and I have done everything but being able to successfully print the list of numbers that the routine produces. So, if I put in the number 5432, I would like the output to be [5432, 3087, 8352, 6174].
Here is the code I have:
kaprekarList :: Integer -> [Integer]
kaprekarList x = n
where p = kaprekar x
n =
if p == 6174
then [p]
else
-- add to list of kaprekar numbers
kaprekarList p
Any help is greatly appreciated!
While not the most beautiful routine (and having a small problem see below) yours seems to work (if the kaprekar function does), so I guess your problem is really there.
Here is a simple implementation together with your function:
kaprekar :: Integer -> Integer
kaprekar n = big - small
where big = read digits
small = read (reverse digits)
digits = take 4 $ (reverse . sort . show $ n) ++ "0000"
kaprekarList :: Integer -> [Integer]
kaprekarList x = n
where p = kaprekar x
n =
if p == 6174
then [x, p]
else
-- add to list of kaprekar numbers
x : kaprekarList p
Please mind the small changes so that you can see the complete derivation instead of just the last element (that is always fixed).
alternative versions
kaprekarList :: Integer -> [Integer]
kaprekarList x = x : if x == 6174 then [] else kaprekarList (kaprekar x)
this one seems to be a bit more idiomatic but will not include the last 6174
kaprekarList :: Integer -> [Integer]
kaprekarList x = takeWhile (/= 6174) $ iterate kaprekar x
this one will (but is ugly - maybe someone knows something like takeUntil in the prelude?):
kaprekarList :: Integer -> [Integer]
kaprekarList x = (takeWhile (/= 6174) $ iterate kaprekar x) ++ [6174]
Here an implementation:
import Data.List (sort)
-- Convert a number to a list of digits
digits :: Integral x => x -> [x]
digits 0 = []
digits x = digits (x `div` 10) ++ [x `mod` 10]
-- Convert a list of digits to a number
undigits :: Integral x => [x] -> x
undigits = foldl (\ a b -> a * 10 + b) 0
-- Compute the next Kaprekar number
nextKapNumber :: Integral x => x -> x
nextKapNumber x = b - a
where n = sort . digits $ x
a = undigits n
b = undigits . reverse $ n
-- Compute the Kaprekar list for a number
kapList :: Integral x => x -> [x]
kapList x = genList [x]
where genList as#(6174:_) = reverse as
genList as#(a:_) = genList $ nextKapNumber a : as
main :: IO ()
main = putStrLn . show $ kapList 5432
Related
I'm a newbie in haskell!
I need to write a function that process an ID number. I need to check the first digit of the integer number. If the number is 1 or 3 then the client is male, if the number is 2 or 4 then female. I think I need a helper function which splitting the long integer number to an integer list.
The fuction called szemelyinem, it has one parameter/argument which is a 11 long integer number.
This is the spliting function:
split :: Integral x => x -> [x]
split 0 = []
split x = split (x `div` 10) ++ [x `mod` 10]
In my head the notion is Split the long number then load it to the function, then check the first element in the list and return with one string. But I don't know how to start this :/
I have an example like this:
szemelyinem 40504291247
Result: "female"
This is the first step.
split :: Integral x => x -> [x]
split 0 = []
split x = split (x `div` 10) ++ [x `mod` 10]
This is the second.
rev:: [Integer] -> [Integer]
rev [] = []
rev (h:t) = rev t ++ [h]
This is the third step
nemdel :: [Integer] -> [Integer]
nemdel [] = []
nemdel (h:t) = drop 10 (h:t)
This is the fourth.
listtonumb:: [Integer] -> Integer
listtonumb = foldl addDigit 0
where addDigit num d = 10*num + d
And the last one.
szemelyinem :: Integer -> [Char]
szemelyinem szam =
if listtonumb(nemdel(rev(split szam))) == 1 || listtonumb(nemdel(rev(split szam))) == 3
then "male"
else if listtonumb(nemdel(rev(split szam))) == 2 || listtonumb(nemdel(rev(split szam))) == 4
then "Female"
else error "Bad ID"
I'm sure about that is a complex way to do this shit.
I am learning Haskell and am currently creating a program that finds all common divisors from 3 different Int:s.
I have a working program but the evaluation time is very long on big numbers. I want advice on how to optimize it.
EXAMPLE: combineDivisors 234944 246744 144456 == [1,2,4,8]
As said I am very new to this so any help is appreciated.
import Data.List
combineDivisors :: Int -> Int -> Int -> [Int]
combineDivisors n1 n2 n3 =
mergeSort list
where list = getTrips concList
concList = isDivisor n1 ++ isDivisor n2 ++ isDivisor n3
isDivisor n = [x | x <- [1..n], mod n x == 0]
getTriplets :: Ord a => [a] -> [a]
getTriplets = map head . filter (\l -> length l > 2) . group . sort
--Merge sort--
split :: [a] -> ([a],[a])
split xs =
let
l = length xs `div` 2
in
(take l xs, drop l xs)
merge :: [Int] -> [Int] -> [Int]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
| y < x = y : merge (x:xs) ys
| otherwise = x : merge xs (y:ys)
mergeSort :: [Int] -> [Int]
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs =
let
(xs1,xs2) = split xs
in
merge (mergeSort xs1) (mergeSort xs2)
If you don't care too much about memory usage, you can just use Data.IntSet and a function to find all factors given a number to do this.
First, let's make a function that returns an IntSet of all factors of a number-
import qualified Data.IntSet as IntSet
factors :: Int -> IntSet.IntSet
factors n = IntSet.fromList . f $ 1 -- Convert the list of factors into a set
where
-- Actual function that returns the list of factors
f :: Int -> [Int]
f i
-- Exit when i has surpassed square root of n
| i * i > n = []
| otherwise = if n `mod` i == 0
-- n is divisible by i - add i and n / i to the list
then i : n `div` i : f (i + 1)
-- n is not divisible by i - continue to the next
else f (i + 1)
Now, once you have the IntSet corresponding to each number, you just have to do a intersection on them to get the result
commonFactors :: Int -> Int -> Int -> [Int]
commonFactors n1 n2 n3 = IntSet.toList $ IntSet.intersection (factors n3) $ IntSet.intersection (factors n1) $ factors n2
That works but is a bit ugly. How about making an intersections function that can take multiple IntSets and produce a final intersection result.
intersections :: [IntSet.IntSet] -> IntSet.IntSet
intersections [] = IntSet.empty
intersections (t:ts) = foldl IntSet.intersection t ts
That should fold on a list of IntSets to find the final intersection
Now you can refactor commonFactors to-
commonFactors :: Int -> Int -> Int -> [Int]
commonFactors n1 n2 n3 = IntSet.toList . intersections $ [factors n1, factors n2, factors n3]
Better? I'd think so. How about one last improvement, a general commonFactors function for n amount of ints
commonFactors :: [Int] -> [Int]
commonFactors = IntSet.toList . intersections . map factors
Note that this is using an IntSet, so it is naturally limited to Ints. If you want to use Integer instead - just replace IntSet with a regular Set Integer
Output
> commonFactors [234944, 246744, 144456]
[1,2,4,8]
You should use the standard algorithm where you prime factorize their GCD:
import Data.List
import qualified Data.Map.Strict as M
-- infinite list of primes
primes :: [Integer]
primes = 2:3:filter
(\n -> not $ any
(\p -> n `mod` p == 0)
(takeWhile (\p -> p * p <= n) primes))
[5,7..]
-- prime factorizing a number
primeFactorize :: Integer -> [Integer]
primeFactorize n
| n <= 1 = []
-- we search up to the square root to find a prime factor
-- if we find one then add it to the list, divide and recurse
| Just p <- find
(\p -> n `mod` p == 0)
(takeWhile (\p -> p * p <= n) primes) = p:primeFactorize (n `div` p)
-- if we don't then the number has to be prime so we're done
| otherwise = [n]
-- count the number of each element in a list
-- e.g.
-- getCounts [1, 2, 2, 3, 4] == fromList [(1, 1), (2, 2), (3, 1), (4, 1)]
getCounts :: (Ord a) => [a] -> M.Map a Int
getCounts [] = M.empty
getCounts (x:xs) = M.insertWith (const (+1)) x 1 m
where m = getCounts xs
-- get all possible combinations from a map of counts
-- e.g. getCombos (M.fromList [('a', 2), ('b', 1), ('c', 2)])
-- == ["","c","cc","b","bc","bcc","a","ac","acc","ab","abc","abcc","aa","aac","aacc","aab","aabc","aabcc"]
getCombos :: M.Map a Int -> [[a]]
getCombos m = allFactors
where
list = M.toList m
factors = fst <$> list
counts = snd <$> list
possible = (\n -> [0..n]) <$> counts
allCounts = sequence possible
allFactors = (\count -> concat $ zipWith replicate count factors) <$> allCounts
-- get the common factors of a list of numbers
commonFactorsList :: [Integer] -> [Integer]
commonFactorsList [] = []
commonFactorsList l = sort factors
where
totalGcd = foldl1 gcd l
-- then get the combinations them and take their products to get the factor
factors = map product . getCombos . getCounts . primeFactorize $ totalGcd
-- helper function for 3 numbers
commonFactors3 :: Integer -> Integer -> Integer -> [Integer]
commonFactors3 a b c = commonFactorsList [a, b, c]
I m a newbie to Haskell. I am pretty good with Imperative languages but not with functional. Haskell is my first as a functional language.
I am trying to figure out, how to get the index of the smallest element in the list where the minimum element is defined by me.
Let me explain by examples.
For example :
Function signature
minList :: x -> [x]
let x = 2
let list = [2,3,5,4,6,5,2,1,7,9,2]
minList x list --output 1 <- is index
This should return 1. Because the at list[1] is 3. It returns 1 because 3 is the smallest element after x (=2).
let x = 1
let list = [3,5,4,6,5,2,1,7,9,2]
minList x list -- output 9 <- is index
It should return 9 because at list[9] is 2 and 2 is the smallest element after 1. x = 1 which is defined by me.
What I have tried so far.
minListIndex :: (Ord a, Num a) => a -> [a] -> a
minListIndex x [] = 0
minListIndex x (y:ys)
| x > y = length ys
| otherwise = m
where m = minListIndex x ys
When I load the file I get this error
• Couldn't match expected type ‘a’ with actual type ‘Int’
‘a’ is a rigid type variable bound by
the type signature for:
minListIndex :: forall a. (Ord a, Num a) => a -> [a] -> a
at myFile.hs:36:17
• In the expression: 1 + length ys
In an equation for ‘minListIndex’:
minListIndex x (y : ys)
| x > y = 1 + length ys
| otherwise = 1 + m
where
m = minListIndex x ys
• Relevant bindings include
m :: a (bound at myFile.hs:41:19)
ys :: [a] (bound at myFile.hs:38:19)
y :: a (bound at myFile.hs:38:17)
x :: a (bound at myFile.hs:38:14)
minListIndex :: a -> [a] -> a (bound at myFile.hs:37:1)
When I modify the function like this
minListIndex :: (Ord a, Num a) => a -> [a] -> a
minListIndex x [] = 0
minListIndex x (y:ys)
| x > y = 2 -- <- modified...
| otherwise = 3 -- <- modifiedd
where m = minListIndex x ys
I load the file again then it compiles and runs but ofc the output is not desired.
What is the problem with
| x > y = length ys
| otherwise = m
?
In short: Basically, I want to find the index of the smallest element but higher than the x which is defined by me in parameter/function signature.
Thanks for the help in advance!
minListIndex :: (Ord a, Num a) => a -> [a] -> a
The problem is that you are trying to return result of generic type a but it is actually index in a list.
Suppose you are trying to evaluate your function for a list of doubles. In this case compiler should instantiate function's type to Double -> [Double] -> Double which is nonsense.
Actually compiler notices that you are returning something that is derived from list's length and warns you that it is not possible to match generic type a with concrete Int.
length ys returns Int, so you can try this instead:
minListIndex :: Ord a => a -> [a] -> Int
Regarding your original problem, seems that you can't solve it with plain recursion. Consider defining helper recursive function with accumulator. In your case it can be a pair (min_value_so_far, its_index).
First off, I'd separate the index type from the list element type altogether. There's no apparent reason for them to be the same. I will use the BangPatterns extension to avoid a space leak without too much notation; enable that by adding {-# language BangPatterns #-} to the very top of the file. I will also import Data.Word to get access to the Word64 type.
There are two stages: first, find the index of the given element (if it's present) and the rest of the list beyond that point. Then, find the index of the minimum of the tail.
-- Find the 0-based index of the first occurrence
-- of the given element in the list, and
-- the rest of the list after that element.
findGiven :: Eq a => a -> [a] -> Maybe (Word64, [a])
findGiven given = go 0 where
go !_k [] = Nothing --not found
go !k (x:xs)
| given == xs = Just (k, xs)
| otherwise = go (k+1) xs
-- Find the minimum (and its index) of the elements of the
-- list greater than the given one.
findMinWithIndexOver :: Ord a => a -> [a] -> Maybe (Word64, a)
findMinWithIndexOver given = go 0 Nothing where
go !_k acc [] = acc
go !k acc (x : xs)
| x <= given = go (k + 1) acc xs
| otherwise
= case acc of
Nothing -> go (k + 1) (Just (k, x)) xs
Just (ix_min, curr_min)
| x < ix_min = go (k + 1) (Just (k, x)) xs
| otherwise = go (k + 1) acc xs
You can now put these functions together to construct the one you seek. If you want a general Num result rather than a Word64 one, you can use fromIntegral at the very end. Why use Word64? Unlike Int or Word, it's (practically) guaranteed not to overflow in any reasonable amount of time. It's likely substantially faster than using something like Integer or Natural directly.
It is not clear for me what do you want exactly. Based on examples I guess it is: find the index of the smallest element higher than x which appears after x. In that case, This solution is plain Prelude. No imports
minList :: Ord a => a -> [a] -> Int
minList x l = snd . minimum . filter (\a -> x < fst a) . dropWhile (\a -> x /= fst a) $ zip l [0..]
The logic is:
create the list of pairs, [(elem, index)] using zip l [0..]
drop elements until you find the input x using dropWhile (\a -> x /= fst a)
discards elements less than x using filter (\a -> x < fst a)
find the minimum of the resulting list. Tuples are ordered using lexicographic order so it fits your problem
take the index using snd
Your function can be constructed out of ready-made parts as
import Data.Maybe (listToMaybe)
import Data.List (sortBy)
import Data.Ord (comparing)
foo :: (Ord a, Enum b) => a -> [a] -> Maybe b
foo x = fmap fst . listToMaybe . take 1
. dropWhile ((<= x) . snd)
. sortBy (comparing snd)
. dropWhile ((/= x) . snd)
. zip [toEnum 0..]
This Maybe finds the index of the next smallest element in the list above the given element, situated after the given element, in the input list. As you've requested.
You can use any Enum type of your choosing as the index.
Now you can implement this higher-level executable specs as direct recursion, using an efficient Map data structure to hold your sorted elements above x seen so far to find the next smallest, etc.
Correctness first, efficiency later!
Efficiency update: dropping after the sort drops them sorted, so there's a wasted effort there; indeed it should be replaced with the filtering (as seen in the answer by Luis Morillo) before the sort. And if our element type is in Integral (so it is a properly discrete type, unlike just an Enum, thanks to #dfeuer for pointing this out!), there's one more opportunity for an opportunistic optimization: if we hit on a succ minimal element by pure chance, there's no further chance of improvement, and so we should bail out at that point right there:
bar :: (Integral a, Enum b) => a -> [a] -> Maybe b
bar x = fmap fst . either Just (listToMaybe . take 1
. sortBy (comparing snd))
. findOrFilter ((== succ x).snd) ((> x).snd)
. dropWhile ((/= x) . snd)
. zip [toEnum 0..]
findOrFilter :: (a -> Bool) -> (a -> Bool) -> [a] -> Either a [a]
findOrFilter t p = go
where go [] = Right []
go (x:xs) | t x = Left x
| otherwise = fmap ([x | p x] ++) $ go xs
Testing:
> foo 5 [2,3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 4
> foo 2 [2,3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 1
> foo 1 [3,5,4,6,5,2,1,7,9,2] :: Maybe Int
Just 9
I have a simple function (used for some problems of project Euler, in fact). It turns a list of digits into a decimal number.
fromDigits :: [Int] -> Integer
fromDigits [x] = toInteger x
fromDigits (x:xs) = (toInteger x) * 10 ^ length xs + fromDigits xs
I realized that the type [Int] is not ideal. fromDigits should be able to take other inputs like e.g. sequences, maybe even foldables ...
My first idea was to replace the above code with sort of a "fold with state". What is the correct (= minimal) Haskell-category for the above function?
First, folding is already about carrying some state around. Foldable is precisely what you're looking for, there is no need for State or other monads.
Second, it'd be more natural to have the base case defined on empty lists and then the case for non-empty lists. The way it is now, the function is undefined on empty lists (while it'd be perfectly valid). And notice that [x] is just a shorthand for x : [].
In the current form the function would be almost expressible using foldr. However within foldl the list or its parts aren't available, so you can't compute length xs. (Computing length xs at every step also makes the whole function unnecessarily O(n^2).) But this can be easily avoided, if you re-thing the procedure to consume the list the other way around. The new structure of the function could look like this:
fromDigits' :: [Int] -> Integer
fromDigits' = f 0
where
f s [] = s
f s (x:xs) = f (s + ...) xs
After that, try using foldl to express f and finally replace it with Foldable.foldl.
You should avoid the use of length and write your function using foldl (or foldl'):
fromDigits :: [Int] -> Integer
fromDigits ds = foldl (\s d -> s*10 + (fromIntegral d)) 0 ds
From this a generalization to any Foldable should be clear.
A better way to solve this is to build up a list of your powers of 10. This is quite simple using iterate:
powersOf :: Num a => a -> [a]
powersOf n = iterate (*n) 1
Then you just need to multiply these powers of 10 by their respective values in the list of digits. This is easily accomplished with zipWith (*), but you have to make sure it's in the right order first. This basically just means that you should re-order your digits so that they're in descending order of magnitude instead of ascending:
zipWith (*) (powersOf 10) $ reverse xs
But we want it to return an Integer, not Int, so let's through a map fromIntegral in there
zipWith (*) (powersOf 10) $ map fromIntegral $ reverse xs
And all that's left is to sum them up
fromDigits :: [Int] -> Integer
fromDigits xs = sum $ zipWith (*) (powersOf 10) $ map fromIntegral $ reverse xs
Or for the point-free fans
fromDigits = sum . zipWith (*) (powersOf 10) . map fromIntegral . reverse
Now, you can also use a fold, which is basically just a pure for loop where the function is your loop body, the initial value is, well, the initial state, and the list you provide it is the values you're looping over. In this case, your state is a sum and what power you're on. We could make our own data type to represent this, or we could just use a tuple with the first element being the current total and the second element being the current power:
fromDigits xs = fst $ foldr go (0, 1) xs
where
go digit (s, power) = (s + digit * power, power * 10)
This is roughly equivalent to the Python code
def fromDigits(digits):
def go(digit, acc):
s, power = acc
return (s + digit * power, power * 10)
state = (0, 1)
for digit in digits:
state = go(digit, state)
return state[0]
Such a simple function can carry all its state in its bare arguments. Carry around an accumulator argument, and the operation becomes trivial.
fromDigits :: [Int] -> Integer
fromDigits xs = fromDigitsA xs 0 # 0 is the current accumulator value
fromDigitsA [] acc = acc
fromDigitsA (x:xs) acc = fromDigitsA xs (acc * 10 + toInteger x)
If you're really determined to use a right fold for this, you can combine calculating length xs with the calculation like this (taking the liberty of defining fromDigits [] = 0):
fromDigits xn = let (x, _) = fromDigits' xn in x where
fromDigits' [] = (0, 0)
fromDigits' (x:xn) = (toInteger x * 10 ^ l + y, l + 1) where
(y, l) = fromDigits' xn
Now it should be obvious that this is equivalent to
fromDigits xn = fst $ foldr (\ x (y, l) -> (toInteger x * 10^l + y, l + 1)) (0, 0) xn
The pattern of adding an extra component or result to your accumulator, and discarding it once the fold returns, is a very general one when you're re-writing recursive functions using folds.
Having said that, a foldr with a function that is always strict in its second parameter is a really, really bad idea (excessive stack usage, maybe a stack overflow on long lists) and you really should write fromDigits as a foldl as some of the other answers have suggested.
If you want to "fold with state", probably Traversable is the abstraction you're looking for. One of the methods defined in Traversable class is
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
Basically, traverse takes a "stateful function" of type a -> f b and applies it to every function in the container t a, resulting in a container f (t b). Here, f can be State, and you can use traverse with function of type Int -> State Integer (). It would build an useless data structure (list of units in your case), but you can just discard it. Here's a solution to your problem using Traversable:
import Control.Monad.State
import Data.Traversable
sumDigits :: Traversable t => t Int -> Integer
sumDigits cont = snd $ runState (traverse action cont) 0
where action x = modify ((+ (fromIntegral x)) . (* 10))
test1 = sumDigits [1, 4, 5, 6]
However, if you really don't like building discarded data structure, you can just use Foldable with somewhat tricky Monoid implementation: store not only computed result, but also 10^n, where n is count of digits converted to this value. This additional information gives you an ability to combine two values:
import Data.Foldable
import Data.Monoid
data Digits = Digits
{ value :: Integer
, power :: Integer
}
instance Monoid Digits where
mempty = Digits 0 1
(Digits d1 p1) `mappend` (Digits d2 p2) =
Digits (d1 * p2 + d2) (p1 * p2)
sumDigitsF :: Foldable f => f Int -> Integer
sumDigitsF cont = value $ foldMap (\x -> Digits (fromIntegral x) 10) cont
test2 = sumDigitsF [0, 4, 5, 0, 3]
I'd stick with first implementation. Although it builds unnecessary data structure, it's shorter and simpler to understand (as far as a reader understands Traversable).
I'm currently working on a program which computes amicable pairs (Project Euler Problem 21). I've already found the solution, however I noticed that a flaw in my program was that it evaluates all of the numbers of the set [1..] whether or not we have already found the number to be a pair.
i.e. If currently evaluating 220 and 284 is found to be it's pair, however continuing on through when the map function gets to 284 it shouldn't evaluate it again.
import Data.List
properDivisors :: (Integral a) => a -> [a]
properDivisors n = [x | x <- [1..n `div` 2],
n `mod` x == 0 ]
amicablePairOf :: (Integral a) => a -> Maybe a
amicablePairOf a
| a == b = Nothing
| a == dOf b = Just b
| otherwise = Nothing
where dOf x = sum (properDivisors x)
b = dOf a
getAmicablePair :: (Integral a) => a -> [a]
getAmicablePair a = case amicablePairOf a of
Just b -> [a,b]
Nothing -> []
amicables = foldr (++) [] ams
where ams = map getAmicablePair [1..]
As an example:
take 4 amicables
returns:
[220,284,284,220]
I'm fairly new to Haskell and functional programming so forgive me if it an obvious solution.
Your problem is, that you try to safe work by outputting both amicable numbers. But actually, you don't safe very much, because your function still calculates for both numbers, whether they are amicable. Why not do it like this:
import Data.List
divSum :: (Integral a) => a -> [a]
divSum n = sum (filter (\a -> a `mod` n == 0) [1..n `div` 2])
isAmicable :: (Integral a) => a -> Bool
isAmicable a = a /= b && a == c where
b = divSum a
c = divSum b
amicables = filter isAmicable [1..]
Perhaps a slight modification in getAmicablePair helps?
getAmicablePair :: (Integral a) => a -> [a]
getAmicablePair a = case amicablePairOf a of
Just b -> if a < b then [a,b] else []
Nothing -> []
... so you just get pairs with a smaller first element