Захватите понятие обратимых функций

Я иногда обнаруживаю, что полезно уловить понятие обратимых функций.

Идея состоит в том, что если две функции f :: a -> b и g :: b -> a являются обратной функцией друг от друга, и если есть еще одна функция h :: b -> b, тогда h также может работать с значениями типа a.

Кроме того, если f' и g' - это еще одна пара функций, которые являются обратной функцией друг друга, (f,g) и (f',g') может быть скомпонован в (f' . f, g . g'), а обратимость сохраняется.

Ниже приведена моя попытка реализовать это в Haskell, и мне интересно, может ли существующая библиотека сделать то же самое (или даже более общее) для меня. Также приветствуются советы и комментарии по поводу моего кода.

Реализация

Сначала я использую записи для хранения двух функций:

data Invertible a b = Invertible
    { into :: a -> b
    , back :: b -> a
    }

into означает «преобразовать a в b», а back означает «конвертировать b обратно в».

И затем несколько вспомогательных функций:

selfInv :: (a -> a) -> Invertible a a
selfInv f = Invertible f f

flipInv :: Invertible a b -> Invertible b a
flipInv (Invertible f g) = Invertible g f

borrow :: Invertible a b -> (b -> b) -> a -> a
borrow (Invertible fIn fOut) g = fOut . g . fIn

liftInv :: (Functor f) => Invertible a b -> Invertible (f a) (f b)
liftInv (Invertible a b) = Invertible (fmap a) (fmap b)

В приведенном выше коде borrow будет использовать пару функций, чтобы сделать свой последний аргумент g доступный для значений типа a. И изменение borrow f на borrow (flipInv f) сделает g доступным для значений типа b. Поэтому borrow отражает мою первоначальную идею создания функции типа b -> b, доступный для значений a, если a и b можно преобразовать друг в друга.

Кроме того, Invertible формирует моноидальную структуру, я использую rappend и rempty, чтобы предложить сходство между ним и Monoid:

rempty :: Invertible a a
rempty = selfInv id

rappend :: Invertible a b
         -> Invertible b c
         -> Invertible a c
(Invertible f1 g1) `rappend` (Invertible f2 g2) =
    Invertible (f2 . f1) (g1 . g2)

Примеры

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

Шифрование данных

Естественно, что Invertible может использоваться по сценарию симметричного шифрования. Invertible (encrypt key) (decrypt key) может быть одним экземпляром, если:

encrypt :: Key -> PlainText -> CipherText
decrypt :: Key -> CipherText -> PlainText

Чтобы немного упростить, я приведу пример шифра Цезаря и предположим, что простой текст содержит только прописные буквы:

-- constructor should be invisible from outside
newtype OnlyUpper a = OnlyUpper
    { getOU :: [a]
    } deriving (Eq, Ord, Show, Functor)

ouAsList :: Invertible (OnlyUpper a) [a]
ouAsList = Invertible getOU OnlyUpper

onlyUpper :: String -> OnlyUpper Char
onlyUpper = OnlyUpper . filter isAsciiUpper

upperAsOrd :: Invertible Char Int
upperAsOrd = Invertible ord' chr'
    where
        ord' x = ord x - ord 'A'
        chr' x = chr (x + ord 'A')

И Цезарь Шифр ​​в основном выполняет некоторую модульную арифметику:

modShift :: Int -> Int -> Invertible Int Int
modShift base offset = Invertible f g
    where
        f x = (x + offset) `mod` base
        g y = (y + (base - offset)) `mod` base

caesarShift :: Invertible Int Int
caesarShift = modShift 26 4

caesarCipher :: Invertible (OnlyUpper Char) (OnlyUpper Char)
caesarCipher = liftInv (upperAsOrd
                        -- Char <-> Int
                        `rappend` caesarShift
                        -- Int <-> Int
                        `rappend` flipInv upperAsOrd)
                        -- Int <-> Char

Один из способов использования Invertible использует только into и back как encrypt и decrypt и Invertible также дает вам возможность манипулировать хранимыми данными, как если бы это был обычный текст:

