Changeset 35810 in project


Ignore:
Timestamp:
07/08/18 21:59:39 (10 days ago)
Author:
kon
Message:

add prefix funcs

Location:
release/5/string-utils/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/5/string-utils/trunk/string-utils.egg

    r35807 r35810  
    33
    44((synopsis "String Utilities")
    5  (version "2.0.2")
     5 (version "2.0.3")
    66 (category data)
    77 (author "[[kon lovett]]")
  • release/5/string-utils/trunk/string-utils.scm

    r35807 r35810  
    66
    77(;export
     8  string-longest-common-prefix
     9  string-longest-common-prefixes
    810  string-fixed-length)
    911
    1012(import scheme
     13  (chicken base)
    1114  (chicken fixnum)
     15  (chicken sort)
    1216  (chicken type)
     17  (only (srfi 1) append! reverse!)
     18  (only (srfi 13) string-null? string-take string-prefix-length)
    1319  (only memoized-string make-string+)
    1420  (only type-checks check-char check-string check-fixnum ))
     21
     22;;
     23
     24(define string-longest-common-prefix-length string-prefix-length)
     25
     26;;
     27
     28(: string-longest-common-prefix (string (list-of string) -> (or boolean string)))
     29;
     30(define (string-longest-common-prefix cand others)
     31  ;
     32  (define (prelen item)
     33    (string-longest-common-prefix-length cand item) )
     34  ;
     35  (let* (
     36    (cells
     37      (map (lambda (item) (cons (prelen item) item)) others))
     38    (cells
     39      (sort cells (lambda (a b) (fx> (car a) (car b)))))
     40    (coalesced
     41      (foldl
     42        (lambda (coalesced cell)
     43          (let* (
     44            (len (car cell))
     45            (str (cdr cell))
     46            (strs `(,str)) )
     47            (if (null? coalesced)
     48              (cons (cons len strs) coalesced)
     49              (let (
     50                (coalesced-cell (car coalesced)) )
     51                (if (fx= len (car coalesced-cell))
     52                  ;share same
     53                  (begin
     54                    (set-cdr! coalesced-cell (append! strs (cdr coalesced-cell)))
     55                    coalesced)
     56                  ;changing of the guard
     57                  (cons (cons len strs) coalesced) ) ) ) ) )
     58        '()
     59        cells))
     60    (coalesced
     61      (sort
     62        coalesced
     63        (lambda (a b)
     64          (if (fx= (car a) (car b))
     65            (fx> (length (cdr a)) (length (cdr b)))
     66            (fx> (car a) (car b)))))) )
     67    ;longest
     68    (if (null? coalesced)
     69      #f
     70      (let* (
     71        (cell (car coalesced))
     72        (strs (cdr cell)) )
     73        (string-take (car strs) (car cell)) ) ) ) )
     74
     75;;
     76
     77(: string-longest-common-prefixes ((list-of string) --> (list-of string)))
     78;
     79(define (string-longest-common-prefixes strs)
     80  (let loop ((strs strs) (pres '()))
     81    (if (null? strs)
     82      pres
     83      (let ((pre (string-longest-common-prefix (car strs) (cdr strs))))
     84        (let (
     85          (pres
     86            (if (or (not pre) (string-null? pre))
     87              pres
     88              (cons pre pres))) )
     89          (loop (cdr strs) pres) ) ) ) ) )
     90
     91;;
    1592
    1693(: string-fixed-length (string fixnum #!rest --> string))
  • release/5/string-utils/trunk/tests/string-utils-test.scm

    r35791 r35810  
    99;;;
    1010
    11 (import string-utils)
     11(import unicode-utils string-hexadecimal)
    1212
    1313(test-group "Unicode"
     
    1818  (test "cebbcebb" (string->hex (unicode-make-string 2 #\U03BB)))
    1919)
     20
     21(import memoized-string)
    2022
    2123(test-group "Memoized"
     
    3436)
    3537
    36 (import (chicken blob) (srfi 4))
     38(import string-hexadecimal (chicken blob) (srfi 4))
    3739
    3840(test-group "To Hex"
     
    4951                (test "d3ca" t) )
    5052)
    51 
    52 (import string-hexadecimal)
    5353
    5454(test-group "String -> Hex"
     
    8989|#
    9090
    91 (import (chicken port) string-interpolation-syntax)
     91(import string-interpolation-syntax (chicken port))
    9292
    9393;must be "top level"; cannot be test-group
     
    105105;;
    106106
    107 #|
    108 (import string-utils-extensions)
     107(import string-utils)
    109108
    110 (test-group "string-utils-extensions"
    111         (let* (
    112           (str "12345f")
    113           (res (string-copy-over! "abcde" str)) )
    114           (test-assert "string-copy-over! return" (eq? str res))
    115           (test "string-copy-over! operation" "abcdef" res) )
    116         (test "23" (string-copy* "12345f" 1 3))
    117         (test "2345f0000" (string-copy* "12345f" 1 10 #\0))
    118         (test 0 (string-count* (lambda (a b) (char=? a b)) "ac" "bdq"))
    119         (test 2 (string-count* (lambda (a b) (char=? a b)) "aca" "adaq"))
    120         (test #\z (string-any* (lambda (a b) (and (char=? a b) a)) "aczq" "bdz"))
    121         (test #\z (string-every* (lambda (a b) (and (char=? a b) a)) "az" "azq"))
     109(test-group "string-utils"
     110  (test "foo" (string-fixed-length "abcde" 1 #:trailing "foo"))
     111  (test "a..." (string-fixed-length "abcde" 4))
     112  (test "abc " (string-fixed-length "abc" 4))
     113
     114  (let ((strs '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))
     115    (test "foobar" (string-longest-common-prefix "foobarbaz" strs))
     116    (test '("ba" "bar" "fooba") (string-longest-common-prefixes strs)) )
    122117)
    123 |#
    124118
    125119;;;
  • release/5/string-utils/trunk/unicode-utils.scm

    r35796 r35810  
    5151
    5252;inefficient
    53 (: unicode-string (#!rest (list-of char) -> string))
     53(: unicode-string (#!rest -> string))
    5454;
    5555(define (unicode-string . chs)
Note: See TracChangeset for help on using the changeset viewer.