مؤامرة إعادة إعمار البيانات قراءة الألوان بكسل من ملفات الصور

Question

كيف يمكنني فتح وقراءة ألوان وحدات البكسل المحددة لملف الصورة في Haskell؟ ما الحزم، والوظائف التي تنصح بها؟

يمكنك إلقاء نظرة على المؤامرة المعروضة والبيانات التي أعيد بناؤها أدناه للحصول على فكرة حول ما أود أتمتة أتمتة. كان لدي طريقي مع هذا الرقم بالذات باستخدام GIMP وتمييز النقاط على الخطوط يدويا.

إذا لم تتمكن من الإجابة على هذا السؤال مع الإشارات إلى 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
-------------------

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)