Welcome to the CHICKEN Scheme pasting service

(use irregex data-structures test)

;; TODO: offer trimming/ci comparison?  that's what the ruby
;; implementation does, but it strikes me as wasteful...

(define (tokenize string)
  (reverse
   (irregex-fold
    '(or (=> number (+ num)) (=> string (+ (~ num))))
    (lambda (_i m acc)
      (let ((number (irregex-match-substring m 'number))
            (string (irregex-match-substring m 'string)))
        (if number
            (cons (string->number number) acc)
            (cons string acc))))
    '() string)))

(test '() (tokenize ""))
(test '(123) (tokenize "123"))
(test '("foo") (tokenize "foo"))
(test '("foo" 123 "bar") (tokenize "foo123bar"))

(define (clamp lower x upper)
  (min (max lower x) upper))

(test 0 (clamp -1 0 1))
(test -1 (clamp -1 -1 1))
(test -1 (clamp -1 -10 1))
(test 1 (clamp -1 1 1))
(test 1 (clamp -1 10 1))

(define (natural-string-compare string1 string2)
  (define (inner as bs)
    (cond
     ((and (null? as) (null? bs)) 0)
     ((null? as) -1)
     ((null? bs) 1)
     (else
      (let ((a (car as))
            (b (car bs)))
        (if (and (number? a) (number? b))
            (cond
             ((< a b) -1)
             ((> a b) 1)
             (else (inner (cdr as) (cdr bs))))
            (let* ((a (if (number? a) (number->string a) a))
                   (b (if (number? b) (number->string b) b))
                   (result (string-compare3 a b)))
              (if (zero? result)
                  (inner (cdr as) (cdr bs))
                  ;; unlike what the docs suggest, string-compare3
                  ;; does *not* clamp to -1 and +1
                  (clamp -1 result 1))))))))
  (inner (tokenize string1) (tokenize string2)))

(test  0 (natural-string-compare "" ""))
(test -1 (natural-string-compare "" "foo"))
(test +1 (natural-string-compare "foo" ""))
(test  0 (natural-string-compare "foo" "foo"))
(test -1 (natural-string-compare "bar" "foo"))
(test +1 (natural-string-compare "foo" "bar"))
(test  0 (natural-string-compare "foo123" "foo123"))
(test -1 (natural-string-compare "foo" "foo123"))
(test +1 (natural-string-compare "foo123" "foo"))
(test -1 (natural-string-compare "foo2" "foo123"))
(test -1 (natural-string-compare "foo99" "foo123"))
(test  0 (natural-string-compare "foo123bar" "foo123bar"))
(test -1 (natural-string-compare "foo123bar" "foo123baz"))
(test +1 (natural-string-compare "foo123qux" "foo123baz"))

(define (natural-string<? string1 string2)
  (if (< (natural-string-compare string1 string2) 0) #t #f))

(define (natural-string<=? string1 string2)
  (if (<= (natural-string-compare string1 string2) 0) #t #f))

(define (natural-string=? string1 string2)
  (if (zero? (natural-string-compare string1 string2)) #t #f))

(define (natural-string<>? string1 string2)
  (if (not (zero? (natural-string-compare string1 string2))) #t #f))

(define (natural-string>? string1 string2)
  (if (> (natural-string-compare string1 string2) 0) #t #f))

(define (natural-string>=? string1 string2)
  (if (>= (natural-string-compare string1 string2) 0) #t #f))

(define (natural-sort strings)
  (sort strings natural-string<?))

(test '("1" "2" "3" "4" "10" "20" "30" "100")
      (natural-sort '("1" "10" "100" "2" "20" "3" "30" "4")))

(test '("a" "a0" "a1" "a1a" "a1b" "a2" "a10" "a20")
      (natural-sort '("a10" "a" "a20" "a1b" "a1a" "a2" "a0" "a1")))