Mescolamento e ordinamento di un ArrayList per ordinare con disposizione casuale dei valori pari

L'ordine dovrebbe essere:

• mescola l'array di partenza
• ordina l'array di partenza

così facendo, quelli che hanno pari preferenza vengono messi in ordine casuale.
Creo una funzione per stampare sulla finestra immediata gli array.

    Sub mostra(ByVal arr As ArrayList)
        For n = 0 To arr.Count - 1
            Debug.Print(arr(n).nome & " " & arr(n).turni)
        Next
        Debug.WriteLine("")
    End Sub

Ecco, quindi adesso provo con le mie due procedure di rimescolamento e ordinamento.

         'Rimescolamento casuale della matrice di partenza
        Dim r As New Random
        Dim x As Integer
        Dim temp As persona
        For n = 0 To matrice.Count - 1
            x = r.Next(matrice.Count - n) + n
            temp = matrice(n)
            matrice(n) = matrice(x)
            matrice(x) = temp
        Next


        'ordinamento della matrice
        matrice.Sort()

        mostra(matrice)

Avendo tutti e tre gli elementi la stessa preferenza, di 50, il risultato dovrebbe essere assolutamente casuale.

Mario 0
Giuseppe 0
Luigi 0

Luigi 0
Mario 0
Giuseppe 0

Giuseppe 0
Luigi 0
Mario 0

Giuseppe 0
Mario 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Luigi 0
Giuseppe 0

Giuseppe 0
Mario 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Luigi 0
Mario 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Giuseppe 0
Mario 0
Luigi 0

Giuseppe 0
Mario 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Giuseppe 0
Luigi 0
Mario 0

Luigi 0
Mario 0
Giuseppe 0

Mario 0
Giuseppe 0
Luigi 0

Giuseppe 0
Mario 0
Luigi 0

Giuseppe 0
Mario 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Giuseppe 0
Luigi 0
Mario 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Luigi 0
Giuseppe 0

Luigi 0
Giuseppe 0
Mario 0

credo che non ci sia nessuna sequenza preferenziale...

Adesso impostiamo una differenza di preferenze, dando a Mario una preferenza di 20. Come risultato, la disposizione casuale dovrebbe applicarsi solo a Giuseppe e Luigi, mentre Mario dovrebbe venire sempre per primo...

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Mario 0
Giuseppe 0
Luigi 0

Sembra funzionare...

Adesso diamo anche a Luigi una preferenza di 20, prevedendo che debba risultare un ordinamento casuale di Mario e Luigi, con Giuseppe sempre per ultimo...

Mario 0
Luigi 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Luigi 0
Mario 0
Giuseppe 0

Mario 0
Luigi 0
Giuseppe 0

Sì... fin qui sembra che ci siamo...

Riepilogo in preparazione di un algoritmo di distribuzione casuale dei turni restanti.

Ho trovato un algoritmo per la distribuzione casuale di un ArrayList.
Ne ho capito e imparato il concetto.

L'idea è di usare un array su cui lavorare, in cui immettere gli elementi.

Ho un array chiamato matrice.

        mario.nome = "Mario"
        giuseppe.nome = "Giuseppe"
        luigi.nome = "Luigi"
        mario.preferenza = 80
        giuseppe.preferenza = 80
        luigi.preferenza = 20

        matrice = New ArrayList
        matrice.Add(mario)
        matrice.Add(giuseppe)
        matrice.Add(luigi)

Ora mi immetto gli elementi su un array che chiamo matrice2, e verifico:

matrice2 = New ArrayList
        For n = 0 To matrice.Count - 1
            matrice2.Add(matrice(n))
        Next

        For n = 0 To matrice2.Count - 1
            Debug.Print(matrice2(n).nome)
        Next

Mario
Giuseppe
Luigi

Bene.
Adesso faccio le operazioni su questa matrice:

Conto il totale delle singole preferenze, memorizzandolo nella variabile totale

        For n = 0 To matrice2.Count - 1
            totale += matrice2(n).preferenza
        Next

