Protheus :: Dividindo para Conquistar

Postado por иαldσ dj junho 25, 2011

Protheus :: Dividindo para Conquistar

Protheus :: Dividindo para conquistar, mostra que Números Perfeitos não são só perfeitos na sua essência. Eles são um perfeito exemplo.

Por causa deles criamos e exploramos as Classes para operações com números muito grandes que acabaram por suavizar a operação de "Números Perfeitos". Mas, como dito anteriormente, apesar de suavizar a operação TMath não consegue, por si só, resolver todos os Números Perfeitos em tempo satisfatório e, por isso, o exemplo para encontrar os Números Perfeitos foi reescrito.

Agora usando Threads. Dividindo para conquistar utiliza o Conceito de Múltiplas Threads do Protheus para tentar amenizar o custoso trabalho de se encontrar os Números Perfeitos.

Como tenho dito, abstrair é a melhor forma se chegar a uma solução. Números Perfeitos é a minha mais perfeita abstração. Se entender os exemplos com Números Perfeitos entenderá qualquer outro exemplo.

Eis agora, Números Perfeitos em Multi Thread. Será o suficiente?

#INCLUDE "PROTHEUS.CH"
#INCLUDE "TRYEXCEPTION.CH"

#DEFINE NP_JOB   05
#DEFINE NP_MAX   25 //9999999999999999999999999
#DEFINE NP_PATHLCK  "\semaforo\"
#DEFINE NP_FILELCK  NP_PATHLCK+"ip_numero.nlck"
#DEFINE NP_LOCKBYNAME NP_PATHLCK+"ip_waitrun.nlck"

#IFNDEF FO_EXCLUSIVE
 #DEFINE FO_EXCLUSIVE 16
#ENDIF

#IFNDEF _SET_DELETED
 #DEFINE _SET_DELETED 11
#ENDIF

