Advogato blog for brlewis

19 Nov 2004

Fri, 19 Nov 2004 14:52:44 GMT

In Coding Challenge: Increment a date/timestamp string, ncm challenges us to "consider the string as a pure 14-digit number, with digits that have very odd add-with-carry relationships." Then think of a fun-to-code way to write a function that could be "a lot faster than calling mktime etc."

Besides losing the libary-call overhead, there are other reasons such a function could be made very fast. Assuming a random distribution of tiemstamps,

Nine out of ten times this function would only be incrementing one character.
Fifty-nine times out of sixty this function would be incrementing one or two characters.
Since these times are GMT and we ignore leap seconds, only once in 24 * 60 * 60 times do we care how many days are in any given month.

Interestingly, nobody seems interested in writing the function this way. It seems much more fun for people to focus on conciseness rather than performance.

For what it's worth, I wrote a Scheme version that does not allocate new objects, is tail recursive, uses functions that are likely to be inlined, and does multiplication and modulo only with constant powers of two, allowing compiler optimization into bitwise operations.

It is longer than the other posted solutions, but all the way through it focuses on finding the most common case, doing it, and returning immediately.

(define (timestamp-increment! timestamp)
  (timestamp-position-increment! timestamp 13))

 (define (timestamp-position-increment! timestamp pos)
  (let ((current-char (string-ref timestamp pos)))
    (case pos
      ((13 11 3 2 1 0) ; last digits of second, minute, all year digits
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 #\9))
      ((12 10) ; first digits of second, minute
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 #\5))
      ((9) ; last digit of hour
       (timestamp-position-increment-depending!
	timestamp pos current-char #\0 #\0 #\9 #\3 #\2))
      ((8) ; first digit of hour
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 #\2))
      ((7) ; last digit of day
       (timestamp-position-increment-day! timestamp pos current-char))
      ((6) ; first digit of day
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 (if (february? timestamp)
					   #\2
					   #\3)))
      ((5) ; last digit of month
       (timestamp-position-increment-depending!
	timestamp pos current-char #\0 #\1 #\9 #\2 #\1))
      ((4) ; first digit of month
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 #\1)))))

 (define (timestamp-position-increment-simple!
	 timestamp pos current-char ch0 ch9)
  (if (char=? current-char ch9)
      (begin
	(string-set! timestamp pos ch0)
	(timestamp-position-increment! timestamp (- pos 1)))
      (string-set! timestamp pos (next-digit current-char))))

 (define (next-digit ch)
  (integer->char (+ 1 (char->integer ch))))

 (define
  (timestamp-position-increment-depending!
   timestamp pos current-char ch0 ch0-special ch9 ch9-special chprev-special)
  (if (and (char=? current-char ch9-special)
	   (char=? (string-ref timestamp (- pos 1)) chprev-special))
      (begin
	(string-set! timestamp pos ch0-special)
	(timestamp-position-increment! timestamp (- pos 1)))
      (timestamp-position-increment-simple!
       timestamp pos current-char ch0 ch9)))

 (define
  (timestamp-position-increment-day! timestamp pos current-char)
  (let ((first-day-pos (string-ref timestamp (- pos 1))))
    (case first-day-pos
      ((#\0 #\1)
       (timestamp-position-increment-simple!
	timestamp pos current-char #\0 #\9))
      ((#\2)
       (if (char<? current-char #\8)
	   (string-set! timestamp pos (next-digit current-char))
	   (if (february? timestamp)
	       (timestamp-position-increment-simple!
		timestamp pos current-char #\1 (ly-day-char timestamp))
	       (timestamp-position-increment-simple!
		timestamp pos current-char #\0 #\9))))
      ((#\3)
       (timestamp-position-increment-simple!
	timestamp pos current-char #\1
	(case (string-ref timestamp (- pos 2))
	  ((#\2 #\3 #\5 #\7 #\8 #\0) #\1) ; 31 in December, March, etc.
	  ((#\1)
	   (if (char=? #\0 (string-ref timestamp (- pos 3)))
	       #\1 ; 31 days in January, 30 in November
	       #\0))
	  (else #\0)))))))

 (define (ly-day-char timestamp)
  (if (positive? (mod4 (string-ref timestamp 2)
		       (string-ref timestamp 3)))
      #\8 ; year not a multiple of 4
      (if (or (char<? #\0 (string-ref timestamp 2))
	      (char<? #\0 (string-ref timestamp 3)))
	  #\9 ; multiple of 4 but not on a century
	  (if (positive? (mod4 (string-ref timestamp 0)
			       (string-ref timestamp 1)))
	      #\8 ; multiple of 4 century
	      #\9)))) ; regular century

 (define (mod4 ch1 ch2)
  (modulo (+ (* 2 (modulo (char->integer ch1) 2))
	     (modulo (char->integer ch2) 4))
	  4))

 (define (february? timestamp)
  (and (char=? #\2 (string-ref timestamp 5))
       (char=? #\0 (string-ref timestamp 4))))

18 Nov 2004

Thu, 18 Nov 2004 21:01:11 GMT

I'm having fun with ncm's programming challenge. Here's a Scheme test harness for it, assuming you call the test function timestamp-increment!

(define test-values
  '(("19991231235959" . "20000101000000")
    ("20000228235959" . "20000229000000")
    ("20000229235959" . "20000301000000")
    ("20040228235959" . "20040229000000")
    ("21000228235959" . "21000301000000")
    ("19000228235959" . "19000301000000")
    ("16000228235959" . "16000229000000")))

 (define (test-answer q-a-pair)
  (let ((a (string-copy (car q-a-pair))))
    (timestamp-increment! a)
    (if (string=? a (cdr q-a-pair))
	'ok
	(cons a q-a-pair))))

 (define test-results
  (map test-answer test-values))

21 Feb 2002

Thu, 21 Feb 2002 16:17:09 GMT

remle: Pretending you've received QUIT does not imply you must pretend you've received CRLF.CRLF.

31 Oct 2001

Wed, 31 Oct 2001 20:55:54 GMT

I've made a lot of progress on my BRL tutorial. Now anybody with Tomcat or similar servlet engine can unpack learnbrl.war and get right into it. Instant web/database app development!

11 Apr 2001

Wed, 11 Apr 2001 20:53:21 GMT

It's great when management is supportive. I got approval for us to pay the author of Kawa Scheme for work that will improve BRL debugging. Two coworkers got their first Scheme lesson yesterday.

14 Feb 2001

Wed, 14 Feb 2001 17:10:06 GMT

Got my Ask Your Sweetie app working. It lets you make a page with a yes/no question for someone to answer. They get back your prepared response according to the answer. You are e-mailed their answer.

13 Feb 2001

Tue, 13 Feb 2001 14:01:44 GMT

Self-correcting bug: My script for transfer of diary entry from Palm would overwrite an old entry rather than create a new one, so the entry in which I posted the code got overwritten. Hopefully nobody copied the old code before it Darwinized itself. I'll edit the old entry with corrected code.

My hosting provider is lame. JServ has not been running for some time. They never got back to me on any bug reports. I would finally phone them days later to get the latest promise. Now they say they're moving to JRun. We'll see. Meanwhile, the only place where I can demo BRL is BRL Cabaret. This is a free service shared by thousands of other apps, and the entire BRL environment gets unloaded after a short period of inactivity. This makes the first page load exceptionally slow. For now I'll wait and see how things go with my regular provider. If it doesn't improve I'll have to consider paying more than $17.95/month for servlet+db hosting.

12 Feb 2001

Mon, 12 Feb 2001 20:01:56 GMT

#!/bin/sh
# script to copy memo from Palm "advogato" category to diary
# Memo must be filed under "advogato" and have 1st line "diary.txt"
 
topdir=$HOME
tmphtml=$topdir/diary$$.html
 
memos -d $topdir
 
cat > $tmphtml <<EOF
<form method="POST" action="http://advogato.org/diary/post.html">
<textarea name="entry"
EOF
 
(echo ' cols=60 rows=16>' ; \
 tail +2 $topdir/[Aa]dvogato/diary.txt \
 | sed -e 's/&/\&amp;/g' -e 's/</\&lt;/g' -e 's/>/\&gt;/g') >> $tmphtml
 
cat >> $tmphtml <<EOF
</textarea>
 <p>
 <input type="submit" name=preview value="Preview">
 <input type="hidden" name=key value="-1">
</form>
EOF
 
netscape -remote "OpenFile($tmphtml)"

29 Aug 2000

Tue, 29 Aug 2000 15:56:24 GMT

Actively working on BRL.