13. Le Texte et les Entrées-Sorties
1 Exercice 13.7.1
Je programme sans vergogne dans un style C impératif, en illustrant un return dans la seconde fonction.
(define (nbchlt str) |
(let ((ch 0) (lt 0)) |
(for i from 0 to (sub1 (string-length str)) |
(let ((c (string-ref str i))) |
(cond ((char-numeric? c) (set! ch (+ ch 1))) |
((char-alphabetic? c) (set! lt (+ lt 1)))))) |
(list ch lt))) |
(define (nb-blancs-en-tete str) |
(let ((cpt 0) (n (string-length str))) |
(let/ec return ; cf let/ec pages 288-289 |
(while #t |
(when (>= cpt n) (return cpt)) |
(when (not (char=? (string-ref str cpt) #\space)) (return cpt)) |
(set! cpt (+ cpt 1)))))) |
2 Exercice 13.7.2
Commençons par programmer un décodeur du code de César connaissant la clé. Il suffit d’inverser le code de César.
(define (decesar str k) |
(let ((cZ (char->integer #\Z))) ; pour ne pas le recalculer |
(define (code-char c) |
(if (not (char-upper-case? c)) ; si c n’est pas une majuscule |
c |
(let ((dist (- cZ (char->integer c)))) |
(integer->char (- cZ (modulo (+ dist k) 26)))))) |
(build-string (string-length str) |
(lambda (i) (code-char (string-ref str i)))))) |
Ensuite, la force brute : en l’absence d’un dictionnaire, on essaye les 26 clés, et l’on obtient :
> (define MSG "DVWZVQ MFLJ UV CR TVIMFZJV KZVUV") |
> (for cle from 0 to 25 |
(printf "[~a] ~a\n" cle (decesar MSG cle))) |
[0] DVWZVQ MFLJ UV CR TVIMFZJV KZVUV |
[1] CUVYUP LEKI TU BQ SUHLEYIU JYUTU |
... |
[17] MEFIEZ VOUS DE LA CERVOISE TIEDE <----------- sic et hic |
... |
[25] EWXAWR NGMK VW DS UWJNGAKW LAWVW |
3 Exercice 13.7.3
(define (tokenizer STR) |
(let ((*i* 0)) |
(define (get-char) |
(if (>= *i* (string-length STR)) |
#f |
(let ((c (string-ref STR *i*))) |
(set! *i* (+ *i* 1)) |
c))) |
(define (unget-char) |
(set! *i* (- *i* 1))) |
(define (digit->int c) ; c est un chiffre |
(- (char->integer c) (char->integer #\0))) |
(define (char->symbol c) |
(string->symbol (string c))) |
(define (get-token) |
(let ((c (get-char))) |
(cond ((not c) #f) |
((member c '(#\+ #\- #\* #\/ #\( #\))) (char->symbol c)) |
((char-numeric? c) (get-number (digit->int c))) |
(else (error "Caractere non reconnu" c))))) |
(define (get-number n) ; n est un accumulateur |
(let ((d (get-char))) |
(cond ((not d) n) |
((char-numeric? d) (get-number (+ (* n 10) (digit->int d)))) |
(else (unget-char) n)))) |
get-token)) |
> (define tok (tokenizer "23-5*(674-12)+1")) |
> (do ((x (tok) (tok)) (L '() (cons x L))) |
((not x) (reverse L))) |
(23 - 5 * |(| 674 - 12 |)| + 1) |
Un symbole ne peut pas contenir de parenthèse, donc Scheme utilise des barres de valeur absolue pour encadrer un symbole contenant des caractères normalement interdits ! J’ai donc le droit d’écrire (ce que je ne fais jamais, mais qui peut être utile dans une production automatique de code):
(define |avec des espaces| 10) |
4 Exercice 13.7.4
(define (nb-blancs-en-tete str) |
(let ((essai (regexp-match " +" str))) |
(if essai (string-length (car essai)) 0))) |
(define (premier-mot str) |
(let ((essai (regexp-match "[a-zA-Z]+" str))) |
(if essai (car essai) #f))) |
Je charge la librairie date de Racket :
(require racket/date) |
(define (today) |
(define (us->fr mois) |
(cadr (assoc (string->symbol mois) |
'((January 1) (February 2) (March 3) (April 4) (May 5) (June 6) (July 7) |
(August 8) (September 9) (October 10) (November 11) (December 12))))) |
(let ((str (date->string (seconds->date (current-seconds))))) |
(printf "###Debug : date --> ~s\n" str) |
(let* ((sol (regexp-match "([a-zA-Z]+), ([a-zA-Z]+) ([0-9]+)[^0-9]*([0-9]+)" str)) |
(mois (third sol)) |
(jour (fourth sol)) |
(annee (fifth sol))) |
(list (string->number jour) (us->fr mois) (string->number annee))))) |
> (today) |
###Debug : date --> "Wednesday, September 22nd, 2010" |
(22 9 2010) |
5 Exercice 13.7.5
(require mzlib/string) ; pour expr->string |
(define (scheme->python L) |
(let* ((str (expr->string L)) |
(str1 (regexp-replace* "[(]" str "[")) |
(str2 (regexp-replace* "[)]" str1 "]")) |
(str3 (regexp-replace* " " str2 ","))) |
str3)) |
6 Exercice 13.7.6
Je commence par définir un espace de noms standard ns afin de pouvoir utiliser eval. L’utilitaire d’intégration est défini comme sous-fonction. Pourquoi utiliser eval partout ? Parce que l’utilisateur, lorsqu’on lui demande une borne, va peut-être entrer un formule, du style (expt 2 3), au lieu d’une simple constante. Si vous avez déjà programmé en C ou en Java, pensez aux complications que cela entraînerait avec ces langages...
(define ns (make-base-namespace)) ; cf page 298 ligne 279 |
(define (valeur-moyenne) |
(define (integrale f a b h) |
(do ((x a (+ x h)) (s #i0 (+ s (f x)))) |
((> x b) (* h s)))) |
(let ((f '?) (a '?) (b '?) (h '?)) |
(printf "Donnez une fonction : ") |
(set! f (eval (read) ns)) |
(printf "Donnez la borne a : ") |
(set! a (eval (read) ns)) |
(printf "Donnez la borne b : ") |
(set! b (eval (read) ns)) |
(printf "Donnez le pas d'integration h : ") |
(set! h (eval (read) ns)) ; eval si dx est fourni par une formule... |
(printf "La valeur moyenne sur [~a,~a] est environ ~a\n" |
a b (/ (integrale f a b h) (- b a))))) |
> (valeur-moyenne) |
Donnez une fonction : (lambda (x) (* x (sin x))) |
Donnez la borne a : 0 |
Donnez la borne b : (expt 2 3) <----------- ! |
Donnez le pas d'integration h : 0.01 |
La valeur moyenne sur [0,8] est environ 0.2741164239538864 |
Une variante consisterait à demander à l’utilisateur une expression en x comme (* x (sin x)) au lieu d’un texte de lambda-expression. Ah, faites-le, c’est instructif...
7 Exercice 13.7.7
(require "adt-arbre23.rkt") |
(define (arbre->java A AL) ; compilation d'un arbre Scheme en une fonction Java |
(define (decode A) |
(if (feuille? A) |
(printf "~a" A) |
(begin (printf "(") |
(decode (fg A)) |
(printf " ~a " (racine A)) |
(decode (fd A)) |
(printf ")")))) |
(printf "float ~a() {\n" (gensym 'java)) |
(for-each (lambda (L) (let ((var (car L)) (val (cadr L))) |
(printf " ~a ~a = ~a;\n" |
(if (integer? val) "int" "float") |
var |
(if (integer? val) val (exact->inexact val))))) |
AL) |
(printf " return ") |
(decode A) |
(printf ";\n\}\n")) |
8 Exercice 13.7.8
Nous allons décoder les dimensions de l’image matrix.gif que vous téléchargez... Les spécifications du format gif se trouvent sur le Web, dans le fichier spec-gif87.txt, dont il suffit de lire les trois premières pages...
(define (dimensions f) ; f est le nom d'un fichier xxxx.gif |
(let ((v (make-vector 4))) |
(call-with-input-file f |
(lambda (p-in) |
; je lis les 6 premiers octets en ASCII [type de l'image] |
(printf "## L'image ~s est de type " f) |
(do ((i 0 (+ i 1))) |
((= i 6) (newline)) |
(display (integer->char (read-byte p-in)))) ; <==> (read-char p-in) |
; je stocke les 4 octets [byte] suivants dans un vecteur |
(let ((v (build-vector 4 (lambda (i) (read-byte p-in))))) |
(printf "## Les octets de la dimensions : v = ~a\n" v) |
(list (+ (vector-ref v 0) (* 256 (vector-ref v 1))) |
(+ (vector-ref v 2) (* 256 (vector-ref v 3))))))))) |
> (dimensions "matrix.gif") |
## L'image "matrix.gif" est de type GIF89a |
## Les octets de la dimensions : v = #(106 1 244 1) |
(362 500) |
9 Exercice 13.7.9
(define (nb-lines f) |
(call-with-input-file f |
(lambda (p-in) |
(do ((str (read-line p-in) (read-line p-in)) (n 0 (+ n 1))) |
((eof-object? str) n))))) |
> (nb-lines "chap13.rkt") |
336 |
ERRATUM : pour la question b), il n’y a pas de tag </img>...
(define (liens f) |
(call-with-input-file f |
(lambda (p-in) |
(let ((L '()) (str (read-line p-in))) |
(while (not (eof-object? str)) |
(let ((essai (regexp-match* "<img src ?= ?\"[^\"]+\"[^>]*>" str))) |
(when (not (null? essai)) |
;(printf "essai --> ~s\n" essai) |
(set! L (append (reverse essai) L)))) |
(set! str (read-line p-in))) |
(reverse L))))) |
> (liens "13.html") |
("<img src=\"matrix.gif\" alt=\"matrix.gif\" />") |
La question c) n’offre pas de difficulté spéciale. Pour d), on peut lire un fichier et écrire les liens dans un autre fichier au fur et à mesure, ou bien utiliser la fonction liens précédente :
(define (extraire-liens f) |
(let ((L (liens f)) (f-out (regexp-replace "(.+)[.].+$" f "\\1.txt" ))) |
(call-with-output-file f-out |
(lambda (p-out) |
(do ((L L (cdr L))) |
((null? L) (void)) |
(fprintf p-out "~s\n" (car L)))) |
#:exists 'replace))) |
Quant à la question e), il faut bien voir que les commentaires ne sont pas des objets Scheme et sont purement et simplement ignorés par la fonction read ! Il suffit donc de lire des objets Scheme et non pas des lignes, quitte à re-prettyfier le fichier dégraissé avec... pretty-print. Dans la réponse qui suit, je pare au plus pressé, en lisant un seul objet Scheme, à savoir une liste débutant par module, et en la ré-affichant dans f-out sans les commentaires, et de manière un peu compressée (pas de sauts de lignes par exemple)... On pourrait aussi retraduire cette liste en un fichier débutant par #lang...
(read-accept-reader #t) ; pour lire un fichier module débutant par #lang |
|
(define (remove-comments f-in f-out) |
(call-with-input-file f-in |
(lambda (p-in) |
(call-with-output-file f-out |
(lambda (p-out) |
(pretty-print (read p-in) p-out)) ; un seul read !! |
#:exists 'replace)))) |
> (remove-comments "chap13.rkt" "chap13-clean.rkt") |
> (require racket/system) |
> (system "cat chap13-clean.rkt") ; appel système à Unix pour voir le fichier produit |
(#%module-begin ; contenu du module = 1 seule grande liste |
(require "while-for.rkt") |
(require "show.rkt") |
"Generalites sur les caracteres, page 283" |
....... |
(system (format "~a gv-tmp.dot&" exe)))))) |
10 Exercice 13.7.10
Il est souvent intéressant de considérer une string comme un port, en entrée ou en sortie...
(define ($read-from-string str) ; la premiere expression Scheme de la chaine str |
(call-with-input-string str read)) |
> ($read-from-string "456 789") |
456 |
> ($read-from-string "(+ (* x 2) 3) 789") |
(+ (* x 2) 3) |
Même technique pour ($read-from-string-all str), sauf que l’on itère la lecture jusqu’à eof, en accumulant les lectures successives dans une liste.
> ($read-from-string-all "(+ (* x 2) 3) 789") |
((+ (* x 2) 3) 789) |
Les exercices 13.7.11 et 13.7.12 vous laissés à votre sagacité...