<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>GNUcode.me</title><id>https://gnucode.me/feeds/tags/scheme mispelling.xml</id><subtitle>Tag: scheme mispelling</subtitle><updated>2024-05-01T13:21:27Z</updated><link href="https://gnucode.me/feeds/tags/scheme mispelling.xml" rel="self" /><link href="https://gnucode.me" /><entry><title>Simple Mispelling Problem</title><id>https://gnucode.me/simple-mispelling-problem.html</id><author><name>Joshua Branson</name><email>jbranso@dismail.de</email></author><updated>2022-11-22T11:00:00Z</updated><link href="https://gnucode.me/simple-mispelling-problem.html" rel="alternate" /><content type="html">&lt;p&gt;Edit: Yes I am aware that I misspelled &amp;quot;mispelling&amp;quot;. I figure it's funny if I
leave it as it is. :)&lt;/p&gt;&lt;p&gt;I had this simple coding problem that I wanted to solve.  Here's the problem:&lt;/p&gt;&lt;p&gt;Suppose you are writing an guix service &lt;a href=&quot;https://notabug.org/jbranso/guix/src/newOpensmtpdBranch/gnu/services/mail.scm&quot;&gt;(like I happen to be)&lt;/a&gt;, and you are
sanitizing user input for various records.  Suppose your user mispells an
option.  Wouldn't it be nice to include a nice helpful hint on what he probably
did wrong?&lt;/p&gt;&lt;pre&gt;&lt;code class=&quot;language-scheme&quot;&gt;(opensmtpd-option (option &amp;quot;forany&amp;quot;))&lt;/code&gt;&lt;/pre&gt;&lt;p&gt;error: (option &amp;quot;forany&amp;quot;) is invalid.
hint: Try &amp;quot;for rcpt-to&amp;quot;, &amp;quot;for domain&amp;quot;, &amp;quot;for local&amp;quot;, &amp;quot;for any&amp;quot;, or &amp;quot;for&amp;quot;.&lt;/p&gt;&lt;p&gt;Using &lt;code&gt;string-prefix-length-ci&lt;/code&gt;, I was able to construct a fairly naive
prococedure that tries to guess what the user meant to type.  Here's what I came
up with:&lt;/p&gt;&lt;pre&gt;&lt;code class=&quot;language-scheme&quot;&gt;;; if strings is (list &amp;quot;auth&amp;quot; &amp;quot;for any&amp;quot; &amp;quot;from local&amp;quot;)
;; Then this will return &amp;quot;Try \&amp;quot;auth\&amp;quot;, \&amp;quot;for any\&amp;quot;, or \&amp;quot;from local\&amp;quot;.&amp;quot;
(define (try-string strings)
  (string-append &amp;quot;Try &amp;quot;
                 (let loop ((strings strings))
                   (cond ((= 1 (length strings))
                          (string-append
                           &amp;quot;or \&amp;quot;&amp;quot; (car strings) &amp;quot;\&amp;quot;.\n&amp;quot;))
                         (else
                          (string-append
                           &amp;quot;\&amp;quot;&amp;quot; (car strings) &amp;quot;\&amp;quot;, &amp;quot;
                           (loop (cdr strings))))))))

