How to Solve it by Computer #13

Algorithm 8.4: Design an algorithm that generates all permutations of the first n integers taken r at a time and allowing unrestricted repetitions. This is sometimes referred to as sample generation. The values of n and r must be greater than zero.

This was also something I never did properly, writing combinatorial algorithms. I want to clean up and do it finally.

So the problem is that we want these permutations of integers. Given n = 4 and r = 2, we get:

1 1
1 2
1 3
1 4
2 1
2 2
2 3
2 4
3 1
3 2
3 3
3 4
4 1
4 2
4 3
4 4

These are n^r = 4^2 = 16 possible elements. For r = 2 the algorithm is pretty simple:

user=> (for [x (range 1 6) y (range 1 6)] [x y])
([1 1] [1 2] [1 3] [1 4] [1 5] [2 1] [2 2] [2 3] [2 4] [2 5] [3 1] [3 2] [3 3] [3 4] [3 5] [4 1] [4 2] [4 3] [4 4] [4 5] [5 1] [5 2] [5 3] [5 4] [5 5])

We iterate over every x and every y. We could write a macro which just creates more variables given r. But let’s take a more general view.

We can see that the sequence [1 2 3 4] is repeated over and over again. The only thing that changes is the first number. More generally, we combine our first number with all the sub-permutations, then our second number, etc.

