Молнии с набивкой в ​​Хаскеле

Question

Пару раз я обнаружил, что хочу иметь в Хаскеле zip, который добавляет заполнение в более короткий список вместо усечения более длинного. Это достаточно легко написать. (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 уже определено где-то?

Answer 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)]

Answer 2

Эта модель встречается довольно часто. Решение, которое я узнал от Пола Кьюзано , заключается в следующем:

data These a b = This a | That b | These a b

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

instance Align [] where
  align f []     []     = []
  align f (x:xs) []     = f (This x)    : align f xs []
  align f []     (y:ys) = f (That y)    : align f [] ys
  align f (x:xs) (y:ys) = f (These x y) : align f xs ys

liftAlign2 f a b = align t
  where t (This l)    = f l b
        t (That r)    = f a r
        t (These 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 (This  (x,y))   = f x y c
        t (That  r)       = f a b r
        t (These (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)]

Answer 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

Answer 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