Generating a list?

[saulgoode]

I wish to generate a sequence of numbers which maximizes the difference between any two elements, but without changing any previously determined elements.

An example might be:

Start (power of 2)

(16 0)

Diff=8

(16 0 8)

Min Diff=4

(16 0 8 12)
(16 0 8 12 4)

Min Diff=2

(16 0 8 12 4 14)
(16 0 8 12 4 14 10)
(16 0 8 12 4 14 10 6)
(16 0 8 12 4 14 10 6 2)

Min Diff=1

(16 0 8 12 4 14 10 6 2 15)
(16 0 8 12 4 14 10 6 2 15 13)
(16 0 8 12 4 14 10 6 2 15 13 11)
(16 0 8 12 4 14 10 6 2 15 13 11 9)
(16 0 8 12 4 14 10 6 2 15 13 11 9 7)
(16 0 8 12 4 14 10 6 2 15 13 11 9 7 5)
(16 0 8 12 4 14 10 6 2 15 13 11 9 7 5 3)
(16 0 8 12 4 14 10 6 2 15 13 11 9 7 5 3 1)

As an example application, imagine I have 16 pencils in various shades of gray (0=black to 15=lightest). I start drawing on a white sheet of paper with the black (darkest) pencil. I then want to switch to most distinct shade to add to the drawing, so I choose the middle gray (#8) pencil. Later I want to add some new stuff and maintain the greatest difference between all the colors on the drawing (I can't change the colors already used), so I can choose either #12 or #4 -- either way will maintain at least a difference of "4" between shades. The next pencil I should use would be either #4 or #12; whichever I didn't use previously.

With this method of selecting my pencils, I could stop drawing at any time and be assured that I have the greatest distinction possible between colors without knowing ahead of time the number of colors.

Any help would be appreciated. I am posting this in the Scheme forum, but Lisp solutions would be equally welcomed.

[justin_ruch1180]

Anyone? I would also love to know..

[Warren Wilkinson]

Here is one solution. But see below for a better one.

Code: Select all

(flet ((score (list i) (apply #'min (mapcar #'(lambda (elem) (abs (- elem i))) list))))
  (defun next (list)
    ;; Add a value that is MOST different from every other element.
    (caar (sort (loop for i from 0 upto 16 unless (member i list) collect (cons i (score list i))) #'> :key #'cdr))))

(next '(16 0))

(next '(16 0 8))

(next '(16 0 8 4))

(next '(16 0 8 4 12))
(next '(16 0 8 4 12 2))
(next '(16 0 8 4 12 2 6))
(next '(16 0 8 4 12 2 6 10))

(next '(16 0 8 4 12 2 6 10 14))
(next '(16 0 8 4 12 2 6 10 14 1))

(next '(16 0 8 4 12 2 6 10 14 1 3))

(next '(16 0 8 4 12 2 6 10 14 1 3 5))


It really feels like there is a mathematical pattern to this, but I'm tired. In anycase, if you know you have 16 colors, why not just do this:

Code: Select all

(defconstant +pen+ '(16 0 8 4 12 2 6 10 14 1 3 5 7 9 11 13 15))


[saulgoode]

It really feels like there is a mathematical pattern to this, but I'm tired. In anycase, if you know you have 16 colors, why not just do this:

Thanks for your response. I am interested in generating the colors (shades of gray) algorithmically because there will be at least 256 of them, perhaps 65536 (16-bit). The ideal would be to implement it as a 'delay'ed evaluation so that new colors are only generated as needed.

As far as discerning a pattern, perhaps a graphical representation might help. Each node in the following binary tree produces two subnodes, one the sum and the other the difference of the node with half its value. In addition, all nodes in a vertical column (and all vertical columns to its left) are guaranteed a minimum difference of the lowest value in the column.



I would like to generalize the approach to generating successive values (I do not care what order the nodes in a particular column are created but the column should be fully generated before proceed to the next) so that I might start with a high value in the leftmost node ("128" in the following image, but in some cases I might want 32768 or somesuch) and only need to generate the values as needed. It shouldn't be that difficult to perform in a brute force, algebraic manner, I'm just thinking there should be a more Lisp-y way of doing it.

[Warren Wilkinson]

Here is some Lisp code that computes (almost) what you want. It might be good enough.

Code: Select all

(defun color (N color)
  (if (zerop color)
      0
    (let ((N (truncate N 2)))
      (+ (* (boole boole-and 1 color) N) (color N (ash color -1))))))

(loop for i from 1 to 256 collecting (color 256 i))
(128 64 192 32 160 96 224 16 144 80 208 48 176 112 240 8 136 72 200 40 168 104
 232 24 152 88 216 56 184 120 248 4 132 68 196 36 164 100 228 20 148 84 212 52
 180 116 244 12 140 76 204 44 172 108 236 28 156 92 220 60 188 124 252 2 130 66
 194 34 162 98 226 18 146 82 210 50 178 114 242 10 138 74 202 42 170 106 234 26
 154 90 218 58 186 122 250 6 134 70 198 38 166 102 230 22 150 86 214 54 182 118
 246 14 142 78 206 46 174 110 238 30 158 94 222 62 190 126 254 1 129 65 193 33
 161 97 225 17 145 81 209 49 177 113 241 9 137 73 201 41 169 105 233 25 153 89
 217 57 185 121 249 5 133 69 197 37 165 101 229 21 149 85 213 53 181 117 245 13
 141 77 205 45 173 109 237 29 157 93 221 61 189 125 253 3 131 67 195 35 163 99
 227 19 147 83 211 51 179 115 243 11 139 75 203 43 171 107 235 27 155 91 219 59
 187 123 251 7 135 71 199 39 167 103 231 23 151 87 215 55 183 119 247 15 143 79
 207 47 175 111 239 31 159 95 223 63 191 127 255 0)

(loop for i from 1 to 16 collecting (color 16 i))
(8 4 12 2 10 6 14 1 9 5 13 3 11 7 15 0)



[saulgoode]

I came up with a Scheme solution, though it is not nearly as succinct as yours. Note that in Scheme, definitions (defun's) always have local scope so unlike Lisp, I can't just put the definition statement (define/defun) within the 'let*' block (else it wouldn't be visible globally).

Code: Select all

(define *bit-depth* 8) ; 4=16 colors, 8=256 colors, 16=65536 colors
(define get-next-color
  (let* ((num-colors (inexact->exact (expt 2 *bit-depth*)))
         (base (inexact->exact (expt 2 *bit-depth*)))
         (colors nil) )
    (lambda ()
      (if (or (null? colors) (= (car colors) base))
        (begin
          (set! base (/ base 2))
          (set! colors (cons  (- num-colors base) colors)) )
        (begin
          (set! colors (cons (- (car colors) (* base 2)) colors))))
      colors )))

Here is a log of a sample run. Note that while the above code returns the list of colors, this was done for debugging/demonstration purposes. For final usage, I will only be creating the next color (no list is then necessary).

Code: Select all

> (set! *bit-depth* 8)
> (define get-next-color ... ) ; initialize things
> (get-next-color)
(128)
> (get-next-color)
(192 128)
> (get-next-color)
(64 192 128)
> (get-next-color)
(224 64 192 128)
> (get-next-color)
(160 224 64 192 128)
> (get-next-color)
(96 160 224 64 192 128)
> (get-next-color)
(32 96 160 224 64 192 128)
> (get-next-color)
(240 32 96 160 224 64 192 128)


Thank you for your help and your code. I will be trying to understand it this weekend (I am not very proficient at Lisp).

[saulgoode]

Here is the code for a version which does not maintain a list of the colors.

Code: Select all

(define *bit-depth* 8) ; 4=16 colors, 8=256 colors, 16=65536 colors
(define get-next-color
  (let ((num-colors (inexact->exact (expt 2 *bit-depth*)))
         (base (inexact->exact (expt 2 *bit-depth*)))
         (color 0) )
    (lambda ()
      (if (or (zero? color) (= color base))
        (begin
          (set! base (/ base 2))
          (set! color (- num-colors base)) )
        (begin
          (set! color (- color (* base 2))) ))
      color )))