Newsgroup: it.comp.appl.access
Titolo: Qui bisogna che qualcuno m' aiuta, ci sto diventando matto : permutazioni

Eqque qua :
(siamo in Excel)
Private Sub CommandButton1_Click()
    Dim C As String
    Dim E As String
    C = Application.ActiveWorkbook.ActiveSheet.Cells(1, 1)
    C = Permuta(C, 1)
End Sub
Public Function Permuta(ByVal C As String, ByRef r As Long) As String
   Dim D As String
   Dim S As String
   If Len(C) = 1 Then
      Permuta = C
      Application.ActiveWorkbook.ActiveSheet.Cells(r, 2) = _
      Application.ActiveWorkbook.ActiveSheet.Cells(r, 2) & C
   Else
      'r = r + 1
      For j = 1 To Len(C)
          'r = r + 1
          S = Mid(C, j, 1): D = Replace(C, S, "")
          Application.ActiveWorkbook.ActiveSheet.Cells(r, 2) = _
          Application.ActiveWorkbook.ActiveSheet.Cells(r, 2) & S &
Permuta(D, r)
          r = r + 1
      Next j
   End If
End Function
Lui le permutazioni le calcola, ma mi incasino
con l' indice r.
Cioe' mi sbaglio nella stampa praticamente.
Mannaggia !

on 17-10-10, radicale 001 supposed :

Il codice sopra indicato proprio non le calcola bene.
Calcola 6 permutazioni in classe 3 assieme ad altri elementi che nulla 
c'entrano. E fin qui nulla di irrimediabile.
Quando deve determinare P4 perï¿œ son dolori; determina una serie di 
numeri fra i quali 3 sole permutazioni esatte.
Sempre che non abbia le traveggole io...
Se vuoi risolvere il problema manu propria io non so aiutarti: con le 
permutazioni ci ho perso il sonno tante volte senza cavare un ragno da 
un buco.
Se ti interessa invece un semplice procedimento ricorsivo che ho 
aggiustato (ma non ï¿œ farina del mio sacco), fammi un fischio.
Bruno

 aggiustato (ma non è farina del mio sacco), fammi un fischio.
Grande !
Sei sempre un grosso Campani' !
Pero' guarda quine (ci sto a un passo ! Un millimetro) :
Ha un difetto. Una scemenza, ma la devo aggiustare.
(,.. Non so ancora come pero', mi verra' ...).
E' un difetto di REPORTING, cioe' non riesce a riportare
bene i dati in output, ma le permutazione se le BEVE
TUTTE e ad una velocita' incredibile.
Si basa sul fatto che ho scoperto con grande STUPORE
che :
permutazioni(abc) =
          a + permutazioni(bc) =
                 b + permutazioni(c) = ba
                 c + permutazioni(b) = cb
          b + permutazioni(ac) =
                 a + permutazioni(c) = ac
                 c + permutazioni(a) = ca
          c + permutazioni(ab) =
                 a + permutazioni(b) = ab
                 b + permutazioni(a) = ba
Approfondite l' albero e lo avrete in generale
per stringhe abcbd ... n comunque lunghe
Cioe' ho scoperto una FANTASTICA E IMPENSABILE
(per me, s' intende) formula ricorsiva che domina le
permutazioni.
-------------------------------------------------------------------
' vettore dove vanno messe le permutazioni
dimensiona vettore_risultati ( )
r = 1, C = "ROM"
Permuta( C , r )
1 Public Sub Permuta(ByVal C As String, ByRef r As Long)
2 Dim D As String
3 Dim S As String
4 Dim j As Long
5 If Len(C) = 1 Then
6 vettore_risultati (r) = vettore_risultati (r) & C
7 r = r + 1
8 Else
9 For j = 1 To Len(C)
' toglie il carettere di posto j dalla stringa
' e passa la stringa ridotta alla procedura
' dopo aver registrato la S
10 S = Mid(C, j, 1)
11 D = Replace(C, S, "")
12 vettore_risultati (r) = vettore_risultati (r) & S
13 Permuta D, r
14 Next j
15 End If
16 End Sub
Avete capito che fa ? Facile no ? Breve e velocisimo
16 lineette de codice.
Solo che quando torna e skippa di 1 la riga del vettore
(istruzione 7) per metterci la perm. successiva si perde il
carattere iniziale.
Ecco che esce infatti :
ROM
MO
ORM
MR
MRO
OR
Capito dove schioda ? ;-)
Riflettetci un attimo, ne vale la pena :
se aggiustato st' algoritmo e' una vera BOMBA, lassate
perde. Un sassolino compatto !

 che :
[...]
Ho inserito nelle (Declarations) di un modulo:
         Dim r As Long
         Dim VR() As String
poi ho eseguito come segue il tuo codice:
==========================================
Public Sub Permuta_Init()
Dim C As String, nPerm As Integer
Dim i As Integer, T As Double
T = Timer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
C = "123456"
nPerm = 1
For i = 1 To Len(C)
    nPerm = nPerm * i
