Protheus :: Advpl : Números Perfeitos o Retorno

"Trama em segredo teus planos
Parte sem dizer adeus
Nem lembra dos meus desenganos
Fere quem tudo perdeu
...
Ah coração leviano não sabe o que fez do meu
Ah coração leviano não sabe o que fez do meu (mas trama)
Este pobre navegante meu coração amante
...

Ah coração teu engano foi esperar por um bem
De um coração leviano que nunca será de ninguém" ( Coração Leviano :: Paulinho da Viola)

Esse dramalhão todo é só pra dizer que, temporariamente, estou me despedindo da Class TMath[I/F]Str.

Esse que vos escreve está se enveredando no mundo dos "Games". Então, em processo de enamoramento, de conquista e de novas "paixões" deixo por um tempo, o Adplv que, com sua bidimensionalidade, está me deixando sem dimensão.

Procuro algo mais cheio de curvas, círculos, esferas, polígonos, vértices, enfim, mais dimensões. Uma delas é o AutoDesk Maya que, como uma "Penteadeira de Puta", está me deixando "perdidinho". Não acho nada, cheio de botões, de regras, de "frescuras".

Pra mostrar que não sou ingrato e que TMath merece e merecerá minha atenção futura, publico o que "seria" o último "post" da Série.

"Números Perfeitos o Retorno" marca a despedida. Números Perfeitos foi reescrita usando a Classe em Advpl TMathIntegerStr. Está mais leve, mas nem por isso, mais rápida. Está mais inteligente (uma vez que posso reiniciar o processo de onde parei e continuar a procurar os demais "Números Perfeitos").

Eis que: Números Perfeitos

