イメージファイルからピクセル色を読み取るプロットデータ再構成

Question

Haskellで画像ファイルの特定のピクセルの色を開いたり読み取ったりするにはどうすればよいですか？どのパッケージ、機能をお勧めしますか？

私が自動化したいアイデアについては、引用されたプロットと再構成されたデータをご覧ください。私はGimpを使ってこの特定の人物と私のやり方をして、手動で行に点をマーキングしました。

ハスケルへの参照でこの質問に答えることはできませんが、このタイプの再構築作業を自動的に処理できる優れたソフトウェアについて知っていれば、~~~~~~~~彼らの名前を教えてください!!

よろしく、 Cetinセルト

UPDATE：表中の下へhttp://hackage.haskell.org/package/explore

が

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

トップに任されている：は今、このためのクロスプラットフォームのHaskellのパッケージがあります 図の右。

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



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) 

を