rendered paste body;DaisyWorld 0.0
;Elementos do Grupo
;
;57958 - Pedro Luiz de Castro
;57878 - Vivek Kantilal Maganlal
(require (lib "include.ss")
(lib "list.ss")
"interface.zo"
"tokenize.zo"
"gerador.zo"
"proj3-aux-fp0708-74.scm")
(include "proj3-margarida-fp0708-74.scm")
(include "proj3-planeta-fp0708-74.scm")
(include "proj3-posicao-fp0708-74.scm")
(include "proj3-simulador-fp0708-74.scm")
#|
### Primeiro Check-Point ###
|#
(define sb 5.67E-8)
(define S 917)
(define ep 0.5)
(define fa 20)
;######### MOSTRA_CONST #########
(define mostra_const
(lambda ()
(begin (display "Constante de Stefan Boltzmann: ")(display sb)(newline)
(display "Fluxo solar: ")(display S)(newline)
(display "Emissividade do planeta: ")(display ep)(newline)
(display "Factor de absorção: ")(display fa))))
;######### LUMINO #########
(define (lumino t)
(if (integer? t)
(if (>= t 0)
(+ 0.6 (* (/ 1.2 200) t))
"Erro de consistência.")
"Erro de input."))
;######### T_PLANETA #########
(define (T_planeta L ab-pl)
(if (and (rational? L)
(rational? ab-pl))
(if (and (> L 0)
(<= 0 ab-pl 1))
(- (expt (/ (* S L (- 1 ab-pl)) (* 0.5 sb)) (/ 1 4)) 273.15)
"Erro de consistência.")
"Erro de input."))
;######### ETAPA #########
(define (etapa conforto mag-viz viz-lim)
(if (and (rational? conforto)
(integer? mag-viz)
(integer? viz-lim))
(if (and (>= mag-viz 0)(>= viz-lim 0))
(cond ((and (< mag-viz viz-lim)(>= conforto 0))1)
((and (>= mag-viz viz-lim)(>= conforto 0))2)
(else 3 ))
"Erro de consistência.")
"Erro de input."))
;############### CONFORTO ##############
(define (conforto t ab-pl ab-loc ab-m tmin tmax)
(define (conforto-aux t ab-pl ab-loc ab-m tmin tmax) ;conforto-aux calcula o conforto no intante t
(- 1 (* (expt (- (/ (+ tmax tmin) 2) (+ (* (- ab-loc ab-m) fa) (T_planeta (lumino t) ab-pl))) 2) (/ 4 (expt (- tmax tmin) 2)))))
(if (and (integer? t)(>= t 0)
(rational? ab-pl)(>= ab-pl 0)(<= ab-pl 1)(rational? ab-pl)
(rational? ab-loc)(>= ab-loc 0)(<= ab-loc 1)
(rational? ab-m)(>= ab-m 0)(<= ab-m 1)
(integer? tmin)(integer? tmax)
(not (= tmax tmin)))
(cond ((> (conforto-aux t ab-pl ab-loc ab-m tmin tmax) 1)1)
((< (conforto-aux t ab-pl ab-loc ab-m tmin tmax) -1)-1)
(else (conforto-aux t ab-pl ab-loc ab-m tmin tmax)))
"Erro de input."))
;######### VIZINHOS_PRINT #########
(define (vizinhos_print x y n-linha n-coluna n)
(define (mostra_vizinhos xx x yy y n-linha n-coluna n)
(if (and (< yy n-linha)(<= yy (+ y n)))
(cond ((and (< xx 0)(< yy 0))(mostra_vizinhos (+ xx 1) x (+ yy 1) y n-linha n-coluna n))
((and (< xx 0)(>= yy 0))(mostra_vizinhos (+ xx 1) x yy y n-linha n-coluna n))
((and (>= xx 0)(< yy 0))(mostra_vizinhos xx x (+ yy 1) y n-linha n-coluna n))
((or (> xx (- n-coluna 1)) (> xx (+ x n))) (mostra_vizinhos (- x n) x (+ yy 1) y n-linha n-coluna n))
(else (begin (display "(")
(display xx)
(display ",")
(display yy)
(display ")")
(mostra_vizinhos (+ xx 1) x yy y n-linha n-coluna n))))))
(if (and (integer? x)
(integer? y)
(integer? n-linha)
(integer? n-coluna)
(integer? n))
(if (and (>= x 0)(>= y 0)
(>= n-linha 0)
(>= n-coluna 0)
(>= n 0)
(> n-linha y)
(> n-coluna x))
(mostra_vizinhos (- x n) x (- y n) y n-linha n-coluna n)
"Erro de consistência.")
"Erro de input."))
#|
### Segundo Check-Point ###
|#
;######### VIZINHOS_LISTA #########
(define (vizinhos_lista pos n-linha n-coluna n)
(define vizinhos ())
(define (mostra_vizinhos yy y xx x n-linha n-coluna n)
(if (and (< yy n-linha) (<= yy (+ y n)))
(cond ((and (< xx 0)(< yy 0))(mostra_vizinhos (+ yy 1) y (+ xx 1) x n-linha n-coluna n))
((and (< xx 0)(>= yy 0))(mostra_vizinhos yy y (+ xx 1) x n-linha n-coluna n))
((and (>= xx 0)(< yy 0))(mostra_vizinhos (+ yy 1) y xx x n-linha n-coluna n))
((or (> xx (- n-coluna 1)) (> xx (+ x n))) (mostra_vizinhos (+ yy 1) y (- x n) x n-linha n-coluna n))
(else (begin (set! vizinhos (cons (nova_posicao yy xx) vizinhos))
(mostra_vizinhos yy y (+ xx 1) x n-linha n-coluna n)))))
(reverse vizinhos))
(if (and (integer? (linha_posicao pos))
(integer? (coluna_posicao pos))
(integer? n-linha)
(integer? n-coluna)
(integer? n)
(posicao_valida? pos n-linha n-coluna))
(if (and (>= (linha_posicao pos) 0)
(>= (coluna_posicao pos) 0)
(>= n-linha 0)
(>= n-coluna 0)
(>= n 0)
(> n-coluna (coluna_posicao pos))
(> n-linha (linha_posicao pos)))
(mostra_vizinhos (- (linha_posicao pos) n) (linha_posicao pos) (- (coluna_posicao pos) n) (coluna_posicao pos) n-linha n-coluna n)
"Erro de consistência.")
"Erro de input."))
;######### QUANTAS_VIZINHAS #########
(define (quantas_vizinhas planeta pos n)
(define (quantas_vizinhas-aux planeta pos n)
(define i 0)
(define contador 0)
(define vizinhos (vizinhos_lista pos (linhas_planeta planeta) (colunas_planeta planeta) n))
(while (< i (length vizinhos))
(if (tem_margarida? planeta (list-ref vizinhos i))
(set! contador (+ contador 1)))
(set! i (+ i 1)))
contador)
(if (and (planeta? planeta)
(posicao? pos)
(integer? n))
(if (and (posicao_valida? pos (linhas_planeta planeta) (colunas_planeta planeta))(<= 0 n))
(quantas_vizinhas-aux planeta pos n)
"Erro de consistência.")
"Erro de input."))
;######### JOGA_PROBABILIDADES #########
(define (joga_probabilidades p npa)
(if (and (rational? p) (integer? npa))
(if (and (<= 0 p 1)(<= 0 npa (- (expt 2 31) 2)))
(< npa (* p (- (expt 2 31) 1)))
"Erro de consistência.")
"Erro de input."))
;######### POSICAO_A_SORTE #########
(define (posicao_a_sorte linhas colunas npa)
(if (and (exact? npa)
(exact? linhas)
(exact? colunas))
(if (and (>= linhas 0)
(>= colunas 0)
(<= 0 npa (- (expt 2 31) 2)))
(nova_posicao (quotient (remainder npa (* linhas colunas)) colunas) (remainder (remainder npa (* linhas colunas)) colunas))
"Erro de consistência.")
"Erro de input."))
;######### NOVO_ALBEDO #########
(define (novo_albedo albedo_mae pmm npa)
(define (aux albedo_mae npa)
(if (< (/ npa (- (expt 2 31) 2)) albedo_mae)
(- albedo_mae (* (/ 1 3) (- albedo_mae (/ npa (- (expt 2 31) 2)))))
(+ albedo_mae (* (/ 1 3) (- (/ npa (- (expt 2 31) 2)) albedo_mae)))))
(if (and (rational? albedo_mae)
(rational? pmm)
(integer? npa))
(if (and (<= 0 albedo_mae 1)(<= 0 pmm 1)(<= 0 npa (- (expt 2 31) 2)))
(if (joga_probabilidades pmm npa)
(aux albedo_mae npa)
albedo_mae)
"Erro de consistência.")
"Erro de input."))
;######### ALB_REGIAO #########
(define (alb_regiao planeta . args)
(define somador 0)
(define (alb_regiao_aux planeta albedo_planeta vizinhos)
(if (null? vizinhos)
somador
(if (tem_margarida? planeta (first vizinhos))
(begin (set! somador (+ somador (albedo_margarida (obtem_margarida planeta (first vizinhos)))))
(alb_regiao_aux planeta albedo_planeta (rest vizinhos)))
(begin (set! somador (+ somador albedo_planeta))
(alb_regiao_aux planeta albedo_planeta (rest vizinhos))))))
(if (null? args)
(if (planeta? planeta)
(/ (alb_regiao_aux planeta (second planeta) (vizinhos_lista (nova_posicao 0 0) (linhas_planeta planeta) (colunas_planeta planeta) (max (colunas_planeta planeta) (linhas_planeta planeta)))) (* (linhas_planeta planeta) (colunas_planeta planeta)))
"Erro de input.")
(if (and (planeta? planeta) (= (length args) 2) (integer? (first args)) (>= (first args) 0) (posicao? (second args)))
(if (and (posicao? (second args)) (posicao_valida? (second args) (linhas_planeta planeta) (colunas_planeta planeta)))
(/ (alb_regiao_aux planeta (albedo_planeta planeta) (vizinhos_lista (second args) (linhas_planeta planeta) (colunas_planeta planeta) (first args))) (* (length (vizinhos_lista (second args) (linhas_planeta planeta) (colunas_planeta planeta) (first args)))))
"Erro de consistência.")
"Erro de input.")))
;############ CONFORTO TÉRMICO #################
(define (conforto_margarida t planeta n posicao)
(define vizinhos (vizinhos_lista posicao (linhas_planeta planeta) (colunas_planeta planeta) n))
(define (tloc fha temperatura_planeta albedo_margarida albedo_local)
(+ temperatura_planeta (* fha (- albedo_local albedo_margarida))))
(if (and (planeta? planeta) (posicao? posicao) (integer? n) (integer? t) (<= 0 t) (<= 0 n))
(if (and (posicao_valida? posicao (linhas_planeta planeta) (colunas_planeta planeta)) (margarida? (obtem_margarida planeta posicao)))
(cond ((> (- 1 (* (/ 4
(expt (- (tempmax_margarida (obtem_margarida planeta posicao))
(tempmin_margarida (obtem_margarida planeta posicao))) 2))
(expt (- (tempideal_margarida (obtem_margarida planeta posicao))
(tloc fa (T_planeta (lumino t) (albedo_planeta planeta)) (albedo_margarida (obtem_margarida planeta posicao)) (alb_regiao planeta n posicao))) 2))) 1) 1)
((< (- 1 (* (/ 4
(expt (- (tempmax_margarida (obtem_margarida planeta posicao))
(tempmin_margarida (obtem_margarida planeta posicao))) 2))
(expt (- (tempideal_margarida (obtem_margarida planeta posicao))
(tloc fa (T_planeta (lumino t) (albedo_planeta planeta)) (albedo_margarida (obtem_margarida planeta posicao)) (alb_regiao planeta n posicao))) 2))) -1) -1)
(else (- 1 (* (/ 4
(expt (- (tempmax_margarida (obtem_margarida planeta posicao))
(tempmin_margarida (obtem_margarida planeta posicao))) 2))
(expt (- (tempideal_margarida (obtem_margarida planeta posicao))
(tloc fa (T_planeta (lumino t) (albedo_planeta planeta)) (albedo_margarida (obtem_margarida planeta posicao)) (alb_regiao planeta n posicao))) 2)))))
"Erro de consistência.")
"Erro de input."))
;############ NASCE_GLOBAL #################
(define (nasce_global t planeta posicao)
(define vizinhos 0)
(define (nasce_global_aux t planeta posicao vizinhos)
(if (null? vizinhos)
posicao
(if (tem_margarida? planeta (first vizinhos))
(nasce_global_aux t planeta posicao (rest vizinhos))
(first vizinhos))))
(if (and (integer? t) (planeta? planeta) (posicao? posicao) (>= t 0) (>= (linha_posicao posicao) 0) (>= (coluna_posicao posicao) 0))
(if (posicao_valida? posicao (linhas_planeta planeta) (colunas_planeta planeta))
(begin
(set! vizinhos (vizinhos_lista posicao (linhas_planeta planeta) (colunas_planeta planeta) (max (linhas_planeta planeta) (colunas_planeta planeta))))
(nasce_global_aux t planeta posicao vizinhos))
"Erro de consistência.")
"Erro de input."))
;############ NASCE_LOCAL ################# TESTAR!
(define (nasce_local t planeta posicao n)
(define vizinhos 0)
(define (nasce_global_aux t planeta posicao vizinhos)
(if (null? vizinhos)
posicao
(if (tem_margarida? planeta (first vizinhos))
(nasce_global_aux t planeta posicao (rest vizinhos))
(first vizinhos))))
(if (and (integer? t) (integer? n) (planeta? planeta) (posicao? posicao) (>= t 0) (>= n 0) (>= (linha_posicao posicao) 0) (>= (coluna_posicao posicao) 0)(tem_margarida? planeta posicao))
(if (posicao_valida? posicao (linhas_planeta planeta) (colunas_planeta planeta))
(begin (set! vizinhos (vizinhos_lista posicao (linhas_planeta planeta) (colunas_planeta planeta) n))
(nasce_global_aux t planeta posicao vizinhos))
"Erro de consistência.")
"Erro de input."))
;############ EFEITO_MARGARIDA #################
(define (efeito_margarida t planeta posicao n limite_vm)
(define npa 2)
(define (efeito_margarida_aux t planeta posicao n limite_vm)
(cond((= 1 resultado)(if (joga_probabilidades conforto npa)
(nasce_local t planeta posicao n)
"nada"))
((= 2 resultado)(if (not (joga_probabilidades conforto npa))
(nasce_global t planeta posicao)
"nada"))
((= 3 resultado)(if (joga_probabilidades (- 0 conforto) npa)
"morre"
"nada"))
(else "Erro de consistência.")))
(define resultado 0)
(define conforto 0)
(if (and (integer? t) (>= t 0) (planeta? planeta) (posicao? posicao) (integer? n) (>= n 0) (integer? limite_vm) (>= limite_vm 0))
(if (posicao_valida? posicao (linhas_planeta planeta) (colunas_planeta planeta))
(begin
(set! conforto (conforto_margarida t planeta n posicao))
(set! resultado (etapa conforto (quantas_vizinhas planeta posicao n) limite_vm))
(efeito_margarida_aux t planeta posicao n limite_vm))
"Erro de consistência.")
"Erro de input."))
;############ APLICA_MARGARIDA #################
(define (aplica_margarida t planeta posicao n limite_vm planeta_futuro)
(define (aplica_margarida_aux t planeta posicao n limite_vm planeta_futuro)
(cond((string=? "morre" (efeito_margarida t planeta posicao n limite_vm))(morre_margarida planeta posicao))
((string=? "nada" (efeito_margarida t planeta posicao n limite_vm)))
((posicao? (efeito_margarida t planeta posicao n limite_vm))(nasce_margarida planeta (efeito_margarida t planeta posicao n limite_vm) margarida))
(else "Erro de input.")))
(aplica_margarida_aux t planeta posicao n limite_vm planeta_futuro))
;########## FUNCOES PA PASSAR O TEMPO, CASO SEJAM NECESSÁRIAS! #################
(define (vm n planeta pos)
(define d (/ (quantas_vizinhas planeta pos n) (length (vizinhos_lista pos (linhas_planeta planeta) (colunas_planeta planeta) n))))
(* d (expt (+ 1 (* n 2)) 2)))