left-handed words


Define a predicate recognizing words that can be typed with only the left hand on a qwerty keyboard.

 $ cat l.scm 
 (use-modules (ice-9 control) (ice-9 rdelim) (ice-9 format)) 
 (include-from-path "srfi-78/srfi-78.scm") 
  
  
 (define (char-set s) 
  
   (define (canonicalize-char c) (char-downcase c)) 
  
   (let ((cset (list->char-set 
           (map (lambda (c) (canonicalize-char c)) (string->list s))))) 
  
     (lambda (o) 
       (and (char? o) (char-set-contains? cset (canonicalize-char o)))))) 
  
 (let ((cs (char-set "aeiou"))) 
   (check ((char-set "") #\a) => #f) 
   (check (cs #\a) => #t) 
   (check (cs #\z) => #f) 
   (check (cs #\A) => #t) 
   (check (cs #\Z) => #f)) 
  
  
 (define (contains? cset s) 
   (let/ec k 
     (for-each (lambda (c) (unless (cset c) (k #f))) (string->list s)) 
     #t)) 
  
 (let ((cs (char-set "star"))) 
   (check (contains? cs "") => #t) 
   (check (contains? cs "rats") => #t) 
   (check (contains? cs "ratz") => #f) 
   (check (contains? cs "art") => #t) 
   (check (contains? cs "moon") => #f)) 
  
  
 (define left-hand-only? 
   (let ((cs (char-set "qwertasdfgzxcvab"))) 
     (lambda (s) (contains? cs s)))) 
  
 (check (left-hand-only? "start") => #t) 
 (check (left-hand-only? "end") => #f) 
  
 (let ((p (open-file "/etc/dictionaries-common/words" "r"))) 
   (let loop ((l '())) 
     (let ((w (read-line p 'split))) 
       (if (eof-object? (cdr w)) 
     (format #t 
         "\nThere are ~d left-hand-only words, the last of which is ~a.\n" 
        (length l) (car l)) 
    (let ((wd (car w))) 
        (loop (if (left-hand-only? wd) (cons wd l) l))))))) 
  
 $ guile l.scm 
  
 ((char-set "") #\a) => #f ; correct 
  
 (cs #\a) => #t ; correct 
 (cs #\z) => #f ; correct 
 (cs #\A) => #t ; correct 
 (cs #\Z) => #f ; correct 
  
 (contains? cs "") => #t ; correct 
 (contains? cs "rats") => #t ; correct 
 (contains? cs "ratz") => #f ; correct 
 (contains? cs "art") => #t ; correct 
 (contains? cs "moon") => #f ; correct 
  
 (left-hand-only? "start") => #t ; correct 
 (left-hand-only? "end") => #f ; correct 
  
 There are 2088 left-hand-only words, the last of which is zeta. 
  
 $ grep -i '^[qwertasdfgzxcvb]*$' /etc/dictionaries-common/words | wc -l 
 2088 
  
 $ grep -i '^[qwertasdfgzxcvb]*$' /etc/dictionaries-common/words | tail -1 
 zeta 
  
 $