Next
ReDim VR(1 To nPerm)
r = 1
Call Permuta(C, r)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox Timer - T
End Sub
=============================================
=============================================
Public Sub Permuta(ByVal C As String, ByRef r As Long)
Dim D As String, S As String, j As Long
Dim TargetRange As Range, i As Integer
Set TargetRange = [Sheet3!E1]
If Len(C) = 1 Then
    VR(r) = VR(r) & C
    r = r + 1
Else
    For j = 1 To Len(C)
    'toglie il carettere di posto j dalla stringa
    'e passa la stringa ridotta alla procedura
    'dopo aver registrato la S
        S = Mid(C, j, 1)
        D = Replace(C, S, "")
        VR(r) = VR(r) & S
        Permuta D, r
    Next j
End If
Columns(TargetRange.Column).ClearContents
For i = 1 To UBound(VR)
    TargetRange(i) = VR(i)
Next
End Sub
=====================================================
Non vorrei raggelare troppo i tuoi entusiasmi, perï¿œ...
Ho eseguito permutazioni di 123, 1234, 12345, 123456; il tempo per 
l'esecuzione della classe 6 ï¿œ stato di oltre 18 secondi: 
un'esagerazione (la procedura ricorsiva di cui ti dicevo impiega 4/100 
di secondo).
Poi per le varie classi stampa 3, 4, 5, 6 raggruppamenti che sono 
permutazioni. Altri raggruppamenti non sono permutazioni; il numero 
complessivo torna comunque con 6, 24, 120, 720.
Direi che sei un po' fuori strada anche se il concetto ï¿œ giusto:
P2 = 12  21
P3 = 312  + 2 Shift-Right (232, 123)
     321  + 2 Shift-Right (231, 213)
P4 = 4312, 4232, 4123 + 3 Shift-Right per ciascuno
     4321, 4231, 4213 + 3 Shift-Right per ciascuno
A parte che la ricorsivitï¿œ non mi piace, io ci sono riuscito solo cosï¿œ;
partendo da P3 ho scritto perï¿œ una pagina buona di codice e il tempo 
rispetto alla ricorsiva ï¿œ piï¿œ che doppio (8|9 centesimi per P6, 36/100 
contro 8/100 per P9).
Il tutto perï¿œ sta TUTTO dentro un'unica Sub.
Bruno

 Bruno
Ragazzuoli, scusasse l'intromissione, ma sto fattariello di cui state
parlando mi sta piacendo, pur non capendo una mazza dell'argomento
(sisi... pur avendo esperienza a gogò, nun lo sò e mai l'ho
trattato)... di che si tratta e a cosa serve nello specifico?...

 trattato)... di che si tratta e a cosa serve nello specifico?...
Generare permutazioni... la via piï¿œ breve e il procedimento piï¿œ veloce.
Ricorsivitï¿œ vs non-ricorsivitï¿œ, etc.
Bruno

 Bruno
Si, permutazioni, questo mi era chiaro... è che non ne comprendo il
campo di applicazione... fammi un esempio (roba banalissima, giusto
per capire).

 per capire).
Come per il 90% della matematica il campo di applicazione ï¿œ quasi 
esclusivamente teorico.
Se vai nel pratico i matemateci dicono che non ï¿œ piï¿œ matematica... ï¿œ 
calcolo!
Valli a capire.
Bruno
PS
In quanti modi cinque giocatori possono disporsi attorno ad un tavolo?
5! = 120
Non considerando la semplice rotazione (cioï¿œ 12345 = 51234 = 45123 = 
34512 = 23451, etc.)
(5-1)! = 24
Utilissimo no? cosï¿œ se uno lo sa e si mette al tavolo del poker ï¿œ 
sicuro di vincere...


Non per banalizzare (probabilmente, molto probabilmente non ho
compreso la cosa), ma ad occhio e croce, non bastano un paio di righe
di codice di questo tipo?
  Dim a, b, str
  For a = 1 To Len(Mio_Testo)
    str = str & Mid$(Mio_Testo, a, 1)
    For b = Len(Mio_Testo) To 1 Step -1
      If a <> b Then
        str = str & Mid$(Mio_Testo, b, 1)
      End If
    Next b
    Msgbox str
    str = ""
  Next a

   Next a
Direi proprio di no.
Con Mio_Testo = "123", "1234", "12345", "123456"
la tua Sub restituisce rispettivamente 3, 4, 5, 6 permutazioni, in 
luogo di 6, 24, 120, 720.
Bruno

 Bruno
Chiaro chiaro...
Function SuperEnalotto(Num As Variant) As Variant
  If Num < 0 Then SuperEnalotto = 0
  If Num = 1 Or Num = 0 Then
    SuperEnalotto = 1
  Else
    SuperEnalotto = Num * SuperEnalottoNum - 1)
  End If
End Function
che cosa utile... :D