exampleCaesar :: IO ()
exampleCaesar = do
    let encF = into caesarCipher
        decF = back caesarCipher
        encrypted = encF (onlyUpper "THEQUICKBROWNFOX")
        decrypted = decF encrypted
        encrypted' = borrow (flipInv caesarCipher
                             `rappend` ouAsList) (++ "JUMPSOVERTHELAZYDOG") encrypted
        decrypted' = decF encrypted'

    print encrypted
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSB"}
    print decrypted
    -- OnlyUpper {getOU = "THEQUICKBROWNFOX"}

    print encrypted'
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSBNYQTWSZIVXLIPEDCHSK"}
    print decrypted'
    -- OnlyUpper {getOU = "THEQUICKBROWNFOXJUMPSOVERTHELAZYDOG"}

Матричная манипуляция

Иногда удобно писать код, который управляет матрицами с помощью Invertible.

Скажем, есть список типов [Int], в которых 0 обозначает пустую ячейку, и мы хотим, чтобы каждый ненулевой элемент перемещался в крайнее левое возможное положение сохраняя при этом порядок:

compactLeft :: [Int] -> [Int]
compactLeft xs = nonZeros ++ replicate (((-) `on` length) xs nonZeros) 0
    where nonZeros = filter (/= 0) xs

Теперь рассмотрим 2D-матрицы, мы хотим «гравитировать» матрицу так, чтобы каждый ненулевой элемент в ней попадал (слева, справа, вверх, вниз) - максимально возможное положение, сохраняя порядок.

data Dir = DU | DD | DL | DR deriving (Eq, Ord, Enum, Show, Bounded)
gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = borrow invertible (map compactLeft)
    where mirrorI = selfInv (map reverse)
          diagonalI = selfInv transpose
          invertible = case dir of
            DL -> rempty
            DR -> mirrorI
            DU -> diagonalI
            DD -> diagonalI `rappend` mirrorI

здесь Invertible вступает в игру благодаря наблюдению, что transpose и map reverse являются обратимыми (более того, они являются обратными функциями сами по себе) , Чтобы мы могли преобразовать матрицы и притвориться, что проблема только «гравитируется влево».

Вот один пример:

print2DMat :: (Show a) => [[a]] -> IO ()
print2DMat mat = do
    putStrLn "Matrix: ["
    mapM_ print mat
    putStrLn "]"

exampleMatGravitize :: IO ()
exampleMatGravitize = do
    let mat = [ [1,0,2,0]
              , [0,3,4,0]
              , [0,0,0,5]
              ]
    print2DMat mat

    let showExample d = do
            putStrLn $ "Direction: " ++ show d
            print2DMat $ gravitizeMat d mat

    mapM_ showExample [minBound .. maxBound]

И результат будет:

Matrix: [
[1,0,2,0]
[0,3,4,0]
[0,0,0,5]
]
Direction: DU
Matrix: [
[1,3,2,5]
[0,0,4,0]
[0,0,0,0]
]
Direction: DD
Matrix: [
[0,0,0,0]
[0,0,2,0]
[1,3,4,5]
]
Direction: DL
Matrix: [
[1,2,0,0]
[3,4,0,0]
[5,0,0,0]
]
Direction: DR
Matrix: [
[0,0,1,2]
[0,0,3,4]
[0,0,0,5]
]

Полный код

Так как для политики просмотра кода требуется полный код (вы также можете найти его из моего gist ):

