Восстановление данных графика чтения цветов пикселей из файлов изображений

Question

Как я могу открыть и прочитать цвета определенных пикселей файла изображения в Haskell? Какие пакеты, функции вы рекомендуете?

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

Если вы не можете ответить на этот вопрос со ссылками на Haskell, но знаете о хорошем программном обеспечении, которое может автоматически выполнять этот тип работ по реконструкции, пожалуйста, ~~~~~~~, скажите мне их имя !! 1005 *

С наилучшими пожеланиями, Цетин Серт

ОБНОВЛЕНИЕ: Теперь есть кроссплатформенный пакет Haskell для этого: http://hackage.haskell.org/package/explore

_{(источник: sourceforge.net )}

Сверху вниз в таблице слева Прямо на рисунке.

-------------------------------------------------------------------



module Main where

import Control.Monad

f x = 3 - x / 80                              -- 80: number of pixels
d x = x - 2                                   -- pixel offset

cisse, goni, kodou, nouna :: [Double]
cisse = [178,200,208,212,209,208,174,116,114,136,158]
goni  = [287,268,229,215,202,174,123,71 ,61 ,92 ,162]
kodou = [184,214,215,202,192,191,181,144,121,145,192]
nouna = [215,231,212,190,196,204,163,96 ,80 ,124,181]

disp :: (String, [Double]) → IO ()
disp (town,pixels) = do
  putStrLn    $ town
  putStrLn    $ ">normals"
  mapM_ print $ points
  putStrLn    $ ">log10s"
  mapM_ print $ log10s
  putStrLn    $ "-------------------"
  where
    points = map (f . d) pixels
    log10s = map (10 **) points

main :: IO ()
main = do
  mapM_ disp [("Cisse", cisse),("Goni", goni),("Kodougou", kodou),("Nouna", nouna)]



--------------------

Cisse
>normals
0.7999999999999998
0.5249999999999999
0.4249999999999998
0.375
0.41249999999999964
0.4249999999999998
0.8500000000000001
1.575
1.5999999999999999
1.325
1.0499999999999998
>log10s
6.30957344480193
3.3496543915782757
2.6607250597988084
2.371373705661655
2.5852348395621885
2.6607250597988084
7.07945784384138
37.583740428844415
39.81071705534971
21.134890398366466
11.220184543019629
-------------------
Goni
>normals
-0.5625
-0.3250000000000002
0.16249999999999964
0.3374999999999999
0.5
0.8500000000000001
1.4874999999999998
2.1375
2.2625
1.875
1.0
>log10s
0.27384196342643613
0.4731512589614803
1.4537843856076607
2.1752040340195222
3.1622776601683795
7.07945784384138
30.725573652674456
137.24609610075626
183.02061063110568
74.98942093324558
10.0
-------------------
Kodougou
>normals
0.7250000000000001
0.34999999999999964
0.3374999999999999
0.5
0.625
0.6374999999999997
0.7624999999999997
1.2249999999999999
1.5125
1.2125
0.625
>log10s
5.308844442309884
2.2387211385683377
2.1752040340195222
3.1622776601683795
4.216965034285822
4.340102636447436
5.787619883491203
16.788040181225597
32.546178349804585
16.31172909227838
4.216965034285822
-------------------
Nouna
>normals
0.3374999999999999
0.13749999999999973
0.375
0.6499999999999999
0.5749999999999997
0.47499999999999964
0.9874999999999998
1.825
2.025
1.4749999999999999
0.7624999999999997
>log10s
2.1752040340195222
1.372460961007561
2.371373705661655
4.46683592150963
3.7583740428844394
2.9853826189179573
9.716279515771058
66.83439175686145
105.92537251772886
29.853826189179586
5.787619883491203
-------------------

Answer 1

Можно использовать pngload и написать простой сканер:

module Main where

import System.Environment
import System.IO.Unsafe
import System.Exit
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import Data.Array.Storable
import Control.Monad
import Control.Applicative
import Codec.Image.PNG

type Name  = String
type Color = RGBA

data RGBA = RGBA Word8 Word8 Word8 Word8 deriving (Show, Read, Eq)

