Haskell dynamically transpose multiple lists to single list recursively

Question

Not sure if "dynamically" is the right word for this problem.

I've been struggling for a while to find a solution for zipping multiple lists into a single list but I'm starting to think that my approach is not possible. It works well for two lists but not for three(and probably not with more than three). The function is supposed to work as transpose but result in a list of integers and not a list of lists of integers. But if it results in a list of lists it would also work. Theoretically, the function is supposed to work for an arbitrary number of lists.

For example [1,2,3] myTranspose [4,5,6] myTranspose [7,8,9] should result in [1, 4, 7, 2, 5, 8, 3, 6, 9]

Is this possiible?

My attempt so far:

myTranspose :: [Int] -> [Int] -> [Int]
myTranspose [] []         = []
myTranspose [x] []        = [x]
myTranspose [] [y]        = [y] 
myTranspose [x] [y]       = [x,y]
myTranspose (x:xs) [y]    = (x:y:xs)
myTranspose [x] (y:ys)    = (x:y:ys)
myTranspose (x:xs) (y:ys) = [x,y] ++ zip' xs ys

EDIT MY ACTUAL PROBLEM:

I should have asked this from the beginning but I thought it would be simpler to convert the problem to a list of integers. Sorry about that.

I have a data-type Function and a function that chains Functions together:

data Function where
    (|||) :: Function -> Function -> Function
    A ::  Char -> Function
    B ::  Int  -> Function

chain :: Function -> Function -> Function
chain f1 f2 = f1 ||| f2

And I also have a function that is supposed to work like transpose as I described above:

(<|||>) :: Funcion -> Function -> Function
 ...something like this..
(<|||>) (p1 ||| p2) (q1 ||| q2)     =  (p1 <|||> q1) ||| (p2 <|||> q2)
(<|||>) (p1 ||| p2)       q          =  p1 <|||> p2 ||| q 
(<|||>)       p         (q1 ||| q2)  =  p  ||| q1 <|||> q2
(<|||>)       p           q          =  p  ||| q

I managed to solve the problem using ordinary lists and the ordinary transpose-function as moonGoose suggested. But the problem is that the compliler complains about not have enough memory if I do it that way. The function call would look like this, exept the list would be very large:

transpose ((A 'a' ||| B 5 ||| A 'n')   <|||>  
             (A 'o' ||| B 3 ||| A 'p') <|||>
            (A 'i' ||| B 0 ||| A 'l'))

But when I run the program with "my" list-function and an imperfect custom transpose-function the compiler don't complain. My thought was that this has to do with laziness. Could that be the issue? Thank you for helping.

Answer 1

After the edit, I think you want something like this? As chi has alluded to already in a comment, it's confusing because it seems that (|||) is associative, which is perhaps the core of the issue you're encountering. If it is associative, then the underlying structure is (non-empty-)list-like, so we know how to take the transpose of them and glue them together easily etc. But if it's not associative, then the representation is instead tree-like, and I don't think you can canonically mappend / transpose trees (eg. does A 0 <> A 1 <> A 2 = (A 0 ||| A 1) ||| A 2 or A 0 ||| (A 1 ||| A 2)? which matters iff (|||) is not associative).

import Control.Lens.Iso (iso, mapping, under)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty)
import Data.Semigroup (sconcat)

instance Semigroup Function where
  (<>) = (|||)

transposeFuncs :: NonEmpty Function -> Function
transposeFuncs = sconcat . under (mapping $ iso reify reflect) NE.transpose
  where
    reflect :: Function -> NonEmpty (Either Char Int)
    reflect (a ||| b) = reflect a <> reflect b
    reflect (A a)     = pure $ Left  a
    reflect     (B b) = pure $ Right b
    reify :: NonEmpty (Either Char Int) -> Function
    reify = sconcat . NE.map (either A B)

transposeFuncs $ NE.fromList 
  [ A 'a' ||| B  5  ||| A 'n'
  , A 'o' ||| B  3  ||| A 'p'
  , A 'i' ||| B  0  ||| A 'l'
  ]
  ==  A 'a' ||| A 'o' ||| A 'i'
  ||| B  5  ||| B  3  ||| B  0
  ||| A 'n' ||| A 'p' ||| A 'l' 

EDIT: If you wished to express associativity in the datatype, then you'd use something like the following. See how much better it is when the types match the intent; each (semantic) value has only one representation. If you allowed for an identity then it would be cleaner still.

import Control.Lens (makeWrapped, mapping, under, _Unwrapped')
import Data.List.NonEmpty (NonEmpty, transpose)
import Data.Semigroup (sconcat)

data FuncAtom
  = A Char
  | B Int

newtype Function
  = FCompose (NonEmpty FuncAtom)
  deriving Semigroup via NonEmpty FuncAtom
makeWrapped ''Function

transposeFuncs :: NonEmpty Function -> Function
transposeFuncs = sconcat . under (mapping _Unwrapped') transpose

Answer 2

Perhaps you may do like this dynamically

zwh :: [[a]] -> [a]
zwh xss = if any ((== 0) . length) xss then []
                                       else hs ++ zwh ts
          where
          (hs,ts) = foldr (\(hs',ts') (rs,qs) -> (hs':rs,ts':qs)) ([],[]) hts
          hts     = (,) <$> head <*> tail <$> xss

λ> zwh [[1,2,3],[4,5,6],[7,8,9]]
[1,4,7,2,5,8,3,6,9]
λ> zwh [[1,2],[4,5,6],[7,8,9]]
[1,4,7,2,5,8]

or depending on the type a, if it is OK to include EQ a => constraint it gets further simplified to

zwh :: Eq a => [[a]] -> [a]
zwh xss = if any (== []) xss then []
                             else hs ++ zwh ts
          where
          (hs,ts) = foldr (\(hs',ts') (rs,qs) -> (hs':rs,ts':qs)) ([],[]) hts
          hts     = (,) <$> head <*> tail <$> xss