Related
I have created a program to remove first smallest element but I dont how to do for second largest:
withoutBiggest (x:xs) =
withoutBiggestImpl (biggest x xs) [] (x:xs)
where
biggest :: (Ord a) => a -> [a] -> a
biggest big [] = big
biggest big (x:xs) =
if x < big then
biggest x xs
else
biggest big xs
withoutBiggestImpl :: (Eq a) => a -> [a] -> [a] -> [a]
withoutBiggestImpl big before (x:xs) =
if big == x then
before ++ xs
else
withoutBiggestImpl big (before ++ [x]) xs
Here is a simple solution.
Prelude> let list = [10,20,100,50,40,80]
Prelude> let secondLargest = maximum $ filter (/= (maximum list)) list
Prelude> let result = filter (/= secondLargest) list
Prelude> result
[10,20,100,50,40]
Prelude>
A possibility, surely not the best one.
import Data.Permute (rank)
x = [4,2,3]
ranks = rank (length x) x -- this gives [2,0,1]; that means 3 (index 1) is the second smallest
Then:
[x !! i | i <- [0 .. length x -1], i /= 1]
Hmm.. not very cool, let me some time to think to something better please and I'll edit my post.
EDIT
Moreover my previous solution was wrong. This one should be correct, but again not the best one:
import Data.Permute (rank, elems, inverse)
ranks = elems $ rank (length x) x
iranks = elems $ inverse $ rank (length x) x
>>> [x !! (iranks !! i) | i <- filter (/=1) ranks]
[4,2]
An advantage is that this preserves the order of the list, I think.
Here is a solution that removes the n smallest elements from your list:
import Data.List
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
ntails :: Int -> [a] -> [(a, Int)] -> [a]
ntails 0 l _ = l
ntails n l s = ntails (n-1) (deleteN (snd $ head s) l) (tail s)
removeNSmallest :: Ord a => Int -> [a] -> [a]
removeNSmallest n l = ntails n l $ sort $ zip l [0..]
EDIT:
If you just want to remove the 2nd smallest element:
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
remove2 :: [a] -> [(a, Int)] -> [a]
remove2 [] _ = []
remove2 [a] _ = []
remove2 l s = deleteN (snd $ head $ tail s) l
remove2Smallest :: Ord a => [a] -> [a]
remove2Smallest l = remove2 l $ sort $ zip l [0..]
It was not clear if the OP is looking for the biggest (as the name withoutBiggest implies) or what. In this case, one solution is to combine the filter :: (a->Bool) -> [a] -> [a] and maximum :: Ord a => [a] -> a functions from the Prelude.
withoutBiggest l = filter (/= maximum l) l
You can remove the biggest elements by first finding it and then filtering it:
withoutBiggest :: Ord a => [a] -> [a]
withoutBiggest [] = []
withoutBiggest xs = filter (/= maximum xs) xs
You can then remove the second-biggest element in much the same way:
withoutSecondBiggest :: Ord a => [a] -> [a]
withoutSecondBiggest xs =
case withoutBiggest xs of
[] -> xs
rest -> filter (/= maximum rest) xs
Assumptions made:
You want each occurrence of the second-biggest element removed.
When there is zero/one element in the list, there isn't a second element, so there isn't a second-biggest element. Having the list without an element that isn't there is equivalent to having the list.
When the list contains only values equivalent to maximum xs, there also isn't a second-biggest element even though there may be two or more elements in total.
The Ord type-class instance implies a total ordering. Otherwise you may have multiple maxima that are not equivalent; otherwise which one is picked as the biggest and second-biggest is not well-defined.
Function, which finds in the list of integers one of the longest ordered increments of subscripts (not necessarily consecutive) numbers. Example:
• Sequence [21,27,15,14,18,16,14,17,22,13] = [14,16,17,22]
I have a problem with the function which takes the initial number from the array, and looks for a sequence:
fstLen:: Int -> [Int] -> [Int]
fstLen a [] = a: []
fstLen x (l:ls) = if x < l then x:(fstLen l ls) else fstLen x ls
I have problems in place, 14,18,16,14,17,22,13
14 < 18 but then 18 > 16 and my algorithm takes the number 16 as the basis and is looking for a new sequence and I need to go back to 14
How can I do it?
(sorry for my english)
You could always just use subsequences from Data.List to get all the possible subsequences in a list. When you get these subsequences, just take the sorted ones with this function and filter:
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
Then get the maximum length subsequence with maximumBy(or another method), with the ordering being comparinglength.
Here is what the code could look like:
import Data.Ord (comparing)
import Data.List (subsequences, maximumBy, nub)
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
max_sequence :: (Ord a) => [a] -> [a]
max_sequence xs = maximumBy (comparing length) $ map nub $ filter isSorted (subsequences xs)
Which seems to work correctly:
*Main> max_sequence [21,27,15,14,18,16,14,17,22,13]
[14,16,17,22]
Note: used map nub to remove duplicate elements from the sub sequences. If this is not used, then this will return [14,14,17,22] as the maximum sub sequence, which may be fine if you allow this.
A more efficient n log n solution can be done by maintaining a map where
keys are the first element of an increasing sequence.
values are a tuple: (length of the sequence, the actual sequence)
and the map maintains the invariance that for each possible size of an increasing sequence, only the lexicographically largest one is retained.
Extra traceShow bellow to demonstrate how the map changes while folding from the end of the list:
import Debug.Trace (traceShow)
import Data.Map (empty, elems, insert, delete, lookupGT, lookupLT)
-- longest (strictly) increasing sequence
lis :: (Ord k, Show k, Foldable t) => t k -> [k]
lis = snd . maximum . elems . foldr go empty
where
go x m = traceShow m $ case x `lookupLT` m of
Nothing -> m'
Just (k, v) -> if fst a < fst v then m' else k `delete` m'
where
a = case x `lookupGT` m of
Nothing -> (1, [x])
Just (_, (i, r)) -> (i + 1, x:r)
m' = insert x a m
then:
\> lis [21,27,15,14,18,16,14,17,22,13]
fromList []
fromList [(13,(1,[13]))]
fromList [(22,(1,[22]))]
fromList [(17,(2,[17,22])),(22,(1,[22]))]
fromList [(14,(3,[14,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(14,(4,[14,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(27,(1,[27]))]
[15,16,17,22]
It is not necessary to retain the lists within the map. One can reconstruct the longest increasing sequence only using the keys and the length of the sequences (i.e. only the first element of the tuples).
Excellent question! Looking forward to a variety of answers.
Still improving my answer. The answer below folds to build increasing subsequences from the right. It also uses the the list monad to prepend new elements to subsequences if the new element is smaller than the head of the subsequence. (This is my first real application of the list monad.) For example,
λ> [[3], [1]] >>= (prepIfSmaller 2)
[[2,3],[3],[1]]
This solution is about as short as I can make it.
import Data.List (maximumBy)
maxSubsequence :: Ord a => [a] -> [a]
maxSubsequence [] = []
maxSubsequence xs = takeLongest $ go [] xs
where
takeLongest :: Ord a => [[a]] -> [a]
takeLongest = maximumBy (\ x y -> compare (length x) (length y))
go :: Ord a => [[a]] -> [a] -> [[a]]
go = foldr (\x subs -> [x] : (subs >>= (prepIfSmaller x)))
where prepIfSmaller x s#(h:_) = (if x < h then [x:s] else []) ++ [s]
Quick test.
λ> maxSubsequence [21,27,15,14,18,16,14,17,22,13]
[15,16,17,22]
wondering how to implement nub over a Seq a
I get that one could do:
nubSeq :: Seq a -> Seq a
nubSeq = fromList . nub . toList
Just wondering is there something standard that does not convert to Lists in order to call nub :: [a]->[a]?
An implementation that occurred to me, based obviously on nub, is:
nubSeq :: (Eq a) => Seq a -> Seq a
nubSeq = Data.Sequence.foldrWithIndex
(\_ x a -> case x `Data.Sequence.elemIndexR` a of
Just _ -> a
Nothing -> a |> x) Data.Sequence.empty
But there must be something more elegant?
thanks.
Not sure whether this qualifies as more elegant but it splits the concerns in independent functions (caveat: you need an Ord constraint on a):
seqToNubMap takes a Seq and outputs a Map associating to each a the smallest index at which it appeared in the sequence
mapToList takes a Map of values and positions and produces a list of values in increasing order according to the specified positions
nubSeq combines these to generate a sequence without duplicates
The whole thing should be O(n*log(n)), I believe:
module NubSeq where
import Data.Map as Map
import Data.List as List
import Data.Sequence as Seq
import Data.Function
seqToNubMap :: Ord a => Seq a -> Map a Int
seqToNubMap = foldlWithIndex (\ m k v -> insertWith min v k m) Map.empty
mapToList :: Ord a => Map a Int -> [a]
mapToList = fmap fst . List.sortBy (compare `on` snd) . Map.toList
nubSeq :: Ord a => Seq a -> Seq a
nubSeq = Seq.fromList . mapToList . seqToNubMap
Or a simpler alternative following #DavidFletcher's comment:
nubSeq' :: forall a. Ord a => Seq a -> Seq a
nubSeq' xs = Fold.foldr cons nil xs Set.empty where
cons :: a -> (Set a -> Seq a) -> (Set a -> Seq a)
cons x xs seen
| x `elem` seen = xs seen
| otherwise = x <| xs (Set.insert x seen)
nil :: Set a -> Seq a
nil _ = Seq.empty
Another way with an Ord constraint - use a scan to make the sets of
elements that appear in each prefix of the list. Then we can filter out
any element that's already been seen.
import Data.Sequence as Seq
import Data.Set as Set
nubSeq :: Ord a => Seq a -> Seq a
nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens)
where
seens = Seq.scanl (flip Set.insert) Set.empty xs
Or roughly the same thing as a mapAccumL:
nubSeq' :: Ord a => Seq a -> Seq a
nubSeq' = fmap fst . Seq.filter snd . snd . mapAccumL f Set.empty
where
f s x = (Set.insert x s, (x, x `notElem` s))
(If I was using lists I would use Maybes instead of the pairs with
Bool, then use catMaybes instead of filtering. There doesn't seem to be catMaybes
for Sequence though.)
I think your code should be pretty efficient. Since Sequences are tree data structures using another tree type data structure like Map or HashMap to store and lookup the previous items doesn't make too much sense to me.
Instead i take the first item and check it's existence in the rest. If exists i drop that item and proceed the same with the rest recursively. If not then construct a new sequence with first element is the unique element and the rest is the result of nubSeq fed by the rest. Should be typical. I use ViewPatterns.
{-# LANGUAGE ViewPatterns #-}
import Data.Sequence as Seq
nubSeq :: Eq a => Seq a -> Seq a
nubSeq (viewl -> EmptyL) = empty
nubSeq (viewl -> (x :< xs)) | elemIndexL x xs == Nothing = x <| nubSeq xs
| otherwise = nubSeq xs
*Main> nubSeq . fromList $ [1,2,3,4,4,2,3,6,7,1,2,3,4]
fromList [6,7,1,2,3,4]
I have been working on a question about reflexive closure:
The reflexive closure of a relation R is the smallest relation bigger than R which is reflexive. In other words, it is R with whatever pairs added to make R reflexive. Write a function (reflClosure) which takes a list of pairs (standing for R) and returns a list of pairs which is the reflexive closure of R. You do not need to worry about the order in which pairs appear in your return value.
I came up with this solution but it seems quite sloppy and lack neatness.
-- QUESTION 2: Functions and relations
reflClosure :: (Eq a) => [(a,a)] -> [(a,a)]
reflClosure (x:xs) = nub ( (x:xs) ++ [ (x,x) | x <- (heads (x:xs)) ++ (tails
(x:xs)) ])
nub :: Eq a => [a] -> [a]
nub = nubBy (==)
nubBy :: (a -> a -> Bool) -> [a] -> [a]
nubBy eq [] = []
nubBy eq (x:xs) = x : nubBy eq (filter (\y -> not (eq x y)) xs)
heads :: (Eq a) => [(a,a)] -> [a]
heads list = nub [x | (x, _) <- list]
tails :: (Eq a) => [(a,a)] -> [a]
tails list = nub [x | (_,x) <- list]
exists :: (Eq a) => (a,a) -> [(a,a)] -> Bool
exists x xs = length (filter (==x) xs) > 0
-- TEST SET FOR Q2
{-
Your functions should have the following behaviour:
reflClosure [(1,2),(3,2)] = [(1,2),(3,2),(1,1),(2,2),(3,3)]
reflClosure [(1,1),(3,5)] = [(1,1),(3,5),(3,3),(5,5)]
DO NOT WORRY ABOUT THE ORDER IN WHICH PAIRS APPEAR IN YOUR LIST
-}
Is there an easier way to do this? Explanation would be incredibly useful to learn from as well.
A nicer way to write heads and tails is the following:
heads :: (Eq a) => [(a,a)] -> [a]
heads = nub . map fst
tails :: (Eq a) => [(a,a)] -> [a]
tails = nub . map snd
It's point-free, plus it uses the more "functional" map rather than a list comprehension.
However, the fact that you need both means there's an even nicer way:
(heads (x:xs), tails (x:xs)) = (\(a,b) -> (nub a) (nub b)) $ unzip (x:xs)
Getting the fsts and the snds is equivalent to an unzip.
Also, you can simplify the signature of exists:
exists :: (Eq a) => a -> [a] -> Bool
exists x xs = length (filter (==x) xs) > 0
since nothing depends on the input being a list of pairs.
Data.List already defines nubBy, so I'm not sure why you've defined it there.
It's not clear why you've defined reflClosure to match on (x:xs), because all you care about (apparently) is that the list is non-empty. Perhaps something like this:
reflClosure :: (Eq a) => [(a,a)] -> [(a,a)]
reflClosure [] = []
reflClosure xs =
let (as,bs) = unzip xs
in nub $ xs ++ [ (x,x) | x <- (nub as) ++ (nub bs) ]
Relations are isomorphic to sets of pairs, not lists of pairs, so it makes sense to model them as such. Note that all the Ord constraints below are there because the implementation of Set needs it.
Use the standard library sets because they are fast.
import Data.Set (Set)
import qualified Data.Set as Set
A type synonym to make the code easier to read:
-- A relation with underlying set s
type Relation s = Set (s,s)
Now we can write a function that gets all the members of the underlying set:
underlyingMembers :: Ord a => Relation a -> Set a
underlyingMembers r = (Set.map fst r) `Set.union` (Set.map snd r)
Once we have that, finding the reflexive closure of a relation is easy:
reflexiveClosure :: Ord a => Relation a -> Relation a
reflexiveClosure r = r `Set.union` (Set.map (\x -> (x,x)) (underlyingMembers r)
If you really need to work with lists, (you really shouldn't, though) you can fromList/toList:
listVersion :: Ord a => [(a,a)] -> [(a,a)]
listVersion = Set.toList . reflexiveClosure . Set.fromList
If any of this is unclear, please leave a comment and I will explain more in detail.
I am very new to Haskell. I am trying to write code in Haskell that finds the first duplicate element from the list, and if it does not have the duplicate elements gives the message no duplicates. I know i can do it through nub function but i am trying to do it without it.
This is one way to do it:
import qualified Data.Set as Set
dup :: Ord a => [a] -> Maybe a
dup xs = dup' xs Set.empty
where dup' [] _ = Nothing
dup' (x:xs) s = if Set.member x s
then Just x
else dup' xs (Set.insert x s)
dupString :: (Ord a, Show a) => [a] -> [Char]
dupString x = case dup x of
Just x -> "First duplicate: " ++ (show x)
Nothing -> "No duplicates"
main :: IO ()
main = do
putStrLn $ dupString [1,2,3,4,5]
putStrLn $ dupString [1,2,1,2,3]
putStrLn $ dupString "HELLO WORLD"
Here is how it works:
*Main> main
No duplicates
First duplicate: 1
First duplicate: 'L'
This is not the your final answer, because it does unnecessary work when an element is duplicated multiple times instead of returning right away, but it illustrates how you might go about systematically running through all the possibilities (i.e. "does this element of the list have duplicates further down the list?")
dupwonub :: Eq a => [a] -> [a]
dupwonub [] = []
dupwonub (x:xs) = case [ y | y <- xs, y == x ] of
(y:ys) -> [y]
[] -> dupwonub xs
In case you are still looking into Haskell I thought you might like a faster, but more complicated, solution. This runs in O(n) (I think), but has a slightly harsher restriction on the type of your list, namely has to be of type Ix.
accumArray is an incredibly useful function, really recommend looking into it if you haven't already.
import Data.Array
data Occurances = None | First | Duplicated
deriving Eq
update :: Occurances -> a -> Occurances
update None _ = First
update First _ = Duplicated
update Duplicated _ = Duplicated
firstDup :: (Ix a) => [a] -> a
firstDup xs = fst . first ((== Duplicated).snd) $ (map g xs)
where dupChecker = accumArray update None (minimum xs,maximum xs) (zip xs (repeat ()))
g x = (x, dupChecker ! x)
first :: (a -> Bool) -> [a] -> a
first _ [] = error "No duplicates master"
first f (x:xs) = if f x
then x
else first f xs
Watch out tho, an array of size (minimum xs,maximum xs) could really blow up your space requirements.