Plotdaten Rekonstruktion Lesepixelfarben von Bilddateien

Question

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

Sie können an dem zitierten Grundstück einen Blick und die rekonstruierten Daten unten für eine Idee auf, was Ich mag würde automatisieren. Ich hatte mich mit dieser speziellen Figur mit Gimp und Markieren der Punkte auf den Linien von Hand.

Wenn Sie diese Frage mit Bezug auf Haskell beantworten können, aber wissen von einem guten Stück Software, die diese Art von Wiederaufbauarbeiten automatisch verarbeiten kann, bitte ~~~~~~~ erzählen Sie mir ihren Namen !!

Mit freundlichen Grüßen, Cetin Sert

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

  

   _{(Quelle: sourceforge.net )}

     

Von oben nach unten in der Tabelle von links nach   Rechts in der Figur.

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



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 benutzen pngload und schreiben einige einfache Scanner:

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)