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))))