Wie aus Daten ganze prozentuale Ergebnisse berechnen

[himitsu]

Und das obwohl's noch nichtmal fertig war/ist :shock:

Och, sooooo inperformant isses nun auch nicht. :roll:
Meistens wird der meiste ja eh nicht ausgeführt und nach maxinam nur einer Runde wird's oftmals auch schon fertig sein.

Die Funktion Math.SumInt hab ich jetzt absichtlich nicht verwendet, da die erste Sum-Schleife schon für die Parameter-Kontrolle verwendet wurde und due 2 kleine Schleife die Bereichsprüfungen der Math.SumInt nicht benötigt.

Es können auch nur negative oder nur positive Werte übergeben werden.

Na gut, ich denk ein paar Optimierungen wären noch möglich, aber erstmal gucken, ob es auch richtig funktioniert.

Delphi-Quellcode:

Uses Types;

Function RoundedPercentage(Const Values: Array of Integer): TIntegerDynArray;
  Var i, i2: Integer;
    Maximum: Int64;
    ResultR: Array of Real;
    MinMaxR: Real;

  Begin
    Maximum := 0;
    For i := 0 to High(Values) do Begin
      If ((Maximum < 0) and (Values[i] > 0))
          or ((Maximum > 0) and (Values[i] < 0)) Then
        Raise Exception.CreateFmt('Invalid Value (%d)', [Values[i]]);
      Inc(Maximum, Values[i]);
    End;
    SetLength(Result,  Length(Values));
    SetLength(ResultR, Length(Values));
    For i := 0 to High(Values) do Begin
      ResultR[i] := Values[i] / Maximum * 100;
      Result[i]  := Round(ResultR[i]);
    End;
    While True do Begin
      i2 := 0;
      For i := 0 to High(Values) do Inc(i2, Result[i]);
      If i2 < 100 Then Begin
        MinMaxR := -1;
        i2      := -1;
        For i := High(Values) downto 0 do
          If Round(Int(ResultR[i])) = Result[i] Then
            If Abs(Frac(ResultR[i])) > MinMaxR Then Begin
              MinMaxR := Abs(Frac(ResultR[i]));
              i2      := i;
            End;
        If i2 < 0 Then Begin
          MinMaxR := -1;
          i2   := -1;
          For i := High(Values) downto 0 do
            If Abs(Frac(ResultR[i])) > MinMaxR Then Begin
              MinMaxR := Abs(Frac(ResultR[i]));
              i2      := i;
            End;
          If i2 < 0 Then i2 := High(Values);
          Inc(Result[i2]);
        End Else Inc(Result[i2]);
      End Else If i2 > 100 Then Begin
        MinMaxR := -1;
        i2      := -1;
        For i := High(Values) downto 0 do
          If Round(Int(ResultR[i])) <> Result[i] Then
            If Abs(Frac(ResultR[i])) < MinMaxR Then Begin
              MinMaxR := Abs(Frac(ResultR[i]));
              i2      := i;
            End;
        If i2 < 0 Then Begin
          MinMaxR := -1;
          i2      := -1;
          For i := High(Values) downto 0 do
            If Abs(Frac(ResultR[i])) < MinMaxR Then Begin
              MinMaxR := Abs(Frac(ResultR[i]));
              i2      := i;
            End;
          If i2 < 0 Then i2 := High(Values);
          Inc(Result[i2]);
        End Else Inc(Result[i2]);
      End Else Break;
    End;
  End;

Procedure TForm1.FormCreate(Sender: TObject);
  Var R: TIntegerDynArray;
    i:   Integer;

  Begin
    R := RoundedPercentage([1545, 1545, 1545, 1545, 1545, 1545, 730]);
    Caption := '';
    For i := 0 to High(R) do
      Caption := Caption + ' ' + IntToStr(R[i]);
  End;

[add]
@Khabarakh: hop hop, Beeilung .. zwei Funktionen sind besser als eine :angel:

[Matze]

Zitat:

Zitat von himitsu

Och, sooooo inperformant isses nun auch nicht. :roll:

Nicht traurig sein. :stupid:

Nur optisch gesehen finde ich die Lösung schon heftig (so viele Schleifen und die zig-fach verschachtelt), im Vergleich zu sowas:

Code:

// change the max. array value to get a sum of 100%
else if ($data_sum != 100)
{
   $max_idx = 0;
   $max_val = 0;

   foreach ($data_percentage as $idx => $value)
   {
      if ($value > $max_val)
      {
         $max_val = $value;
         $max_idx = $idx;
      }
   }

   $data_percentage[$max_idx] += (100 - $data_sum);
}

Aber deine Lösung ist auf alle Fälle genauer und wenn man Wert auf Genauigkeit legt, mit Sicherheit die bessere Wahl. :-)

Grüße

[himitsu]

deine etwas "ungerechtere" und schnellere Variante könnte man in Delphi auch recht kurz gestalten :stupid:

Delphi-Quellcode:

Uses Types, Math;

Function RoundedPercentage(Const Values: Array of Integer): TIntegerDynArray;
  Var i, i2: Integer;

  Begin
    SetLength(Result, Length(Values));
    i2 := SumInt(Values);
    //For i := 0 to High(Values) do Result[i] := Round(Values[i] / i2 * 100);
    For i := 0 to High(Values) do Result[i] := (Values[i] * 100 + i2 shr 1) div i2;
    Inc(Result[High(Result)], 100 - SumInt(Result));
  End;

Code:

15.45  15.45  15.45  15.45  15.45  15.45  7.30

15     15     15     16     16     16     7   // version 1

15     15     15     15     15     15     10  // version 2, also die Jetzige