Wie aus Daten ganze prozentuale Ergebnisse berechnen

[himitsu]

Und das obwohl's noch nichtmal fertig war/ist

Och, sooooo inperformant isses nun auch nicht.
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