How to un-flatten a list

Question

I can flatten a nested data structure with ease, but the dual operation seems awfully difficult (at least for me).

Given a List of type [(a,b,c)], how can I create a nested structure, i.e.

unflatten :: (Ord a, Ord b) => [(a,b,c)] -> [(a, [(b, [c])])]

such that each a only occurs only once and likewise each combination of (a,b)

I don't quite know why I am struggling with this, because the dual operation is really simple

flatten :: [(a, [(b, [c])])] -> [(a,b,c)]
flatten xs = [(a,b,c) | (a,bcs) <- xs, (b,cs) <- bcs, c<-cs]

Update

Following EricR's suggestion I wrote a function which does one level of un-flattening, but I am still struggling to extend it

grp :: Ord b => [(b,c)] -> [(b,[c])]
grp xs = do
    b <- (nub . sort . map fst) xs 
    let cs = [c' | (b',c') <- xs, b'==b]
    return (b,cs)

Answer 1

Following ErikR's advice, a pattern emerged how to extend it to longer and longer tuples.

-- construct some raw material
l a i = map ((a ++) . show) [1..i]
l4 = [(a,b,c,d) | d<-l "d" 3, c <- l "c" 3, b<-l "b" 3, a<-l "a" 2 ]

grp2 :: Ord a => [(a,b)] -> [(a,[b])]
grp2 xs = do
    a <- (nub . sort . map fst) xs 
    let bs = [b' | (a',b') <- xs, a'==a]
    return (a,bs)

grp3 :: (Ord a, Ord b) => [(a,b,c)] -> [(a,[(b,[c])])]
grp3 ys = do
    (a, bcs) <- grp2 (map split3 ys)
    return (a, grp2 bcs)
          where
              split3 (a,b,c) = (a,(b,c))

grp4 :: (Ord a, Ord b, Ord c) => [(a,b,c,d)] -> [(a,[(b,[(c,[d])])])]
grp4 zs = do
    (a, bcds) <- grp2 (map split4 zs)
    return (a, grp3 bcds)
          where
              split4 (a,b,c,d) = (a,(b,c,d))

Now

*Main> pp $ grp4 l4

Prints

[ ( "a1"
  , [ ( "b1"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    , ( "b2"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    , ( "b3"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    ]
  )
, ( "a2"
  , [ ( "b1"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    , ( "b2"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    , ( "b3"
      , [ ( "c1" , [ "d1" , "d2" , "d3" ] )
        , ( "c2" , [ "d1" , "d2" , "d3" ] )
        , ( "c3" , [ "d1" , "d2" , "d3" ] )
        ]
      )
    ]
  )
]

Answer 2

Personally I'd put that data into a nested map. You can always pull it out again into nested association lists afterwards.

First convert each item into a (small) nested map with 1 element in the list [c]:

import qualified Data.Map as M
import Data.List

triplesToMaps :: [(a,b,c)] -> [M.Map a (M.Map b [c])]
triplesToMaps = map (\(a,b,c) -> M.singleton a (M.singleton b [c]))

then combine them all using unionWith

combineMaps :: (Ord a, Ord b) => [M.Map a (M.Map b [c])] -> M.Map a (M.Map b [c])
combineMaps = foldl' (M.unionWith (M.unionWith (++))) M.empty

and then, if you want, bring it back to lists:

flattenToLists :: M.Map a (M.Map b [c]) -> [(a,[(b,[c])])]
flattenToLists = M.assocs . (M.map M.assocs)

Example:

> flattenToLists . combineMaps . triplesToMaps $ [(1,2,3),(1,2,4),(1,3,5),(2,6,8)]
[(1,[(2,[3,4]),(3,[5])]),(2,[(6,[8])])]

In practice you probably wouldn't flattenToLists because the nested map is the more useful structure.

Incidentally, if Map had the "right" Monoid structure then M.unionWith (M.unionWith (++)) would just be mappend, and the whole thing could be foldMap (\(a,b,c) -> M.singleton a (M.singleton b [c])).

[edited : added the dual as in the question]

Oh, and to go back to [(a,b,c)] two approaches spring to mind. The list comprehension just like yours, but using assocs:

flatten :: M.Map a (M.Map b [c]) -> [(a,b,c)]
flatten m = [(a,b,c) | (a,bcs) <- M.assocs m, (b,cs) <- M.assocs bcs, c <- cs]

or the version using foldMap:

flatten' :: M.Map a (M.Map b [c]) -> [(a,b,c)]
flatten' = M.foldMapWithKey (\a -> M.foldMapWithKey (\b -> foldMap (\c -> [(a,b,c)])))