My function rtnDryPlaces is supposed to return a list of all dry places if they were dry on a particular day - with day 1 being yesterday (last element) and day 7 being last week (first element).
type Name = String
type Location = (Float,Float)
type RainfallFigures = [Int]
type Place = (Name,Location,RainfallFigures)
testData=[("London", (51.5, -0.1), [0, 0, 5, 8, 8, 0, 0]),("Cardiff", (51.5 , -3.2),[12, 8, 15, 0, 0, 0, 2])]
rtnDryPlaces :: [Place] -> Int -> [Name]
rtnDryPlaces ((a,(b,c),d):xs) n
| d == [] = []
| (reverse d)!!n-1 == 0 = a:rtnDryPlaces xs n
demo 4 = print (rtnDryPlaces testData 2 )
The second guard reverses the list and returns the element at that index (index is day). If it returns 0, then the name a is appended to the list of names which have also returned 0 for that day. When the test data runs out, so does the rainfall data so I've set the stop condition to be when d = []
One of the problems is that the recursive calls will eventually reach the empty list, and you did not define a result for that:
rtnDryPlaces :: [Place] -> Int -> [Name]
rtnDryPlaces [] _ = []
rtnDryPlaces ((a,(b,c),d):xs) n
| d == [] = []
| (reverse d)!!n-1 == 0 = a:rtnDryPlaces xs n
But even then it will not work (yet). For example (reversed d)!!n-1 is interpreted as ((reverse d)!!n)-1, so it first takes the element at index n, and then it will subtract that element with 1. It will not take the n-1 element.
Furthermore if the (reversed d)!!(n-1) is not zero, then that guard will not "fire", and thus we get again an exhaustive pattern failure. We thus should add an otherwise at the end:
rtnDryPlaces :: [Place] -> Int -> [Name]
rtnDryPlaces [] _ = []
rtnDryPlaces ((a,_,d):xs) n
| d == [] = []
| (reverse d)!!(n-1) == 0 = a:rtnDryPlaces xs n
| otherwise = rtnDryPlaces xs n
Now this will give us a result:
Prelude> rtnDryPlaces testData 2
["London","Cardiff"]
But we can still make this more elegant by making use of filter and map:
rtnDryPlaces :: [Place] -> Int -> [Name]
rtnDryPlaces ps n = map (\(x,_,_) -> x) (filter p ps)
where p (_,_,d) | (0:_) <- drop (n-1) (reverse d) = True
| otherwise = False
or as #DanielWagner says, with list comprehension:
rtnDryPlaces :: [Place] -> Int -> [Name]
rtnDryPlaces ps n = [p | (p, _, d) <- ps, 0 <- take 1 . drop (n-1) . reverse $ d]
Here the take 1 . drop (n-1) will make a singleton list (given the list has enough elements) with the amount of rain for that day. If that then pattern matches with 0, we will yield p in the result. If the value for that day does not match with 0, or the list has not enough elements (then take 1 . drop (n-1) (reverse d) will yield an empty list), then that element is not emitted in the result.
Related
I'm trying the solve the first question in Advent of Code 2017, and come up with the following solution to calculate the needed value:
checkRepetition :: [Int] -> Bool
checkRepetition [] = False
checkRepetition (x:xs)
| x == ( head xs ) = True
| otherwise = False
test :: [Int] -> Int
test [] = 0
test [x] = 0
test xs
| checkRepetition xs == True = ((head xs)*a) + (test (drop a xs))
| otherwise = test (tail xs)
where
a = (go (tail xs)) + 1
go :: [Int] -> Int
go [] = 0
go xs
| checkRepetition xs == True = 1 + ( go (tail xs) )
| otherwise = 0
However, when I give an input that contains repetitive numbers such as [1,3,3], it gives the error
*** Exception: Prelude.head: empty list
However, for 1.5 hours, I couldn't figure out exactly where this error is generated. I mean any function that is used in test function have a definition for [], but still it throws this error, so what is the problem ?
Note that, I have checked out this question, and in the given answer, it is advised not to use head and tail functions, but I have tested those function for various inputs, and they do not throw any error, so what exactly is the problem ?
I would appreciate any help or hint.
As was pointed out in the comments, the issue is here:
checkRepetition (x:xs)
| x == ( head xs ) = True
xs is not guaranteed to be a non-empty list (a one-element list is written as x:[], so that (x:xs) pattern matches that xs = []) and calling head on an empty list is a runtime error.
You can deal with this by changing your pattern to only match on a 2+ element list.
checkRepetition [] = False
checkRepetition [_] = False
checkRepetition (x1:x2:_) = x1 == x2
-- No need for the alternations on this function, by the way.
That said, your algorithm seems needlessly complex. All you have to do is check if the next value is equal, and if so then add the current value to the total. Assuming you can get your String -> [Int] on your own, consider something like:
filteredSum :: [Int] -> Int
filteredSum [] = 0 -- by definition, zero- and one-element lists
filteredSum [_] = 0 -- cannot produce a sum, so special case them here
filteredSum xss#(first:_) = go xss
where
-- handle all recursive cases
go (x1:xs#(x2:_)) | x1 == x2 = x1 + go xs
| otherwise = go xs
-- base case
go [x] | x == first = x -- handles last character wrapping
| otherwise = 0 -- and if it doesn't wrap
-- this should be unreachable
go [] = 0
For what it's worth, I think it's better to work in the Maybe monad and operate over Maybe [Int] -> Maybe Int, but luckily that's easy since Maybe is a functor.
digitToMaybeInt :: Char -> Maybe Int
digitToMaybeInt '0' = Just 0
digitToMaybeInt '1' = Just 1
digitToMaybeInt '2' = Just 2
digitToMaybeInt '3' = Just 3
digitToMaybeInt '4' = Just 4
digitToMaybeInt '5' = Just 5
digitToMaybeInt '6' = Just 6
digitToMaybeInt '7' = Just 7
digitToMaybeInt '8' = Just 8
digitToMaybeInt '9' = Just 9
digitToMaybeInt _ = Nothing
maybeResult :: Maybe Int
maybeResult = fmap filteredSum . traverse digitToMaybeInt $ input
result :: Int
result = case maybeResult of
Just x -> x
Nothing -> 0
-- this is equivalent to `maybe 0 id maybeResult`
Thank you for the link. I went there first to glean the purpose.
I assume the input will be a string. The helper function below constructs a numeric list to be used to sum if predicate is True, that is, the zipped values are equal, that is, each number compared to each successive number (the pair).
The helper function 'nl' invokes the primary function 'invcap' Inverse Captcha with a list of numbers.
The nl function is a list comprehension. The invcap function is a list comprehension. Perhaps the logic in this question is at fault. Overly complicated logic is more likely to introduce errors. Proofs are very much easier when logic is not cumbersome.
The primary function "invcap"
invcap l = sum [ x | (x,y) <- zip l $ (tail l) ++ [head l], x == y]
The helper function that converts a string to a list of digits and invokes invcap with a list of numeric digits.
nl cs = invcap [ read [t] :: Int | t <- cs]
Invocation examples
Prelude> nl "91212129" ......
9 ' ' ' ' ' ' ' ' ' ' ' ' '
Prelude> nl "1122" ......
3
I'm trying to optimize my old code from Project Euler #23 and noticed some strange slowdown while removing useless comparisons in a function for list merging.
My code:
import Data.List
import Debug.Trace
limit = 28123
-- sum of all integers from 1 to n
summe :: Int -> Int
summe n = div (n*(n+1)) 2
-- all divisors of x excluding itself
divisors :: Int -> [Int]
divisors x = l1 ++ [x `div` z | z <- l1, z*z /= x, z /= 1]
where m = floor $ sqrt $ fromIntegral x
l1 = [y | y <- [1..m] , mod x y == 0]
-- list of all abundant numbers
liste :: [Int]
liste = [x | x <- [12..limit] , x < sum (divisors x)]
-- nested list with sums of abundent numbers
sumliste :: [[Int]]
sumliste = [[x+y | x <- takeWhile (<=y) liste, x + y <= limit] | y <- liste]
-- reduced list
rsl :: [[Int]] -> [Int]
rsl (hl:[]) = hl
rsl (hl:l) = mergelists hl (rsl l)
-- build a sorted union of two sorted lists
mergelists :: [Int] -> [Int] -> [Int]
mergelists [] [] = []
mergelists [] b = b
mergelists a [] = a
mergelists as#(a:at) bs#(b:bt)
-- | a == b = a : mergelists at bt
-- | a > b = b : mergelists as bt
-- | a < b = a : mergelists at bs
| a == b = if a == hl1
then trace "1" l1
else a : l1
| a > b = if b == hl2
then trace "2" l2
else b : l2
| a < b = if a == hl3
then trace "3" l3
else a : l3
where l1 = mergelists at bt
hl1 = if null l1 then a + 1 else head l1
l2 = mergelists as bt
hl2 = head l2
l3 = mergelists at bs
hl3 = head l3
-- build the sum of target numbers by subtracting sum of nontarget numbers from all numbers
main = print $ (summe limit) - (sum $ rsl sumliste)
My problem is the function mergelists. The body of this functions contains some useless if clauses (as can be seen by the missing trace output) and could be refactored to the three commented lines. The problem with this is an increase of execution time from 3.4s to 5.8s what I can't understand.
Why is the shorter code slower?
As Thomas M. DuBuisson suggested, the problem has to do with the lack of strictness. The following code is a slight modification of the code that you have commented out, which uses the $! operator to ensure that the mergelists call is evaluated before forming the list.
mergelists :: [Int] -> [Int] -> [Int]
mergelists [] [] = []
mergelists [] b = b
mergelists a [] = a
mergelists as#(a:at) bs#(b:bt)
| a == b = (a :) $! mergelists at bt
| a > b = (b :) $! mergelists as bt
| a < b = (a :) $! mergelists at bs
The function $! ensures if the result of (_ :) $! mergelists _ _ is evaluated, then mergelists _ _ must be evaluated as well. Thanks to the recursion, this implies that if the result of mergelists is evaluated, then the entire list must be evaluated.
In the slow version,
mergelists as#(a:at) bs#(b:bt)
| a == b = a : mergelists at bt
| a > b = b : mergelists as bt
| a < b = a : mergelists at bs
you can inspect the first element of the result without evaluating the remainder of the list. The call to mergelists in the tail of the list is stored as an unevaluated thunk. This has various implications:
This is good if you only need a small portion of the merged list, or if the inputs are infinitely long.
On the other hand, if the lists aren't that big to begin with and/or you need all the elements eventually, this adds extra overhead due to the presence of the thunk. It also means that the garbage collector doesn't get to free any of the inputs since the thunks will retain references to them.
I don't understand exactly why it's slower for your particular problem though — perhaps someone more experienced can shed some light on this.
I've noticed that, at -O0, the "slow version" is actually the fastest of the three approaches, so I suspect that GHC was able to take advantage of the strictness and produce more optimized code.
I need to count values inbetween values in a list i.e. [135,136,138,140] would count all the numbers between 135-136,136-138,138-140. with the input list [135.2,135.3,137,139] would out put[2,1,1] using type [Float] [Float] [Int]. So far I have:
heightbetween :: Float -> Float -> [Float] -> Int
heightbetween _ _ [] = 0
heightbetween n s (x:xs)
| (n < x) && (s > x) = 1 + (heightbetween n s xs)
| otherwise = heightbetween n s xs
count :: [Float] -> [Float] -> [Int]
count [] [] = []
count [x,y] = [(x,y)]
count (x:y:ys) = (x,y):count (y:ys)
forEach fun lst = heightbetween op ([],lst)
where
op (start,[]) = Nothing
op (start,a:as) = Just (start++(fun a):as
,(start++[a],as))
forPairs fun lst lst2 = map (map fst)
$ forEach (\(a,b)->(fun a b,b))
$ zip lst lst2
Your count looks strange. It should be like this:
-- count -> ranges -> data -> [counts]
count :: [Float] -> [Float] -> [Int]
count [] _ = [] -- no ranges given -> empty list
count [_] _ = [] -- no ranges, but single number -> empty list
count _ [] = [] -- no data given -> empty list
count (x:y:xs) d =
(heightbetween x y d) : count (y:xs) d
heightbetween :: Float -> Float -> [Float] -> Int
heightbetween _ _ [] = 0
heightbetween n s (x:xs)
| (n < x) && (s > x) = 1 + (heightbetween n s xs)
| otherwise = heightbetween n s xs
The other lines are obsolete.
Then invoking
count [135,136,138,140] [135.2,135.3,137,139]
gives
[2,1,1]
First, make sure that your range list is in order....
rangePoints = [135,136,138,140]
orderedRangePoints = sort rangePoints
Next, you will find it much easier to work with actual ranges (which you can represent using a 2-tuple (low,high))
ranges = zip orderedRangePoints $ tail orderedRangePoints
You will need an inRange function (one already exists in Data.Ix, but unfortunately it includes the upperbound, so you can't use it)
inRange (low,high) val | val >= low && val < high = True
inRange _ _ = False
You will also want to order your input points
theData = sort [135.2,135.3,137,139]
With all of this out of the way, the binCount function is easy to write.
binCount'::[(Float, Float)]->[Float]->[Int]
binCount' [] [] = []
binCount' (range:rest) vals =
length valsInRange:binCount' rest valsAboveRange
where
(valsInRange, valsAboveRange) = span (`inRange` range) vals
Notice, that I defined a function called binCount', not binCount. I did this, because I consider this an unsafe function, because it only works on ordered ranges and values.... You should finalize this by writing a safer binCount function, which puts all of the stuff above in its where clause. You should probably add all the types and some error checking also (what happens if a value is outside of all ranges?).
I am trying to generate all k-item sets for use in apriori, I am following this pseudocode:
L1= {frequent items};
for (k= 2; Lk-1 !=∅; k++) do begin
Ck= candidates generated from Lk-1 (that is: cartesian product Lk-1 x Lk-1 and eliminating any
k-1 size itemset that is not frequent);
for each transaction t in database do
increment the count of all candidates in
Ck that are contained in t
Lk = candidates in Ck with min_sup
end
return U_k Lk;
,here is the code I have:
-- d transactions, threshold
kItemSets d thresh = kItemSets' 2 $ frequentItems d thresh
where
kItemSets' _ [] = [[]]
kItemSets' k t = ck ++ (kItemSets' (k+1) ck)
where
-- those (k-1) length sets that meet the threshold of being a subset of the transactions in d
ck = filter (\x->(countSubsets x d) >= thresh) $ combinations k t
-- length n combinations that can be made from xs
combinations 0 _ = [[]]
combinations _ [] = []
combinations n xs#(y:ys)
| n < 0 = []
| otherwise = case drop (n-1) xs of
[ ] -> []
[_] -> [xs]
_ -> [y:c | c <- combinations (n-1) ys]
++ combinations n ys
-- those items of with frequency o in the dataset
frequentItems xs o = [y| y <- nub cs, x<-[count y cs], x >= o]
where
cs = concat xs
isSubset a b = not $ any (`notElem` b) a
-- Count how many times the list y appears as a subset of a list of lists xs
countSubsets y xs = length $ filter (isSubset y ) xs
count :: Eq a => a -> [a] -> Int
count x [] = 0
count x (y:ys) | x == y = 1+(count x ys)
| otherwise = count x ys
transactions =[["Butter", "Biscuits", "Cream", "Newspaper", "Bread", "Chocolate"],
["Cream", "Newspaper", "Tea", "Oil", "Chocolate"] ,
["Chocolate", "Cereal", "Bread"],
["Chocolate", "Flour", "Biscuits", "Newspaper"],
["Chocolate", "Biscuits", "Newspaper"] ]
But when I compile I get the error:
apriori.hs:5:51:
Occurs check: cannot construct the infinite type: a0 = [a0]
Expected type: [a0]
Actual type: [[a0]]
In the second argument of kItemSets', namely `ck'
In the second argument of `(++)', namely `(kItemSets' (k + 1) ck)'
Failed, modules loaded: none.
But when I run from ghci:
*Main> mapM_ print $ filter (\x->(countSubsets x transactions ) >= 2 ) $ combinations 2 $ frequentItems transactions 2
["Biscuits","Newspaper"]
["Biscuits","Chocolate"]
["Cream","Newspaper"]
["Cream","Chocolate"]
["Newspaper","Chocolate"]
["Bread","Chocolate"]
Which is correct, since it's those 2-item sets that meet the occurrence threshold in the set of transactions. But what I need for the 3-item sets is
[["Biscuits", "Chocolate", "Newspaper" ],
["Chocolate", "Cream", "Newspaper"]]
and for this to be appended to the list of 2-item sets. How would I change my current code to achieve this? I know it can be built from the 2-item set, but I'm not sure how to go about it.
Had to use this for line 5:
kItemSets' k t = ck ++ (kItemSets' (k+1) $ nub $ concat ck)
Not the most efficient but it works.
I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:
prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]
factorial n = product [1..n]
factC x = sum $ map factorial (decToList x)
chain74 x | x == 0 = []
| x == 1 = [1]
| x /= factC x = x : chain74 (factC x)
But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?
When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.
So this calculates the length of the non-cyclic part of a list:
uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
where uniqlength_ [] ls = length ls
uniqlength_ (x:xs) ls
| x `elem` ls = length ls
| otherwise = uniqlength_ xs (x:ls)
(Performance might be better when using a set instead of a list, but I haven't tried that.)
What about passing another argument (y for example) to the chain74 in the list comprehension.
Morning fail so EDIT:
[.. ((length $ chain74 x x False)-1)]
chain74 x y not_first | x == y && not_first = replace_with_stop_value_:-)
| x == 0 = []
| x == 1 = [1]
| x == 2 = [2]
| x /= factC x = x : chain74 (factC x) y True
I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:
http://coder.bsimmons.name/blog/2009/04/cycle-detection/
Just change the return type from String to Bool.
EDIT: Here is a modified version of the algorithm I posted about:
cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k [] = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
where find _ _ c _ [] = False
find i x c p (x':xs)
| c > k = False -- no cycles after k elements
| x == x' = True -- found a cycle
| c == p = find c x' (c+1) (p*2) xs
| otherwise = find i x (c+1) p xs
You can remove the 'k' if you know your list will either cycle or terminate soon.
EDIT2: You could change the following function to look something like:
prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]
Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:
chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])
Giving:
take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]
map head $ filter ((== 60) . length) (take 10000 chains)
is
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]
It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).
If you just want to remove cycles from a list you can use:
decycle :: Eq a => [a] -> [a]
decycle = dc []
where
dc _ [] = []
dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs
decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]