이미지 파일에서 픽셀 색상을 읽는 플롯 데이터 재구성

Question

하스켈에서 이미지 파일의 특정 픽셀 색상을 열고 읽는 방법은 무엇입니까? 어떤 패키지, 기능을 권장합니까?

내가 자동화하고 싶은 아이디어에 대해 아래의 인용 된 플롯 및 재구성 된 데이터를 살펴볼 수 있습니다. 나는 Gimp를 사용하여이 특정 그림으로가는 길을 가졌고 수동으로 선에 점을 표시했다.

하스켈에 대한 언급으로이 질문에 답할 수는 없지만 이러한 유형의 재건 작업을 자동으로 처리 할 수있는 훌륭한 소프트웨어에 대해 알고 있다면 ~~~~~~ 그들의 이름을 말해주십시오!

최고 감사합니다, 세틴 르트

UPDATE : 테이블의 하단에 http://hackage.haskell.org/package/explore

는

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

가기 왼쪽된다 지금 이것에 대한 크로스 플랫폼 하스켈 패키지있다 그림에서 오른쪽.

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



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) 

을