{-# LANGUAGE DeriveFunctor #-}
import Data.Char
import Data.Function
import Data.List

data Invertible a b = Invertible
    { into :: a -> b
    , back :: b -> a
    }

selfInv :: (a -> a) -> Invertible a a
selfInv f = Invertible f f

rempty :: Invertible a a
rempty = selfInv id

rappend :: Invertible a b
         -> Invertible b c
         -> Invertible a c
(Invertible f1 g1) `rappend` (Invertible f2 g2) =
    Invertible (f2 . f1) (g1 . g2)

flipInv :: Invertible a b -> Invertible b a
flipInv (Invertible f g) = Invertible g f

borrow :: Invertible a b -> (b -> b) -> a -> a
borrow (Invertible fIn fOut) g = fOut . g . fIn

liftInv :: (Functor f) => Invertible a b -> Invertible (f a) (f b)
liftInv (Invertible a b) = Invertible (fmap a) (fmap b)

-- examples
-- constructor should be invisible from outside
newtype OnlyUpper a = OnlyUpper
    { getOU :: [a]
    } deriving (Eq, Ord, Show, Functor)

ouAsList :: Invertible (OnlyUpper a) [a]
ouAsList = Invertible getOU OnlyUpper

onlyUpper :: String -> OnlyUpper Char
onlyUpper = OnlyUpper . filter isAsciiUpper

upperAsOrd :: Invertible Char Int
upperAsOrd = Invertible ord' chr'
    where
        ord' x = ord x - ord 'A'
        chr' x = chr (x + ord 'A')

modShift :: Int -> Int -> Invertible Int Int
modShift base offset = Invertible f g
    where
        f x = (x + offset) `mod` base
        g y = (y + (base - offset)) `mod` base

caesarShift :: Invertible Int Int
caesarShift = modShift 26 4

caesarCipher :: Invertible (OnlyUpper Char) (OnlyUpper Char)
caesarCipher = liftInv (upperAsOrd
                        -- Char <-> Int
                        `rappend` caesarShift
                        -- Int <-> Int
                        `rappend` flipInv upperAsOrd)
                        -- Int <-> Char

exampleCaesar :: IO ()
exampleCaesar = do
    let encF = into caesarCipher
        decF = back caesarCipher
        encrypted = encF (onlyUpper "THEQUICKBROWNFOX")
        decrypted = decF encrypted
        encrypted' = borrow (flipInv caesarCipher
                             `rappend` ouAsList) (++ "JUMPSOVERTHELAZYDOG") encrypted
        decrypted' = decF encrypted'

    print encrypted
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSB"}
    print decrypted
    -- OnlyUpper {getOU = "THEQUICKBROWNFOX"}

    print encrypted'
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSBNYQTWSZIVXLIPEDCHSK"}
    print decrypted'
    -- OnlyUpper {getOU = "THEQUICKBROWNFOXJUMPSOVERTHELAZYDOG"}


-- gravitize
compactLeft :: [Int] -> [Int]
compactLeft xs = nonZeros ++ replicate (((-) `on` length) xs nonZeros) 0
    where nonZeros = filter (/= 0) xs

data Dir = DU | DD | DL | DR deriving (Eq, Ord, Enum, Show, Bounded)

gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = borrow invertible (map compactLeft)
    where mirrorI = selfInv (map reverse)
          diagonalI = selfInv transpose
          invertible = case dir of
            DL -> rempty
            DR -> mirrorI
            DU -> diagonalI
            DD -> diagonalI `rappend` mirrorI

print2DMat :: (Show a) => [[a]] -> IO ()
print2DMat mat = do
    putStrLn "Matrix: ["
    mapM_ print mat
    putStrLn "]"

exampleMatGravitize :: IO ()
exampleMatGravitize = do
    let mat = [ [1,0,2,0]
              , [0,3,4,0]
              , [0,0,0,5]
              ]
    print2DMat mat

    let showExample d = do
            putStrLn $ "Direction: " ++ show d
            print2DMat $ gravitizeMat d mat

    mapM_ showExample [minBound .. maxBound]

main :: IO ()
main = do
    exampleCaesar
    exampleMatGravitize
43 голоса | спросил Javran 17 MaramMon, 17 Mar 2014 11:11:05 +04002014-03-17T11:11:05+04:0011 2014, 11:11:05

1 ответ


10

Нейминг:

Есть много имен, которые я бы изменил. Некоторые из них имеют значение больше, чем другие (локальные имена в let не являются такой большой сделкой, даже если они ужасны, но имя для широко используемой функции должно быть наводящим на размышления, если это возможно). Некоторые из них я более уверен, чем другие.

Я бы изменил borrow на within. Старое имя неплохое, но я думаю, что новый намекает на правильный путь. Я бы изменил Invertible на Transform, поскольку обратимая функция является только одной функцией, и мы говорим о двух связанных функциях. Bijection - это математическое имя для него, и оно также будет иметь хорошее имя, но мне кажется (по крайней мере, мне) предположить, что домен и диапазон - это все типы ввода и вывода, а не каждая функция, которую мы хотели бы использовать с этим, подходит.

