#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 )
|
Só uma observaçao:
ResponderExcluirOque será de mim sem o Naldoidão!?
Eu tinha mania de clicar no link do naldo no GTalk esperando qualquer dica nova no blog.
ResponderExcluirAgora...
Campanha #voltanaldo