Реализация де-свертки на Хаскелле (Ричардсон Люси)

Question

Я пытаюсь реализовать алгоритм де-свертки в Haskell и не могу найти более простой, чем Ричардсон Люси. Я посмотрел на существующую реализацию matlab/python, но не могу понять, с чего начать и как именно реализовать. Я хочу использовать библиотеку https://github.com/lehins/hip. Если кто-то может предоставить схему некоторой реализации или общее представление о функциях с некоторыми фрагментами кода, это было бы очень полезно для меня.

Заранее спасибо!

Answer 1

Алгоритм на самом деле довольно прост. Использование обозначения на странице Википедии для деконволюции Ричардсона-Люси, если базовое изображение u0 был свернут ядром p производить наблюдаемое изображение dЗатем вы можете выполнить итерацию функции:

deconvolve p d u = u * conv (transpose p) (d / conv p u)

над u с начальной начальной оценкой (из dнапример, чтобы получить прогрессивно лучшую оценку u0,

В HIP, фактический одношаговый deconvolve функция может выглядеть так:

deconvolve :: Image VS X Double
           -> Image VS RGB Double
           -> Image VS RGB Double
           -> Image VS RGB Double
deconvolve p d u
  = u * conv (transpose p) (d / conv p u)
  where conv = convolve Edge

и вы могли бы использовать что-то вроде этого:

let us = iterate (deconvolve p d) d
    u10 = us !! 10  -- ten iterations

Пример полной программы:

import Graphics.Image as I
import Graphics.Image.Interface as I
import Prelude as P

blur :: Image VS X Double
blur = blur' / scalar (I.sum blur')
  where blur' = fromLists [[0,0,4,3,2]
                          ,[0,1,3,4,3]
                          ,[1,2,3,3,4]
                          ,[0,1,2,1,0]
                          ,[0,0,1,0,0]]

deconvolve :: Image VS X Double
           -> Image VS RGB Double
           -> Image VS RGB Double
           -> Image VS RGB Double
deconvolve p d u
  = u * conv (transpose p) (d / conv p u)
  where conv = convolve Edge

main :: IO ()
main = do
  -- original underlying image
  u0 <- readImage' "images/frog.jpg" :: IO (Image VS RGB Double)
  -- the kernel
  let p = blur
  -- blurred imaged
  let d = convolve Edge p u0
  -- iterative deconvolution
  let us = iterate (deconvolve p d) d
      u1 = us !! 1 -- one iteration
      u2 = us !! 20 -- twenty iterations

  let output = makeImage (rows u0, cols u0 * 4)
        (\(r,c) ->
           let (i, c') = c `quotRem` cols u0
           in index ([u0,d,u1,u2] !! i) (r,c'))
        :: Image VS RGB Double

  writeImage "output.jpg" output

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