Zipping con relleno en Haskell

Question

Un par de veces me he encontrado queriendo un zip en Haskell que agrega relleno a la lista más corta en lugar de truncar la más larga. Esto es bastante fácil de escribir. (Monoid funciona para mí aquí, pero también se podría sólo tiene que pasar en los elementos que desea utilizar para el relleno.)

zipPad :: (Monoid a, Monoid b) => [a] -> [b] -> [(a, b)] 
zipPad xs [] = zip xs (repeat mempty) 
zipPad [] ys = zip (repeat mempty) ys 
zipPad (x:xs) (y:ys) = (x, y) : zipPad xs ys 

Este enfoque pone feo cuando se trata de definir zipPad3. He escrito el siguiente y luego se dio cuenta de que, por supuesto, no funciona:

zipPad3 :: (Monoid a, Monoid b, Monoid c) => [a] -> [b] -> [c] -> [(a, b, c)] 
zipPad3 xs [] [] = zip3 xs (repeat mempty) (repeat mempty) 
zipPad3 [] ys [] = zip3 (repeat mempty) ys (repeat mempty) 
zipPad3 [] [] zs = zip3 (repeat mempty) (repeat mempty) zs 
zipPad3 xs ys [] = zip3 xs ys (repeat mempty) 
zipPad3 xs [] zs = zip3 xs (repeat mempty) zs 
zipPad3 [] ys zs = zip3 (repeat mempty) ys zs 
zipPad3 (x:xs) (y:ys) (z:zs) = (x, y, z) : zipPad3 xs ys zs 

En este punto hice trampa y sólo se utiliza para recoger length la lista más larga y la almohadilla de los otros.

¿Estoy pasando por alto una forma más elegante de hacer esto, o es algo como zipPad3 ya definido en alguna parte?

Answer 1

¿Qué hay de encargo head y tail funciones (llamado next y rest en mi ejemplo más abajo)?

import Data.Monoid 

zipPad :: (Monoid a, Monoid b) => [a] -> [b] -> [(a,b)] 
zipPad [] [] = [] 
zipPad xs ys = (next xs, next ys) : zipPad (rest xs) (rest ys) 

zipPad3 :: (Monoid a, Monoid b, Monoid c) => [a] -> [b] -> [c] -> [(a,b,c)] 
zipPad3 [] [] [] = [] 
zipPad3 xs ys zs = (next xs, next ys, next zs) : zipPad3 (rest xs) (rest ys) (rest zs) 

next :: (Monoid a) => [a] -> a 
next [] = mempty 
next xs = head xs 

rest :: (Monoid a) => [a] -> [a] 
rest [] = [] 
rest xs = tail xs 

prueba fragmento:

instance Monoid Int where 
    mempty = 0 
    mappend = (+) 

main = do 
    print $ zipPad [1,2,3,4 :: Int] [1,2 :: Int] 
    print $ zipPad3 [1,2,3,4 :: Int] [9 :: Int] [1,2 :: Int] 

Su salida:

[(1,1),(2,2),(3,0),(4,0)] 
[(1,9,1),(2,0,2),(3,0,0),(4,0,0)] 

Answer 2

Este patrón se acerca bastante. Una solución que he aprendido de Paul Chiusano es el siguiente:

data OneOrBoth a b = OneL a | OneR b | Both a b 

class Align f where 
    align :: (OneOrBoth a b -> c) -> f a -> f b -> f c 

instance Align [] where 
    align f []  []  = [] 
    align f (x:xs) []  = f (OneL x) : align f xs [] 
    align f []  (y:ys) = f (OneR y) : align f [] ys 
    align f (x:xs) (y:ys) = f (Both x y) : align f xs ys 

liftAlign2 f a b = align t 
    where t (OneL l) = f l b 
     t (OneR r) = f a r 
     t (Both l r) = f l r 

zipPad a b = liftAlign2 (,) a b 

liftAlign3 f a b c xs ys = align t (zipPad a b xs ys) 
    where t (OneL (x,y)) = f x y c 
     t (OneR r)  = f a b r 
     t (Both (x,y) r) = f x y r 

zipPad3 a b c = liftAlign3 (,,) a b c 

Una pequeña prueba en ghci:

*Main> zipPad3 ["foo", "bar", "baz"] [2, 4, 6, 8] [True, False] "" 0 False 
[("foo",2,True),("bar",4,False),("baz",6,False),("",8,False)] 

Answer 3

Hay momentos en los que desea ser capaz de aplicar una función diferente a cualquiera de la cola en lugar de sólo suministro mempty o manuales ceros así:

zipWithTail :: (a -> a -> a) -> [a] -> [a] -> [a] 
zipWithTail f (a:as) (b:bs) = f a b : zipWithTails f as bs 
zipWithTail f [] bs = bs 
zipWithTail f as _ = as 

zipWithTails :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] 
zipWithTails l r f (a:as) (b:bs) = f a b : zipWithTails l r f as bs 
zipWithTails _ r _ [] bs = fmap r bs 
zipWithTails l _ _ as _ = fmap l as 

que utilizan la antigua cuando estoy haciendo algo así como zipWithTail (+) y el primero cuando necesito hacer algo como zipWithTail (*b) (a*) (\da db -> a*db+b*da) ya que el primero puede ser mucho más eficiente que alimentar un defecto en una función, y el último un poco.

Sin embargo, si solo quisiera hacer una versión más sucinta de lo que tiene, probablemente podría recurrir a mapAccumL, pero no es más claro, y ++ puede ser costoso.

zipPad as bs = done $ mapAccumL go as bs 
    where go (a:as) b = (as,(a,b)) 
      go [] b = ([],(mempty,b)) 
      done (cs, both) = both ++ fmap (\x -> (x, mempty)) cs 

Answer 4

Una forma más sencilla de hacerlo es con Maybe. Ilustraré con la formulación más general de Edward :

import Data.Maybe 
import Control.Applicative 

zipWithTails l r f as bs = catMaybes . takeWhile isJust $ 
    zipWith fMaybe (extend as) (extend bs) 
    where 
    extend xs = map Just xs ++ repeat Nothing 
    fMaybe a b = liftA2 f a b <|> fmap l a <|> fmap r b