#INCLUDE "PROTHEUS.CH" #INCLUDE "TRYEXCEPTION.CH" #DEFINE N_MAX 25 //9999999999999999999999999 /*/ Funcao: U_MathIPNum() Autor: Marinaldo de Jesus Data: 14/06/2011 Uso: Verificar os Numeros Perfeitos em um Determinado Intervalo /*/ User Function MathIPNum() Local aDBs := {} Local cE Local cP := "1" Local cN := "6" Local cM := "" Local cT1 := AnsiToOem( "O Número: " ) Local cT2 := AnsiToOem( " é perfeito" ) Local cRDD := "DBFCDXADS" Local cLRDD := RddSetDefault( @cRDD ) Local nCN Local nBL Local nEL := N_MAX Local nPDL Local oInt := TMathIntegerStr():New() Private cAliasNP := GetNextAlias() Private cAliasIP := GetNextAlias() BEGIN SEQUENCE IF !( OpenDBs( @cRDD , @aDBs ) ) BREAK EndIF For nBL := 2 To nEL cM := Replicate( "9" , nBL ) nPDL := nBL ConOut( "" , "" , "De: " + cN + " a " + cM + " Temos:" , "" ) While ( ( cE := PadL( cN , nPDL , "0" ) ) < PadL( cM , nPDL , "0" ) ) nCN := Len( cN ) nPDL := Max( nCN , nPDL ) cP := oInt:__Pow( "2" , Str( nCN ) ) IF NPerfeito( oInt , @cN , @cM , @cP , @cE , @nPDL ) ConOut( cT1 + cN + cT2 ) EndIF cN := oInt:Add( cN , "2" ) End While Next nBL END SEQUENCE aEval( aDBs , { |cAlias| ( cAlias )->( dbCloseArea() ) } ) ConOut( "" , AnsiToOem( "Final de Verificação" ) ) RddSetDefault( cLRDD ) Return( NIL ) /*/ Funcao: NPerfeito Autor: Marinaldo de Jesus Data: 14/06/2011 Uso: Verificar se um numero eh um "Numero Perfeito" fonte: http://pt.wikipedia.org/wiki/N%C3%BAmero_perfeito /*/ Static Function NPerfeito( oInt , cN , cM , cP , cE , nPDL ) Local cS := cP Local cF := IF( cE < cM , cE , cM ) Local cR Local cI Local cSm Local cP1 Local lLock := .F. Local lPrimo := .F. Local lFPrimo := .F. Local lPerfeito := .F. BEGIN SEQUENCE IF ( cAliasNP )->( dbSeek( cN , .F. ) ) BREAK EndIF lFPrimo := ( cAliasIP )->( dbSeek( cN , .F. ) ) IF ( lFPrimo ) lPrimo := .T. IF ( ( cAliasIP )->IP_TTS ) lPerfeito := ( cAliasIP )->IP_PERFECT BREAK EndIF lLock := ( cAliasIP )->( rLock() ) EndIF While ( PadL( cS , nPDL , "0" ) <= PadL( cF , nPDL , "0" ) ) cI := oInt:Divide( cN , cS , @cR ) IF ( cR == "0" ) IF ( lPrimo := NPrimo( oInt , @cI ) ) Exit EndIF EndIF cS := oInt:Add( cS , "2" ) nPDL := Max( Len( cS ) , nPDL ) End While IF !( lPrimo ) ( cAliasNP )->( dbAppend( .T. ) ) ( cAliasNP )->NP_NUMERO := cN ( cAliasNP )->( dbrUnLock() ) BREAK EndIF IF !( lFPrimo ) ( cAliasIP )->( dbAppend( .T. ) ) ( cAliasIP )->IP_NUMERO := cN lLock := .T. EndIF cSm := "0" cP1 := "1" While ( PadL( cP1 , nPDL , "0" ) < cE ) IF ( oInt:Mod( cN , cP1 ) == "0" ) cSm := oInt:Add( cSm , cP1 ) EndIF cP1 := oInt:Add( cP1 , "1" ) nPDL := Max( Len( cP1 ) , nPDL ) End While lPerfeito := ( cN == cSm ) IF ( lLock ) ( cAliasIP )->IP_PERFECT := lPerfeito ( cAliasIP )->IP_TTS := .T. ( cAliasIP )->( dbrUnLock() ) EndIF End Sequence Return( lPerfeito ) /*/ Funcao: NPrimo Autor: Marinaldo de Jesus Data: 14/06/2011 Uso: Verificar se um numero eh um "Numero Primo" /*/ Static Function NPrimo( oInt , cN ) Local c2 := oInt:Divide( cN , "2" ) Local cI := "2" Local cJ Local nPDL := Len( c2 ) While ( PadL( cI , nPDL , "0" ) <= PadL( c2 , nPDL , "0" ) ) cJ := cI While ( PadL( cJ , nPDL , "0" ) <= PadL( c2 , nPDL , "0" ) ) IF ( oInt:Multiply( cI , cJ ) == cN ) Return( .F. ) EndIF cJ := oInt:Add( cJ , "1" ) nPDL := Max( Len( cJ ) , nPDL ) End While cI := oInt:Add( cI , "1" ) nPDL := Max( Len( cI ) , nPDL ) End While Return( .T. ) /*/ Funcao: OpenDBs Autor: Marinaldo de Jesus Data: 14/06/2011 Uso: Tenta abir as tabelas que serao utilizadas /*/ Static Function OpenDBs( cRDD , aDBs ) Local aDBNP Local aDBIP Local cDBNP := "np_numero.dbf" Local cIDNP := "np_numero.cdx" Local cDBIP := "ip_numero.dbf" Local cIDIP := "ip_numero.cdx" Local lOpened := .F. TRYEXCEPTION IF !File( cDBNP ) aDBNP := { { "NP_NUMERO" , "C" , N_MAX , 0 } } IF !( MsCreate( cDBNP , @aDBNP , @cRDD ) ) UserException( AnsiToOem( "Impossível Criar: " ) + cDBNP ) EndIF EndIF IF !( MsOpenDbf( .T. , @cRDD , @cDBNP , @cAliasNP , .T. , .F. , .T. , .F. ) ) UserException( AnsiToOem( "Impossível abrir: " ) + cDBNP ) EndIF IF !File( cIDNP ) ( cAliasNP )->( OrdCreate( cIDNP , "NP_NUMERO" , "NP_NUMERO" , { || NP_NUMERO } , .F. ) ) IF !File( cIDNP ) UserException( AnsiToOem( "Impossível Indexar: " ) + cIDNP ) EndIF EndIF ( cAliasNP )->( dbClearIndex() ) ( cAliasNP )->( OrdListAdd( cIDNP , "NP_NUMERO" ) ) aADD( aDBs , cAliasNP ) IF !File( cDBIP ) aDBIP := { { "IP_NUMERO" , "C" , N_MAX , 0 } , { "IP_PERFECT" , "L" , 1 , 0 } , { "IP_TTS" , "L" , 1 , 0 } } IF !( MsCreate( cDBIP , @aDBIP , @cRDD ) ) UserException( AnsiToOem( "Impossível Criar: " ) + cDBIP ) EndIF EndIF IF !( MsOpenDbf( .T. , @cRDD , @cDBIP , @cAliasIP , .T. , .F. , .T. , .F. ) ) UserException( AnsiToOem( "Impossível abrir: " ) + cDBIP ) EndIF IF !File( cIDIP ) ( cAliasIP )->( OrdCreate( cIDIP , "IP_NUMERO" , "IP_NUMERO" , { || IP_NUMERO } , .F. ) ) IF !File( cIDIP ) UserException( "Impossível Indexar: " + cIDIP ) EndIF EndIF ( cAliasIP )->( dbClearIndex() ) ( cAliasIP )->( OrdListAdd( cIDIP , "IP_NUMERO" ) ) aADD( aDBs , cAliasIP ) lOpened := .T. CATCHEXCEPTION lOpened := .F. ConOut( CaptureError() ) ENDEXCEPTION Return( lOpened )

Para baixar o código “final” da Classe TMath[I/F]Str e  dos exemplos, clique aqui.

e, para terminar, um fragmento da música de Dudu Falcão, interpretada por Danni Carlos.

...

"Eu quero ficar perto
De tudo que acho certo
Até o dia em que eu
Mudar de opinião
A minha experiência
Meu pacto com a ciência
Meu conhecimento
É minha distração...


Coisas que eu sei
Eu adivinho
Sem ninguém ter me contado
Coisas que eu sei
O meu rádio relógio
Mostra o tempo errado
Aperte o Play..." ( Coisas Que Eu Sei :: Danni Carlos ::  Composição : Dudu Falcão )

[]s

иαldσ dj