Path: ...!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: tuning - corrected shootout entry
Date: Mon, 2 Sep 2024 21:17:39 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 59
Message-ID: <vb5a1f$30apa$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 02 Sep 2024 23:17:39 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="a435632fcbba468531e98d5e4c12abf8";
	logging-data="3156778"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+7M0l12WlA7oltMSTyds4N"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:JMg04bgKgJVUbsFbYGAWVl0iFqg=
Bytes: 2716

Nicolas Neuss wrote:

> (defun wordcount (&optional (stream *standard-input*)
>                   &aux (*readtable* (copy-readtable)) (table (make-hash-table)))
>   ;; tweak readtable
>   (loop for char across "\".;,#:()[]{}" do
>        (set-syntax-from-char char #\Space))
>   ;; count
>   (loop for word = (read stream nil #\.) until (eq word #\.)
>      do (incf (gethash word table 0)))
>   ;; output
>   (let ((*print-pretty* nil))
>     (loop for (word . count) in
>          (sort (loop for a being the hash-keys of table using (hash-value b)
>                   collect (cons a b))
>                #'(lambda (a b)
>                    (or (> (cdr a) (cdr b))
>                        (string<= (car a) (car b)))))
>        do (format t "~D : ~A~%" count (string-downcase word)))))
> 
> ;;; Testing:
> (wordcount (make-string-input-stream "A b a hello.B, a Hello b"))

Gauche Scheme

(use srfi-13) ; string-tokenize string-upcase
(use srfi-14) ; char. sets
(use srfi-42) ; do-ec

(define (wordcount :optional (port (current-input-port)))
  (rlet1 al '()
    (do-ec
      (:port line port read-line)
      (:list word (string-tokenize line char-set:letter))
      (ainc! al (string-upcase word)))))

(call-with-input-string
  "Foo.b,a:e c(d)e d
   c b a[foo]FOO"
  wordcount)

  ===>
(("D" . 2) ("C" . 2) ("E" . 2) ("A" . 2) ("B" . 2) ("FOO" . 3))

Given:

(define-syntax ainc!
  (syntax-rules ()
    [(_ alist key val func default)
     (let ((pair (assoc key alist)))
       (if pair
         (set-cdr! pair (func val (cdr pair)))
         (set! alist (cons (cons key (func val default)) alist))))]
    [(_ alist key val func)
     (ainc! alist key val func 0)]
    [(_ alist key val)
     (ainc! alist key val +)]
    [(_ alist key)
     (ainc! alist key 1)]))