;; suppose string is &amp;quot;for anys&amp;quot;
;; and strings is (list &amp;quot;for any&amp;quot; &amp;quot;for local&amp;quot; &amp;quot;for domain&amp;quot;)
;; then hint-string will return &amp;quot;Did you mean &amp;quot;for any&amp;quot;?&amp;quot;
(define* (hint-string string strings
                      #:key (fieldname #f))
  (if (not (string? string))
      (try-string strings)
      (let loop ((current-max 1)
                 (loop-strings strings)
                 (hint-strings '()))
        (if (null? loop-strings)
            (cond ((= 1 (length hint-strings)) ;; only one worthwhile match
                   (if fieldname
                       (string-append &amp;quot;Did you mean (&amp;quot; fieldname &amp;quot; \&amp;quot;&amp;quot;
                                      (car hint-strings) &amp;quot;\&amp;quot;) ?\n&amp;quot;)
                       (string-append &amp;quot;Did you mean \&amp;quot;&amp;quot; (car hint-strings)
                                      &amp;quot;\&amp;quot;?\n&amp;quot;)))
                  (else (if (null? hint-strings)
                            (try-string strings)
                            (try-string hint-strings))))
            (let* ((element-string (car loop-strings))
                   (element-max
                    (string-prefix-length-ci element-string string)))
              (cond ((&amp;gt; element-max current-max)
                     (loop element-max (cdr loop-strings)
                           (list element-string)))
                    ((= element-max current-max)
                     (loop current-max (cdr loop-strings)
                           (cons element-string hint-strings)))
                    (else (loop current-max
                                (cdr loop-strings) hint-strings))))))))&lt;/code&gt;&lt;/pre&gt;&lt;p&gt;It won't recognize that &amp;quot;or any&amp;quot; or &amp;quot;bor any&amp;quot; should match &amp;quot;for any&amp;quot;, but for
most mispellings, it should be half decent, provided the user got the first
character right.&lt;/p&gt;&lt;p&gt;What do you all think?  How would you write such a procedure?&lt;/p&gt;&lt;p&gt;EDIT: Well it turns out that the guix developers actually have a
(string-closest) procedure.  The relevant code can be found in
(guix utils) and (guix combinators):&lt;/p&gt;&lt;pre&gt;&lt;code class=&quot;language-scheme&quot;&gt;(define fold2
  (case-lambda
    ((proc seed1 seed2 lst)
     &amp;quot;Like `fold', but with a single list and two seeds.&amp;quot;
     (let loop ((result1 seed1)
                (result2 seed2)
                (lst     lst))
       (if (null? lst)
           (values result1 result2)
           (call-with-values
               (lambda () (proc (car lst) result1 result2))
             (lambda (result1 result2)
               (loop result1 result2 (cdr lst)))))))
    ((proc seed1 seed2 lst1 lst2)
     &amp;quot;Like `fold', but with two lists and two seeds.&amp;quot;
     (let loop ((result1 seed1)
                (result2 seed2)
                (lst1    lst1)
                (lst2    lst2))
       (if (or (null? lst1) (null? lst2))
           (values result1 result2)
           (call-with-values
               (lambda () (proc (car lst1) (car lst2) result1 result2))
             (lambda (result1 result2)
               (loop result1 result2 (cdr lst1) (cdr lst2)))))))))

(define (string-distance s1 s2)
  &amp;quot;Compute the Levenshtein distance between two strings.&amp;quot;
  ;; Naive implemenation
  (define loop
    (mlambda (as bt)
      (match as
        (() (length bt))
        ((a s ...)
         (match bt
           (() (length as))
           ((b t ...)
            (if (char=? a b)
                (loop s t)
                (1+ (min
                     (loop as t)
                     (loop s bt)
                     (loop s t))))))))))

  (let ((c1 (string-&amp;gt;list s1))
        (c2 (string-&amp;gt;list s2)))
    (loop c1 c2)))

(define* (string-closest trial tests #:key (threshold 3))
  &amp;quot;Return the string from TESTS that is the closest from the TRIAL,
according to 'string-distance'.  If the TESTS are too far from TRIAL,
according to THRESHOLD, then #f is returned.&amp;quot;
  (identity                              ;discard second return value
    (fold2 (lambda (test closest minimal)
             (let ((dist (string-distance trial test)))
               (if (and  (&amp;lt; dist minimal) (&amp;lt; dist threshold))
                   (values test dist)
                   (values closest minimal))))
           #f +inf.0
           tests)))&lt;/code&gt;&lt;/pre&gt;&lt;p&gt;A lot of the above code is a little bit above my head, but it sure looks cool.&lt;/p&gt;&lt;p&gt;And it actually works better than mine.:&lt;/p&gt;&lt;pre&gt;&lt;code class=&quot;language-scheme&quot;&gt;;; old scheme code
(display (hint-string &amp;quot;bor any&amp;quot; (list &amp;quot;for any&amp;quot; &amp;quot;auth&amp;quot; &amp;quot;rdns&amp;quot;)))

Try &amp;quot;for any&amp;quot;, &amp;quot;auth&amp;quot;, or &amp;quot;rdns&amp;quot;.

;; It didn't match any string.  :(

;; Let's try guix's (string-closest _) ...

(string-closest &amp;quot;bor any&amp;quot; (list &amp;quot;for any&amp;quot; &amp;quot;auth&amp;quot; &amp;quot;rdns&amp;quot;))

$1 = &amp;quot;for any&amp;quot;&lt;/code&gt;&lt;/pre&gt;&lt;p&gt;Awesome!&lt;/p&gt;</content></entry></feed>