Initial data commit

Task/Bitmap-Histogram/Haskell/bitmap-histogram-2.hs

@@ -0,0 +1,27 @@
+import Bitmap
+import Bitmap.RGB
+import Bitmap.BW
+import Bitmap.Netpbm
+import Control.Monad.ST
+import Data.Array
+
+main = do
+    i <- readNetpbm "original.ppm" :: IO (Image RealWorld RGB)
+    writeNetpbm "bw.pbm" =<< stToIO (do
+        h <- histogram i
+        toBWImage' (medianIndex h) i)
+
+histogram :: Color c => Image s c -> ST s [Int]
+histogram = liftM f . getPixels where
+    f = elems . accumArray (+) 0 (0, 255) . map (\i -> (luminance i, 1))
+
+medianIndex :: [Int] -> Int
+{- Given a list l, finds the index i that minimizes
+  abs $ sum (take i l) - sum (drop i l) -}
+medianIndex l = result
+  where (result, _, _, _, _) =
+            iterate f (0, 0, 0, l, reverse l) !! (length l - 1)
+        f (n, left, right, lL@(l : ls), rL@(r : rs)) =
+            if   left < right
+            then (n + 1, left + l, right,     ls, rL)
+            else (n,     left,     right + r, lL, rs)