Re: non-lexicographic string comparison

On Nov 11, 5:00 am, Marco Maggi <mrc....@xxxxxxxxx> wrote:
the Tcl language has the [lsort] command with `dictionary'
sorting for strings; it means that when two strings have an
embedded number, the numbers are considered as integers by
the comparison function; so "ciao3" sorts before "ciao10".

I wonder if someone has already written such comparison
function in pure Scheme and is distributing it under a Libre
license, so that I can shamelessly include it in my
libraries. :-)

I made the function below for you. I place it in the public domain.
I don't know if it does exactly what you want.

(define (my-string<? a b)
(define str-num cons)
(define str-num-str car)
(define str-num-num cdr)
(define (->string x)
(if (string? x) x (str-num-str x)))
(define (parts x)
(define (digit? c)
(memv c (string->list "0123456789")))
(let loop ((x (reverse (string->list x)))
(str (list))
(num (list))
(accum (list)))
(define (accum-str)
(if (null? str)
accum
(cons (list->string str) accum)))
(define (accum-num)
(if (null? num)
accum
(let ((s (list->string num)))
(cons (str-num s (string->number s))
accum))))
(cond
((null? x)
(cond ((not (null? str))
(assert (null? num))
(accum-str))
((not (null? num))
(assert (null? str))
(accum-num))
(else accum)))
((digit? (car x))
(loop (cdr x)
(list)
(cons (car x) num)
(accum-str)))
(else
(loop (cdr x)
(cons (car x) str)
(list)
(accum-num))))))
(let loop ((a (parts a))
(b (parts b)))
(cond
((null? a)
(not (null? b)))
((null? b) #F)
((and (string? (car a))
(string? (car b)))
(if (string=? (car a) (car b))
(loop (cdr a) (cdr b))
(string<? (car a) (car b))))
((and (not (string? (car a)))
(not (string? (car b))))
(if (= (str-num-num (car a))
(str-num-num (car b)))
(loop (cdr a) (cdr b))
(< (str-num-num (car a))
(str-num-num (car b)))))
(else
(string<? (->string (car a))
(->string (car b)))))))

(my-string<? "123" "45")
#F
(my-string<? "ciao3" "ciao10")
#T
(my-string<? "foo4bar3zab10" "foo4bar3zab2")
#F
(my-string<? "foo4bar3zab" "foo4bar10")
#T
(my-string<? "foo12" "12foo")
#F
(my-string<? "12bar" "foobar")
#T
(my-string<? "12.3" "12.10")
#T
(my-string<? "12.3" "12,10")
#F
(list-sort my-string<? (quote ("foo123" "foo42" "foo7")))
("foo7" "foo42" "foo123")

--
: Derick
----------------------------------------------------------------
.

Relevant Pages

  • Re: non-lexicographic string comparison
    ... ;;Split a string into the list of its parts. ... (loop (cdr chars) ... (cons (car chars) ...
    (comp.lang.scheme)
  • Re: About absolute reference frame......
    ... The centripetal force is real, ... door of a car pushing sideways on you as the car turns a corner. ... One person might say there is a force backwards on the voodoo head. ... The only agent available for such a force is the string. ...
    (sci.physics.relativity)
  • Re: hmmm ... a solution but not a high order procedure.
    ... Since ones that go together are likely to be adjacent in a sorted list, if you compare each pair of adjacent filenames with some sort of string difference function, and limit it to some magic number for "these two things are really different", then you can use my partition function to sort them for you. ... you stayed with car cdr and a couple of minor procedures ... ... (define (odd-numbers message liste) ...
    (comp.lang.scheme)
  • Re: hmmm ... a solution but not a high order procedure.
    ... you stayed with car cdr and a couple of minor procedures ... ... (define (position char string) ... Yes, you're right, higher order function for higher order ... (define (odd-numbers message liste) ...
    (comp.lang.scheme)
  • Re: Newbie - need a small push on recursion / higher order procedures
    ... seems that first referred to the first 'word' of the string sentence defined ... 'rest are the equivalent of first and rest (car and cdr) for lists??? ... (define (odd-numbers message liste) ...
    (comp.lang.scheme)