在Haskell中将列表拆分为非空子列表

时间:2018-10-14 17:25:44

标签: haskell

我必须将给定列表拆分为非空子列表,每个子列表 严格按升序,严格降序或包含所有相等的元素。例如,[5,6,7,2,1,1,1]应该变为[[5,6,7],[2,1],[1,1]]。

这是我到目前为止所做的:

splitSort :: Ord a => [a] -> [[a]] 
splitSort ns = foldr k [] ns
  where
    k a []  = [[a]]
    k a ns'@(y:ys) | a <= head y = (a:y):ys
                   | otherwise = [a]:ns'

我认为我已经很近了,但是当我使用它时,它输出的是[[5,6,7],[2],[1,1,1]]而不是[[5,6,7],[2 ,1],[1,1]]。

6 个答案:

答案 0 :(得分:2)

这是一个有点丑陋的解决方案,在一行代码中有三个reverse

addElement :: Ord a => a -> [[a]] -> [[a]]
addElement a []  = [[a]]
addElement a (x:xss) = case x of
  (x1:x2:xs) 
    | any (check a x1 x2) [(==),(<),(>)] -> (a:x1:x2:xs):xss
    | otherwise -> [a]:(x:xss)
  _  -> (a:x):xss
  where 
    check x1 x2 x3 op = (x1 `op` x2) && (x2 `op` x3) 

splitSort xs = reverse $ map reverse $ foldr addElement [] (reverse xs)

如果稍微修改addElement,就可以摆脱所有的反转。

编辑: 这是一个可逆的版本(甚至适用于无限列表):

splitSort2 []         = []
splitSort2 [x]        = [[x]]
splitSort2 (x:y:xys)  = (x:y:map snd here):splitSort2 (map snd later)
  where 
    (here,later) = span ((==c) . uncurry compare) (zip (y:xys) xys)
    c            = compare x y  

编辑2: 最后,这是一个基于单一装饰/取消装饰的解决方案,它避免了多次比较任何两个值,并且效率可能更高。

splitSort xs = go (decorate xs) where
  decorate :: Ord a => [a] -> [(Ordering,a)]
  decorate xs = zipWith (\x y -> (compare x y,y)) (undefined:xs) xs

  go :: [(Ordering,a)] -> [[a]]
  go ((_,x):(c,y):xys)  = let (here, later) = span ((==c) . fst) xys in 
                              (x : y : map snd here) : go later
  go xs = map (return . snd) xs -- Deal with both base cases

答案 1 :(得分:2)

最初尝试的结果很长,可能效率很低,但出于完整性考虑,我会尽量保留它。最好只是跳到最后寻找答案。

一个很好的问题...但是事实证明它有点硬。我的方法是细分的,每个细分我都会解释;

import Data.List (groupBy)

splitSort :: Ord a => [a] -> [[a]]
splitSort (x:xs) = (:) <$> (x :) . head <*> tail $ interim
                   where
                   pattern = zipWith compare <$> init <*> tail
                   tuples  = zipWith (,) <$> tail <*> pattern
                   groups  = groupBy (\p c -> snd p == snd c) . tuples $ (x:xs)
                   interim = groups >>= return . map fst

*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
  • pattern函数(zipWith compare <$> init <*> tail)的类型为Ord a => [a] -> [Ordering],当与[5,6,7,2,1,1,1]一起使用时,将其inittail相比较zipWith因此结果将是[LT,LT,GT,GT,EQ,EQ]。这就是我们需要的模式。
  • tuples函数将使用列表中的tail,并将pattern的结果中的元素与相应的元素进行元组化。所以我们最终会得到类似[(6,LT),(7,LT),(2,GT),(1,GT),(1,EQ),(1,EQ)]的内容。
  • groups函数在元组的第二项上利用Data.List.groupBy并生成所需的子列表,例如[[(6,LT),(7,LT)],[(2,GT),(1,GT)],[(1,EQ),(1,EQ)]]
  • 临时是我们摆脱Ordering类型值和元组的地方。临时结果为[[6,7],[2,1],[1,1]]
  • 最后,在主函数主体(:) <$> (x :) . head <*> tail $ interim上,我们的列表的第一项(x)附加到head的子列表中(无论如何都必须存在),并辉煌地存在解决方案。

编辑:因此,调查@JonasDuregård发现的[0,1,0,1]导致的[[0,1],[0],[1]]问题,我们可以得出结论,结果中将没有长度为的子列表。 1个,但最后一个除外。我的意思是,对于像[0,1,0,1,0,1,0]这样的输入,上面的代码会产生[[0,1],[0],[1],[0],[1],[0]],而它应该[[0,1],[0,1],[0,1],[0]]。因此,我相信在最后阶段添加一个squeeze函数应该可以纠正逻辑。