Eseguo il calcolo che attribuisce i turni a seconda della preferenza:

        For n = 0 To matrice2.Count - 1
            matrice2(n).turni = Math.Floor(numTurni / totale * matrice2(n).preferenza)
        Next

e verifico, nella matrice iniziale matrice l'attribuzione dei turni, contando il totale dei turni attribuiti;
Quindi stampo i turni attribuiti e il resto da attribuire:

        For n = 0 To matrice.Count - 1
            Debug.Print(matrice(n).nome & " " & matrice(n).turni)
            attribuiti += matrice(n).turni
        Next

        resto = numTurni - attribuiti

        Debug.Print("attribuiti " & attribuiti)
        Debug.Print("resto " & resto)

Ecco:

Mario 44
Giuseppe 44
Luigi 11
attribuiti 99
resto 1

---

Fin qua nessuna novità: ora, però, provo a cancellare matrice2. Ecco tutto il codice con il codice che cancella la matrice2 in rosso. Quella matrice mi serve solo per lavorarci.

mario.nome = "Mario"
        giuseppe.nome = "Giuseppe"
        luigi.nome = "Luigi"
        mario.preferenza = 80
        giuseppe.preferenza = 80
        luigi.preferenza = 20

        matrice = New ArrayList
        matrice.Add(mario)
        matrice.Add(giuseppe)
        matrice.Add(luigi)


        matrice2 = New ArrayList
        For n = 0 To matrice.Count - 1
            matrice2.Add(matrice(n))
        Next

        For n = 0 To matrice2.Count - 1
            totale += matrice2(n).preferenza
        Next

        For n = 0 To matrice2.Count - 1

            matrice2(n).turni = Math.Floor(numTurni / totale * matrice2(n).preferenza)
        Next
        matrice2.Clear()
        For n = 0 To matrice.Count - 1
            Debug.Print(matrice(n).nome & " " & matrice(n).turni)
            attribuiti += matrice(n).turni
        Next

        resto = numTurni - attribuiti

        Debug.Print("attribuiti " & attribuiti)
        Debug.Print("resto " & resto)

---

Ora posso scegliere se distribuire i turni restanti solo a quelli che hanno il massimo delle preferenze o se escludere quelli che vogliono il minimo.
Questa soluzione mi sembra la più giusta.
Dunque devo costruire una funzione che elimini quelli che vogliono il minimo, progressivamente.

Una distribuzione migliore

Con quel codice che ho fatto ultimamente, però, l'ultimo turno viene sempre ridistribuito a quello che ha espresso la più alta preferenza che si trova per ultimo.
Se ad esprimere la preferenza più alta sono più di uno, il progressivo restringersi dell'array dal basso elimina persone che hanno la stessa preferenza dell'ultimo.

Luigi 50 33
Giuseppe 50 33
Mario 50 33
resto 1
-----
Luigi 50 33
Giuseppe 50 33
Mario 50 33
resto 1
-----
Luigi 50 33
Giuseppe 50 33
Mario 50 34
resto 0
-----

Questo non va bene.

Dovrei assicurare la casualità, e quindi trovare un altro algoritmo...

Si potrebbe procedere in modo da:

• Isolare quelli che esprimono il grado più alto di preferenza
• Porli in un altro array
• Rimescolarli in modo casuale
• Procedere con l'attribuzione per riduzione progressiva dell'array come fatto prima.

---

Intanto, verifichiamo se le operazioni svolte su un altro array si ripercuotono sugli oggetti elencati nel primo array. Sono convinto che debba essere necessariamente così...
Però verifichiamo.
Dispongo gli oggetti su un array:

        mario.nome = "Mario"
        giuseppe.nome = "Giuseppe"
        luigi.nome = "Luigi"
        mario.preferenza = 50
        giuseppe.preferenza = 50
        luigi.preferenza = 50

        matrice = New ArrayList
        matrice.Add(mario)
        matrice.Add(giuseppe)
        matrice.Add(luigi)

