Exame de 2ª chamada, 28/1/2002
RESOLUÇÃO
1.1
(define retira-elemento
(lambda (elem lis)
(cond
((null? lis) '())
((equal? elem (car lis)) (cdr lis))
(else (cons (car lis) (retira-elemento elem (cdr lis)))))))
1.2
(define ordena-em-ascendente
(lambda (lis)
(if (null? lis)
'()
(let ((val-min (apply min lis)))
(cons val-min (ordena-em-ascendente (retira-elemento val-min lis)))))))
2.1
(define sel-jogo-furos
(lambda (jogo col lin)
(vector-ref (vector-ref jogo col) lin)))
2.2
(define mod-jogo-furos!
(lambda (jogo col lin codigo)
(vector-set! (vector-ref jogo col) lin codigo)))
2.3
No Anexo A, pode verificar que os principais procedimentos utilizados
por jogo-dos-furos são:
faz-jogo-furos e vai-jogar.
Este procedimento, vai-jogar, utiliza: visu-jogo,
pede-mais-um-furo e visu-premio!
2.4
(define visu-jogo-furos
(lambda (jogo)
(let ((numero-colunas (vector-length jogo))
(numero-linhas (vector-length (vector-ref jogo 0))))
(newline)
(letrec ((visu-linha
(lambda (n-lin n-col ainda-tem furos)
(cond ((and (= n-col numero-colunas) ainda-tem)
(newline) ; apenas muda de linha
furos) ; devolve os furos existentes
((= n-col numero-colunas) furos) ; nem sequer muda de linha
((not
(or (equal? (sel-jogo-furos jogo n-col n-lin) 'furado)
(equal? (sel-jogo-furos jogo n-col n-lin) 'vazio)))
(display (+ (* n-lin numero-colunas) n-col 1))
(display " ")
(visu-linha n-lin (add1 n-col) #t (add1 furos)))
(else (visu-linha n-lin (add1 n-col) ainda-tem furos)))))
;
(visu-todas-as-linhas
(lambda (conta-linhas conta-furos)
(cond ((= conta-linhas numero-linhas) conta-furos)
(else
(let ((furos (visu-linha conta-linhas 0 #f conta-furos)))
(visu-todas-as-linhas (add1 conta-linhas) furos)))))))
;
(visu-todas-as-linhas 0 0))))) ; comec,a na linha 0, a linha superior...
Anexo A
; ---------- pergunta 2 -------------
; sugestoes para melhoria sao bem-vindas.
;
; esboc,o do programa principal, de onde se deduzem os procedimentos principai
(define jogo-dos-furos
(lambda (colunas linhas)
(let ((jogo (faz-jogo-furos colunas linhas)))
(vai-jogar jogo)
(display "E ainda uma coleccao de premios"))))
;
; ciclo escolha do furo e mostra do premio
(define vai-jogar
(lambda (jogo)
(let ((n-furos-existentes (visu-jogo jogo)))
(if (> n-furos-existentes 0)
(let ((furo (pede-mais-um-furo jogo)))
(visu-premio! jogo (car furo) (cdr furo))
(newline)
(vai-jogar jogo))))))
;
; pede um furo e verifica se corresponde a já furado; se assim for,
; repete o pedido. Devolve um par com a col e lin do furo escolhido.
(define pede-mais-um-furo
(lambda (jogo)
(letrec ((numero-colunas (vector-length jogo))
(numero-linhas (vector-length (vector-ref jogo 0)))
(ciclo
(lambda ()
(display "Furo: ")
(let* ((furo (read))
(coluna (car (numero-do-furo->col.lin furo jogo)))
(linha (cdr (numero-do-furo->col.lin furo jogo))))
(if (or (< furo 1)
(> furo (* numero-colunas numero-linhas))
(equal? (sel-premio jogo coluna linha) 'furado))
(ciclo)
(cons coluna linha))))))
(ciclo))))
;
; para alem de visualizar o premio situado em col e lin, ainda
; fura esse premio ... deixando a cartolina com menos um furo
(define visu-premio!
(lambda (cartolina col lin)
(let ((premio (sel-premio cartolina col lin)))
(cond
((equal? premio 'vermelho) (display "vermelho - Caixa de chocolates grande"))
((equal? premio 'azul) (display "azul - Caixa de chocolates media"))
((equal? premio 'verde) (display "verde - Chocolate grande"))
((equal? premio 'amarelo) (display "amarelo - Chocolate medio"))
((equal? premio 'castanho) (display "castanho - Chocolate pequeno"))
(else (display "Cor desconhecida!")))
(mod-premio! cartolina col lin 'furado))))
;
; procedimentos que trabalham com a estrutura de dados escolhida
;
; mostra o estado do jogo
(define visu-jogo
(lambda (cartolina)
(let ((numero-colunas (vector-length cartolina))
(numero-linhas (vector-length (vector-ref cartolina 0))))
(newline)
(letrec ((visu-linha
(lambda (n-lin n-col ainda-tem furos)
(cond ((and (= n-col numero-colunas) ainda-tem)
(newline) ; apenas muda de linha
furos) ; devolve os furos existentes
((= n-col numero-colunas) furos) ; nem sequer muda de linha
((not
(or (equal? (sel-premio cartolina n-col n-lin) 'furado)
(equal? (sel-premio cartolina n-col n-lin) 'vazio)))
(display (+ (* n-lin numero-colunas) n-col 1))
(display " ")
(visu-linha n-lin (add1 n-col) #t (add1 furos)))
(else (visu-linha n-lin (add1 n-col) ainda-tem furos)))))
;
(visu-todas-as-linhas
(lambda (conta-linhas conta-furos)
(cond ((= conta-linhas numero-linhas)
conta-furos)
(else
(let ((furos (visu-linha conta-linhas 0 #f conta-furos)))
(visu-todas-as-linhas (add1 conta-linhas) furos)))))))
;
(visu-todas-as-linhas 0 0))))) ; comec,a na linha 0, a linha superior...
;
; constroi jogo com as dimensoes pedidas
(define faz-jogo-furos
(lambda (colunas linhas)
(let ((dim (* colunas linhas)))
(let* ((cartolina (faz-cartolina colunas linhas))
(n-cast (round (* .5 dim)))
(n-amar (round (* .25 dim)))
(n-verd (round (* .13 dim)))
(n-azul (round (* .07 dim)))
(n-verm (- dim (+ n-cast n-amar n-verd n-azul))))
(poe-codigo! n-cast 'castanho cartolina 1)
(poe-codigo! n-amar 'amarelo cartolina (+ n-cast 1))
(poe-codigo! n-verd 'verde cartolina (+ n-cast n-amar 1))
(poe-codigo! n-azul 'azul cartolina (+ n-cast n-amar n-verd 1))
(poe-codigo! n-verm 'vermelho cartolina (+ n-cast n-amar n-verd n-azul 1))
(baralha! cartolina)
cartolina))))
;
; cria uma cartolina vazia
(define faz-cartolina
(lambda (colunas linhas)
(let ((cartolina (make-vector colunas)))
(letrec ((ciclo
(lambda (n)
(if (= n colunas)
cartolina
(begin
(vector-set! cartolina n (make-vector linhas 'vazio))
(ciclo (add1 n)))))))
(ciclo 0)))))
;
; coloca n premios na cartolina, seguidos, a partir de i-partida
(define poe-codigo!
(lambda (n cod cartolina i-partida)
(letrec ((ciclo
(lambda (conta)
(if (= conta n)
'ok
(let ((furo (numero-do-furo->col.lin (inexact->exact (+ i-partida conta)) cartolina)))
(mod-premio! cartolina (car furo) (cdr furo) cod)
(ciclo (add1 conta)))))))
(ciclo 0))))
;
; distribui os premios 'a sorte
(define baralha!
(lambda (cartolina)
(letrec ((numero-colunas (vector-length cartolina))
(numero-linhas (vector-length (vector-ref cartolina 0)))
(dim (* numero-colunas numero-linhas))
(ciclo
(lambda (indice)
(if (= indice dim)
'ok
(begin
(troca-entre-si! cartolina indice (add1 (random dim)))
(ciclo (add1 indice)))))))
(ciclo 1))))
;
; troca posicao de dois premios
(define troca-entre-si!
(lambda (cartolina i j)
(let* ((furo1 (numero-do-furo->col.lin i cartolina))
(furo2 (numero-do-furo->col.lin j cartolina))
(col1 (car furo1))(lin1 (cdr furo1))
(col2 (car furo2))(lin2 (cdr furo2))
(temp (sel-premio cartolina col1 lin1)))
(mod-premio! cartolina col1 lin1 (sel-premio cartolina col2 lin2))
(mod-premio! cartolina col2 lin2 temp))))
;
; selector
(define sel-premio
(lambda (cartolina col lin)
(vector-ref (vector-ref cartolina col) lin)))
;
; modificador
(define mod-premio!
(lambda (cartolina col lin codigo)
(vector-set! (vector-ref cartolina col) lin codigo)))
;
; dado o numero de um furo de uma cartolina,
; devolve um par com a coluna e linha do furo na cartolina.
(define numero-do-furo->col.lin
(lambda (furo cartolina)
(let ((n-colunas (vector-length cartolina))
(numero (sub1 furo)))
(cons (remainder numero n-colunas)
(quotient numero n-colunas)))))
;
(display "jogo-dos-furos (4x3)")
(jogo-dos-furos 4 3)