import Data.List (groupBy)

splitSort :: Ord a => [a] -> [[a]]
splitSort []     = []
splitSort [x]    = [[x]]
splitSort (x:xs) = squeeze $ (:) <$> (x :) . head <*> tail $ interim
                   where
                   pattern = zipWith compare <$> init <*> tail
                   tuples  = zipWith (,) <$> tail <*> pattern
                   groups  = groupBy (\p c -> snd p == snd c) $ tuples (x:xs)
                   interim = groups >>= return . map fst

                   squeeze []           = []
                   squeeze [y]          = [y]
                   squeeze ([n]:[m]:ys) = [n,m] : squeeze ys
                   squeeze ([n]:(m1:m2:ms):ys) | compare n m1 == compare m1 m2 = (n:m1:m2:ms) : squeeze ys
                                               | otherwise                     = [n] : (m1:m2:ms) : squeeze ys
                   squeeze (y:ys)       = y : squeeze s

*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]

是;您也将同意,该代码原来太冗长,可能不太有效。

答案:当我不断告诉我自己走错路时,我必须相信我的后脑。有时,像在这种情况下,问题可以简化为一条if then else指令,比我最初预期的要简单得多。

runner :: Ord a => Maybe Ordering -> [a] -> [[a]]
runner _       []  = []
runner _       [p] = [[p]]
runner mo (p:q:rs) = let mo'    = Just (compare p q)
                         (s:ss) = runner mo' (q:rs)
                     in if mo == mo' || mo == Nothing then (p:s):ss
                                                      else [p] : runner Nothing (q:rs)
splitSort :: Ord a => [a] -> [[a]]
splitSort = runner Nothing

我的测试用例

*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
*Main> splitSort [1,2,3,5,2,0,0,0,-1,-1,0]
[[1,2,3,5],[2,0],[0,0],[-1,-1],[0]]

答案 2 :(得分:1)

我想知道如果拆分列表并将其分组,是否可以使用foldr解决这个问题

 [5,6,7,2,1,1,1]

 [[5,6,7],[2,1],[1,1]]

代替

 [[5,6,7],[2],[1,1,1]]

问题出在文件夹的每个步骤中,我们只知道右侧的排序子列表和要处理的数字。例如读取[5,6,7,2,1,1,1]的[1,1]并进行下一步后,我们就有了

1, [[1, 1]] 

没有足够的信息来确定是否将新的1组或1组设置为[[1,1]]

因此,我们可以通过从左到右读取list的元素以及为什么要使用foldl来构造所需的排序子列表。这是没有优化速度的解决方案。

编辑: 正如@JonasDuregård在评论中指出的问题,一些多余的代码已被删除,并提防它不是一种有效的解决方案。

splitSort::Ord a=>[a]->[[a]]
splitSort numList = foldl step [] numList
    where step [] n       = [[n]]
          step sublists n = groupSublist (init sublists) (last sublists) n

          groupSublist sublists [n1] n2 = sublists ++ [[n1, n2]]
          groupSublist sublists sortedList@(n1:n2:ns) n3
            | isEqual n1 n2 = groupIf (isEqual n2 n3) sortedList n3 
            | isAscen n1 n2 = groupIfNull isAscen sortedList n3
            | isDesce n1 n2 = groupIfNull isDesce sortedList n3
            | otherwise     = mkNewGroup sortedList n3
            where groupIfNull check sublist@(n1:n2:ns) n3
                    | null ns   = groupIf (check n2 n3) [n1, n2] n3
                    | otherwise = groupIf (check (last ns) n3) sublist n3
                  groupIf isGroup | isGroup   = addToGroup
                                  | otherwise = mkNewGroup
                  addToGroup gp n = sublists ++ [(gp ++ [n])]
                  mkNewGroup gp n = sublists ++ [gp] ++ [[n]]

          isEqual x y = x == y
          isAscen x y = x < y
          isDesce x y = x > y

答案 3 :(得分:1)

对于此解决方案,我假设您想要“最长的反弹”。我的意思是:

splitSort [0, 1, 0, 1] = [[0,1], [0,1]]    -- This is OK
splitSort [0, 1, 0, 1] = [[0,1], [0], [1]] -- This is not OK despite of fitting your requirements 

基本上,有两部分:

  • 首先,将列表分为两部分:(a, b)。考虑到前两个元素的顺序,a部分是最长的反弹行情。 b部分是列表的其余部分。
  • 第二,在splitSort上应用b并将所有列表放入一个列表中

