BlackTDN Search

sexta-feira, 17 de junho de 2011

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

2 comentários:

  1. Só uma observaçao:

    Oque será de mim sem o Naldoidão!?

    ResponderExcluir
  2. Eu tinha mania de clicar no link do naldo no GTalk esperando qualquer dica nova no blog.

    Agora...

    Campanha #voltanaldo

    ResponderExcluir