Ora preparo un altro ArrayList e vi trasferisco alcuni elementi. Verifico prima il valore sulla finestra immediata.

        Debug.Print(matrice(0).preferenza)
        Dim matrice2 As New ArrayList
        matrice2.Add(matrice(0))

Ora modifico un valore dell'elemento e verifico se anche l'elemento del primo ArrayList si è modificato.

        matrice2(0).preferenza = 1234

        Debug.Print(matrice(0).preferenza)

50
1234

Ecco, come volevasi dimostrare. Era ovvio, del resto!

---

---

E dunque, determiniamo il massimo valore presente in matrice.

        mario.preferenza = 50
        giuseppe.preferenza = 50
        luigi.preferenza = 50

.......

        Dim base As Integer = 0
        For Each elemento In matrice
            If elemento.preferenza > base Then base = elemento.preferenza
        Next

        Debug.Print(base)

50

Vario un po' i valori...

        mario.preferenza = 20
        giuseppe.preferenza = 80
        luigi.preferenza = 50

........

        Dim base As Integer = 0
        For Each elemento In matrice
            If elemento.preferenza > base Then base = elemento.preferenza
        Next

80

Sì, sì, funziona...

Avevo già elaborato una funzioncina che svolgeva questo compitino, l'ho messa in un modulo:

Module funzioni
    Public Function Max(ByVal m As ArrayList) As Integer
        Dim base As Integer = 0
        For Each elemento In m
            If elemento > base Then base = elemento
        Next
        Return base
    End Function
End Module

Vediamo se funziona in questo contesto...

        mario.preferenza = 20
        giuseppe.preferenza = 80
        luigi.preferenza = 50

        matrice = New ArrayList
        matrice.Add(mario)
        matrice.Add(giuseppe)
        matrice.Add(luigi)

        Debug.Print(Max(matrice))

Eccezione first-chance di tipo 'System.InvalidCastException' in Microsoft.VisualBasic.dll

AHIAHIAHI!!! Invalid cast!!! Certo! Elemento è l'oggetto, non la proprietà che mi interessa!!!

Vediamo...

Module funzioni
    Public Function Max(ByVal m As ArrayList) As Integer
        Dim base As Integer = 0
        For Each elemento In m
            If elemento.preferenza > base Then base = elemento.preferenza
        Next
        Return base
    End Function

End Module

Non è il massimo, ma funziona...

80

Bene.
Ora devo isolare in un altro array gli elementi che portano questo valore massimo.

        matrice2 = New ArrayList
        For Each elemento In matrice
            If elemento.preferenza = Max(matrice) Then matrice2.Add(elemento)
        Next

        For Each elemento In matrice2
            Debug.Print(elemento.nome & " " & elemento.preferenza)
        Next

...con verifica, ovviamente. Ho impostato così i valori di preferenza delle persone:

        mario.preferenza = 120
        giuseppe.preferenza = 80
        luigi.preferenza = 120

Vediamo...

Mario 120
Luigi 120

Perfetto!

Cambiamo i valori e vediamo ancora...

        mario.preferenza = 80
        giuseppe.preferenza = 80
        luigi.preferenza = 20

Mario 80
Giuseppe 80

Benissimo!

Ho ottenuto di isolare in un altro ArrayList solo quelli che hanno una preferenza maggiore, onde attribuire i turni che avanzano come resto nella prima distribuzione.
Mi sembra giusto, infatti, attribuire più turni a chi preferisce farne di più. Ma in modo casuale qualora questa distribuzione debba essere necessariamente disuguale.

Codice per la ridistribuzione di turni in base a una preferenza

Codice per la ridistribuzione di turni in base a una preferenza da 0 a 100.

Class persona
    Implements IComparable
    Public nome As String
    Public preferenza As Integer
    Public turni As Integer

    Public Function CompareTo(ByVal obj As Object) As Integer Implements System.IComparable.CompareTo
        Dim altro As persona = DirectCast(obj, persona)
        Return Me.preferenza.CompareTo(altro.preferenza)
    End Function