/*/
 Funcao: U_MathIPNum()
 Autor: Marinaldo de Jesus
 Data: 14/06/2011
 Uso: Verificar os Numeros Perfeitos em um Determinado Intervalo
/*/
User Function MathIPNum()

 Local aJob   := {}
 Local aDBs   := {}
 
 Local cE
 
 Local cN   := "6"
 Local cM   := ""

 Local cT1   := AnsiToOem( "O Número: " )
 Local cT2   := AnsiToOem( " é perfeito" )
 
 Local cRDD   := "DBFCDXADS"
 Local cGlbV   := ""
 Local cLRDD   := RddSetDefault( @cRDD )
 Local cThreadID  := AllTrim( Str( ThreadId() ) )
 Local cEnvServer := GetEnvServer()
 
 Local lJob   := .T.
 Local lExit   := .F.

 Local nID
 Local nNR
 Local nBL
 Local nEL   := NP_MAX
 
 Local nPDL
 Local nfHdl
 
 Local oInt   := TMathIntegerStr():New()

 Private cAliasIP := GetNextAlias()

 BEGIN SEQUENCE

  ConOut( "" , "" , AnsiToOem( "Números Perfeitos: Início do Processamento..." ) )

  While !( lIsDir( NP_PATHLCK ) )
   nNR := 0
   MakeDir( NP_PATHLCK )
   IF ( ++nNR > 10 )
    ConOut( "" , "" , AnsiToOem( "Impossível Criar Diretório: " + NP_PATHLCK ) )
    BREAK
   EndIF
  End While

  IF !( OpenDBs( @cRDD , @aDBs , .T. ) )
   ConOut( "" , "" , AnsiToOem( "Impossível Iniciar Processamento. Aguardando a Finalização das Threads Pendentes" ) , AnsiToOem( "Tente Novamente... " ) )
   BREAK
  EndIF

  nNR := 0
  While !( File( NP_FILELCK ) )
   nfHdl := fCreate( NP_FILELCK )
   IF ( ++nNR > 10 )
    ConOut( "" , "" , AnsiToOem( "Impossível Criar arquivo: " + NP_FILELCK ) )
    BREAK
   EndIF
   fClose( nfHdl )
  End While 

  ConOut( "" , "" , AnsiToOem( "Números Perfeitos: Início do Cálculo " ) , "Para encerrar o Processamento, exclua o arquivo "  + NP_FILELCK )

  For nID := 1 To NP_JOB
   aAdd( aJob , Array( 5 ) )
   aJob[ nID ][ 1 ] := .F.
  Next nID

  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" ) )

    IF !File( NP_FILELCK )
     ConOut( "" , "" , AnsiToOem( "Finalização Forçada. Arquivo " + NP_FILELCK + " não encontrado" ) )
     Break
    EndIF
    
    While !( KillApp() )

     nNR  := 0
     lJob := .T.

     For nID := 1 To NP_JOB
  
      IF !( aJob[ nID ][ 1 ] )
  
             aJob[ nID ][ 1 ]  := .T.
       aJob[ nID ][ 2 ]  := !( lJob )
             aJob[ nID ][ 3 ]  := ( "__NP__" + "ThreadID__" + cThreadID + "__ID__" + AllTrim( Str( nID ) ) )
             aJob[ nID ][ 4 ]  := ""
             aJob[ nID ][ 5 ]  := .F.

       IF ( lJob )

              PutGlbValue( aJob[ nID ][ 3 ] , "" )
              
              aJob[ nID ][ 4 ] := cN

              StartJob( "U__NPJOB" , cEnvServer , .F. , aJob[ nID ][ 3 ] , @cN , @cM , @cE , @nPDL , @cRDD )

              IF ( nID < NP_JOB )
              
               cN     := oInt:Add( cN , "2" )
               nPDL    := Max( Len( cN ) , nPDL )
               
               IF ( ( cE := PadL( cN , nPDL , "0" ) ) > PadL( cM , nPDL , "0" ) )
 
                lJob   := .F.
                cN    := oInt:SubTract( cN , "2" )
                cE     := PadL( cN , nPDL , "0" )
 
               EndIF

        EndIF
 
             Else

              PutGlbValue( aJob[ nID ][ 3 ] , ".F." )

             EndIF
  
      EndIF
  
      IF !( aJob[ nID ][ 2 ] )
  
       cGlbV := GetGlbValue( aJob[ nID ][ 3 ] )
       
       IF !( cGlbV == "" )
   
        aJob[ nID ][ 2 ] := .T.
        aJob[ nID ][ 5 ] := &( cGlbV )
        cGlbV    := NIL
  
        ClearGlbValue( aJob[ nID ][ 3 ] )
  
        lExit    := ( ( ++nNR ) == NP_JOB )
  
        IF ( lExit )
         Exit
        EndIF
  
       EndIF
  
      Else
  
       lExit := ( ( ++nNR ) == NP_JOB )
  
       IF ( lExit )
        Exit
       EndIF
     
      EndIF
  
     Next nID 

     IF ( lExit )
      lExit := .F.
      Exit
     EndIF

    End While

    For nID := 1 To NP_JOB
     aJob[ nID ][ 1 ] := .F.
     IF (;
       ( aJob[ nID ][ 5 ] );
       .and.;
       ( aJob[ nID ][ 4 ] <> "" );
      ) 
      ConOut( cT1 + aJob[ nID ][ 4 ] + cT2 )
     EndIF 
    Next nID

    cN   := oInt:Add( cN , "2" )
    nPDL    := Max( Len( cN ) , nPDL )

   End While
  
  Next nBL

 END SEQUENCE

 aEval( aDBs , { |cAlias| ( cAlias )->( dbCloseArea() ) } )

 RddSetDefault( cLRDD )

 ConOut( "" , "" , AnsiToOem( "Números Perfeitos: Final do Processamento..." ) )

 ConOut( "" , "" )

Return( NIL )

/*/
 Funcao:  U__NPJOB()
 Autor:  Marinaldo de Jesus
 Data:  14/06/2011
 Uso:  Job para verificar se Determinado Numero eh Perfeito
 Sintaxe: StartJob( "U__NPJOB" , cEnvServer , .F. , cID , cN , cM , cE , nPDL , cRDD )
/*/
User Function _NPJOB( cID , cN , cM , cE , nPDL , cRDD )

 Local aDBs   := {}

 Local lPerfeito  := .F.

 Local oInt   := TMathIntegerStr():New()

 BEGIN SEQUENCE

  RddSetDefault( @cRDD )

  Private cAliasIP := GetNextAlias()

  IF !( OpenDBs( @cRDD , @aDBs , .F. ) )
   BREAK
  EndIF

  lPerfeito  := NPerfeito( @oInt , @cN , @cM , @cE , @nPDL )

 END SEQUENCE 

 PutGlbValue( cID , IF( lPerfeito , ".T." , ".F." ) )
 
 aEval( aDBs , { |cAlias| ( cAlias )->( dbCloseArea() ) } )