Я бы сменил локальный invertible на transform, чтобы соответствовать, поэтому borrow invertible (map compactLeft) становится within transform (map compactLeft).

Я бы изменил mirrorI -> mirror и diagonalI -> diagonal; я ничего не добавляю, это выглядит так, как будто вы сначала используете римские цифры. Я также изменил бы DD, DL, DR, DU -> DOWN, LEFT, RIGHT, UP, так как это просто яснее.

Суффикс Inv не помогает. Не у всех функций есть это, и это недостаточно написано, чтобы быть наводящим на размышления. Кроме того, если мы изменим его из Invertible, это уже не имеет смысла. Итак, selfInv -> involution, liftInv -> lift, flipInv -> backwards. involution - это математическое имя для функции, которая является ее собственным инверсным (и если вы этого не знали, не чувствуйте себя плохо, я только предполагал, что может быть именем для него, пока я не пойду в Google). flip уже сделан, и я думаю, что backwards более наводящий на размышления (reverse тоже было бы неплохо, но это также взято). lift не воспринимается, насколько я знаю, но это похоже на то, что кажется. Если да, то liftT или liftTr может работать (или liftB, если мы используем Bijection)).

Я бы изменил fIn, fOut -> f, f'. Использование f' не совсем говорит: «Я инвертирован», но это несколько подсказывает, если мы знаем, как Transform определен /должен использоваться.

Я понимаю, почему вы назвали rempty и rappend, как и вы, но имена заставили меня (и, вероятно, сделать других), попытаться сделать это Monoid, и это не сработает. Я бы изменил rempty -> idT, rappend -> >>>. >>> соответствует классу Category и является красиво интуитивно понятным (и не нуждается в backquotes). Я не совсем уверен в idT, и это, вероятно, может быть улучшено, но мне все же кажется немного лучше, чем rempty.

Я также изменил бы into, back -> fwd, rev, но здесь у меня мало оснований. Кажется немного более наводящим на размышления о вещи, которая может идти в обоих направлениях, а не в коробке, в которую вы можете войти и выйти, но не может быть перевернута наизнанку. Оригинальные имена здесь хороши.

Все имена в одном месте:

  

DD, DL, DR, DU -> DOWN, LEFT, RIGHT, UP

     

Обратимый -> Преобразование

     

обратимый -> преобразовать

     

mirrorI -> зеркало

     

diagonalI -> диагональ

     

selfInv -> инволюции

     

liftInv -> лифт

     

flipInv -> назад

     

в, назад -> fwd, rev

     

fIn, fOut -> f, f '

     

rempty -> IDT

     

rappend -> > > >

Экземпляры, которые не работают:

Monad, Applicative и Functor не работают, потому что fmap :: (a -> b) -> f a -> f b, и это не подходит.

Моноид не работает, потому что mappend :: a -> a -> a, и наша композиция принимает 2 разных типа и возвращает еще один другой тип.

Кажется, что стрелка должна работать сначала, но arr :: (b -> c) -> a b c. Типы хорошо сочетаются, но нам нужен способ, который имеет смысл взять произвольную функцию и найти ее обратную. Функции и стрелки идут в одну сторону, но мы хотим идти в обоих направлениях.