End Class
Public Class Form1
    Dim WithEvents miaGriglia As Griglia(Of jLabel)
    Dim risultato As Double
    Dim indice As Integer
    Dim mario As New persona
    Dim giuseppe As New persona
    Dim luigi As New persona
    Dim numTurni As Integer = 100
    Dim totale As Integer
    Dim attribuiti As Integer = 0
    Dim matrice As ArrayList
    Dim resto As Integer
    Dim aggiunta As Integer
    Private Sub Form1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
        mario.nome = "Mario"
        giuseppe.nome = "Giuseppe"
        luigi.nome = "Luigi"
        mario.preferenza = 50
        giuseppe.preferenza = 50
        luigi.preferenza = 50

        matrice = New ArrayList
        matrice.Add(mario)
        matrice.Add(giuseppe)
        matrice.Add(luigi)

        'conto il totale delle preferenze
        matrice.Sort()
        calcolo()
       
        
    End Sub
    Sub calcolo()

        If indice = matrice.Count Then Return
        For n = indice To matrice.Count - 1
            totale += matrice(n).preferenza
        Next

        'attribuisco i turni


        For n = indice To matrice.Count - 1
            aggiunta = Math.Floor(numTurni / totale * matrice(n).preferenza)
            matrice(n).turni += aggiunta
            attribuiti += aggiunta
        Next



        For n = 0 To matrice.Count - 1
            Debug.Print(matrice(n).nome & " " & matrice(n).preferenza & " " & matrice(n).turni)
        Next
        resto = numTurni - attribuiti
        Debug.Print("resto " & resto)
        totale = 0
        attribuiti = 0
        numTurni = resto
        Debug.Print("-----")
        indice += 1
        calcolo()

    End Sub
End Class

Operazioni sulle stringhe Substring e Mid.

Dividere una stringa.
Il metodo Substring estrae un pezzo di stringa a partire da un indirizzo e per una certa lunghezza.
Esploriamo questo metodo:

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim stringa As String = "Questa è una stringa"
        Debug.Print(stringa.Substring(0, 3))
    End Sub
End Class

Que

Quindi il metodo Substring estrae una stringa che parte dall'indirizzo specificato e ha la lunghezza specificata.

La funzione Mid, invece:

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim stringa As String = "Questa è una stringa"
        Debug.Print(Mid(stringa, 0, 3))
    End Sub
End Class

Eccezione first-chance di tipo 'System.ArgumentException' in Microsoft.VisualBasic.dll

Con questa funzione, la lettura avviene dal carattere successivo a quello che ha per indice il numero specificato (non parte da 0 ma da 1).

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim stringa As String = "Questa è una stringa"
        Debug.Print(Mid(stringa, 1, 3))
    End Sub
End Class

Que

Aggiunta di separator ai menu

Devo aggiungere un sottomenu bianco...

Fatto: basta aggiungere un sottomenu senza specificare testo, o anche specificando una stringa vuota...
Come si aggiunge una linea sul menu? Mi sembra bello separare i sottomenu "pieni" da quello vuoto...

Dim separatore As New ToolStripSeparator
            mioMenu.Items.Add(separatore)
            sottomenu = New ToolStripMenuItem()
            sottomenu.Text = ""
            AddHandler sottomenu.Click, AddressOf Trascrivi
            mioMenu.Items.Add(sottomenu)

Aggiunti separatore e menu vuoto, e aggiustato il codice in modo che in caso di click sul menu vuoto non si faccia alcun calcolo...

    Sub CALCOLO()
        If mioMenu.Items(SelectedMenu).Text <> "" Then nomiGriglia.CelleDellaColonna(0)(SelectedMenu).BackColor = Color.Red
    End Sub

in effetti, un calcolo si deve fare, ma andiamo per gradi...

Alla ricerca di un metodo di calcolo più rapido

Bene.
Ora devo modificare questo mammuth e velocizzarlo.

Ho in mano, salvato come una variabile, il sottomenu selezionato al momento del click per introdurre nella casella il nome.
Che ci faccio?

