Код: Выделить всё
(in-package :cl-user)
(defparameter *результаты* -1000)
(defun обнули-результаты ()
(setf *результаты* (make-hash-table :test 'equalp)))
(defparameter *разделители*
(format nil "\"\|<>\\'.:,-;(){}[]^&+*/!~~#$ %=?¿`„“«»˛_ˉ¡~A" #\Tab))
(defun разделитель-ли (б)
(find б *разделители*))
(defun интересный-файл-из-A2-ли (имя-файла)
(member (pathname-type имя-файла)
'("Mod" "ярм" "md" "txt" "sh" "xml")
:test 'string-equal))
(defun посчитай-слова-в-A2 (директория имя-файла-отчёта)
(обнули-результаты)
(budden-tools:map-dir 'посчитай-в-одном директория
:subdirs :recurse
:file-test 'интересный-файл-из-A2-ли)
(отфильтруй-результаты)
(выведи-отчёт имя-файла-отчёта)
(values))
(defun выкинуть-это-слово-ли (слово)
(cond
((find (elt слово 0) "0123456789")
t)
((= (length слово) 1)
t)
((every (lambda (б) (find б "0123456789")) слово)
t)
((and (find #\0 слово)
(find #\h слово :test 'equalp)
(every (lambda (б) (find б "01234567890ABCDEFH")) слово))
t)
((and (= (length слово) 8)
(every (lambda (б) (find б "01234567890ABCDEF")) слово))
t)
(t
nil)))
(defun отфильтруй-результаты ()
(maphash (lambda (к з)
(declare (ignore з))
(when (выкинуть-это-слово-ли к)
(remhash к *результаты*)))
*результаты*))
(defun выведи-отчёт (имя-файла-отчёта)
(with-open-file (в имя-файла-отчёта
:direction :output
:if-does-not-exist :create
:if-exists :supersede
:external-format :utf-8)
(maphash
(lambda (к з)
(print `(,к ,з) в))
*результаты*)))
(defun посчитай-долю-русских ()
(let ((к-во-русских 0)
(к-во-всего 0))
(maphash
(lambda (к з)
(declare (ignore з))
(when (some 'russian-budden-tools:cyrillic-char-p к)
(incf к-во-русских))
(incf к-во-всего))
*результаты*)
(format t "~&Русских: ~A, всего: ~A, доля = ~A"
к-во-русских
к-во-всего
(float (/ к-во-русских (+ 0.01 к-во-всего))))))
(defun посчитай-в-одном (имя-файла)
(handler-case
(with-open-file (ч имя-файла :direction :input :external-format :utf-8)
(loop
(let* ((строка (read-line ч nil nil))
(кнф (null строка)))
(when кнф (return))
(let* ((слова
(split-sequence:split-sequence-if #'разделитель-ли
строка
:remove-empty-subseqs t)))
(dolist (слово слова)
(учти-слово слово))))))
(sb-impl::stream-decoding-error
(e)
(declare (ignore e))
(format *error-output* "~&Файл ~S - не в ФПЮ8~%" имя-файла))))
(defun учти-слово (слово)
(cond ((gethash слово *результаты*)
(incf (gethash слово *результаты*)))
(t
(setf (gethash слово *результаты*) 1))))
#|
(progn
(посчитай-слова-в-A2 #p"c:/ob/jaos/" "c:/ob/отчёт.текст")
(посчитай-долю-русских))
|#