BlackTDN Search

quinta-feira, 26 de agosto de 2010

Protheus :: Curiosidade Matemática (Números Perfeitos)

O ADVPL não é uma linguagem puramente matemática e possui certa limitação em sua precisão numérica. Em função dessa limitação, o maior "Numero Perfeito" calculado em ADVPL será um número igual ou menor ao obtido através da operação: 2^56 = 72057594037927936.

Lembrando que 72057594037927936 não é um "Número Perfeito".

Mas afinal, o que é um "Número Perfeito"?

"Número Perfeito" é um número natural cuja soma de seus divisores próprios (excluído o próprio número) coincide com o número.

Ex.:

Numero 6:
Divisores: 1,2,3
Soma dos Divisores: 1+2+3=6

Numero 28
Divisores: 1,2,4,7,14
Soma dos Divisores: 1+2+4+7+14=28

Numero:496
Divisores: 1,2,4,8,16,31,62,124,248
Soma dos Divisores: 1+2+4+8+16+31+62+124+248=496

O Maior "Número Perfeito" conhecido é: 2.305.843.008.139.952.128

A título de curiosidade faremos um programa em ADVPL que verifica se um número é um "Número Perfeito". É algo que eu faria usando C ou C++ ou uma linguagem específica para operações matemáticas como o Fortran.

A expressão matemática, em ADVPL para calcular uma sequência de "Números Perfeitos" é:

2^(n-1)*(2^n-1)  onde n representa a ordem do Numero Perfeito:

Ex.:

para n = 2: 2^1(2^2 - 1) = 6


para n = 3: 2^2(2^3 - 1) = 28

para n = 5: 2^4(2^5 - 1) = 496

para n = 7: 2^6(2^7 - 1) = 8128

Vamos ao Código:

Função: NumeroPerfeito( nIntNum ) Retorna True se Numero Perfeito, False, caso contrário.


1: #DEFINE N_MAX 2^56 //72057594037927936
 2: /*/
 3:  Funcao: NumPerfeito
 4:  Autor: Marinaldo de Jesus
 5:  Data: 26/08/2010
 6:  Uso: Verificar se um numero eh um "Numero Perfeito"
 7: /*/
 8: Static Function NumPerfeito( nIntNum )
 9: 
10: Local nSum   := 0
11: Local nPlus  := 0
12: 
13: Local lPrimo := .F.
14: 
15: Local nInt  := 0
16: Local nStart := ( 2 ^ Len( LTrim( Str( nIntNum ) ) ) )
17: Local nFinish := Min( N_MAX , nIntNum )
18: 
19: For nMult := nStart To nFinish Step 2
20: 
21:  nInt := ( nIntNum / nMult )
22:  IF ( ( nInt - Int( nInt ) ) > 0 )
23:   Loop
24:  EndIF
25:  
26:  IF ( lPrimo := IsPrimo( nInt ) )
27:   Exit
28:  EndIF
29: 
30: Next nMult
31: 
32: IF !( lPrimo )
33:  Return( .F. )
34: EndIF
35: 
36: While ( ++nPlus < nIntNum )
37:  IF ( ( nIntNum % nPlus ) == 0 )
38:       nSum += nPlus
39:  EndIF
40: End While      
41: 
42: Return( nIntNum == nSum )
      

Função IsPrimo( nNum ) Retorna true se numero primo, false caso contrário. Será usada como função Auxiliar para calcular o "Número Perfeito".


1: /*/
 2:  Funcao: IsPrimo
 3:  Autor: Marinaldo de Jesus
 4:  Data: 26>/08/2010
 5:  Uso: Verificar se um numero eh um "Numero Primo"
 6: /*/
 7: Static Function IsPrimo( nNum )
 8: 
 9:  Local n2
10:  Local nI
11:  Local nJ
12: 
13:  n2 = Int( nNum / 2 )
14: 
15:  For nI := 2 To n2
16:   For nJ := nI To n2
17:    if ( ( nI * nJ ) == nNum )
18:     Return( .F. )
19:    endif
20:   Next nJ
21:  Next nI
22: 
23: Return( .T. )
      

Função: u_IsPerfectNum(), teste para achar os números perfeitos em um determinado intervalo.


1: User Function IsPerfectNum()
 2: 
 3: Local n
 4: 
 5: For n := 6 To N_MAX Step 2 //Onde: #DEFINE N_MAX 2^56 //72057594037927936
 6:  IF NumPerfeito( n )
 7:   ConOut( "Numero:" + Str( n ) + " eh perfeito" )
 8:  EndIF
 9: Next n
10: 
11: ConOut( "Final de Verificacao" )
12: 
13: Return( NIL )
      
Para acharmos os n Primeiros "Números Perfeitos" fariamos algo do tipo:


1: For n := 1 To 100 
2:   nNum := Int( 2^(n-1)*(2^n-1) )
3:     IF NumPerfeito( nNum )  
4:       ConOut(  "Numero: " + Transform(n,"999") + " :: " + Transform( nNum , "99999999999999999" ) )
5:     EndIF        
6: Next n
      

Não tive paciência de esperar a execução da função de exemplo para obter todos os "Números Perfeitos" possíveis em ADVPL ( demora muuuuuuuuuuuuuito ). Se alguém tiver a curiosidade de testar e tiver paciência para esperar o termino da execução, publique um cometário com o conteúdo.

Um Desafio, tentei otimizar o código de forma a torná-lo o mais rápido possível, se alguém tiver uma idéia melhor, ficaria grato em vê-la.

Se desejar baixar o código, clique aqui

[]s
иαldσ dj

Nenhum comentário:

Postar um comentário