Категория идеально подходит, но когда я попытался заставить ее работать, компилятор жаловался на все использование . в программе, которая была неоднозначной. Там может быть способ заставить его работать, но глядя на Control.Category , прирост почти не существовал, поэтому я отказался от попытки. Интерфейс (>>>

Экземпляры, которые работают:

Не

Изменения без названия:

Предложение в комментариях mjolka верное, и полученный код:

modShift base offset = Transform f g
    where
        f x = (x + offset) `mod` base
        g y = (y - offset) `mod` base

выглядит лучше и понятнее.

Это:

compactLeft xs = nonZeros ++ replicate (((-) `on` length) xs nonZeros) 0
    where nonZeros = filter (/= 0) xs

является немного уродливым и может быть упрощен к этому:

compactLeft xs = take (length xs) $ nonZeros ++ repeat 0
    where nonZeros = filter (/= 0) xs

Я бы представил новую функцию, которая абстрагирует шаблон в круглых скобках в

caesarCipher = liftInv (upperAsOrd
                        -- Char <-> Int
                        `rappend` caesarShift
                        -- Int <-> Int
                        `rappend` flipInv upperAsOrd)
                        -- Int <-> Char

создавая мои предложенные имена имен, он становится:

caesarCipher = lift (upperAsOrd >>> caesarShift >>> backwards upperAsOrd)

и новая функция, которую я предлагаю:

nest :: Transform a b -> Transform b b -> Transform a a
nest ab bb = backwards ab <<< bb <<< ab

Причина, по которой я использую <<<, состоит в том, что она состоит в том же порядке, что и ., и таким образом, nest выглядит очень похоже на within (функция, ранее известная как borrow)), которая сильно напоминает ее подпись типа.

Здесь они (оба), с типом сигнатур:

within :: Transform a b -> (b -> b) -> a -> a
within (Transform f f') g = f' . g . f

nest :: Transform a b -> Transform b b -> Transform a a
nest ab bb = backwards ab <<< bb <<< ab

Я не могу быть уверен, основываясь только на одном примере, что это будет обычно использоваться, но это будет иметь смысл, если это произойдет, исходя из того, что он появился один раз в небольшом наборе примеров и на подобие подобия типа. Кроме того, nest может быть не самым лучшим именем, но мне кажется разумным, и я не мог думать о лучшем.

Используя nest, мы можем переписать caesarCipher еще короче:

caesarCipher = lift $ nest upperAsOrd caesarShift

Мы также использовали $, чтобы избежать обертывания круглых скобок вокруг nest.

gravitizeMat не изменяется, за исключением nameschanges, но это более читаемо.

До:

data Dir = DU | DD | DL | DR deriving (Eq, Ord, Enum, Show, Bounded)
gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = borrow invertible (map compactLeft)
    where mirrorI = selfInv (map reverse)
          diagonalI = selfInv transpose
          invertible = case dir of
            DL -> rempty
            DR -> mirrorI
            DU -> diagonalI
            DD -> diagonalI `rappend` mirrorI

После:

data Dir = UP | DOWN | LEFT | RIGHT deriving (Eq, Ord, Enum, Show, Bounded)
gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = within transform (map compactLeft)
    where mirror = involution (map reverse)
          diagonal = involution transpose
          transform = case dir of
            LEFT  -> idT
            RIGHT -> mirror
            UP    -> diagonal
            DOWN  -> diagonal >>> mirror

exampleCaesar не сильно меняется, но эта часть выглядит лучше.

До:

    encrypted' = borrow (flipInv caesarCipher
                         `rappend` ouAsList) (++ "JUMPSOVERTHELAZYDOG") encrypted

После:

    encrypted' = within (backwards caesarCipher >>> ouAsList)
                        (++ "JUMPSOVERTHELAZYDOG") encrypted

Здесь я думаю, что предложение для backwards действительно сияет, поскольку прямое направление caesarCipher - это шифрование, а обратное направление - расшифровка, но здесь мы пытаемся беспорядок с открытым текстом зашифрованного текста, который использует его обратно.

В целом:

Это был хороший код. Было несколько имен, которые могли бы быть более наводящими на размышления, и несколько мест, где сложные выражения могли быть упрощены, но в целом это былоприятным для чтения и интересной идеей.

Полный измененный код:

