Dvorak-fr : disposition de clavier ergonomique
Ergonomie du poste de travail informatique
Comments in English below
Tables des fréquences de caractère, digramme et trigramme dans un texte en langue française, établies à l'aide de ce programme
(in-package :CL-user)
;;;; Le calcul de la fréquence d'occurrence des caractères, digrammes et
;;;; trigrammes dans un texte est réalisé par les deux fonctions
;;;; principales suivantes:
;;;;
;;;; 1. la fonction Compter-Caractères fait le décompte des caractères,
;;;; digrammes et trigrammes contenus dans un fichier dont le chemin d'accès
;;;; lui est donné en argument. Les décomptes sont stockés dans des tables de
;;;; hachage (tables associatives).
;;;;
;;;; 2. A partir des données du nombre d'occurrences stockées dans les tables,
;;;; la fonction Rapport-Des-Fréquences publie un rapport de fréquence dont le
;;;; contenu dépend de la valeur de ses arguments (clefs).
;;;; Par défaut le rapport est présenté dans la fenêtre d'interaction et:
;;;; - tous les types d'items sont publiés (caractères, digrammes et
;;;; trigrammes)
;;;; - les items sont triés selon leur fréquence
;;;; - le détail des voyelles accentuées apparaît
;;;; - les espaces, les chiffres et les retours à la ligne sont ignorés
;;;; - les digrammes et les trigrammes dont la fréquence est plus petite que
;;;; 0.2% ne sont pas présentés.
;;;;
;;;; Voir la fin de ce fichier pour des exemples d'utilisation
;;;;
;;;; REMARQUE
;;;; Ce programme est une adaptation française du programme original:
;;;; - la plupart des noms de fonctions et de variables ont été traduits en
;;;; français, pour le reste voir le glossaire ci-dessous
;;;; - quelques commentaires ont été ajoutés pour le lecteur non averti.
;;;; L'objectif premier étant d'assurer un support à un cours d'introduction
;;;; à la programmation (en français).
;;;;
;;;; Glossaire anglais-français
;;;; --------------------------
;;;; char : abréviation de character (caractère)
;;;; count : (dé)compte, compter
;;;; inc : abréviation de increment (incrémenter, incrément)
;;;; input : entrée
;;;; output : sortie
;;;; result : résultat
;;;; string : chaîne de caractères
;;;; tab : caractère tabulation
;;;;
;;;;
;;;; ENGLISH
;;;; *******
;;;;
;;;; Functions to compute and report frequencies of characters, digrams and
;;;; trigrams from a text file
;;;;
;;;; There are 2 main functions:
;;;;
;;;; 1. Compter-Caractères (count-characters) : counts the occurrences of
;;;; characters, digrams and trigrams from a text file. The data are stored in
;;;; hashtables.
;;;; 2. Rapport-Des-Fréquences (report-frequencies) : from the data in the
;;;; hashtables, it reports the frequencies according to its arguments. Unless
;;;; specified otherwise, it:
;;;; - reports frequencies of characters, digrams and trigrams
;;;; - sorts items by frequency
;;;; - distinguishes accented vowels
;;;; - ignores spaces, digits and newlines
;;;; - doesn't publish items whose frequency is less than .2%
;;;;
;;;; Examples:
;;;;
;;;; counts the occurences in text.txt file
;;;; (compter-caractères #p"c:\\test.txt")
;;;;
;;;; reports the frequencies in the toploop window
;;;; (rapport-des-fréquences)
;;;;
;;;; doesn't report digrams and trigrams
;;;; sorts characters alphabetically
;;;; (rapport-des-fréquences :trier-freq? NIL :2g? NIL :3g? NIL)
;;;;
;;;; idem but doesn't distinguish accented vowels
;;;; (rapport-des-fréquences :trier-freq? NIL :accentuées? NIL :2g? NIL :3g? NIL)
;;;;
;;;; reports only digrams with 2 vowels
;;;;(rapport-des-fréquences
;;;; :caract? NIL
;;;; :3g? NIL
;;;; :filtre-grammes (lambda (s)
;;;; (every #'voyelle s)))
;;;;
;;;; reports only digrams with one E at least (accented or not)
;;;;(rapport-des-fréquences
;;;; :caract? NIL
;;;; :3g? NIL
;;;; :filtre-grammes (lambda (s)
;;;; (find #\E s ; items stored in uppercase
;;;; ;; voyelle returns the vowel without accent or NIL
;;;; :key (lambda (c) (or (voyelle c)
;;;; c))))
;;;;
;;;;
;;;; Francis Leboutte - Juin 2002
;;;; f.leboutte @ algo.be
;;;;
;;;****************************************************************************
;;; Variables
;;; 3 tables de hachage pour stocker le décompte caractères, des digrammes
;;; et des trigrammes.
;;; Note: il n'est pas nécessaire d'initialiser le nombre d'entrées d'une
;;; table de hachage.
;;;
;;; entrée : la clef d'accès est le caractère (majuscule), la valeur est le
;;; nombre d'occurences
(defvar *caractères* (make-hash-table))
;;; entrée : la clef d'accès est le digramme (string, majuscule), la valeur est
;;; le nombre d'occurences
(defvar *digrammes* (make-hash-table :test #'equal))
;;; entrée : la clef d'accès est le digramme (string, majuscule), la valeur est
;;; le nombre d'occurences
(defvar *trigrammes* (make-hash-table :test #'equal))
;;; pour conserver le chemin d'accès du Fichier à Analyser
(defvar *chemin-FA* NIL)
;;;****************************************************************************
;;; La fonction compter-caractères fait le décompte des caractères, des
;;; digrammes et des trigrammes contenus dans un fichier dont le chemin d'accès
;;; lui est donné en argument. Les décomptes sont stockés dans des tables de
;;; hachage.
;;; Chemin : chemin d'accès du fichier à analyser (pathname)
;;; NB des espaces (#\space) consécutifs sont comptés pour un seul espace
(defun compter-caractères (chemin
&optional
;; par défaut les tabs (caractère tabulation) ne
;; sont pas comptés
(tab? NIL))
;; remise à zéro des tables
(clrhash *caractères*)
(clrhash *digrammes*)
(clrhash *trigrammes*)
(unless (and (or (stringp chemin) (pathnamep chemin))
(probe-file chemin))
(error "Il n'existe pas de fichier correspondant au chemin d'accès~%~A"
chemin))
(setf *chemin-FA* chemin)
(let (;; pour le décompte des espaces consécutifs (pour information)
(espaces-non-comptés 0))
;; ouverture d'un flot (Stream) sur le fichier (Path). Note : le flot est
;; fermé automatiquement dès la sortie de la forme (with-open-file …)
(with-open-file (stream chemin :direction :input)
(loop ; boucle
with caract-précédent and c1 and c2 and c3
;; lecture d'un caractère - eof : End Of File
as char = (read-char stream NIL :eof)
while (not (eq char :eof))
do
(cond ((char= char #\space)
(setf c1 NIL c2 NIL c3 NIL)
(if (char= #\space caract-précédent)
(incf espaces-non-comptés)
(inc-char-count #\space)))
((char= #\tab char)
(setf c1 NIL c2 NIL c3 NIL)
(when tab?
(inc-char-count #\tab)))
((char= #\newline char)
(setf c1 NIL c2 NIL c3 NIL)
(inc-char-count #\newline))
(T
(inc-char-count char)
(setf c3 char)
(when c2
(inc-grammes c1 c2 c3))
(setf c1 c2 c2 c3)))
(setf caract-précédent char)))
(format t "~% espaces non comptés : ~D" espaces-non-comptés)
))
;;; A partir des données du nombre d'occurrences stockées dans les tables,
;;; la fonction Rapport-Des-Fréquences publie un rapport de fréquence dont le
;;; contenu dépend de la valeur des arguments (clefs).
;;; Par défaut le rapport est présenté dans la fenêtre d'interaction et:
;;; - tous les types d'items sont publiés (caractères, digrammes et trigrammes)
;;; - les items sont triés selon leur fréquence
;;; - le détail des voyelles accentuées apparaît
;;; - les espaces, les chiffres et les retours à la ligne sont ignorés
;;; - les digrammes et les trigrammes dont la fréquence est plus petite que 0.2%
;;; ne sont pas présentés
(defun rapport-des-fréquences (&key
;; où sortir le rapport :
;; - soit dans la fenêtre d'interaction (T), le défaut
;; - soit dans un fichier (pathname designator)
(chemin T)
;; T : tri selon la fréquence, sinon tri alphabétique
(trier-freq? T)
;; T : fait le détail des voyelles accentuées
(accentuées? T)
;; NIL : les espaces et tabs n'interviennent pas
;; dans le décompte
(espaces? NIL)
;; NIL : les chiffres n'interviennent pas
(chiffres? NIL)
;; NIL : les retours à la ligne n'interviennent pas
(retours? NIL)
;; % , seuil de fréq à partir duquel un n-gramme est
;; présenté dans le rapport
(seuil-de-fréq .2)
(nbre-décimales 2)
;; présente les caractères ou non
(caract? T)
;; présente les digrammes ou non
(2g? T)
;; présente les trigrammes ou non
(3g? T)
;; fonction d'un argument (un di ou un trigramme) pour
;; ne publier que certains des digrammes (trigrammes)
;; Voir les exemples d'utilisation (fin du fichier)
filtre-grammes)
;; définition de 3 fonctions locales
(labels ((intervient? (caract)
(and (or chiffres?
(not (digit-char-p caract)))
(or espaces?
(not (member caract '(#\tab #\space))))
(or retours?
(not (char= caract #\newline)))))
(format-ligne (stream caract count total)
(format stream "~&~A~C~A~C~,vF"
(nom-caract caract)
#\tab count #\tab
nbre-décimales
(float (* 100 (/ count total)))))
(rapport-des-fréquences-aux (stream)
(let ((total 0)
(result nil))
(format stream "~&Analyse du fichier ~A~2%" *chemin-FA*)
(when caract?
(maphash (lambda (k v) ; Key (caract) - Value (décompte)
(when (intervient? k)
(let (voyelle)
(cond (accentuées?
(push (cons k v) result))
((setf voyelle (voyelle k))
(let ((dp (assoc voyelle result)))
(if dp
(incf (cdr dp) v)
(push (cons voyelle v) result))))
(T (push (cons k v) result))))
(incf total v)))
*caractères*)
(format stream "~&~D occurences de caractères:~2%" total)
(setf result
(if trier-freq?
(sort result #'>= :key #'cdr)
(sort result
;; tri alphabétique: il ne suffit pas d'utiliser le
;; prédicat char< , car il faut que les voyelles accentuées
;; tombent en bonne place …
(lambda (caract-majuscule1 caract-majuscule2)
(let ((voy1 (voyelle caract-majuscule1))
(voy2 (voyelle caract-majuscule2)))
(if (and voy1 voy2 (char= voy1 voy2))
(char< caract-majuscule1 caract-majuscule2)
(char< (if voy1 voy1 caract-majuscule1)
(if voy2 voy2 caract-majuscule2)))))
:key #'car)))
(mapc (lambda (dp)
(let ((caract (car dp))
(count (cdr dp)))
(when (intervient? caract)
(format-ligne stream caract count total))))
result))
(rapport-des-di-et-trigrammes stream
:seuil-de-fréq seuil-de-fréq
:nbre-décimales nbre-décimales
:filtre-grammes filtre-grammes
:2g? 2g?
:3g? 3g?))))
;; corps principal
(if (eq t chemin)
(rapport-des-fréquences-aux T)
(with-open-file (stream chemin :direction :output
:if-does-not-exist :create
:if-exists :overwrite)
(rapport-des-fréquences-aux stream)))
(values)))
(defun rapport-des-di-et-trigrammes (stream
&key
(seuil-de-fréq .2)
(nbre-décimales 2)
filtre-grammes
(2g? T)
(3g? T))
(flet ((rapport-table (table-h)
(let ((total-occurrences 0)
(nbre-n-grammes 0) ; nbre-n-grammes différents
(result NIL)
(gram-length (block :n (maphash (lambda (k v)
(declare (ignore v))
(return-from :n (length k)))
table-h))))
(maphash (lambda (k v)
(incf nbre-n-grammes)
(push (cons k v) result)
(incf total-occurrences v))
table-h)
(setf result (sort result #'>= :key #'cdr))
(format stream "~2%~D ~A différents (~D occurences):~2%"
nbre-n-grammes
(if (= gram-length 2) "digrammes" "trigrammes")
total-occurrences)
(block :report
(mapc (lambda (dp)
(let* ((k (car dp))
(count (cdr dp))
(percent (float (* 100 (/ count total-occurrences)))))
(cond ((< percent seuil-de-fréq)
(return-from :report))
((or (not filtre-grammes)
(funcall filtre-grammes k))
(format stream "~&~A~C~A~C~,vF"
k #\tab count #\tab
nbre-décimales percent))
(T NIL))))
result)))))
(when 2g? (rapport-table *digrammes*))
(when 3g? (rapport-table *trigrammes*))
(values)))
;;; incrémente les décomptes dans les tables *digrammes* et *trigrammes*
;;; selon les arguments
(defun inc-grammes (c1 c2 c3)
(declare (optimize (speed 3) (safety 1) (debug 0) (space 0)))
;; définition d'une macro locale
(macrolet ((char-up (char) ; caractère en majuscule
`(when (alpha-char-p ,char)
(setf ,char (char-upcase ,char)))))
;; définition d'une fonction locale
(flet ((inc-grammes-aux (n-gramme table-h)
(let ((value (gethash n-gramme table-h)))
(cond (value
(setf (gethash n-gramme table-h) (1+ value)))
;; le di(tri)gramme doit être copié car la fonction
;; make-string+ ne crée pas de nouvelle chaîne de
;; caractères
(T (setf (gethash (copy-seq n-gramme) table-h) 1))))))
(char-up c2)
(char-up c3)
(inc-grammes-aux (make-string+ 2 c2 c3) *digrammes*)
(when c1
(char-up c1)
(inc-grammes-aux (make-string+ 3 c1 c2 c3) *trigrammes*))
)))
;;; Retourne une chaîne de caractères de longueur Size contenant les
;;; caractères Chars (qui doivent être au nombre de Size)
;;; NB ne crée pas de nouvelle chaîne de caractères
(defun make-string+ (size &rest chars)
;; declaration pour le compilateur (optimisation de la vitesse d'exécution)
(declare (optimize (speed 3) (safety 1) (debug 0) (space 0)))
;; load-time-value : optimisation, S2 (S3) est associés à un objet littéral
;; (literal object) dans le code compilé (une chaîne de caractères de
;; longueur 2 - string). On évite ainsi la reconstruction du string à chaque
;; appel de la fonction make-string+
(let* ((s2 (load-time-value (make-string 2)))
(s3 (load-time-value (make-string 3)))
(s (if (= size 2) s2 s3)))
(loop for char in chars
as i = 0 then (1+ i)
do
(setf (char s i) char))
s))
(defun inc-char-count (char)
(when (alpha-char-p char)
(setf char (char-upcase char)))
(let ((value (gethash char *caractères*)))
(cond (value
(setf (gethash char *caractères*) (1+ value)))
(T (setf (gethash char *caractères*) 1)))))
;;; si c'est une voyelle accentuée retourne la même voyelle sans accent (majuscule)
;;; sinon si c'est une voyelle sans accent retourne la voyelle (majuscule)
;;; sinon (ce n'est pas une voyelle) retourne NIL
;;; Function pouvant servir au français et au néerlandais au moins
(defun voyelle (caract-majuscule)
(case caract-majuscule
((#\E #\É #\È #\Ê #\Ë) #\E)
((#\I #\Î #\Ï) #\I)
((#\U #\Ù #\Û #\Ü) #\U)
((#\A #\À #\Â #\Ä) #\A)
((#\O #\Ô #\Ö) #\O)
(T NIL)))
(defun nom-caract (caract)
(case caract
(#\tab "tab")
(#\space "espa")
(#\. "pt")
(#\, "virg")
(#\; "pt-v")
(#\' "apos")
(#\" "guil")
(#\newline "ret")
(#\` "bkq") ; Accent grave isolé ou 'backquote' - pas en français
(T (if (alphanumericp caract)
caract
(let ((nom (char-name caract)))
(if nom
nom
caract))))))
;;;****************************************************************************
#|
Exemples d'utilisation
----------------------
;;; analyse (comptage) du fichier c:\mes documents\test.txt
(compter-caractères #p"c:\\mes documents\\test.txt")
;;; publication des résultats dans la fenêtre d'interaction
(rapport-des-fréquences)
;;; publication dans le fichier c:\mes documents\rapport-test.txt
(rapport-des-fréquences :chemin #p"c:\\mes documents\\rapport-test.txt")
;;; publie uniquement les caractères (pas les digrammes, ni les trigrammes),
;;; triés alphabétiquement
(rapport-des-fréquences :trier-freq? NIL :2g? NIL :3g? NIL)
;;; même chose mais une voyelle accentuée est comptée sous la voyelle
;;; sans l'accent
(rapport-des-fréquences :trier-freq? NIL :accentuées? NIL :2g? NIL :3g? NIL)
;;; publie uniquement les digrammes à 2 voyelles
(rapport-des-fréquences
:caract? NIL
:3g? NIL
:filtre-grammes (lambda (s)
(every #'voyelle s)))
;;; publie uniquement les digrammes comportant au moins un E (accentué ou non)
(rapport-des-fréquences
:caract? NIL
:3g? NIL
:filtre-grammes (lambda (s)
(find #\E s ; #\E et pas #\e car stockage majuscule
;; voyelle retourne la voyelle sans accent ou NIL
:key (lambda (c) (or (voyelle c)
c)))))
|#