(defn generate-sample
  "Implements the sample generation algorithm
   which produces permutations of n integers
   with length r"
  [n r]
  {:pre [(pos? n) (pos? r)]}
  (let [numbers (range 1 (inc n))]
    (loop [result (map vector numbers)
           new-r r]
      (if (> new-r 1)
        (recur 
          (apply 
            concat
            (for [idx numbers] 
              (map #(conj % idx) result)))
          (dec new-r))
        result))))

Again, no super hard code. We basically iterate over our existing result set and append the integers up to n to each one and then do it again recursively. I’m surprised that it was that easy :D

And here’s some output:

user=> (generate-sample 4 1)
([1] [2] [3] [4])
user=> (generate-sample 4 2)
([1 1] [2 1] [3 1] [4 1] [1 2] [2 2] [3 2] [4 2] [1 3] [2 3] [3 3] [4 3] [1 4] [2 4] [3 4] [4 4])
user=> (generate-sample 4 3)
([1 1 1] [2 1 1] [3 1 1] [4 1 1] [1 2 1] [2 2 1] [3 2 1] [4 2 1] [1 3 1] [2 3 1] [3 3 1] [4 3 1] [1 4 1] [2 4 1] [3 4 1] [4 4 1] [1 1 2] [2 1 2] [3 1 2] [4 1 2] [1 2 2] [2 2 2] [3 2 2] [4 2 2] [1 3 2] [2 3 2] [3 3 2] [4 3 2] [1 4 2] [2 4 2] [3 4 2] [4 4 2] [1 1 3] [2 1 3] [3 1 3] [4 1 3] [1 2 3] [2 2 3] [3 2 3] [4 2 3] [1 3 3] [2 3 3] [3 3 3] [4 3 3] [1 4 3] [2 4 3] [3 4 3] [4 4 3] [1 1 4] [2 1 4] [3 1 4] [4 1 4] [1 2 4] [2 2 4] [3 2 4] [4 2 4] [1 3 4] [2 3 4] [3 3 4] [4 3 4] [1 4 4] [2 4 4] [3 4 4] [4 4 4])

How to Solve it by Computer #12

Algorithm 8.3: Design and implement a recursive algorithm to solve the Towers of Hanoi problem for one or more disks.

I actually never written code for that problem. I want to finally do this – I don’t care how long this takes. Let’s do it.

The representation is important. I first thought about using lists however most often I see an other one – a simpler one. We only need to know the largest number for each pole. This is a good tip.

See how it works if we have one disk: We just move the disk from our starting pole to our end pole and we’re done. The great thing about the smallest disk is that it can move everywhere. We don’t have to check anything.

user=> (solve-hanoi 1 :a :b :c)
Move 1 from :a to :c

Let’s add an other disk. To move disk 2 from :a to :c we have to clean :a first. Preferably to :b, so that we can move :c without problems.

user=> (solve-hanoi 2 :a :b :c)
Move 1 from :a to :b
Move 2 from :a to :c

However, we aren’t ready yet. Disk one needs to move from :b to :c.

user=> (solve-hanoi 2 :a :b :c)
Move 1 from :a to :b
Move 2 from :a to :c
Move 1 from :b to :c

Looks fine. Now, hopefully this works for 3 disks. And it worked:

user=> (solve-hanoi 3 :a :b :c)
Move 1 from :a to :c
Move 2 from :a to :b
Move 1 from :c to :b
Move 3 from :a to :c
Move 1 from :b to :a
Move 2 from :b to :c
Move 1 from :a to :c

Here’s the incredible short code:

(defn solve-hanoi
  "Solves the tower of hanoi problem"
  [disk start spare end]
  (when (>= disk 1)
      (do
        (solve-hanoi (dec disk) start end spare)
        (println "Move" disk "from" start "to" end)
        (solve-hanoi (dec disk) spare start end))))

The biggest revelation was that it only matters were the largest disk is. Somehow a super simple problem but I had problems wrapping my head around it. Maybe it was because I had problems understanding it at a kid and still think that I can’t understand it properly. Strange but simple.

So, to solve the problem I have to take the smaller disk, move it on spare, move my larger disk to end, and move the smaller disk from spare to end. That’s it. Thanks to recursion it works for all n. Magic.

How to Solve it by Computer #11

First we start with a starting sequence. Which evenly distributes the values:

user=> (take 2 (repeat (int (/ 1 2))))
(0 0)

Then we need the reminding values which can be calculated like this:

user=> (rem 1 2)
1

Afterwards we just generate a new sequence with X=1 one and Y=n-X zeros:

user=> (into (take (- 2 (rem 1 2)) (repeat 0)) (take (rem 1 2) (repeat 1)))
(1 0)

Now we just need to map this and got our desired output:

user=> (map + (take 2 (repeat (int (/ 1 2)))) (into (take (- 2 (rem 1 2)) (repeat 0)) (take (rem 1 2) (repeat 1))))
(1 0)

That’s quite unreadable, therefore I’ll write a short function:

(defn get-whitespace-distribution
  "Returns a coll with the distribution of additional
   white spaces"
  [n-whitespace needed-whitespace]
  (let [rem-whitespace (rem needed-whitespace n-whitespace)]
    (map + 
         (take n-whitespace (repeat (int (/ needed-whitespace n-whitespace))))
         (into
           (take (- n-whitespace rem-whitespace) (repeat 0))
           (take rem-whitespace (repeat 1))))))

And the function in action:

user=> (get-whitespace-distribution 2 1)
(1 0)
user=> (get-whitespace-distribution 2 5)
(3 2)

Works fine. Ok, the next step is to insert these additional white spaces. That is, we go into a list, take the first whitespace, insert additional one and go the next one.

(defn insert-whitespace
  "Insert the amount of additional whitespaces given by whitespace-distribution
  into the provided sentence"
  [sentence whitespace-distribution]
  (loop [rest-sentence sentence
         rest-distribution whitespace-distribution
         new-sentence nil]
    (if (seq rest-sentence)
      (if (not= (first rest-sentence) \space)
        (recur 
          (next rest-sentence) 
          rest-distribution 
          (conj new-sentence (first rest-sentence)))
        (recur (next rest-sentence) 
               (next rest-distribution) 
               (into new-sentence 
                     (take 
                       (inc (first rest-distribution)) 
                       (repeat \space)))))
      new-sentence)))

The idea is pretty basic. We iterate through the sentence, if we see a whitespace, we add our additional white spaces, else we just add the current character.

Let’s see if it works:

user=> (insert-whitespace sentence (get-whitespace-distribution 2 1))
(\a \space \s \i \space \space \s \i \h \T)
user=> (insert-whitespace sentence (get-whitespace-distribution 2 2))
(\a \space \space \s \i \space \space \s \i \h \T)
user=> (insert-whitespace sentence (get-whitespace-distribution 2 3))
(\a \space \space \s \i \space \space \space \s \i \h \T)

Looks good, now let’s generalize the function:

(defn left-right-justify-line
  "Returns a split text of lines justified"
  [line n]
  (let [clean-line (map delete-right-spaces (wrap-word line n))]
    (map #(left-right-justify % n) clean-line)))

It just applies all the functions on it. And here’s the function in action:

user=> (map #(apply str (reverse %)) (left-right-justify-line "This is a sentence which is quite long" 10))
("" "quite long" "which   is" "sentence" "This  is a")

Works. It have the feeling that I made it harder than it’s actually is :D but it was a good learning experience.

How to Solve it by Computer #10

Algorithm 6.2: Design and implement a procedure that will left and right justify text in a way that avoids splitting words and leaves paragraphs indented. An attempt should also be made to distribute the additional blanks as evenly as possible in the justified line.

Let’s take the example from above. Same sentence, same n. Our output should be something like

    This  is a
    sentence
    which   is
    quite long

We already know how to create lines with a maximum length, now we need to add additional spaces. That’s actually what I did by hand. I copied the above text and insert spaces. If you look back at our function, you can see its output.

user=> (wrap-word "This is a sentence which is quite long" 10)
((\space) (\q \u \i \t \e \space \l \o \n \g) (\w \h \i \c \h \space \i \s \space) (\s \e \n \t \e \n \c \e \space) (\T \h \i \s \space \i \s \space \a \space))

Let’s take the first part of the sentence:

(\T \h \i \s \space \i \s \space \a \space)

We need to delete trailing spaces first. There’s a short solution which is a probably a bit slow. However, this is just a learning experience, therefore performance isn’t that important. Also in production code I would use the library function trimr.

First we reverse the string, then we drop all spaces and then we reverse the string again.

user=> sentence
(\T \h \i \s \space \i \s \space \a \space)
user=> (reverse sentence)
(\space \a \space \s \i \space \s \i \h \T)
user=> (drop-while #(= \space %) (reverse sentence))
(\a \space \s \i \space \s \i \h \T)
user=> (reverse (drop-while #(= \space %) (reverse sentence)))
(\T \h \i \s \space \i \s \space \a)

Now we can apply that function, which I called delete-right-spaces on our complete sentence:

user=> (map delete-right-spaces (wrap-word "This is a sentence which is quite long" 10))
(() (\q \u \i \t \e \space \l \o \n \g) (\w \h \i \c \h \space \i \s) (\s \e \n \t \e \n \c \e) (\T \h \i \s \space \i \s \space \a))

Looks good. The next step is to calculate

a) How many white spaces we need to justify the text
b) Were to put them

We can calculate the current length of a line quite easily, we now the maximum aka. n therefore we need (n – length) additional white spaces.

For our cleaned sentence, we need:

user=> (- 10 (count sentence))
1

one additional whitespace. Were should we put them? Depends on the white spaces. One idea is that we ‘duplicate’ our existing white spaces starting with the first one. Here’s an example of the imagined function:

Input: (\T \h \i \s \space \i \s \space \a) and n = 10

=> we need one additional white space

Output: (\T \h \i \s \space \space \i \s)

In case we need two or more it should be evenly spaced. That is we need to know how many white spaces there are:

user=> (count (filter #(= \space %) sentence))
2

Here we have two. Now we know how many each whitespace needs: 1/2. However, that isn’t possible. Therefore, I want an other
imagined function which returns a partition which is as evenly distributed as possible given the needed white spaces and the available whitespace.

Input: 1 needed 2 available
Output: (1 0)

Continues tomorrow.