feat(compress): SVD approximation of image

README.md

@@ -16,6 +16,9 @@ Options:
   --rotate <n> - rotate image by n degrees
   --grayscale - turn the image grayscale
   --invert - invert (negative) the image
+  --compress <n> - approximate the (width - n)-th rank of image using SVD
+                   a number between 0 (no compression) and image width (full compression)
+                   note: this is not size compression
   --output <filename> - output name, defaults to 'output.png'
 ```
 

app/Main.hs

@@ -11,6 +11,7 @@ module Main where
                          , argContrast :: Double
                          , argGamma :: Int
                          , argBrightness :: Double
+                         , argCompress :: Int
                          }
 
   opts = Options { file = ""
@@ -22,6 +23,7 @@ module Main where
                  , argContrast = 0
                  , argGamma = 1
                  , argBrightness = 0
+                 , argCompress = 0
                  }
 
   main :: IO ()
@@ -39,6 +41,7 @@ module Main where
         putStrLn "  --rotate <n> - rotate image by n degrees"
         putStrLn "  --grayscale - turn the image grayscale"
         putStrLn "  --invert - invert (negative) the image"
+        putStrLn "  --compress <n> - approximate the (width - n)-th rank of image using SVD, note: this is not size compression, a number between 0 (no compression) and image width (full compression)"
         putStrLn "  --output <filename> - output name, defaults to output.png"
       else do 
         let options = parseArgs args opts
@@ -49,13 +52,14 @@ module Main where
           Left err -> print err
           Right p -> do
             let edited = rotate (argRotate options) Nothing 
-                      . fade (argFade options / 100)
+                       . fade (argFade options / 100)
-                      . contrast (argContrast options)
+                       . contrast (argContrast options)
-                      . gamma (argGamma options)
+                       . gamma (argGamma options)
-                      . brightness (argBrightness options)
+                       . brightness (argBrightness options)
-                      . conditionalFn grayscale (argGrayscale options) 
+                       . conditionalFn grayscale (argGrayscale options) 
-                      . conditionalFn invert (argInvert options) $ p
+                       . conditionalFn invert (argInvert options)
-            writePicturePng "output.png" edited
+                       . compress (argCompress options) $ p
+            writePicturePng (output options) edited
             
         return ()
 
@@ -72,6 +76,7 @@ module Main where
   parseArgs ("--contrast":n:rest) opts = parseArgs rest (opts { argContrast = read n })
   parseArgs ("--brightness":n:rest) opts = parseArgs rest (opts { argBrightness = read n })
   parseArgs ("--gamma":n:rest) opts = parseArgs rest (opts { argGamma = read n })
+  parseArgs ("--compress":n:rest) opts = parseArgs rest (opts { argCompress = read n })
   parseArgs ("--output":n:rest) opts = parseArgs rest (opts { output = n })
   parseArgs (name:rest) opts = parseArgs rest (opts { file = name })
 

src/Data/Picture.hs

@@ -20,6 +20,7 @@ module Data.Picture ( Picture
                     , brightness
                     , gamma
                     , invert
+                    , compress
                     -- * Converting between Image and Picture
                     , fromImage
                     , toImage
@@ -34,6 +35,7 @@ module Data.Picture ( Picture
     import qualified Data.Vector.Storable as V
     import System.IO
     import Data.Maybe
+    import Debug.Trace
 
     -- | (R, G, B) color channels
     type Picture = (Matrix Double, Matrix Double, Matrix Double)
@@ -108,9 +110,8 @@ module Data.Picture ( Picture
       where
         f = cmap (`subtract` 255)
 
-    {- | Rotate 'Picture' for the specified degrees, around the specified origin.
+    -- | Rotate 'Picture' for the specified degrees, around the specified origin.
-     - If the origin is `Nothing`, rotates around the center
+    -- If the origin is `Nothing`, rotates around the center
-     -}
     rotate :: Double -> Maybe (Int, Int) -> Picture -> Picture
     rotate deg orig (r, g, b) = (f r, f g, f b)
       where
@@ -135,5 +136,17 @@ module Data.Picture ( Picture
 
         f m = reshape (cols m) $ fromList $ map (\[x, y] -> if y < 0 || y >= rows r || x < 0 || x >= cols r then 255 else m `atIndex` (y, x)) movedIndices
 
+    -- | Compress the image using SVD
+    -- note: this is not size compression, it's just a k-rank approximation of the image
+    compress :: Int -> Picture -> Picture
+    compress rate (r, g, b) = (f r, f g, f b)
+      where
+        k = cols r - rate
+        f m =
+          let (u, s, v) = svd m
+              si = diagRect 0 s (rows m) (cols m)
+              (mu, ms, mv) = (u ?? (All, Take k), si ?? (Take k, Take k), (tr v) ?? (Take k, All))
+          in mu <> ms <> mv
+
     bound (l, u) x = max l $ min u x
     pixelBound = bound (0, 255)