Списки списков списков

Ответ 1

Я считаю, что следующий пример должен быть близок к тому, что вы имели в виду. Сначала мы объявляем натуральные числа на уровне типа. Затем мы определяем векторы, которые несут их длину как тип phantom (см. векторы фиксированной длины в Haskell, часть 1: Использование GADT). И затем мы определяем структуру для вложенных списков списков..., которая несет глубину как тип phantom. Наконец, мы можем правильно определить тип rGroupBy.

{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}

import Data.List (groupBy)

data Zero
data Succ n

data Vec n a where
    Nil  ::                 Vec Zero a
    Cons :: a -> Vec n a -> Vec (Succ n) a

data LList n a where
    Singleton :: a           -> LList Zero a
    SuccList  :: [LList n a] -> LList (Succ n) a

-- Not very efficient, but enough for this example.
instance Show a => Show (LList n a) where
    showsPrec _ (Singleton x)   = shows x
    showsPrec _ (SuccList lls)  = shows lls

rGroupBy :: Vec n (a -> a -> Bool) -> [a] -> LList (Succ n) a
rGroupBy Nil
    = SuccList . map Singleton
rGroupBy (Cons f fs)
    = SuccList . map (rGroupBy fs) . groupBy f

-- TEST ------------------------------------------------------------

main = do
    let input = ["1.1", "1.2.1", "1.2.2", "2.1", "2.2", "3"]

    -- don't split anything
    print $ rGroupBy Nil input
    -- split on 2 levels
    print $ rGroupBy (Cons (deweyGroup 1) 
                           (Cons (deweyGroup 2) Nil))
               input 
  where
    deweyGroup :: Int -> String -> String -> Bool
    deweyGroup i a b = a!!idx == b!!idx where idx = 2*(i-1)

Ответ 2

Другой способ принудительного применения ограничения, что все ветки имеют равную глубину, заключается в использовании вложенного типа данных:

data LoL a = One [a] | Many (LoL [a])

mapLoL :: ([a] -> [b]) -> LoL a -> LoL b
mapLoL f (One xs) = One (f xs)
mapLoL f (Many l) = Many $ mapLoL (map f) l

rGroupBy :: [a -> a -> Bool] -> [a] -> LoL a
rGroupBy [] xs = One xs
rGroupBy (f:fs) xs = Many $ mapLoL (groupBy f) $ rGroupBy fs xs

Разлагая определение LoL, мы видим, что неформально

LoL a = [a] | [[a]] | [[[a]]] | ...

Тогда мы можем сказать, например:

ghci> rGroupBy [(==) `on` fst, (==) `on` (fst . snd)] [ (i,(j,k)) | i<-[1..3], j<-[1..3], k<-[1..3]]

чтобы вернуться

