Traceroute puzzle

Which ISPs appear in the following traceroute, and where do they interconnect?

  1 swiCE3-10GE-1-4.switch.ch (130.59.36.210) 0 msec # local AS: 559
  2 bb1.tor.primus.ca (195.69.145.154) [AS 3549] 108 msec
  3 216.254.129.3 (216.254.129.3) [AS 6407] 108 msec
  4 www.primus.ca (216.254.141.10) [AS 6407] 104 msec

This Blog now speaks IPv6

Google just posted an announcement on Google App Engine Blog: App Engine and IPv6, Round 2. This announces that ghs.google.com now has an IPv6 address, although, as with many other Google hostnames, the IPv6 address is only visible if your organisation or ISP has been "whitelisted" for IPv6/AAAA records in Google's DNS.

In addition, Google have added an alternate name, ghs46.google.com, that announces both traditional IP (IPv4) and IPv6 addresses even for non-whitelisted users. This allows users of Google Apps to "opt-in" to IPv6. One example where you can do this is if you have your blog hosted on Blogger, but use your own domain name - like this blog. I have already changed blog.simon.leinen.ch to point to ghs46, so if you have IPv6 connectivity, you might already have loaded this blog post over IPv6.

GCJ 2010: Load Testing in Common Lisp (wrong)

I thought a little about this problem, and then had the idea that the optimal strategy would be to do a binary search between L and P in log-C space. So the required number of tries would be

(defun min-tests (l p c)
  (max 0 (ceiling (log (- (log p c) (log l c)) 2))))

This gave the correct results for the tiny input set on the problem description page, but unfortunately failed on even the small competition set. At this point I gave up and passed on to C (Making Chess Boards), which was more fun anyway.

Later I noticed that someone else solved the small set in Lisp in an identical way, except they computed the log-C distance differenty:

(defun min-tests (l p c)
  (max 0 (ceiling (log (log )/ p l) c) 2))))

With this modification, my code successfully solved the small practice set! Just shows that floating-point arithmetic should never be trusted.

Unfortunately this fails on the large input set, probably because the approach is too simplistic.

GCJ 2010: Making Chess Boards in Common Lisp (Online Round 1C)

I was on the right track with this one, but made a logical mistake and wasn't able to fix it before time ran out. I fixed my code in the half hour after the deadline, and it was able to solve the small input set. After about another hour, I had improved the logic so that it solved the large input set quickly enough. The code that I have now is easily fast enough for solving this puzzle (4 seconds for the large set), although it is not optimal.

The general approach is as follows: We compute a "scores" matrix from the bottom right up towards the top left. Each entry in the score matrix contains the size of the maximum proper chess board starting at the corresponding spot in the board matrix, towards the bottom right.

We keep another matrix that contains, for each position, the maximum score towards the bottom or right.

Then it's easy to find the largest boards that we can cut out, in the proper order. As we cut out squares, we recompute parts of the score and max-score matrices. My code recomputes a little than is actually necessary - that's a possible area of improvement.