Return( lPerfeito )

/*/
 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 , cE , nPDL )

 Local cSm
 Local cP1

 Local lLock  := .F.
 Local lFIPNum := .F.
 Local lPerfeito := .F.

 BEGIN SEQUENCE

  lFIPNum := ( cAliasIP )->( dbSeek( cN , .F. ) )
  
  IF ( lFIPNum  )
   IF ( ( cAliasIP )->IP_TTS )
    lPerfeito := ( cAliasIP )->IP_PERFECT
    BREAK
   EndIF 
   lLock := ( cAliasIP )->( rLock() )
  EndIF

  IF !( lFIPNum )
   ( 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: OpenDBs
 Autor: Marinaldo de Jesus
 Data: 14/06/2011
 Uso: Tenta abir as tabelas que serao utilizadas
/*/
Static Function OpenDBs( cRDD , aDBs , lChkEmpty )

 Local aDBNP
 Local aDBIP

 Local cDBIP   := "ip_numero.dbf"
 Local cIDIP   := "ip_numero.cdx"
 Local cEmpty

 Local lOpened  := .F.

 Local lPack
 Local lSetDeleted
 
 Local nWait
 Local nfHdl
 
 Static nContinue

 DEFAULT lChkEmpty := .F.

 TRYEXCEPTION

  lChkEmpty := ( lChkEmpty .or. !File( cDBIP ) .or. !File( cIDIP ) )

  IF ( lChkEmpty ) 
   nWait := 0
   While ( File( NP_LOCKBYNAME ) )
    fErase( NP_LOCKBYNAME )
    IF !( File( NP_LOCKBYNAME ) )
     Exit
    EndIF
    IF ( ( ++nWait ) > 10 )
     UserException( "Impossível Obter Exclusividade para Criação para Inicio do Processamento" )
    EndIF
    Sleep( 10 )
   End While
   nWait := 0
   While !( File( NP_LOCKBYNAME ) )
    nfHdl := fCreate( NP_LOCKBYNAME )
    IF ( File( NP_LOCKBYNAME ) )
     fClose( nfHdl )
     nfHdl := fOpen( NP_LOCKBYNAME , FO_EXCLUSIVE )
     nWait := 0
     While !( fError() == 0 )
      nfHdl := fOpen( NP_LOCKBYNAME , FO_EXCLUSIVE )
      IF ( fError() == 0 )
       Exit
      EndIF
      IF ( ( ++nWait ) > 10 )
       UserException( "Impossível Obter Exclusividade para Criação para Inicio do Processamento" )
      EndIF
      Sleep( 10 )
     End While
     Exit
    EndIF
    IF ( ( ++nWait ) > 10 )
     UserException( "Impossível Obter Exclusividade para Criação para Inicio do Processamento" )
    EndIF
    Sleep( 10 )
   End While
   nWait := 0
   While ( File( NP_FILELCK ) )
    fErase( NP_FILELCK ) 
    Sleep( 10 )
    IF !( File( NP_FILELCK ) )
     Exit
    EndIF
    IF ( ( ++nWait ) > 10 )
     UserException( "Impossível Apagar arquivo " +  NP_FILELCK + " para Inicio do Processamento" )
    EndIF
   End While
  EndIF

  Sleep( 10 )

  IF !File( cDBIP )
   aDBIP := { { "IP_NUMERO" , "C" , NP_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 , !( lChkEmpty ) , .F. , .T. , .F. ) )
   UserException( AnsiToOem( "Impossível abrir: " ) + cDBIP )
  EndIF

  IF ( lChkEmpty )
   ( cAliasIP )->( dbClearIndex() )
   ( cAliasIP )->( dbCloseArea() )
   nWait := 0
   While ( File( cIDIP ) )
    fErase( cIDIP )
    IF !( File( cIDIP ) )
     Exit
    EndIF
    IF ( ( ++nWait ) > 10 )
     UserException( "Impossível Apagar arquivo " +  cIDIP + " Reidexação da Tabela" )
    EndIF
    Sleep( 10 )
   End While
   IF !( MsOpenDbf( .T. , @cRDD , @cDBIP , @cAliasIP , !( lChkEmpty ) , .F. , .T. , .F. ) )
    UserException( AnsiToOem( "Impossível abrir: " ) + cDBIP )
   EndIF
  EndIF
  
  IF !File( cIDIP )
   ( cAliasIP )->( OrdCreate( cIDIP , "IP_NUMERO" , "IP_NUMERO" , { || IP_NUMERO } , .F. ) )
   IF !File( cIDIP )
    UserException( "Impossível Indexar: " + cIDIP )
   EndIF
   ( cAliasIP )->( dbCloseArea() )
   IF !( MsOpenDbf( .T. , @cRDD , @cDBIP , @cAliasIP , !( lChkEmpty ) , .F. , .T. , .F. ) )
    UserException( AnsiToOem( "Impossível abrir: " ) + cDBIP )
   EndIF
  EndIF
  ( cAliasIP )->( dbClearIndex() )
  ( cAliasIP )->( OrdListAdd( cIDIP , "IP_NUMERO" ) )

  IF ( lChkEmpty )
   lSetDeleted := Set( _SET_DELETED , .F. )
   cEmpty  := Space( NP_MAX )
   ( cAliasIP )->( dbGotop() )
   lPack  := ( cAliasIP )->( ( IP_NUMERO == cEmpty ) .or. dbSeek( cEmpty , .F. ) )
   While ( cAliasIP )->( !Eof() .and. ( IP_NUMERO == cEmpty ) )
    ( cAliasIP )->( dbDelete() )
    ( cAliasIP )->( dbSkip() )
   End While
   IF ( lPack )
    ( cAliasIP )->( __dbPack() )
   EndIF 
   Set( _SET_DELETED , lSetDeleted )
   ( cAliasIP )->( dbCloseArea() )
   lOpened := OpenDBs( @cRDD , @aDBs , .F. )
   IF ( ValType( nfHdl ) == "N" )
    IF ( nfHdl > 0 )
     fClose( nfHdl )
    EndIF
   EndIF
   IF File( NP_LOCKBYNAME )
    fErase( NP_LOCKBYNAME )
   EndIF 
  Else
   aAdd( aDBs , cAliasIP )
   lOpened := .T.
  EndIF

 CATCHEXCEPTION 

  IF ( lChkEmpty )

   IF ( ValType( nfHdl ) == "N" )
    IF ( nfHdl > 0 )
     fClose( nfHdl )
    EndIF
   EndIF
   IF File( NP_LOCKBYNAME )
    fErase( NP_LOCKBYNAME )
   EndIF

   DEFAULT nContinue := 0

   ++nContinue

   IF ( nContinue <= 10 )
   
    Sleep( 300 )

    lOpened  := OpenDBs( @cRDD , @aDBs , @lChkEmpty )

    IF !( lOpened )

     Sleep( 300 )

    EndIF

   Else
   
    ConOut( "" , "" , CaptureError() )
   
   EndIF 

  Else

   ConOut( "" , "" , CaptureError() )
  
  EndIF


 ENDEXCEPTION NODELSTACKERROR

Return( lOpened )

Acredito que não. Números Perfeitos requer mais que isso. Então, seguiremos para o Processamento em Grid e com Multi Thread.

Quer os originais da implementação? clique aqui.

[]s
иαldσ dj

Comentários

Anônimo25 de junho de 2011 às 23:07
Cara, vc é show... e está de volta!
ResponderExcluir
Respostas
Anônimo27 de agosto de 2014 às 10:39
Na moral.
Vc é surreal, que q é isso velho.
Respeito!!
ResponderExcluir
Respostas

Adicionar comentário

Pesquisar este blog

BlackTDN

Postagem em destaque

BlackTDN :: LeetCode :: Comparando Implementações Harbour e TLPP para o Desafio Longest Palindromic Substring

Protheus :: Dividindo para Conquistar

Comentários

Postar um comentário

Postagens mais visitadas

BlackTDN :: RLeg ~ Desvendando a Função ParamBox

Protheus :: Chamando Funções do Menu Diretamente e sem a Necessidade de Login