calcolo cervellotico

[visodont]

Cari programmatori,
voi che siete bravi in matematica, risolvetemi questo problema trovando un algoritmo adatto, con un ciclo di for. Sono 15 giorni che ci provo ma non ci riesco.

Ecco il problema :

Ci sono 10 persone che ricevono una percentuale di una certa somma per esempio 1000

Somma = 1000
' le percentuali relative sono
Pc(1) =40%
Pc(2) =10%
Pc(3) =20%
Pc(4) = 0%
Pc(5) = 5%
Pc(6) = 5%
Pc(7) = 0%
Pc(8) = 0.5
Pc(9) = 9.5
Pc(10) =10
' Calcola le relative cifre
For I = 1 to 10
Cifra(I) = (Somma/100)* Pc(I)
next
' Le % e le cifre assegnate saranno le eguenti
Pc(1) =40% = 400
Pc(2) =10% = 100
Pc(3) =20% = 200
Pc(4) = 0% = 0
Pc(5) = 5% = 50
Pc(6) = 5& = 50
Pc(7) = 0% = 0
Pc(8) = 0.5 = 5
Pc(9) = 9.5 = 95
Pc(10) =10 = 100

Tot. 100% 1000


Ora a queste persone voglio assegnare un' altra cifra con un calcolo del tipo "Robin Hood" ( dare di più a chi ha preso meno e viceversa )

La seconda cifra è di 100 e andrebbe assegnata in proporzione inversa alle % precedenti e chiaramente il totale delle seconde cifre parziali assegnate deve essere sempre 100.
Il totale generale deve chiaramente sempre essere eguale a 1000.

Non so proprio come fare. Evidentemente la matematica nonè il mio forte ! Qualcuno mi può togliere dagli impicci ?

Grazie, e Ciao a tutti,
visodont

[cisky]

Umh, direi che la formula può essere questa:

ImportoDopoRobinHood = ImportoIniziale + ((Importo totale da assegnare / (SUM(100- %Pesona))) * (100 - %Pesona)) - ((Importo totale da assegnare /100) * %persona)

Dato che come l'ho scritta non si capisce nulla, ho creato un programmino VB6 per chiarire meglio le idee.

Se non ti è chiaro chiedi pure...

Private Sub x()

    Const IMPORTO_TOTALE = 1000
    Const IMPORTO_DA_ASSEGNARE = 100
    
    Dim nPercs(5)           As Single       ' *** Percentuali iniziali
    Dim nImporto(5)         As Double       ' *** Importi finali
    Dim nImportoIniz        As Double       ' *** Importi iniziale (Prima della distribuzione)
    Dim nToAdd              As Double       ' *** Importo Robin Hood da aggiungere
    Dim nToRemove           As Double       ' *** Importo Robin Hood da rimuovere
    Dim nSumPercInverse     As Integer      ' *** Somma delle % inverse (Somma di quello che manca per arrivare al 100%)
    Dim nIncremento         As Double
    Dim sMsg                As String
    Dim nImpTotForCheck     As Double       ' *** x verificare se il totale è corretto
    Dim i                   As Integer
    
    ' *** Valori di % (Tanto per provare...)
    '
    nPercs(0) = 40
    nPercs(1) = 25
    nPercs(2) = 20
    nPercs(3) = 10
    nPercs(4) = 5
    nPercs(5) = 0
    
    ' *** Calcolo la somma di tutte le % inverse SUM(100 - % persona)
    '
    For i = 0 To 5
        nSumPercInverse = nSumPercInverse + (100 - nPercs(i))
    Next i
    
    ' *** Ottengo l'importo per % da aggiungere ad ogni persona
    '
    nIncremento = IMPORTO_DA_ASSEGNARE / nSumPercInverse
    
    sMsg = sMsg & "Importo generale iniziale = " & IMPORTO_TOTALE & vbCrLf
    
    For i = 0 To 5
    
        ' *** l'importo iniziale è ovviamente il totale in base alla %
        '
        nImportoIniz = (IMPORTO_TOTALE / 100) * nPercs(i)
        
        ' *** Calcolo l'importo da aggiungere
        '
        nToAdd = nIncremento * (100 - nPercs(i))
        
        ' *** Calcolo la quantità da rimuovere (E' proporzionale alla %)
        '
        nToRemove = (IMPORTO_DA_ASSEGNARE / 100) * nPercs(i)
        
        nImporto(5) = nImportoIniz + nToAdd - nToRemove     ' *** Importo dopo Robin Hood
    
        sMsg = sMsg & vbCrLf & "Importo persona N° " & i + 1 & "         = " & nImportoIniz
        sMsg = sMsg & vbCrLf & "Importo Dopo Robin Hood = " & nImporto(5)
        If nToAdd - nToRemove > 0 Then
            sMsg = sMsg & "  (+" & nToAdd - nToRemove & ")" & vbCrLf
        Else
            sMsg = sMsg & "  (" & nToAdd - nToRemove & ")" & vbCrLf
        End If
    
        nImpTotForCheck = nImpTotForCheck + nImporto(5)     ' *** x verificare se il totale è corretto.
    Next i
        
    sMsg = sMsg & vbCrLf & vbCrLf & "Totale generale dopo Robin Hood = " & nImpTotForCheck
        
    MsgBox sMsg

End Sub

Ciao!

[visodont]

Grazie mille, proverò se funziona, spero proprio di si !

Ciao,
visodont