Закрепление с заполнением в Haskell

Несколько раз я обнаружил, что хочу zip в Haskell, который добавляет дополнение к более короткому списку вместо того, чтобы обрезать более длинный. Это достаточно легко написать. (Monoid работает для меня здесь, но вы также можете просто передать элементы, которые вы хотите использовать для заполнения.)

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

Этот подход становится уродливым при попытке определить zipPad3. Я набрал следующее, а затем понял, что, конечно, он не работает:

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

На этом этапе я обманул и просто использовал length, чтобы выбрать самый длинный список и наложить остальные.

Я не замечаю более элегантный способ сделать это или что-то вроде zipPad3 уже определен где-то?

Ответ 1

Как насчет пользовательских head и tail функций (названных next и rest в моем примере ниже)?

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

Тестовый фрагмент:

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]

Его вывод:

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

Ответ 2

Этот шаблон довольно много. Решение, которое я узнал из Paul Chiusano, выглядит следующим образом:

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

Небольшой тест в 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)]

Ответ 3

Более простой способ сделать это - Maybe. Я проиллюстрирую с помощью Эдварда более общая формулировка:

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

Ответ 4

Бывают случаи, когда вы хотите использовать другую функцию для хвоста, а не только для mempty или ручных нулей:

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

Я использую первое, когда делаю что-то вроде zipWithTail (+) и первый, когда мне нужно сделать что-то вроде zipWithTail (*b) (a*) (\da db -> a*db+b*da), так как первое может быть намного более эффективным, чем подавать значение по умолчанию в функцию, а второе - немного.

Однако, если вы просто хотите сделать более сжатую версию того, что у вас есть, вы, вероятно, можете перейти к mapAccumL, но его не яснее, а ++ может быть дорогостоящим.

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