instance Storable RGBA where
  sizeOf _    = sizeOf (0 :: Word8) * 4
  alignment _ = 1
  poke color (RGBA r g b a) = do
        let byte :: Ptr Word8 = castPtr color
        pokeElemOff byte 0 r
        pokeElemOff byte 1 g
        pokeElemOff byte 2 b
        pokeElemOff byte 3 a
  peek color = do
        let byte :: Ptr Word8 = castPtr color
        r <- peekElemOff byte 0
        g <- peekElemOff byte 1
        b <- peekElemOff byte 2
        a <- peekElemOff byte 3
        return $ RGBA r g b a

--

checkForAlpha :: PNGImage -> IO ()
checkForAlpha (hasAlphaChannel -> True) = return ()
checkForAlpha (hasAlphaChannel -> _   ) = putStrLn "no alpha channel going on!!!" >> exitWith (ExitFailure 1)

--

main :: IO ()
main = do
  putStrLn $ "ExPloRe 0.0 : Experimental Plot Reconstructor"

  args@(path:legend_:tr_:tg_:tb_:ta_:start_:step_:_) <- getArgs

  -- initialize image
  Right img <- loadPNGFile path
  let bitmap  = imageData  img
  let (wu,hu) = dimensions img
  let (w,h)   = (fromIntegral wu, fromIntegral hu)

  putStrLn $ "-------------------------------------------------------------------"
  putStrLn $ ""
  putStrLn $ "call  : " ++ tail (filter (/= '"') $ concatMap ((' ':) . show) args)
  putStrLn $ ""

  putStrLn $ "image : " ++ path
  putStrLn $ "legend: " ++ legend_
  putStrLn $ ""

  putStrLn $ "width : " ++ show w
  putStrLn $ "height: " ++ show h

  checkForAlpha img -- !!


  -- initialize lines
  let [tr,tg,tb,ta] = map read [tr_,tg_,tb_,ta_] :: [Int]
  mapM_ (\(n,v) -> putStrLn $ show n ++ " ~ : " ++ show v) $ zip "rgba" [tr,tg,tb,ta]

  lines_ <- readFile legend_
  let lines = read lines_ :: [(Name,Color)]

  putStrLn $ "lines : " ++ (show $ length lines)
  putStrLn $ ""
  mapM_ (putStrLn . show) lines


  -- initialize scan

  let (@#)   = mu w
  let start  = read start_ :: Double
  let step   = read step_  :: Double
  let rows   = [0..h]
  let cols   = takeWhile (< w) $ map (floor . (start +) . (step *)) [0..]
  let icols  = zip [1..] cols

  -- scan bitmap
  let (~=) = mcc tr tg tb ta
  mapM_ (scan bitmap icols rows (@#) (~=)) lines

--

scan bitmap icols rows (@#) (~=) (name,color) = do
  putStrLn $ ""
  putStrLn $ "-------------------------------------------------------------------"
  putStrLn $ show color
  putStrLn $ ""
  putStrLn $ name
  putStrLn $ ""
  withStorableArray bitmap $ \byte -> do
        let pixel :: Ptr RGBA = castPtr byte
        forM_ icols $ \(n,j) -> do
            let matches = flip filter rows $ \i -> (pixel @# i) j ~= color
            let m = median matches
            putStrLn $ case not . null $ matches of
                True  -> show n ++ "\t" ++ show j ++ "\t" ++ show m ++ "\t" ++ show matches
                False -> show n ++ "\t" ++ show j ++ "\t   \t[]"

--
cb t x y = (abs $ (fromIntegral x) - (fromIntegral y)) < t

mcc :: Int -> Int -> Int -> Int -> RGBA -> RGBA -> Bool
mcc tr tg tb ta (RGBA a b c d) (RGBA x y z w) =
  cb tr a x && cb tg b y && cb tb c z && cb ta d w

median :: [a] -> a
median xs = xs !! (fromIntegral . floor . (/ 2) . fromIntegral . length) xs

(@!) :: Storable a => Ptr a -> Int -> IO a
(@!) = peekElemOff

mu :: Storable a => Int -> Ptr a -> Int -> Int -> a
mu w p j i = unsafePerformIO $ p @! (i + j * w)