{-# LANGUAGE DeriveFunctor #-}
import Data.Char
import Data.Function
import Data.List

data Transform a b = Transform
    { fwd :: a -> b
    , rev :: b -> a
    }

involution :: (a -> a) -> Transform a a
involution f = Transform f f

idT :: Transform a a
idT = involution id

(>>>) :: Transform a b -> Transform b c -> Transform a c
(Transform f1 g1) >>> (Transform f2 g2) =
    Transform (f2 . f1) (g1 . g2)

(<<<) :: Transform b c -> Transform a b -> Transform a c
f <<< g = g >>> f

backwards :: Transform a b -> Transform b a
backwards (Transform f g) = Transform g f

within :: Transform a b -> (b -> b) -> a -> a
within (Transform f f') g = f' . g . f

nest :: Transform a b -> Transform b b -> Transform a a
nest ab bb = backwards ab <<< bb <<< ab

lift :: (Functor f) => Transform a b -> Transform (f a) (f b)
lift (Transform f g) = Transform (fmap f) (fmap g)

-- examples
-- constructor should be invisible from outside
newtype OnlyUpper a = OnlyUpper
    { getOU :: [a]
    } deriving (Eq, Ord, Show, Functor)

ouAsList :: Transform (OnlyUpper a) [a]
ouAsList = Transform getOU OnlyUpper

onlyUpper :: String -> OnlyUpper Char
onlyUpper = OnlyUpper . filter isAsciiUpper

upperAsOrd :: Transform Char Int
upperAsOrd = Transform ord' chr'
    where
        ord' x = ord x - ord 'A'
        chr' x = chr (x + ord 'A')

modShift :: Int -> Int -> Transform Int Int
modShift base offset = Transform f g
    where
        f x = (x + offset) `mod` base
        g y = (y - offset) `mod` base

caesarShift :: Transform Int Int
caesarShift = modShift 26 4

caesarCipher :: Transform (OnlyUpper Char) (OnlyUpper Char)
caesarCipher = lift $ nest upperAsOrd caesarShift

exampleCaesar :: IO ()
exampleCaesar = do
    let encF = fwd caesarCipher
        decF = rev caesarCipher
        encrypted = encF (onlyUpper "THEQUICKBROWNFOX")
        decrypted = decF encrypted
        encrypted' = within (backwards caesarCipher >>> ouAsList)
                            (++ "JUMPSOVERTHELAZYDOG") encrypted
        decrypted' = decF encrypted'

    print encrypted
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSB"}
    print decrypted
    -- OnlyUpper {getOU = "THEQUICKBROWNFOX"}

    print encrypted'
    -- OnlyUpper {getOU = "XLIUYMGOFVSARJSBNYQTWSZIVXLIPEDCHSK"}
    print decrypted'
    -- OnlyUpper {getOU = "THEQUICKBROWNFOXJUMPSOVERTHELAZYDOG"}


-- gravitize
compactLeft :: [Int] -> [Int]
compactLeft xs = take (length xs) $ nonZeros ++ repeat 0
    where nonZeros = filter (/= 0) xs

data Dir = UP | DOWN | LEFT | RIGHT deriving (Eq, Ord, Enum, Show, Bounded)

gravitizeMat :: Dir -> [[Int]] -> [[Int]]
gravitizeMat dir = within transform (map compactLeft)
    where mirror = involution (map reverse)
          diagonal = involution transpose
          transform = case dir of
            LEFT  -> idT
            RIGHT -> mirror
            UP    -> diagonal
            DOWN  -> diagonal >>> mirror

print2DMat :: (Show a) => [[a]] -> IO ()
print2DMat mat = do
    putStrLn "Matrix: ["
    mapM_ print mat
    putStrLn "]"

exampleMatGravitize :: IO ()
exampleMatGravitize = do
    let mat = [ [1,0,2,0]
              , [0,3,4,0]
              , [0,0,0,5]
              ]
    print2DMat mat

    let showExample d = do
            putStrLn $ "Direction: " ++ show d
            print2DMat $ gravitizeMat d mat

    mapM_ showExample [minBound .. maxBound]

main :: IO ()
main = do
    exampleCaesar
    exampleMatGravitize
ответил Michael Shaw 18 +04002014-10-18T12:45:13+04:00312014bEurope/MoscowSat, 18 Oct 2014 12:45:13 +0400 2014, 12:45:13

Похожие вопросы

Популярные теги

security × 330linux × 316macos × 2827 × 268performance × 244command-line × 241sql-server × 235joomla-3.x × 222java × 189c++ × 186windows × 180cisco × 168bash × 158c# × 142gmail × 139arduino-uno × 139javascript × 134ssh × 133seo × 132mysql × 132