x Luigi o joe chiarimenti funzione Spazioscript

[i legend]

ciao
ho dovuto utilizzare la funzione numeriripetutirilevatiV (aMioArray,aRipetuti,aQuanti)
non riesco a farle rintracciare i numeri superiori a 90
quindi o non vengono valutati alla base o sto sbagliando qualcosa.

se non lo fa provo a compilarla
grazie

 

[joe]

Ciao Ilegend.

Se non ricordo male è come scrivi.

È semplice per te riscrivere questa funzione

eliminando il limite dei 90 estratti.

 

[i legend]

Ciao Joe Immaginavo
ho provato a scrivere una funzione ma sicuramente è ottimizzabile

Ultimamente mi occupo a tempo pieno di mio padre e in piu per risolvere i miei problemucci di salute (ero diventato obeso, ora tutto rientrato) ,è da tanto che non faccio piu script e pertanto ho perso un po di smalto (se mai c'è ne stato)

se perfavore ci potete dare un occhiata
p.s : ho usato ordina matrice turbo è temo che possa rallentare il tempo di elaborazione
nella realta devo scorrere solo 11 elementi.
ecco la sub con la funzione
che spero funzioni correttamente

Option Explicit
'Lo scopo dello script è controllare il corretto funzionamento della funzione GetRipetuti
' non se ne assicura il funzionamento
' avevo anche pensato ad utilizzare do while partendo il conteggio dal fondo ma non credo possa essere piu veloce
' senza utilizzare OrdinaMatriceTurbo diventa tutto piu difficile 
Sub Main
    ReDim aV(101),aRip(UBound(aV))
    Dim i
    For i = 1 To UBound(aV)
        aV(i) = NumeroCasuale(1,100)
        If aV(i) > 90 Then Scrivi aV(i)
    Next
    ReDim aNum(0),aQ(0)
    aV(101) = MassimoV(aV) + 1
    Call NumeriRipetutiRilevatiV(aV,aNum,aQ)
    Scrivi StringaNumeri(aNum,,True)
    Scrivi StringaNumeri(aQ,,True)
    Call GetRipetuti(aV,aRip)
    Scrivi"------------------"
    Scrivi StringaNumeri(aRip,,True)
End Sub
Function GetRipetuti(aV,aRip)
    Dim N1,N2,N3,C
    Call OrdinaMatriceTurbo(aV,1)
    For N1 = 1 To UBound(aV) - 2
        N2 = N1 + 1
        If aV(N1) = aV(N2) Then
            N3 = N2 + 1

            If aV(N2) < aV(N3) Then
                C = C + 1

                aRip(C) = aV(N2)
            End If
        End If
    Next
    ReDim Preserve aRip(C)
End Function

 

[LuigiB]

Ciao Legend..qui dal cellulare non riesco a vedere bene il tuo codice e capire perche hai voluto usare l ordinamento..per lo scopo non e necessario..se sai il limite dei numeri possibili puoi creare in array e valorizzare a true il tale elemento solo se gia non e valorizzato al termine rileggi l array e prendi i numeri che identificano i elementi valorizzati. Un altra soluzione potrebbe essere l uso di una collection in cui onserisci l elemento con la chiave..dato che nella collection non possono esistere due elementi con uguale chiave al termine rileggendone il contenuto avrai solo elementi univoci..

 

[i legend]

Ciao luigi come credevo c'è molto da ottimizzare.
al volo ho preso la strada più che immediata.
avevo messo i valori in colonna dato un occhiata e compilato l algoritmo. Semplice semplice
ora provo a implementare una delle tue idee
sperando di riuscire
a dopo

 

[i legend]

Ciao Luigi ora ho provato ad elaborare l algoritmo senza utilizzare ordinamatrice

sono curioso di leggere il tuo se puoi o hai voglia di scriverlo per valutare le differenze dei tempi di elaborazione.

sarei altrettanto curioso di leggere quella di joe
non per fare raffronti ovviamente ma sempre perchè mi piace imparare dai "Meglio"

Option Explicit
'Lo scopo dello script è controllare il corretto funzionamento della funzione GetRipetuti
' non se ne assicura il funzionamento
' avevo anche pensato ad utilizzare do while partendo il conteggio dal fondo ma non credo possa essere piu veloce
' senza utilizzare OrdinaMatriceTurbo diventa tutto piu difficile 
Sub Main
    ReDim aV(101),aRip(UBound(aV))
    Dim i
    For i = 1 To UBound(aV)
        aV(i) = NumeroCasuale(1,100)
        If aV(i) > 90 Then Scrivi aV(i)
    Next
    ReDim aNum(0),aQ(0)
    aV(101) = MassimoV(aV) + 1
    Call NumeriRipetutiRilevatiV(aV,aNum,aQ)
    Scrivi StringaNumeri(aNum,,True)
    Scrivi StringaNumeri(aQ,,True)
    Call GetRipetuti(aV,aRip)
ReDim aTro (0)
Call GetRipMag90(aV,aTro)
Scrivi StringaNumeri(aTro,,True)


    Scrivi"------------------"
    Scrivi StringaNumeri(aRip,,True)
End Sub
' Algoritmo per Array Ordinato
Function GetRipetuti(aV,aRip)
    Dim N1,N2,N3,C
    Call OrdinaMatriceTurbo(aV,1)
    For N1 = 1 To UBound(aV) - 2
        N2 = N1 + 1
        If aV(N1) = aV(N2) Then
            N3 = N2 + 1

            If aV(N2) < aV(N3) Then
                C = C + 1

                aRip(C) = aV(N2)
            End If
        End If
    Next
    ReDim Preserve aRip(C)
End Function
'Algoritmo per Array NonOrdinato
Function GetRipMag90(aRip,aTro)
    Dim i,j,m,k
    For i = 1 To UBound(aRip) - 1
        m = 0
        For j = i + 1 To UBound(aRip)
            If aRip(j) > - 1 Then
                If aRip(i) = aRip(j) Then m = m + 1:aRip(j) = - 1
            End If
        Next
        If m > 0 Then
            k = k + 1
            ReDim Preserve aTro(k)
            aTro(k) = aRip(i)
        End If
    Next
End Function

spero che raccolga tutti i dati

 

[LuigiB]

ciao Legend , ecco qui l'implementazione di tutti e 3 i metodi

con ordinamatrice
con arrayflag
con collection

bada bene usare ordinamatrice va benissimo probabilmente è anche il piu veloce però introduce la complicazione dell'algoritomo per leggere l'array ordinato allla ricerca dei doppi...

Option Explicit
Class clsNumConRpetizioni
    Dim Num
    Dim nPres
    Sub IncrementaPres
        nPres = nPres + 1
    End Sub
End Class
Sub Main
    Dim aV,aRetN,aRetQ
    Dim k

    ReDim aV(10)
    For k = 1 To UBound(aV)
        aV(k) = NumeroCasuale(91,100)
    Next

    Call EliminaRipetutiConOrdinaMatrice(aV,aRetN,aRetQ)
    Call GestioneOutput(aV,aRetN,aRetQ,"EliminaRipetutiConOrdinaMatrice")


    Call EliminaRipetutiConArrayFlag(aV,aRetN,aRetQ)
    Call GestioneOutput(aV,aRetN,aRetQ,"EliminaRipetutiConArrayFlag")

    Call EliminaRipetutiConCollection(aV,aRetN,aRetQ)
    Call GestioneOutput(aV,aRetN,aRetQ,"EliminaRipetutiConCollection")


End Sub
Sub EliminaRipetutiConOrdinaMatrice(aV,aRetN,aRetQ)
    Dim k,i,nUpper
    nUpper = UBound(aV)
    ReDim aRetN(nUpper)
    ReDim aRetQ(nUpper)
    Call OrdinaMatriceTurbo(aV,1)
    i = 0
    For k = 1 To UBound(aV)
        i = i + 1
        aRetN(i) = aV(k)
        Do While aV(k + aRetQ(i)) = aRetN(i)
            aRetQ(i) = aRetQ(i) + 1
            If k + aRetQ(i) > nUpper Then Exit Do
        Loop
        k = k +(aRetQ(i) - 1)

    Next
    ReDim Preserve aRetN(i)
    ReDim Preserve aRetQ(i)


End Sub

Sub EliminaRipetutiConArrayFlag(aV,aRetN,aRetQ)

    Dim k,i,nUpper

    nUpper = MassimoV(aV)
    ReDim aRetN(nUpper)
    ReDim aRetQtmp(nUpper)
    ReDim aRetQ(nUpper)

    ReDim aFlag(nUpper)

    For k = 1 To UBound(aV)
        If Not aFlag(aV(k)) Then
            i = i + 1
            aRetN(i) = aV(k)
            aFlag(aV(k)) = True
            aRetQtmp(aV(k)) = aRetQtmp(aV(k)) + 1

        Else
            aRetQtmp(aV(k)) = aRetQtmp(aV(k)) + 1

        End If
    Next
    ReDim Preserve aRetN(i)
    ReDim Preserve aRetQ(i)

    For k = 1 To UBound(aRetN)
        aRetQ(k) = aRetQtmp(aRetN(k))
    Next

End Sub

Sub EliminaRipetutiConCollection(aV,aRetN,aRetQ)

    Dim k,i,nUpper,sKey
    Dim coll,cNum
    Set coll = GetNewCollection





    For k = 1 To UBound(aV)

        sKey = "k" & aV(k)
        If GetItemCollection(coll,sKey,cNum) Then
            cNum.IncrementaPres
        Else
            Set cNum = New clsNumConRpetizioni
            cNum.Num = aV(k)
            cNum.nPres = 1
            coll.Add cNum,sKey
        End If


    Next

    nUpper = coll.count
    ReDim aRetN(nUpper)
    ReDim aRetQ(nUpper)

    For k = 1 To coll.count
        Set cNum = coll(k)
        aRetN(k) = cNum.Num
        aRetQ(k) = cNum.nPres

    Next

End Sub


Sub GestioneOutput(aInput,aNumUnivoci,aQuantRip,sFunzione)

    Dim k
    Dim aV

    Call Scrivi(sFunzione)
    Call Scrivi(StringaNumeri(aInput))
    aV = Array("","Numero","Ripetizioni")
    Call InitTabella(aV)
    For k = 1 To UBound(aNumUnivoci)
        aV(1) = aNumUnivoci(k)
        aV(2) = aQuantRip(k)
        Call AddRigaTabella(aV)

    Next
    Call CreaTabella(1 ,1)
End Sub

 

[i legend]

Ciao luigi grazie mille
studiero il codice con attenzione
mi chiedo come mai funzionano anche le.mie.
grazie ancora

 

[i legend]

La classe non è acqua
sei un grande

 

[LuigiB]

Troppo buono....ciao....

 

[joe]

Ringrazio anch'io per la "Stele di Luigi"

che permette un rapido confronto tra i 3 modelli-stili di programmazione.

 

[LuigiB]

Come la famosa stele di rosetta che permise la comprensione dei grroglifici....grazie Joe