Many (Many (One [[[(1,(1,1)),(1,(1,2)),(1,(1,3))]],[[(1,(2,1)),(1,(2,2)),(1,(2,3)), ...

Ответ 3

На самом деле у вас есть дерево. Попробуйте представить его с рекурсивной структурой данных:

data LoL a = SoL [a] | MoL [LoL a] deriving (Eq, Show)

rGroupBy :: [(a -> a -> Bool)] -> [a] -> LoL a
rGroupBy (f:fs) = MoL . map (rGroupBy fs) . groupBy f
rGroupBy []     = SoL

deweyGroup :: Int -> String -> String -> Bool
deweyGroup i a b = a!!idx == b!!idx where idx = 2*(i-1)

rGroupBy [deweyGroup 1, deweyGroup 2] ["1.1", "1.2.1", "1.2.2", "2.1", "2.2", "3.0"] дает:

MoL [MoL [SoL ["1.1"],
          SoL ["1.2.1","1.2.2"]],
     MoL [SoL ["2.1"],
          SoL ["2.2"]],
     MoL [SoL ["3.0"]]
    ]

Ответ 4

Если вы хотите обеспечить равномерную глубину, существует (справедливый) стандартный трюк, чтобы сделать это с использованием полиморфной рекурсии. То, что мы будем делать, - это позвоночник "более глубоких" конструкторов, рассказывающий, насколько глубоко вложен список, а затем окончательный конструктор "здесь" с глубоко вложенным списком:

data GroupList a = Deeper (GroupList [a]) | Here a deriving (Eq, Ord, Show, Read)

Фактически, тип, определенный как определенный, имеет один эстетический выбор, который вы можете изменить в своем коде: конструктор Here принимает один a, а не список a s. Последствия этого выбора вроде бы разбросаны по остальной части этого ответа.

Здесь пример значения этого типа, показывающий списки списков; он имеет два конструктора Deeper, соответствующих глубине-два вложения, которые он имеет:

> :t Deeper (Deeper (Here [[1,2,3], []]))
Num a => GroupList a

Вот несколько примеров функций.

instance Functor GroupList where
    fmap f (Here   a ) = Here   (f a)
    fmap f (Deeper as) = Deeper (fmap (fmap f) as)
    -- the inner fmap is at []-type

-- this type signature is not optional
flatten :: GroupList [a] -> GroupList a
flatten (Here   a ) = Deeper (Here a)
flatten (Deeper as) = Deeper (flatten as)

singleGrouping :: (a -> a -> Bool) -> GroupList [a] -> GroupList [a]
singleGrouping f = flatten . fmap (groupBy f)

rGroupBy :: [a -> a -> Bool] -> [a] -> GroupList [a]
rGroupBy fs xs = foldr singleGrouping (Here xs) fs

Ответ 5

В качестве упражнения типа хакерства это можно реализовать со стандартными списками.

Все, что нам нужно, это произвольная функция depthStringBy:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts,
  UndecidableInstances, IncoherentInstances,
  TypeFamilies, ScopedTypeVariables #-}

import Data.List
import Data.Function

class StringGroupable a b where
    groupStringBy :: Pred -> a -> b

instance (StringGroupable a b, r ~ [b]) => StringGroupable [a] r where
    groupStringBy f = map (groupStringBy f)

instance (r ~ [[String]]) => StringGroupable [String] r where
    groupStringBy p = groupBy p

Что работает следующим образом:

*Main> let lst = ["11","11","22","1","2"]
*Main> groupStringBy ((==) `on` length) lst
[["11","11","22"],["1","2"]]
*Main> groupStringBy (==) . groupStringBy ((==) `on` length) $ lst
[[["11","11"],["22"]],[["1"],["2"]]]

Таким образом, мы можем использовать эту функцию напрямую (хотя ее нужно поместить в обратном порядке):

inp = ["1.1", "1.2.1", "1.2.2", "2.1", "2.2", "3"]

deweyGroup :: Int -> String -> String -> Bool
deweyGroup i a b = a!!idx == b!!idx where idx = 2*(i-1)

-- gives: [[["1.1"],["1.2.1","1.2.2"]],[["2.1"],["2.2"]],[["3"]]]
test1 = groupStringBy (deweyGroup 2) . groupStringBy (deweyGroup 1) $ inp

Но если вы хотите использовать свой оригинальный образец, мы можем его взломать. Сначала нам нужна переменная функция аргумента, которая передает все аргументы, но последние в обратном порядке через ., а затем применяет полученную функцию к последнему аргументу:

class App a b c r where
    app :: (a -> b) -> c -> r

instance (b ~ c, App a d n r1, r ~ (n -> r1)) => App a b (c -> d) r where
    app c f = \n -> app (f . c) n

instance (a ~ c, r ~ b) => App a b c r where
    app c a = c a

Работает следующим образом:

*Main> app not not not True
False
*Main> app (+3) (*2) 2
10

Затем разверните его с помощью специального правила для нашего типа предикатов type Pred = String -> String -> Bool:

type Pred = String -> String -> Bool

instance (StringGroupable b c, App a c n r1, r ~ (n -> r1)) => App a b Pred r where
    app c p = app ((groupStringBy p :: b -> c) . c)

И, наконец, оберните его в rGroupBy (функция id будет первой в конвейере):

rGroupBy :: (App [String] [String] Pred r) => Pred -> r
rGroupBy p = app (id :: [String] -> [String]) p

Теперь он должен работать для любого числа предикатов группировки типа Pred, создавая список глубины, равный числу предикатов, которые были поставлены:

-- gives: [["1.1","1.2.1","1.2.2"],["2.1","2.2"],["3"]]
test2 = rGroupBy (deweyGroup 1) inp

-- gives: [[["1.1"],["1.2.1","1.2.2"]],[["2.1"],["2.2"]],[["3"]]]
test3 = rGroupBy (deweyGroup 1) (deweyGroup 2) inp

-- gives: [[[["1.1"]],[["1.2.1","1.2.2"]]],[[["2.1"]],[["2.2"]]],[[["3"]]]]
test4 = rGroupBy (deweyGroup 1) (deweyGroup 2) (deweyGroup 1) inp

Таким образом, это возможно (и, вероятно, может быть упрощено), но, как всегда, с подобным хакером не рекомендуется использовать ни для чего, кроме упражнения.