Plot Daten Rekonstruktion lesen Pixelfarben aus Bilddateien

Question

Wie kann ich Farben von bestimmten Pixeln einer Bilddatei in Haskell öffnen und lesen? Welche Pakete, Funktionen empfehlen Sie?

Sie können sich die zitierte Zeichnung und die rekonstruierten Daten unten ansehen, um eine Vorstellung davon zu erhalten, was ich automatisieren möchte. Ich habe mich mit dieser speziellen Figur mit Gimp beschäftigt und die Punkte auf den Linien manuell markiert.

Wenn Sie diese Frage mit Verweisen auf Haskell nicht beantworten können, aber von einer guten Software wissen, die automatisch mit dieser Art von Rekonstruktionsarbeit umgehen kann, bitte ~~~~~~~ sagen Sie mir ihren Namen !!

Mit besten Grüßen, Cetin Sert

UPDATE: Jetzt gibt es ein Cross-Plattform-Haskell-Paket für diesen: http://hackage.haskell.org/package/explore

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

oben nach unten in der Tabelle von links nach Rechts in der Abbildung.

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



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

Man kann pngload verwenden und einige einfache Scanner schreiben:

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)