Newsgroup: it.comp.lang.visual-basic
Titolo: [?] - Popolazione dinamica di un vettore ed ordinamento dello stesso.

Ciao a tutti,
    ho un vettore del tipo
    type MiaStruttura
        valore1 as tipo1
        valore2 as tipo2
        valore3 as tipo3
        frequenzavalori as long
    end type
    dim MioVettore() as MiaStruttura
    in MioVettore() devo caricare una serie di dati incrementando di 1
frequenzavalori ogni volta che trovo valore1, valore2, valore3 (nell'ordine)
già presenti. Se non è presente questa sequenza di valori aggiungo la
sequenza aumentando dinamicamente la dimensione del vettore stesso (non
conosco a priori la dimensione massima del vettore, può essere 1 come può
essere 10000).
    Successivamente devo ordinare tali dati e metterli a video senza dover
lasciare il PC acceso tutta la notte ;-)
    Per la parte a video, ho risolto con l'aiuto di Zanna in qualche post
precedente a questo.
    Per il resto il codice che ho stilato è il seguente, ma è abbastanza
lento si può fare qualcosa per velocizzarlo un poco ?
    Le condizioni + o - normali di funzionamento prevedono che la variabile
    QuantiSiamo è circa 3000 considerando soli 50 casi elaborati. Io lo
dovrei far lavorare con almeno 500 casi e quindi QuantiSiamo sale a 30000
    Help Me.
        Grazie per ogni risposta,
            Ciao, Rocco
'*************************
'dichiarazione del tipo di dati
'*************************
Private Type Terna
    FREQ As Long
    N1 As Integer
    N2 As Integer
    N3 As Integer
End Type
'*************************
'Procedura Principale
'*************************
Public Sub Inizializza()
Dim DB As ADODB.Connection
Dim RS As Variant
Dim Numeri() As Terna
Dim i As Long
Dim j As Long
Dim Ordina As Long
Dim IMAX As Long
Dim Trovato As Long
Dim QuantiSiamo As Long
Dim Posizione as Long
    ReDim Numeri(0)
    IMAX = 0
    Set DB = CreateObject("ADODB.Connection"): DB.Open "dblotto"
    SSQL = "select count(id) as Elementi from resoconto"
    Set RS = DB.Execute(SSQL)
    QuantiSiamo = RS("Elementi")
    SSQL = "Select * From resoconto"
    Set RS = DB.Execute(SSQL)
    Do While Not RS.EOF
        DoEvents
        Posizione =  Trova(rs("valore1"),rs("valore2"),rs("valore3"),
Numeri(), IMAX)
            If Posizione = -1 Then
                IMAX = IMAX + 1
                ReDim Preserve Numeri(IMAX)
                Numeri(IMAX).FREQ = 0
                Numeri(IMAX).N1 = rs("valore1")
                Numeri(IMAX).N2 = rs("valore2")
                Numeri(IMAX).N3 = rs("valore3")
                Numeri(IMAX).FREQ = 1
            Else
                Numeri(Posizione).FREQ = Numeri(Posizione).FREQ + 1
            End If
        RS.MoveNext
    Loop
    DB.Close
    Call OrdinaVettore(Numeri(), IMAX)
    'Inizio Grazie Zanna
    For i = 1 To IMAX
        DoEvents
        RTB.SelStart = Len(RTB.Text)
        RTB.SelText = Numeri(i).N1 & " " & Numeri(i).N2 & " " & Numeri(i).N3
& " | " & Numeri(i).FREQ & vbCrLf
    Next i
    'Fine Grazie Zanna        ;-))
    ReDim Numeri(0)
End Sub
'*************************
'Funzione Trova
'*************************
Private Function Trova(V1 as integer, V2 as integer, V3 as integer,
Vettore() As Terna, MaxI As Long) As Long
Dim kk As Long
Dim Trovato as long
    Trovato = -1
    For kk = 1 To MaxI
            DoEvents
            If (Vettore(kk).N1 = V1) and (Vettore(kk).N2 = V2) and
(Vettore(kk).N3 = V3) Then
                       Trovato = kk
                       Exit For
            End If
    Next kk
End Sub
'*************************
'Procedura OrdinaVettore
'*************************
Private Sub OrdinaVettore(Vettore() As Terna, Limite As Long)
Dim i As Long
Dim j As Long
Dim App As Terna
    For i = 1 To Limite - 1
        For j = i + 1 To Limite
            DoEvents
            If (Vettore(j).FREQ > Vettore(i).FREQ) Then
                App.FREQ = Vettore(i).FREQ
                App.N1 = Vettore(i).N1
                App.N2 = Vettore(i).N2
                App.N3 = Vettore(i).N3
                Vettore(i).FREQ = Vettore(j).FREQ
                Vettore(i).N1 = Vettore(j).N1
                Vettore(i).N2 = Vettore(j).N2
                Vettore(i).N3 = Vettore(j).N3
                Vettore(j).FREQ = App.FREQ
                Vettore(j).N1 = App.N1
                Vettore(j).N2 = App.N2
                Vettore(j).N3 = App.N3
            End If
        Next j
    Next i
End Sub

 lasciare il PC acceso tutta la notte ;-)
[SNIP]
Non entro nel merito della prima parte, ma per quanto riguarda la routine
"OrdinaVettore" considera che:
- Le variabili dichiarate con un tipo strutturato possono essere copiate tra
di loro con una semplice assegnazione, senza dover copiare i membri uno a
uno; il blocco di istruzioni dopo "If (Vettore(j).FREQ > Vettore(i).FREQ)
Then" puo' essere semplificato quindi in
App =  Vettore(i)
Vettore(i) = Vettore(j)
Vettore(j) = App
- la tua funzione di ordinamento ricalca il caro vecchio BubbleSort, che non
e' il massimo della vita in quanto a prestazioni, specie con gli ordini di
grandezza che ti riproponi... sul Sito Comune trovi parecchi esempi di
algoritmi differenti che puoi sperimentare; e' sufficiente sostituire il
vettore in ingresso con il tipo di dato giusto (la tua struttura) e cambiare
la IF di confronto
Ciao
--
Luca Dormio - 
luca....@tin.it
________________________________
"Marty, non stai ragionando in maniera quadridimensionale"
Dr. Emmett L. Brown

 Ciao
    Vado subito a controllare ......
        Grazie 1000 per l'informazione ;-)
Ciao, Rocco

 la IF di confronto
[CUT]
    Ho imparato una cosa importante oggi. Andavo avanti con il Bubble Sort
poiché era l'unico imparato (fino ad ora) e non mi ero mai posto il problema
di una funzione di ordinamento diversa.
    Comunque ho stravolto le cose eliminando tutta una serie di funzioni e
trasformando i vettori in un database SQL. 2 query fanno quello che
dovrebbero fare 2 funzioni. I risultati li metto in 2 database separati.
    Considerando che nelle ultime ore ho stravolto un poco il mio modo di
vedere la programmazione, hai qualche suggerimento sull'utilizzo di database
?
    Io per aprire una connessione e lanciare una query utilizzo questo
codice
    Dim DB As ADODB.Connection
    Dim RS As Variant   'L' ADODB.Recordset sembra essere più lento in
apertura. Impressione solo mia o è così ?
    Set DB = CreateObject("ADODB.Connection")
    DB.Open "NomeConnessione"
    SSQL = "query da eseguire"
    Set RS = DB.Execute(SSQL)
    ' //
    Set RS = Nothing: RS.close
    Set DB = Nothing: DB.close
    E' buono o posso velocizzare con qualche accorgimento ?
        Grazie per ogni eventuale risposta.
Ciao, Rocco