(defun solve-case (caseno in)
  (let* ((m (read in)) (n (read in)))
    (let ((board (make-array (list m n)))
          (score (make-array (list m n)))
          (maxscore (make-array (list m n)))
          (cuts '())
          (cut 0))
      (dotimes (i m)
        (let ((line (read-line in)))
          (dotimes (j-hi (floor n 4))
            (let ((digit (parse-integer line :start j-hi :end (1+ j-hi) :radix 16)))
              (dotimes (j-lo 4)
                (let ((j (+ (* j-hi 4) j-lo)))
                  (setf (aref board i j)
                    (if (logbitp (- 3 j-lo) digit) 1 0))))))))
      (update-scores board score maxscore m n 0 0 m n)
      (let (last-width (last-i 0) (last-j 0))
        (loop
          (let ((width (aref maxscore 0 0)))
            (when (zerop width)
              (return))
            (when (eql width 1)
              (push (cons width (- (* m n) cut)) cuts)
              (return))
            (multiple-value-bind (imax jmax)
                (if (eql last-width width)
                    (find-first-from board score m n last-i last-j width)
                  (find-first-from board score m n 0 0 width))
              (assert imax)
              (setq last-i imax last-j jmax last-width width)
              (cut-out board m n imax jmax width)
              (incf cut (* width width))
              (let ((old (assoc width cuts)))
                (if old
                    (incf (cdr old))
                  (push (cons width 1) cuts)))
              (update-scores board score maxscore m n imax jmax (+ imax width) (+ jmax width))))))
      (format t "Case #~D: ~D~%" (1+ caseno) (length cuts))
      (dolist (sizes (reverse cuts))
        (format t "~D ~D~%" (car sizes) (cdr sizes))))))

(defun find-first-from (board score m n i0 j0 width)
  (declare (ignore board))
  (do ((i i0 (1+ i)))
      ((>= i m))
    (do ((j (if (= i i0) j0 0) (1+ j)))
        ((>= j n))
      (when (= (aref score i j) width)
        (return-from find-first-from (values i j))))))

(defun cut-out (board m n i j width)
  (declare (ignore m n))
  (let ((start (aref board i j)))
    (dotimes (ioff width)
      (dotimes (joff width)
        (let ((old (aref board (+ i ioff) (+ j joff))))
          (assert (not (eql old '-)))
          (assert (evenp (+ start old ioff joff))))
        (setf (aref board (+ i ioff) (+ j joff)) '-)))))

(defun update-scores (board score maxscore m n imin jmin imax jmax)
  (declare (type (simple-array t (* *)) board score maxscore))
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (let (dirty)
    (do ((i (1- imax) (1- i)))
        ((or (< i 0)
             (and (< i imin) (not dirty))))
      (setq dirty nil)
      (do ((j (1- jmax) (1- j)))
          ((< j 0))
        (let ((oldscore (aref score i j))
              (newscore
               (cond ((eq (aref board i j) '-) 0)
                     ((or (= i (1- m)) (= j (1- n))) 1)
                     (t (if (eql (aref board i j) (aref board (1+ i) (1+ j)))
                            (let ((here (aref board i j)))
                              (if (and (eql here (aref board (1+ i) (1+ j)))
                                       (eql (- 1 here)
                                            (aref board i (1+ j)))
                                       (eql (- 1 here)
                                            (aref board (1+ i) j)))
                                  (1+ (min (aref score (1+ i) (1+ j))
                                           (aref score i (1+ j))
                                           (aref score (1+ i) j)))
                                1))
                          1)))))
          (unless (eql oldscore newscore)
            (setf (aref score i j) newscore)
            (setq dirty t)))
        (let* ((oldmax (aref maxscore i j))
               (newmax (aref score i j)))
          (when (and (< (1+ i) m) (> (aref maxscore (1+ i) j) newmax))
            (setq newmax (aref maxscore (1+ i) j)))
          (when (and (< (1+ j) n) (> (aref maxscore i (1+ j)) newmax))
            (setq newmax (aref maxscore i (1+ j))))
          (unless (eql oldmax newmax)
            (setf (aref maxscore i j) newmax)
            (setq dirty t)))))))

GCJ 2010: Rope Intranet in Common Lisp (Online Round 1C)

I failed at online round 1 this year, although I tried twice in sub-rounds 1B and 1C. The first puzzle in sub-round 1C, Rope Intranet was easy, and I handed in the correct solutions for both the small and the large input in less than ten minutes. Here is the straightforward code:

(defun solve (file)
  (with-open-file (in file)
    (let ((ncases (read in)))
      (dotimes (caseno ncases)
        (solve-case caseno in)))))

(defun solve-case (caseno in)
  (let ((n (read in)))
    (let ((wires (make-array (list n))))
      (dotimes (i n)
        (setf (aref wires i)
          (cons (read in) (read in))))
      (let ((sol (intersections wires)))
        (format t "Case #~D: ~D~%" (1+ caseno) sol)))))

(defun intersections (wires)
  (let ((result 0))
    (do ((i 0 (1+ i)))
        ((>= i (length wires))
         result)
      (do ((j (1+ i) (1+ j)))
          ((>= j (length wires)))
        (when (intersectsp (aref wires i) (aref wires j))
          (incf result))))))

(defun intersectsp (w1 w2)
  (if (< (car w1) (car w2))
      (> (cdr w1) (cdr w2))
    (< (cdr w1) (cdr w2))))

GCJ 2010: Theme Park in Common Lisp (Qualification Round)

A trivial implementation will work fine for small cases, but not for a day with 10⁸ rounds! I convinced myself (correctly I think) that I need to memoize intermediate results. I decided that I should memoize, for each group that is at the head of the queue, two values: The number of people (thus Euros) from the head of the group that would fit into the roller coaster, and the pointer to the next head of the queue (the index of the first group that will not fit). Then I could just iterate R rounds starting with queue pointer 0, and add up the (mostly cached) results. I would have to compute the roller-coaster occupation at most once for each group in the queue (max. 1000 in the large case).

However, I still have to iterate R rounds, so depending on the speed of the computer this can take long. During my attempt at the large example, I suspected that the laptop I was running this on wouldn't complete the computation in time, and copied everything over to a faster machine. On the laptop it took 2'40", on the faster machine around 45".

This is the (inefficient) code as used in the contest:

(defvar *get-riders-cache*)

(defun solve (input)
  (with-open-file (in input)
    (let ((n (read in)))
      (dotimes (k n)
 (solve-case k in)))))

(defun solve-case (caseno in)
  (let* ((R (read in))
  (k (read in))
  (N (read in)))
    (let ((gs (make-array (list N))))
      (dotimes (i N)
        (setf (aref gs i) (read in)))
      (let ((*get-riders-cache* (make-riders-cache N)))
        (solve-1 caseno R k gs 0 0)))))

(defun make-riders-cache (N)
  (make-array (list N) :initial-element nil))

(defun get-riders-cache (N) (aref *get-riders-cache* N))
(defun set-riders-cache (N new)
  (setf (aref *get-riders-cache* N) new))
  
(defun solve-1 (caseno R k gs ptr sum)
  (if (= R 0)
      (finish-solution caseno sum)
    (multiple-value-bind (next-group-size next-ptr)
 (get-riders k gs ptr)
      (solve-1 caseno (1- R) k gs next-ptr (+ sum next-group-size)))))

(defun get-riders (R gs ptr)
  (let ((cached (get-riders-cache ptr)))
    (if cached
 (values (car cached) (cdr cached))
      (multiple-value-bind (size next-ptr)
   (get-riders-1 R gs ptr (length gs) 0)
 (set-riders-cache ptr (cons size next-ptr))
 (values size next-ptr)))))
  
(defun get-riders-1 (R gs ptr rql size)
  (declare (type (unsigned-byte 30) R ptr rql size))
  (declare (optimize (debug 0) (speed 3)))
  (if (or (= rql 0) (< R (aref gs ptr)))
      (values size ptr)
    (get-riders-1 (- R (aref gs ptr)) gs (mod (1+ ptr) (length gs)) (1- rql) (+ size (aref gs ptr)))))

(defun finish-solution (caseno sum)
  (format t "Case #~D: ~D~%" (1+ caseno) sum))

Back at home, I decided that I had to optimize this some more. In particular, when one finds a cycle (a queue index that has already been encountered during a previous round), one can just compute how many of those cycles can be filled with the remaining rounds, and add that number multiplied with the number of Euros earned during a cycle to the account. Then that leaves only a small (smaller than the cycle) number of rounds to execute.

(defun solve-1 (caseno R k gs ptr sum)
  (assert (>= R 0))
  (if (= R 0)
      (finish-solution caseno sum)
    (multiple-value-bind (next-group-size next-ptr last-seen old-sum)
        (get-riders k R gs ptr sum)
      (if last-seen
          (let ((cycle-length (- last-seen R))
                (per-cycle (- sum old-sum)))
            (multiple-value-bind (ncycles remaining-rounds)
                (truncate R cycle-length)
              (incf sum (* ncycles per-cycle))
              (setq R remaining-rounds))
            (if (zerop R)
                (finish-solution caseno sum)
              (solve-1 caseno (1- R) k gs next-ptr (+ sum next-group-size))))
        (solve-1 caseno (1- R) k gs next-ptr (+ sum next-group-size))))))

This code takes 0.34 seconds for my large input, even on my netbook at home - which took 20 minutes for my initial (naïve with memoization) solution! Only eight minutes are allowed for submission of a large solution...

In a way I was right not to optimize this further, because the naïve memoized solution turned out to be (just) fast enough. But this is exactly the kind of not-thinking-the-problem-through that will hurt me in the "real" rounds of the competition. Maybe it would be good training to change the solution into one that calculates all possible values up front rather than on-demand (caching).

Followup: Complexity Analysis and Iterative Solution

The complexity of the first algorithm (naïve with memoization) is O(R+N²).  The work for each R is just a memory access (within the relatively small cache), an integer addition that fits in 64 bits, and a few assignments.  Therefore it can still work when R is close to 10⁸.  The N² comes from computing the occupancies of the roller coaster for each possible group that may be in front of the queue at the start of a round.  There are N such groups.  For each position, computing the occupancy may take up to N steps.  Note that by "computing the occupancy", I always mean computing the occupancy and the next head-of-queue group.

The complexity of the second algorithm (like first but with cycle detection) is O(N²), because each possible position in the queue (there are N of these) can be visited twice at a maximum.  Again, the complexity of finding the occupation of the roller coaster given a queue pointer is O(N).

The complexity can be brought down to O(N) as follows: The occupancy is computed completely only for the first queue-head group.  Then, the occupancy for each subsequent group can be computed incrementally from the previous one in a small number of steps. Here is an implementation of this algorithm:

(defun solve-case (caseno in)
  (let* ((R (read in))
  (k (read in))
  (N (read in)))
    (declare (type (integer 1 100000000) R)
      (type (integer 1 1000000000) k)
      (type (integer 1 1000) N))
    (let ((g (make-array (list N))))
      (dotimes (i N)
        (setf (aref g i)
          (make-group (read in))))
      (let ((fill-level 0)
            (end 0))
        (do ((start 0 (1+ start)))
            ((= start (length g)))
          (setq fill-level
            (if (zerop start)
                0
              (- fill-level (group-size (aref g (1- start))))))
          (loop
            (when (> (+ fill-level (group-size (aref g end))) k)
              (return))
            (incf fill-level (group-size (aref g end)))
            (setq end (mod (1+ end) (length g)))
            (when (= start end)
              (return)))
          (setf (group-next-pointer (aref g start)) end)
          (setf (group-fill-level (aref g start)) fill-level)))
      (let ((ptr 0) (sum 0) (found-cycle nil))
        (declare (type (integer 0 999) ptr))
        (let ((result
               (loop
                 (when (= R 0) (return sum))
                 (let ((group (aref g ptr)))
                   (when (and (not found-cycle) (group-last-seen group))
                     (setq found-cycle t)
                     (let ((cycle-length (- (group-last-seen group) R))
                           (per-cycle (- sum (group-euros-at-last-seen group))))
                       ;;(declare (type (integer 1 1000) cycle-length))
                       (multiple-value-bind (ncycles remaining-rounds)
                           (truncate R cycle-length)
                         (incf sum (* ncycles per-cycle))
                         (setq R remaining-rounds))
                       (when (zerop R) (return sum))))
                         (setf (group-last-seen group) R)
                         (setf (group-euros-at-last-seen group) sum)
                         (decf R)
                         (setq ptr (group-next-pointer group))
                         (incf sum (group-fill-level group))))))
          (format t "Case #~D: ~D~%" (1+ caseno) result))))))

For my large-input set, this is not significantly faster than the second program (0.21s instead of 0.34s on my Netbook). But it would scale to a queue with massively more groups. And it is possibly optimal in terms of complexity class.

GCJ 2010: Fair Warning in Common Lisp (Qualification Round)

The maximum possible factor is determined by the GCD between the Great Events in the past. Sorry for the unclear explanation. Anyway, the way I solved this is: I first sort the sequence of ages of past events in descending order. Then I normalize them with respect to the most recent of these events, by subtracting the smallest of these ages. I take the GCD of the other (non-smallest) event ages. This GCD defines a kind of cycle. The apocalypse (or party) will happen at the next possible cycle boundary after OR AT the current time.

Thankfully, Common Lisp has a variadic GCD function and efficient bignum implementations.

(defun solve (file)
  (with-open-file (in file)
    (let ((ncases (read in)))
      (dotimes (caseno ncases)
 (solve-case in caseno)))))

(defun solve-case (in caseno)
  (let ((nevents (read in)))
    (let ((events (make-array (list nevents))))
      (dotimes (k nevents)
 (setf (aref events k)
   (read in)))
      ;; We would like these to be in canonical order, let's say decreasing
      (setq events (sort events #'>))
      (let ((solution (time-to-apocalypse events)))
 (format t "Case #~D: ~D~%" (1+ caseno) solution)))))

(defun time-to-apocalypse (events)
  (let ((reckon (aref events (1- (length events))))) ;time since last event
    (dotimes (k (length events))
      (decf (aref events k) reckon))
    (let ((gcd (apply #'gcd (coerce (subseq events 0 (1- (length events))) 'list))))
      (if (= gcd 1)
   0
 (rem (- gcd (rem reckon gcd)) gcd)))))

GCJ 2010: Snapper Chain in Common Lisp (Qualification Round)

The snapper chain is a simple binary counter modulo 2^N. The light bulb is on iff the value of the counter is all-ones. So all we have to do is check for that counter value.

(defun solve (file)
  (with-open-file (in file)
    (let ((ncases (read in)))
      (dotimes (caseno ncases)
 (solve-case caseno in)))))

(defun solve-case (caseno in)
  (let ((n (read in))
 (k (read in)))
    (let ((solution (light-on-p n k)))
      (format t "Case #~D: ~A~%" (1+ caseno) (if solution "ON" "OFF")))))

(defun light-on-p (n k)
  (let ((cycle (ash 1 n)))
    (= (rem k cycle) (1- cycle))))