~jackwines/mean-color-filter

4a3f019c448e9d702530ec2de1aa6c278a8b1309 — Jack Wines 1 year, 8 months ago f4f7585
swapped to sampling
7 files changed, 70 insertions(+), 19 deletions(-)

M README.md
A landscape.jpeg
A landscapeResult.png
M mean-color-filter.cabal
A sierra.jpg
A sierraResult.png
M src/Main.hs
M README.md => README.md +15 -6
@@ 1,13 1,22 @@
to build:
This project usess cluster recognition on a sample of 300 pixels in an image to reduce the number of colors in said image.

### usage

make sure you have [nix](nixos.org/nix) installed.
```
nix-build release.nix
mean-color-filter image.png cutFactor # replace cutFactor with a number between 0 and 1.8ish
```
plain ol `cabal new-build` or `cabal v1-build` might also work in a pinch.

### examples

![](sierra.jpg)
![](sierraResult.png)
![](landscape.jpeg)
![](landscapeResult.png)

run input image as arguement:
### to build:

make sure you have [nix](nixos.org/nix) installed.
```
mean-triangle-filter inputImage.jpg
nix-build release.nix
```
`cabal new-build` or `cabal v1-build`gt might also work in a pinch.

A landscape.jpeg => landscape.jpeg +0 -0

A landscapeResult.png => landscapeResult.png +0 -0

M mean-color-filter.cabal => mean-color-filter.cabal +4 -2
@@ 20,11 20,13 @@ extra-source-files:  CHANGELOG.md
executable mean-color-filter
  main-is:             Main.hs
  -- other-modules:
  -- other-extensions:
  other-extensions: ScopedTypeVariables
  build-depends:       base,
                       hip,
                       vector,
                       hierarchical-clustering
                       hierarchical-clustering,
                       random

  hs-source-dirs:      src
  default-language:    Haskell2010
  ghc-options: -threaded

A sierra.jpg => sierra.jpg +0 -0

A sierraResult.png => sierraResult.png +0 -0

M src/Main.hs => src/Main.hs +51 -11
@@ 6,6 6,8 @@ import qualified Graphics.Image.ColorSpace as CS
import qualified Graphics.Image.Processing as P
import qualified Data.Clustering.Hierarchical as C
import qualified System.Environment as Env
import qualified System.Random as R
import qualified Data.Function as F
import Data.List




@@ 15,8 17,10 @@ chunksOf n ls = splita : chunksOf n splitb
    where
        (splita, splitb) = splitAt n ls

distance :: (Int, CS.Pixel CS.RGB Double) -> (Int, CS.Pixel CS.RGB Double) -> C.Distance
distance (_, (CS.PixelRGB hue sat int)) (_, (CS.PixelRGB hue' sat' int'))
distance' :: (Int, CS.Pixel CS.RGB Double) -> (Int, CS.Pixel CS.RGB Double) -> C.Distance
distance' (_, a) (_, b) = distance a b

distance (CS.PixelRGB hue sat int) (CS.PixelRGB hue' sat' int')
    = vecLen [(hue - hue'), (sat - sat'), (int - int')]
    where
        vecLen = sqrt . sum . map (** 2)


@@ 36,7 40,7 @@ sat (CS.PixelRGB hue sat int) = sat
int (CS.PixelRGB hue sat int) = int


getLvl dendro = map C.elements $ C.cutAt dendro 0.2
cutDendro cut dendro = map C.elements . C.cutAt dendro $ cut
-- getLvl (C.Branch _ d1 d2) 1 = [C.elements d1, C.elements d2]
-- getLvl (C.Branch x d1 d2) levels 
--     | (length . C.elements $ (C.Branch x d1 d2)) < 10 = [C.elements $ C.Branch x d1 d2]


@@ 48,16 52,52 @@ changeToMeans ps = zip (map fst ps) (repeat mean')
    where
        mean' = meanColor . map snd $ ps

sample :: (Vec.Unbox a) => R.StdGen -> Int -> Vec.Vector a -> [a]
sample gen n xs = map (Vec.unsafeIndex xs) rands
    where
        rands :: [Int]
        rands = take n . R.randomRs (0, Vec.length xs) $ gen

reconstructImg :: Int -> [[(Int, CS.Pixel CS.RGB Double)]] -> Img.Image Img.VU CS.RGB Double
reconstructImg colNum ps = Img.fromLists . chunksOf colNum . map snd . sortOn fst . concatMap changeToMeans $ ps

clustersFromSample :: R.StdGen -> Int -> Img.Image Img.VU CS.RGB Double -> C.Dendrogram (Img.Pixel CS.RGB Double)
clustersFromSample gen n img = makeDendrogram sampled distance
    where
        sampled :: [Img.Pixel CS.RGB Double]
        sampled = sample gen n $ Int.toVector img

nonClusterImage :: Img.Image Img.VU CS.RGB Double -> Double -> Img.Image Img.VU CS.RGB Double
nonClusterImage img cut' = reconstructImg (Img.cols img) . cutDendro cut' . makeDendrogram pixels $ distance'
    where
        pixels = zip [0..] . concat . Img.toLists $ img

minimumOn :: Ord b => (a -> b) -> [a] -> a
minimumOn f = minimumBy (compare `F.on` f)

reconstructClusterImage :: Img.Image Img.VU CS.RGB Double -> [[Img.Pixel CS.RGB Double]] -> Img.Image Img.VU CS.RGB Double
reconstructClusterImage img clusters = Img.map (\x -> minimumOn (distance x) clusterMeans) img
    where
        clusterMeans :: [Img.Pixel CS.RGB Double]
        clusterMeans = map meanColor clusters

sampleClusterImage gen n img cut = reconstructClusterImage img . cutDendro cut $ clustersFromSample gen n img

makeDendrogram = C.dendrogram C.CLINK

sqImg :: Img.Image Img.VU CS.RGB Double -> Img.Image Img.VU CS.RGB Double
sqImg = Img.map (fmap (**2))

sqrtImg :: Img.Image Img.VU CS.RGB Double -> Img.Image Img.VU CS.RGB Double
sqrtImg = Img.map (fmap sqrt)

main :: IO ()
main = do
    (arg : _) <- Env.getArgs
    img <- P.scale P.Bilinear P.Edge (0.2, 0.2) <$> Img.readImageRGB Img.VU arg
    let pixels = zip [0..] . concat . Img.toLists $ img
    let dendo = C.dendrogram C.CLINK pixels distance
    let lvls = getLvl dendo
    print $ length lvls
    let img' = reconstructImg (Img.cols img) lvls
    Img.writeImage "result.png" $ img'
    -- parse command line args
    (arg : cut : []) <- Env.getArgs
    let cut' = read cut :: Double
    img <- sqImg <$> Img.readImageRGB Img.VU arg
    -- let reconstructed = nonClusterImage img cut'
    gen <- R.getStdGen
    let img' = sampleClusterImage gen 300 img cut'
    Img.writeImage "result.png" $ sqrtImg img'