Reconstruction de données de tracé de lecture de couleurs de pixels à partir de fichiers image

Question

Comment puis-je ouvrir et lire les couleurs de pixels spécifiques d'un fichier image dans Haskell? Quels paquets, fonctions recommandez-vous?

Vous pouvez jeter un coup d'oeil sur le graphique cité et les données reconstruites ci-dessous pour une idée de ce que je voudrais automatiser. J'ai eu mon chemin avec cette figure particulière en utilisant Gimp et en marquant les points sur les lignes manuellement.

Si vous ne pouvez pas répondre à cette question avec des références à Haskell mais que vous connaissez un bon logiciel capable de gérer automatiquement ce type de travail de reconstruction, s'il vous plaît ~~~~~~~ dites-moi leur nom !!

Cordialement, Cetin Sert

MISE À JOUR: Maintenant, il y a un paquet Haskell multi-plateforme pour cela: http://hackage.haskell.org/package/explore

plot http://corsis.sourceforge.net/img/fig37-points.png

haut en bas dans le tableau est laissée à À droite sur la figure.

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



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

On peut utiliser pngload et écrire du scanner simple:

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)