From Newsgroup: comp.lang.lisp

Erik Naggum wrote:

| Suppose i have a text file and i want to count strings in it.
| Specifically, the first 5 characters of each line in this file are a
| vendor code. Then i want to ouptut all vendor codes and how many
| times they show up in the input.

Here's my cut at that task:

(let ((hash (make-hash-table :test #'equal)))
(with-open-file (stream ...file-args...)
(handler-case
(loop
(let ((vendor (read-sequence stream (make-string 5))))
;; skip to end of line and consume
(peek-char #\newline stream)
(read-char stream)
;; real body of loop
(incf (gethash vendor hash 0))))
;; use conditions to simplify error handling
(end-of-file ())))
(dolist (key (sort (hash-table-keys hash) #'string<))
(format t "~A,~A~%" key (gethash key hash))))

Gauche Scheme

(use srfi-13) ;; string functions

Using a collector that collects into an association list.

(define table (malistbag))

(with-input-from-file "input.dat"
(lambda ()
(do. ((line (read-line) <>)) ;; <> means repeat preceding expr.
((eof-object? line))
(when (> (string-length line) 4)
(table (string-take line 5) 1 +)))))

(dolist (e (sort (table) > cdr))
(print (car e) " " (cdr e)))

===>
V0003 3
V0002 2
V0001 1

Given:

;; Non-destructive.
(define (update-alist alist k v :optional (func #f) (default 0))
(define (alter-entry e)
(if func
(let ((new-v (func v (if e (cdr e) default))))
(cons k new-v))
(cons k v)))
(let go ((the-list alist) (seen '()))
(cond ((null? the-list) (cons (alter-entry #f) seen))
((equal? k (caar the-list))
(append (cons (alter-entry (car the-list)) seen)
(cdr the-list)))
(#t (go (cdr the-list) (cons (car the-list) seen))))))

(define (malistbag)
(let ((bag '()))
(case-lambda
[() bag]
[(k) (let ((e (assoc k bag))) (and e (cdr e)))]
[(k val) (set! bag (update-alist bag k val))]
[(k val func) (set! bag (update-alist bag k val func))]
[(k val func def) (set! bag (update-alist bag k val func def))])))

(define-syntax do.-aux
(syntax-rules ( <> )
[ (do.-aux ((v init <>) more ...) seen stuff ...)
(do.-aux ((v init init) more ...) seen stuff ...) ]
[ (do.-aux (what more ...) (seen ...) stuff ...)
(do.-aux (more ...) (seen ... what) stuff ...) ]
[ (do.-aux () seen stuff ...)
(do seen stuff ...) ] ))
(define-syntax do.
(syntax-rules ()
[ (do. things more ...)
(do.-aux things () more ...) ] ))
--- Synchronet 3.21d-Linux NewsLink 1.2