Fefe will meinen Code nicht …

Tue, 16 Dec 2008 03:18:27 +0000

Da Fefe meinen Code scheinbar nicht haben will, poste ich ihn hier. Kommentare sind willkommen. Verbesserungsvorschläge ebenso.

(defvar *words*)
(defun skip-whitespaces ()
  "Skip whitespaces and return the first non-whitespace"
  (loop
     for cchar = (read-char *standard-input* nil nil)
     while (member cchar '(#Space #Newline))
     finally
       (return cchar)))
(defun read-word ()
  "Read all characters to the next occurence of a whitespace"
  (let ((ret (make-array 0
			:element-type 'character
			:fill-pointer 0
			:adjustable t))
	(read (skip-whitespaces)))
    (when read
      (vector-push-extend read ret)
      (loop
	 for cchar = (read-char *standard-input* nil nil)
	 until (member cchar '(nil #Space #Newline))
	 do (vector-push-extend cchar ret))
      ret)))
(defun count-words ()
  (let ((*words* (make-hash-table :test 'equal)))
    (loop
       for read = (read-word)
       while read
       do (if (gethash read *words* nil)
	      (incf (gethash read *words*))
	      (setf (gethash read *words*) 1)))
    (let ((wordlist nil))
      (maphash #'(lambda (key val) (push (cons key val) wordlist)) *words*)
      (dolist (out (sort wordlist #'(lambda (x y) (> (cdr x) (cdr y)))))
	(format t "~A:~d~%" (car out) (cdr out))))))
(count-words)

Follow

Bekomme jeden neuen Artikel in deinen Posteingang.