Newsgroup: it.comp.lang.visual-basic
Titolo: algoritmo anagramma

come trovo tutte le possibili combinazioni dei caratteri di una stringa ?
grazie, a.

Andrea:
  prova a vedere il progetto CalcComb a:
 
http://www.flanguasco.org
C' e' una routine per gli anagrammi (incluso il
sorgente C da cui l' ho tradotta).
Ciao, scusa se non posso darti altri dettagli ma
sono in vacanza e non ho il mio PC a portata di mano :-)))
Franco


 come trovo tutte le possibili combinazioni dei caratteri di una stringa ?
CalcComp di Franco Languasco. Se poi ti serve di sapere se
sono parole di senZo comBiuto, mi sa che ti tocca fare una
ricerca in un dizionario. File dizionari in italiano si dovrebbero
trovare (quelli per i cracker di password, per esempio :-) ),
credo.
Magari ci sarebbe qualche problema per le coniugazioni
dei verbi eccetera.
Bye, G.

 dei verbi eccetera.
no prob. per la correzione li sottopongo al ng :P
ciao, a.

 no prob. per la correzione li sottopongo al ng :P
Fobbe (o saresse ?) la rovina.
Un Paperino che si, stavolta c'è lo mettuto l'ottì.

 Fobbe (o saresse ?) la rovina.
Voi avete grossi problemi! ;)
Kalor
--
Sito Comune: 
http://www.it-lang-vb.net/
Manifesto: 
http://www.it-lang-vb.net/docs/Manifesto.txt

 come trovo tutte le possibili combinazioni dei caratteri di una stringa ?
    Se vai su:
 
http://www.microsoft.com/data/
praticamente tutto il sito fa quello che chiedi ma ancora non funziona bene
(la solita M$!). L'ho provato con le lettere  A, B, C e come risultato ho
ottenuto:
    ADO
    DAO
    RDO
    JET
    ...
    Se poi hai voglia di verificare se funziona, quello che segue e' un
abbozzo per l'estrazione di un anagramma a caso. Sicuramente sbaglio ma non
mi sembra di aver visto in giro questa possibilita'. Ovviamente non va bene
per la ricerca di tutti gli anagrammi perche' credo sia lento e perche' non
considera le lettere ripetute.
' ------------------------------------------------------------
  Option Explicit
' ------------------------------------------------------------
' ------------------------------------------------------------
  Public Const gc_sMsgErrTitle = "ERRORE#"
' ------------------------------------------------------------
' ************************************************************
  Private Sub Main()
' ------------------------------------------------------------
  On Error GoTo errh
' ------------------------------------------------------------
  Dim sInput  As String
  Dim lIndex  As Long
  Dim lFatt   As Long
  Dim sText   As String
  sInput _
    = InputBox( _
          "Immetti il testo di cui vuoi l'anagramma:" _
        , "Anagrammi")
  If Len(sInput) = 0 Then
  Else
    lFatt = 1
    For lIndex = 2 To Len(sInput)
      lFatt = lFatt * lIndex
    Next
    ' 1. Ricava un anagramma a caso di sInput:
    '
    Randomize
    lIndex = Int(lFatt * Rnd)
    sText = RicavaAnagramma(sInput, lIndex)
    Debug.Print "*** Uno a caso ****"
    Debug.Print lIndex, sText
    ' 2. Ricava sInput al contrario:
    '
    lIndex = lFatt - 1
    sText = RicavaAnagramma(sInput, lIndex)
    Debug.Print "*** Contrario ****"
    Debug.Print lIndex, sText
    ' 3. Ricava tutti gli anagrammi di sInput:
    '
    Debug.Print "*** Tutti ****"
    For lIndex = 0 To lFatt - 1
      sText = RicavaAnagramma(sInput, lIndex)
      Debug.Print lIndex, sText
    Next
  End If
ext:
  Exit Sub
errh:
  With Err
    MsgBox .Description, vbCritical, gc_sMsgErrTitle & .Number
  End With
  Resume ext
  End Sub
' ************************************************************
' ************************************************************
  Private Function RicavaAnagramma( _
    ByVal Text As String _
  , ByVal Index As Long _
  ) As String
' ------------------------------------------------------------
  On Error GoTo errh
' ------------------------------------------------------------
  Dim lLength As Long
  Dim lFatt() As Long
  Dim lIndex  As Long
  Dim sTemp   As String
  Dim lPos    As Long
' ------------------------------------------------------------
  lLength = Len(Text)
  ReDim lFatt(1 To lLength)
  lFatt(1) = 1
  For lIndex = 2 To lLength
    lFatt(lIndex) = lFatt(lIndex - 1) * (lIndex - 1)
  Next
  sTemp = Text
  For lIndex = lLength To 1 Step -1
    lPos = (Int(Index / lFatt(lIndex)) Mod lIndex) + 1
    RicavaAnagramma = RicavaAnagramma & Mid$(sTemp, lPos, 1)
    sTemp _
      = Mid$(sTemp, 1, lPos - 1) _
      & Mid$(sTemp, lPos + 1, lLength - lPos)
  Next
ext:
  Exit Function
errh:
  RicavaAnagramma = ""
  With Err
    MsgBox .Description, vbCritical, gc_sMsgErrTitle & .Number
  End With
  Resume ext
  End Function
' ************************************************************
--
Ciao.
Maurizio
--------
?SPQR(C)
 X
--------