Il numero di indice del sottomenu corrisponde all'indice del nome nella matrice dei nomi, e corrisponderà all'indice della casella nella matrice delle caselle appartenenti a una determinata colonna.
Facendo valere questa corrispondenza, si può fare un calcolo limitato all'oggetto di interesse senza stare ogni volta a sfogliare tutto l'array di caselle perdendo moltissimo tempo.

Ho bisogno di lavorare un po' su un menu isolato per vedere se si può ricavare un indice di un sottomenu.

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim sottomenu As New ToolStripMenuItem
        sottomenu.Text = "STRONZO"
        MenuStrip1.Items.Add(sottomenu)
        MenuStrip1.Items(0).BackColor = Color.Cyan
    End Sub

Ecco, dunque devo salvare come variabile non il sottomenu come variabile oggetto ma il suo indice come variabile numerica (tipo Integer o altro).

Cambio il tipo di variabile...

    Dim SelectedMenu As Integer 'indice del menu selezionato

Adesso provvediamo a salvare l'indice del sottomenu, e non più il sottomenu, in questa variabile.

    Sub Trascrivi(ByVal sender As Object, ByVal e As EventArgs)

        SelectedItem.Text = sender.text
        SelectedMenu = mioMenu.Items.IndexOf(sender)
        MsgBox(SelectedMenu)
        CALCOLO()

Bene.
Abbiamo memorizzato l'indice del sottomenu.
Adesso usiamolo. Facciamo una prova...

        nomiGriglia.CelleDellaColonna(0)(SelectedMenu).BackColor = Color.Red

inserita nella routine "Calcolo()".
E funziona!!!

La casella si colora di rosso immediatamente. Prima, con quel metodo rudimentale del dover sfogliare tutte le caselle, passava più di mezzo secondo.

Alcune funzioni per navigare nella mia griglia di celle.

Ecco, nell'ambito della mia griglia di celle, le funzioni che ho creato:

Ecco alcune funzioni che , fornendo come parametro una cella, fanno vari calcoli.

---

Funzioni che, data la cella, identificano la colonna e la riga della cella:

    'identifica la colonna della casella
    Public Function colonna(ByVal sender As Object) As Integer
        Return IndexOf(sender) Mod casxFila
    End Function
    'identifica la riga della casella
    Function fila(ByVal sender As Object) As Integer
        Return IndexOf(sender) \ casxFila
    End Function

La prima è piuttosto facile: il resto della divisione dell'indice di una casella per il numero di caselle per fila dà la colonna.
La seconda è anch'essa facile: la divisione intera dell'indice per il numero di caselle per riga dà la riga.

---

Funzioni che, data la cella, identificano le celle precedente e successiva:

       'identifica la casella precedente nell'array
    Function precedente(ByVal sender As Object) As Label
        Return Me(IndexOf(sender) - 1)
    End Function
    ''identifica la casella successiva nell'array
    Function successiva(ByVal sender As Object) As Label
        Return Me(IndexOf(sender) + 1)
    End Function

Queste partono dall'indice della cella nell'array, diminuendolo o aumentandolo di uno.

---

Funzioni che, data la cella, identificano la cella corrispondente nella fila precedente e nella successiva:

    'data la casella, identifica la casella corrispondente del giorno prima
    Function PrevParall(ByVal sender As Object) As Label
        Return Me(IndexOf(sender) - casxFila)
    End Function
    'data la casella, identifica la casella corrispondente del giorno dopo
    Function NextParall(ByVal sender As Object) As Label
        Return Me(IndexOf(sender) + casxFila)
    End Function

Queste desumono l'indice della casella cliccata e lo diminuiscono o lo aumentano di un numero pari al numero delle celle per riga.

Funzioni che restituiscono arrays.

Funzione che restituisce un array di stringhe:

---

Funzione che restituisce un array di labels:

Ripasso di ParamArray (array passata come parametro)

Esploriamo ParamArray...

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        funzione("ciao", "buongiorno", "scemo", "cretino")
 
    End Sub

    Sub funzione(ByVal ParamArray parametri() As String)
        For n = 0 To parametri.Length - 1
            MsgBox(parametri(n))
        Next

    End Sub

End Class