이미지 파일에서 픽셀 색상을 읽는 데이터 재구성을 플롯하십시오
문제
Haskell에서 이미지 파일의 특정 픽셀 색상을 열고 읽으려면 어떻게해야합니까? 어떤 패키지, 기능을 권장합니까?
인용 된 플롯과 아래의 재구성 된 데이터를 볼 수 있습니다. 나는 김프를 사용 하여이 특별한 인물을 사용하고 수동으로 줄에 포인트를 표시했습니다.
Haskell에 대한 언급 으로이 질문에 대답 할 수 없지만 이러한 유형의 재구성 작업을 자동으로 처리 할 수있는 좋은 소프트웨어를 알고 있다면 ~~~~~~~ 이름을 말 해주세요 !!
안부, Cetin Sert
업데이트: 이제이를위한 크로스 플랫폼 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
-------------------
해결책
하나는 사용할 수 있습니다 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)
제휴하지 않습니다 StackOverflow