出人意料的是,最长的集会却是混乱而平直的。给定列表x:y:xs:根据构造,xy将属于集会。 xs中属于集会的元素取决于它们是否遵循Orderingx的{​​{1}}。为了检查这一点,您将已比较y的每个元素与其先前的元素进行比较,并在Ordering更改时拆分列表。 (边缘情况是模式匹配的)在代码中:

Ordering

答案 4 :(得分:1)

每个有序前缀都已经按一定顺序排列,只要它最长,您就不必在意哪个前缀:

import Data.List (group, unfoldr)

foo :: Ord t => [t] -> [[t]]
foo = unfoldr f
  where
  f []  = Nothing
  f [x] = Just ([x], [])
  f xs  = Just $ splitAt (length g + 1) xs
            where 
            (g : _) = group $ zipWith compare xs (tail xs)

length可以被融合以使splitAt本质上成为一元计数,因此并不那么严格(不必要,正如JonasDuregård正确评论的那样):

  ....
  f xs  = Just $ foldr c z g xs
            where 
            (g : _) = group $ zipWith compare xs (tail xs)
            c _ r (x:xs) = let { (a,b) = r xs } in (x:a, b)
            z     (x:xs) = ([x], xs)

答案 5 :(得分:0)

我最初的想法是:

ordruns :: Ord a => [a] -> [[a]]
ordruns = foldr extend []
  where
    extend a [                    ] = [      [a]      ]
    extend a (    [b]       : runs) =       [a,b]   : runs
    extend a (run@(b:c:etc) : runs)
      | compare a b == compare b c  =       (a:run) : runs
      | otherwise                   = [a] : run     : runs

它从右边急切地填充,同时在每个子列表的所有相邻对中保持Ordering。因此,只有第一个结果可以在其中包含单个项目。

思考过程是这样的:Ordering描述了我们正在寻找的三种子序列类型:升序LT,等于EQ或降序GT。每次我们添加另一个项目时都保持相同意味着这将在整个子序列中匹配。因此,我们知道只要Ordering不匹配,就需要重新开始运行。此外,不可能比较0或1个项目,因此我们创建的每个运行都至少包含1个项目,如果只有1个项目,则我们确实添加了新项目。

我们可以添加更多规则,例如偏好填充左或右。合理的优化方法是存储序列的顺序,而不是对每个项目的前两个项目进行两次比较。我们还可以使用更具表现力的类型。我还认为,由于该版本从正确的位置进行收集,因此该版本效率低下(并且不适用于无限列表)。这主要是因为我可以使用缺点(:)来构建列表。

第二个想法:我可以使用普通递归从左侧收集列表。

ordruns :: Ord a => [a] -> [[a]]
ordruns [] = []
ordruns [a] = [[a]]
ordruns (a1:a2:as) = run:runs
  where
    runs = ordruns rest
    order = compare a1 a2
    run = a1:a2:runcontinuation
    (runcontinuation, rest) = collectrun a2 order as
    collectrun _ _ [] = ([], [])
    collectrun last order (a:as)
      | order == compare last a =
          let (more,rest) = collectrun a order as
          in (a:more, rest)
      | otherwise = ([], a:as)

更多练习。如果我们只建立一次比较列表以进行分组怎么办?

import Data.List

ordruns3 [] = []
ordruns3 [a] = [[a]]
ordruns3 xs = unfoldr collectrun marked
  where
    pairOrder = zipWith compare xs (tail xs)
    marked = zip (head pairOrder : pairOrder) xs
    collectrun [] = Nothing
    collectrun ((o,x):xs) = Just (x:map snd markedgroup, rest)
      where (markedgroup, rest) = span ((o==).fst) xs

然后是一个groupBy :: (a -> a -> Bool) -> [a] -> [[a]]但没有groupOn :: Eq b => (a -> b) -> [a] -> [[a]]的部分。我们可以使用包装器类型来处理。

import Data.List

data Grouped t = Grouped Ordering t
instance Eq (Grouped t) where
  (Grouped o1 _) == (Grouped o2 _) = o1 == o2
ordruns4 [] = []
ordruns4 [a] = [[a]]
ordruns4 xs = unmarked
  where
    pairOrder = zipWith compare xs (tail xs)
    marked = group $ zipWith Grouped (head pairOrder : pairOrder) xs
    unmarked = map (map (\(Grouped _ t) -> t)) marked

当然,包装类型的测试可以转换为使用groupBy的函数:

import Data.List

ordruns5 [] = []
ordruns5 [a] = [[a]]
ordruns5 xs = map (map snd) marked
  where
    pairOrder = zipWith compare xs (tail xs)
    marked = groupBy (\a b -> fst a == fst b) $
               zip (head pairOrder : pairOrder) xs

这些标记版本与JonasDuregård所采用的装饰概念相同。