F90: Programa de estatística básica
From AdonaiMedrado.Pro.Br
Este código foi desenvolvido pelos alunos Ana Carolina. Essia Cassia, Fabiana Pereira, Gabriela Isabel, Jéssica Santos, Jurandi Prazeres, Otávio Neto, Roberto Joaquiim e Rogerio Oliveira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 25/11/2008.
PROGRAM Estatistica IMPLICIT NONE LOGICAL::L CHARACTER (LEN=300)::Caminho, caminho2 INTEGER:: i, n REAL::AUX REAL, DIMENSION (:), ALLOCATABLE :: v WRITE(*,*)"QUANTOS NUMEROS TEM O SEU BANCO DE DADOS?" READ(*,*) n ALLOCATE (v(1:n)) WRITE (*,*) "DIGITE O CAMINHO DO SEU BANCO DE DADOS,", & " CASO JÁ O TENHA DIGITADO EM FORMATO "".TXT"", ", & "Exemplo:C:\Meus documentos\entrada.txt, ",& "CASO CONTRÁRIO DIGITE ""NAO""." READ (*,*) Caminho IF (Caminho/="nao")THEN OPEN (UNIT=10, FILE=Caminho) READ (10,*)(v(i), i=1,n) CLOSE (10) ELSE WRITE (*,*) "Digite seu banco de dados" READ (*,*)(v(i), i=1,n) END IF DO L=.False. DO i=1,(n-1) IF (v(i)>v(i+1)) THEN AUX=v(i) v(i)=v(i+1) v(i+1)=AUX L=.true. END IF END DO IF(.not.L) THEN EXIT END IF END DO CALL MenuPrincipal(v) DEALLOCATE(v) CONTAINS SUBROUTINE MenuPrincipal(VetorDeEntrada) REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada INTEGER :: C DO WRITE (*,*) "Escolha uma opção:" WRITE (*,*) "1- Moda" WRITE (*,*) "2- Média" WRITE (*,*) "3- Mediana" WRITE (*,*) "4- Variância" WRITE (*,*) "5- Desvio Padrão" WRITE (*,*) "6- Coeficiente de Variação" WRITE (*,*) "7- Frequência" WRITE (*,*) "8- Amplitude Total" WRITE (*,*) "9- Tudo" WRITE (*,*) "10- Sair" READ (*,*) C IF (c/=10) THEN WRITE (*,*) "Para salvar o output,",& "abra o bloco de notas e salve um arquivo em branco com nome desejado,",& "em seguida digite o nome do caminho onde salvou o arquivo",& "Exemplo:C:\Meus documentos\saida.txt" READ (*,*) caminho2 OPEN (UNIT=11, FILE=caminho2, ACCESS="APPEND") END IF SELECT CASE (C) CASE (1) CALL Moda (VetorDeEntrada) CASE (2) WRITE (*,*) "A média é ", & Media(VetorDeEntrada) WRITE (11,*) "A média é ", & Media(VetorDeEntrada) CASE (3) WRITE (*,*) "A mediana é ", & Mediana(VetorDeEntrada) WRITE (11,*) "A mediana é ", & Mediana(VetorDeEntrada) CASE (4) WRITE (*,*) "A variância é ", & Variancia(VetorDeEntrada) WRITE (11,*) "A variância é ", & Variancia(VetorDeEntrada) CASE (5) WRITE (*,*) "O desvio padrão é ", & DesvioPadrao(VetorDeEntrada) WRITE (11,*) "O desvio padrão é ", & DesvioPadrao(VetorDeEntrada) CASE (6) WRITE (*,*) "O coeficiente de variação é ", & CoeficienteDeVariacao(VetorDeEntrada) WRITE (11,*) "O coeficiente de variação é ", & CoeficienteDeVariacao(VetorDeEntrada) CASE (7) CALL Frequencia (v) CASE (8) WRITE (*,*) "A Amplitude Total é: ", & Amplitude(VetorDeEntrada) WRITE (11,*) "A Amplitude Total é: ", & Amplitude(VetorDeEntrada) CASE (9) CALL Moda (VetorDeEntrada) WRITE (*,*) "A média é ", & Media(VetorDeEntrada) WRITE (11,*) "A média é ", & Media(VetorDeEntrada) WRITE (*,*) "A mediana é ", & Mediana(VetorDeEntrada) WRITE (11,*) "A mediana é ", & Mediana(VetorDeEntrada) CALL Frequencia (v) WRITE (*,*) "A variância é ", & Variancia(VetorDeEntrada) WRITE (11,*) "A variância é ", & Variancia(VetorDeEntrada) WRITE (*,*) "O desvio padrão é ", & DesvioPadrao(VetorDeEntrada) WRITE (11,*) "O desvio padrão é ", & DesvioPadrao(VetorDeEntrada) WRITE (*,*) "O coeficiente de variação é ", & CoeficienteDeVariacao(VetorDeEntrada) WRITE (11,*) "O coeficiente de variação é ", & CoeficienteDeVariacao(VetorDeEntrada) WRITE (*,*) "A Amplitude Total é: ", & Amplitude(VetorDeEntrada) WRITE (11,*) "A Amplitude Total é: ", & Amplitude(VetorDeEntrada) CASE (10) STOP "Programa encerrado." END SELECT IF (c/=10) THEN CLOSE (11) END IF END DO END SUBROUTINE MenuPrincipal SUBROUTINE Moda(Vetor) IMPLICIT NONE INTEGER::i=0,K=1,CONT,quant_max=1 REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: Vetor REAL::M(2,n) DO i = 1, n M(2,i) = 1 END DO CONT=1 i=1 DO IF (Vetor(CONT)==Vetor(CONT+1)) THEN IF (i==1) THEN M(1,i) = Vetor(CONT) M(2,i) = M(2,i)+1 i=i+1 ELSE IF (M(1,i-1)==Vetor(CONT)) THEN M(2,i-1)=M(2,i-1)+1 ELSE M(1,i)=Vetor(CONT) M(2,i)=M(2,i)+1 i = i+1 END IF END IF END IF CONT=CONT+1 IF (CONT>=n) THEN EXIT END IF END DO DO IF(M(2,K)>quant_max) THEN quant_max = M(2,K) END IF K = K+1 IF (K>=i) THEN EXIT END IF END DO K=1 WRITE(*,*)"A moda é :" WRITE(11,*)"A moda é :" IF (quant_max==1) THEN DO WRITE(*,*)"->",Vetor(K) WRITE(11,*)"->",Vetor(K) K = K+1 IF (K>n) THEN EXIT END IF END DO ELSE DO IF(M(2,K)==quant_max) THEN WRITE(*,*)"->",M(1,K) WRITE(11,*)"->",M(1,K) END IF K = K+1 IF (K>=i) THEN EXIT END IF END DO END IF END SUBROUTINE REAL FUNCTION Media(VetorDeEntrada) REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada REAL:: Soma Soma = 0 DO i=1,SIZE(VetorDeEntrada) Soma = Soma + VetorDeEntrada(i) END DO Media = Soma / (SIZE(VetorDeEntrada) * 1.0) END FUNCTION Media REAL FUNCTION Variancia(VetorDeEntrada) REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada REAL, DIMENSION (:), ALLOCATABLE :: VetorSomatorio REAL :: MediaDosElementos INTEGER::Soma ALLOCATE (VetorSomatorio(1:n)) MediaDosElementos = Media(VetorDeEntrada) DO i=1,SIZE(VetorDeEntrada) VetorSomatorio(i) = (VetorDeEntrada(i)-MediaDosElementos)**2 END DO Soma = 0 DO i=1,SIZE(VetorDeEntrada) Soma = Soma + VetorSomatorio(i) END DO Variancia = Soma / (SIZE(VetorDeEntrada) * 1.0) DEALLOCATE(VetorSomatorio) END FUNCTION Variancia REAL FUNCTION DesvioPadrao(VetorDeEntrada) IMPLICIT NONE REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada DesvioPadrao = SQRT (Variancia(VetorDeEntrada)) END FUNCTION DesvioPadrao REAL FUNCTION CoeficienteDeVariacao(VetorDeEntrada) IMPLICIT NONE REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada CoeficienteDeVariacao = (DesvioPadrao(VetorDeEntrada)*1.0) / & (Media(VetorDeEntrada)*1.0) END FUNCTION CoeficienteDeVariacao SUBROUTINE Frequencia(V) IMPLICIT NONE REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: V INTEGER::i,f i=1 Do f=1 Do If (i/=n .and. V(i)==V(i+1)) then f=f+1 i=i+1 Else Write (*,*) "A frequência de", V(i),"=", f Write (11,*) "A frequência de", V(i),"=", f i=i+1 EXIT End If End Do If (i>=n) then If (i==n.and. V(i)/=V(i-1)) then Write (*,*) "A frequência de", V(i),"=", 1 Write (11,*) "A frequência de", V(i),"=", 1 End if exit End if End Do END SUBROUTINE Frequencia REAL FUNCTION Amplitude(VetorDeEntrada) IMPLICIT NONE REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada Amplitude=(VetorDeEntrada(n)-VetorDeEntrada(1)) END FUNCTION Amplitude REAL FUNCTION Mediana(VetorDeEntrada) REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada IF (MOD(N,2)/= 0) THEN Mediana= VetorDeEntrada((N+1)/2) ELSE Mediana=(VetorDeEntrada(N/2)+VetorDeEntrada((N+2)/2))/(2*1.0) END IF END FUNCTION Mediana END PROGRAM Estatistica
