Pixel sort like thing in racket

expl.md

Similar to Kim Asendorf's pixels sorting but in racket.

Use:

(glitch y-pred x-pred img)

Where:

• y-pred is a function which takes two pixels (color r g b a) and compares them for sorting on columns.
• x-pred is a function which takes two pixels (color r g b a) and compares them for sorting on rows.
• img is an image?

Examples:

Original:

Glitched:

(glitch (white? 140) (white? 140) 
        (bitmap/url "http://mysticmesseneger.webs.com/Rocky%20Mountains.jpg"))

(glitch (black? 110) (white? 100)
        (bitmap/url "http://mysticmesseneger.webs.com/Rocky%20Mountains.jpg"))

Original:

Glitched:

(glitch (black? 60) (black? 60) 
        (bitmap/url "http://www.artrenewal.org/artwork/186/186/1971/mona_lisa-large.jpg"))

pxlsrt.rkt

#lang racket

(require 2htdp/image)

(define (colorsort a b)
  (> 
   (+ (color-red a)
      (color-green a)
      (color-blue a))
   (+ (color-red b)
      (color-green b)
      (color-blue b))))

(define (partition-by pred lst)
  (define (loop pred lst acc)
    (cond 
      [(empty? lst) (reverse (map reverse acc))]
      [(empty? acc) 
       (loop pred 
             (rest lst) 
             (list (list (first lst))))]
      [(pred (first lst))
       (loop pred
             (rest lst)
             (cons (list (first lst)) acc))]
      [else
       (loop pred
             (rest lst)
             (cons (cons (first lst) (first acc)) (rest acc)))]))
  (loop pred lst '()))

(define (chunk-list-all lst n)
  (if (<= (length lst) n) (list lst)
      (cons (take lst n) 
            (chunk-list-all (drop lst n) n))))

(define (translate matrix)
  (if (empty? (first matrix)) '()
      (cons (map first matrix)
            (translate (map rest matrix)))))

(define (black? threshold)
  (λ (c)
    (and
     (< (color-red   c) threshold)
     (< (color-green c) threshold)
     (< (color-blue  c) threshold))))

(define (white? threshold)
  (λ (c)
    (and
     (> (color-red   c) threshold)
     (> (color-green c) threshold)
     (> (color-blue  c) threshold))))

(define (sort-single-list pred lst)
  (apply append 
         (map (λ (l) (sort l colorsort))
              (partition-by pred lst))))

(define (sort-list-of-lists pred lsts)
   (map (λ (l) (sort-single-list pred l)) lsts))

(define (glitch y-pred x-pred img)
  (define pixels (image->color-list img))
  (define w (image-width img))
  (define h (image-height img))
  (color-list->bitmap 
   (apply append 
          (sort-list-of-lists x-pred
                              (translate
                               (sort-list-of-lists y-pred
                                                   (translate (chunk-list-all pixels w))))))
   w h))