PasteRack.org
Paste # 77970
2014-09-02 14:39:59

Forked from paste # 78658.

Fork as a new paste.

Paste viewed 112 times.


Embed:

Finding alphabetic words 4 (updated to match QI claim)

  1. #lang racket
  2.  
  3. ; Given a File containing a newline-delineated list of English words, find the number of words
  4. ; whose individual letters are in alphabetical order.
  5.  
  6. ; According to the QI episode "Kitsch", there are only three such 6-letter words
  7.  
  8. ; Word -> List
  9. ; takes a Word and turns it into a list of that word's characters as 1-char strings.
  10. (define (listify w)
  11.   (map string (string->list w)))
  12.  
  13. ; Word -> Boolean
  14. ; Checks a Word and determines whether the letters are in alphabetical order
  15. (define (alphabetic? w)
  16.   (let ([word (string-downcase w)])
  17.     (equal? (listify word) (sort (listify word) string<?))))
  18.  
  19. ; Word -> Boolean
  20. ; Checks a Word to see if it is a valid word, ie. contains both consonants and vowels
  21. (define (real-word? w)
  22.   (memf (lambda (c) (member c '("a" "e" "i" "o" "u" "y"))) (listify w)))
  23.  
  24. ; String String -> String
  25. ; Takes two strings, returns the largest
  26. (define (string-max s1 s2)
  27.   (if (>= (string-length s1) (string-length s2))
  28.       s1
  29.       s2))
  30.  
  31. ; List -> Word
  32. ; Finds the longest word in a list of words
  33. (define (longest lst)
  34.   (foldl string-max "" lst))
  35.  
  36. ; Filename -> List
  37. ; Iterates over the given file, building a list of words which are alphabetic
  38. (define (alphabetic-in-file word-file)
  39.   (for/list ([w (in-lines (open-input-file word-file))]
  40.              #:when (and (alphabetic? w)
  41.                          (real-word? w)))
  42.     w))
  43.  
  44. ; List -> Lists
  45. ; Outputs a report containing useful information about the alphabetic list
  46. (define (alpha-report word-file)
  47.   (let ([lst (alphabetic-in-file word-file)])
  48.     (displayln `(Alphabetic words in file: ,(length lst)))
  49.     (displayln `(Longest alphabetic word in file: ,(longest lst)))
  50.     (displayln `(Number of alphabetic words with exactly 6 letters:
  51.                         ,(length (filter (lambda (s) (= (string-length s) 6)) lst))))
  52.     (displayln `(List of alphabetic words with exactly 6 letters:
  53.                       ,(filter (lambda (s) (= (string-length s) 6)) lst)))
  54.     (displayln `(Number of alphabetic words with greater than 6 letters:
  55.                         ,(length (filter (lambda (s) (> (string-length s) 6)) lst))))
  56.     (displayln `(List of alphabetic words with greater than 6 letters:
  57.                       ,(filter (lambda (s) (> (string-length s) 6)) lst)))
  58.     (displayln `(Number of alphabetic words with greater than 3 letters:
  59.                         ,(length (filter (lambda (s) (> (string-length s) 3)) lst))))
  60.     ; (displayln `(List of alphabetic words: ,lst))
  61.     ))
  62.  
  63. ;; Sample Output Report
  64. ; Using the file "wordsEn.txt" gained from http://www-01.sil.org/linguistics/wordlists/english/
  65. ; (alpha-report "wordsEn.txt") produces the following report:
  66. ; (Alphabetic words in file: 544)
  67. ;(Longest alphabetic word in file: billowy)
  68. ;(Number of alphabetic words with exactly 6 letters: 37)
  69. ;(List of alphabetic words with exactly 6 letters: (abbess abbott abhors accent accept access accost adders afflux almost begins begirt bellow bijoux billow biopsy bloops blotty cellos chills chilly chimps chinos chintz chippy chivvy choosy choppy clotty efflux effort floors floppy flossy ghosty glossy knotty))
  70. ;(Number of alphabetic words with greater than 6 letters: 2)
  71. ;(List of alphabetic words with greater than 6 letters: (beefily billowy))
  72. ;(Number of alphabetic words with greater than 3 letters: 351)
  73.  
  74. ; As we can see therefore, there are in fact 37 6-letter alphabetic words, just from this list

=>