Mathe mit Strings (die deutsche StringMatheLib ._. )

[Corpsman]

Oh man, ich hab grad auch versucht das teil nach D5 zu portieren und hatte die Selben Fehler wie in Post 29 hätt ich doch zuerst gelesen, naja ...
ich habe

Delphi-Quellcode:

  If istNegativ(b) Then System.Error(reInvalidOp);

zu

Delphi-Quellcode:

If istNegativ(b) Then  raise Exception.create('reInvalidOp');

gemacht.

Das RunError gibts zwar, aber die ganzen Konstanten reInvalidOp .. müste man dann auch noch setzen.

[himitsu]

Zitat:

Zitat von Corpsman

Das RunError gibts zwar, aber die ganzen Konstanten reInvalidOp .. müste man dann auch noch setzen.

Da muß ich nur mal in der Umrechnungstabelle nachsehn ... die Codes haben da nur andere Werte (und Byte statt SET)

Delphi-Quellcode:

Function Zufallszahl(Mathe: TMathe; Const von, bis: String): String;
  Var d:  String;
    s, i: Integer;

  Begin
    If Mathe.Vergleich(von, bis) > 0 Then System.Error(reRangeError);
    d := Mathe.Differenz(bis, von);
    Mathe.Plus1(d);
    SetLength(Result, Length(d) * 2 + 33);
    s := RandSeed;
    For i := Length(Result) downto 1 do Result[i] := Char(Random(10) + Ord('0'));
    RandSeed := s;
    Random;
    i := Length(Result);
    Result := Mathe.Produkt(Result, d);
    Result := Mathe.Quotient(Result, Mathe.Potenz('10', IntToStr(i)));
    Result := Mathe.Summe(Result, von);
  End;

Function Zufallszahl(Const von, bis: MatheString): MatheString;
  Var d, r: String;
    s, i:   Integer;

  Begin
    If von > bis Then System.Error(reRangeError);
    d := bis - von + 1;
    SetLength(r, Length(d) * 2 + 33);
    s := RandSeed;
    For i := Length(r) downto 1 do r[i] := Char(Random(10) + Ord('0'));
    RandSeed := s;
    Random;
    Result := ((MatheString(r) * d) div Power('10', Length(r))) + von;
  End;

muß aber noch etwas dran arbeiten
Wollte ich gestern eigentlich noch nicht Posten, weil ich dachte die Verteilung sei sch****,
aber anscheinend ist sie garnicht soooo schlecht :D

Delphi-Quellcode:

a: MatheString;
i, i2: Integer;
X: Array of Integer;
S: String;

Memo1.Lines.BeginUpdate;
Try
  SetLength(X, 10001);
  ZeroMemory(@X[0], Length(x) * SizeOf(Integer));
  For i := 0 to 100000 do Begin
    a := Zufallszahl('1000', '10000');
    Memo1.Lines.Add(a);
    i2 := Integer(a);
    If (i2 < 1000) or (i2 > 10000) Then ASM INT 3 End;
    Inc(X[i2]);
  End;
  Memo1.Lines.Add('*******************');
  S := '';
  For i := 0 to High(X) do Begin
    If i mod 1000 = 0 Then Begin
      Memo1.Lines.Add(S);
      S := '*** ' + IntToStr(i) + ': ';
    End;
    If X[i] <= 26 Then S := S + Char(X[i] + Ord('A')) Else S := S + '*';
  End;
  Memo1.Lines.Add(S);
Finally
  Memo1.Lines.EndUpdate;
End;

Zitat:

1979
1998
5600
1460
5546
1454
7346
7035
7904
3672
3967
...
4897
6790
9679
1867

*** 0: AAAAAAAAAAAAAAAA...AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAA
*** 1000: NRMPHJXHKLOMKNII...LGMQKNMPNJLNMLPFLPGHMOJGPIQSOMJ NKNOGLGINMNNKH
*** 2000: NLLMMEMMHJGKMNLM...KJLLIOOMOJHJPIUJKNLFJGOHHKNJIOH PHJMJKJMQHNLJJ
*** 3000: JIJOQQHNMPNILGLL...LJKLIOIHJPJOKPNNOJLQMMKJOFNRQHH QJLJMNJEPFQODR
*** 4000: LKULFJIIQOMKONNG...OOJJNLIMFIQLKHHJEHGSFLJMXNLLHML OLFNPJHISNLKMK
*** 5000: IIJKKPPJHKILLKKG...QTNOJILMONJNLMNLNLNJNJNJRJHNOMI IQRKIPMKPPJILK
*** 6000: KKNHHMLKMMKFKPNK...KTNILNJPINIIKJINLJGQLNOLLMGKJKL JNLJNURLIOKOUM
*** 7000: UMNSNKNJOOJIJKSH...IJOELOJNNGGJNHLKNKLPJMRNQQJNHRO GLKKMKLMNLKIPM
*** 8000: OJMJHOJKKIHPMINK...GJQHHGFNMKNPNLLJKLKJJLIOQKIPLLF HJTMJQSMMIJOII
*** 9000: NRMIQNMMMILQJLNG...KNKJMLNTLPJOJKINLHQGMFMLIOMLQSG ONMIJPFHIQOQIL
*** 10000: A

A = kein Wert | B = ein Mal gefunden | C = 2 ....
und wie ich grad seh, ist die 10000 auch nicht besetzt, also

Delphi-Quellcode:

X := Zufallszahl('1000', '10000');

entspricht nur 1.000 <= X < 10.000

ich füg also nich ein INC hinzu, werd' es einbauen und dann die nächsten Minuten irgendwann alles hochladen


hab auch grad noch 'nen Fehler in Mathe.Vergleich gefunden,
da stannd z.B. If Length(a) < Length(a), was natrülich nicht so das gewünschte Ergebnis brachte :nerd:

[himitsu]

Zitat:

Zitat von himitsu

und wie ich grad seh, ist die 10000 auch nicht besetzt, also

OK, es hatte doch richtig gerechnet ... nur das Ergebnis wurde vorhin falsch angezeigt :wall:

Das mit der Units Types hab ich jetzt erstmal einfach mit dem {$IF}-Problem verknüpft und es darüber abgeschaltet :angel2:

ja und wegen dem Error <> Exception:
Da man ja auch ohne SysUtils arbeiten kann und somit dann Exception nicht zur Verfügung stünde,
wird der Fehler über (Run)Error abgesetzt.
Und sobald die SysUtils auch nur irgendwo im Programm vorhanden ist, werden diese Fehlercodes dann an die passenden Exceptions weitergeleitet. :angel:

Bin gespannt, ob es nun auch in D5 läuft.

[add]
In den Festpunktzahlen hat nun jede Variable sicherheitshalben einen eigenen internen Wert für die Nachkommastellen,
falls da mal wer mittendrin den globalen Wert für die maximalen Nachkommastellen ändert :shock:

[add]
Und wegen dem zusätzlichem undn unglücklich Positioniertem Edit in Demo 3 nicht wundern.
Bin grad etwas am Testen, was das Rundungsverhalten bei den Rechenoperationen betrifft.

[qwertz543221]

zur random funktion:

wo wird denn die variable "randseed" initialisiert / deklariert?

in deiner function zufallszahl(mathe:tmathe;const von, bis:string):string; wird sie zwar genutzt aber nicht deklariert.


hab ich vlt ein update der Tmathe verpasst?

[GPRSNerd]

Randseed ist aus der Unit "System".

[himitsu]

Jupp, ich nutze praktisch für die "kleineren" Einheiten den Zufallsgenerator von Delphi, aus der Unit System.

Und falls sich wer fragt, warum ich da RandSeed auslese und vorallem warum es dann wieder zurückgesetzt wird:
Das ist, damit die Gleichverteilung der Zufallszahlen erhalten bleibt und der Generator nicht durch die "vielen" Aufrufe von Random unnötig gestört wird.
Praktisch nutze ich zwar Random mehrfach pro Zufallszahl, aber effektiv wird die Funktion nur einmal aufgerufen.

[qwertz543221]

ok danke für die info.
ich dachte das sei vlt. eine eigene var / const für diese funktion.

[sirius]

Ich habe mal folgende Ergänzung gemacht (für alle, die keine class operators nutzen können):

Delphi-Quellcode:

Unit StringMatheLib;
//ich tippe hier nur die Ergänzungen, alles andere von himi sollte man beibehalten

interface

uses Variants;


type

  TMatheVarData = packed record
    VType: TVarType;
    Reserved1, Reserved2, Reserved3: Word;
    Mathe: String; //Man könnte hier auch TMathe drin speichern und den String in die Klasse legen, wäre etwas elegenater und sicherer, da man mit der automatischen Verwaltung der Strings nicht kollidieren kann. Ich wollte nur grad die Klasse TMathe nicht umschreiben.
    Reserved4: LongInt;
  end;


  TMatheVariant=class(TCustomVariantType)
   public
    procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operator: TVarOp); override;
    procedure UnaryOp(var Right: TVarData; const Operator: TVarOp); override;
    function CompareOp(const Left, Right: TVarData; const Operator: TVarOp): Boolean; override;
    procedure Compare(const Left, Right: TVarData; var Relationship: TVarCompareResult); override;
    procedure Cast(var Dest: TVarData; const Source: TVarData); override;
    procedure CastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); override;
    procedure Clear(var V: TVarData); override;
    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
    function IsClear(const V: TVarData): Boolean; override;
   protected
    function LeftPromotion(const V: TVarData; const Operator: TVarOp; out RequiredVarType: TVarType): Boolean; override;
    function RightPromotion(const V: TVarData; const Operator: TVarOp; out RequiredVarType: TVarType): Boolean; override;
  end;


  function VarMatheCreate:Variant; overload;
  function VarMatheCreate(const Init:string):Variant; overload;
  function VarMatheCreate(const Init:Integer):Variant; overload;

implementation


var TempMatheVariant:TMatheVariant=nil;
    Mathe:TMathe=nil;


function VarMatheCreate(const Init:string):Variant;
begin
  VarClear(Result);
  TMatheVarData(Result).VType:=TempMatheVariant.VarType;
  TMatheVarData(Result).Mathe:=Init;
end;
function VarMatheCreate:Variant;
begin
  result:=VarMatheCreate('0');
end;
function VarMatheCreate(const Init:Integer):Variant;
var s:string;
begin
  str(init,s);
  result:=VarMatheCreate(s);
end;




{ TMatheVariant }


procedure TMatheVariant.BinaryOp(var Left: TVarData; const Right: TVarData;
  const Operator: TVarOp);
var sRight:string;
begin
  if TMatheVarData(Left).VType<>TempMatheVariant.VarType then
    RaiseInvalidOp;
  if TMatheVarData(Right).VType=TempMatheVariant.VarType then
    sRight:=TMatheVarData(Right).Mathe
  else
    sRight:=VarToStr(Variant(Right));

  case Operator of
    opAdd:
      TMatheVarData(Left).Mathe:=Mathe.Summe(TMatheVarData(Left).Mathe,
                                             sRight);
    opSubtract:
      TMatheVarData(Left).Mathe:=Mathe.Differenz(TMatheVarData(Left).Mathe,
                                                 sRight);
    opMultiply:
      TMatheVarData(Left).Mathe:=Mathe.Produkt(TMatheVarData(Left).Mathe,
                                               sRight);
    opIntDivide:
      TMatheVarData(Left).Mathe:=Mathe.Quotient(TMatheVarData(Left).Mathe,
                                                sRight);
    opModulus:
      TMatheVarData(Left).Mathe:=Mathe.Modulo(TMatheVarData(Left).Mathe,
                                              sRight);
    else
      RaiseInvalidOp;
  end;
end;

procedure TMatheVariant.Cast(var Dest: TVarData; const Source: TVarData);
begin
  VarDataClear(Dest);
  fillchar(Dest,sizeof(dest),0);
  TMatheVarData(Dest).VType:=TempMatheVariant.VarType;
  if TMatheVarData(Source).VType=TempMatheVariant.VarType then
    TMatheVarData(Dest).Mathe:=TMatheVarData(Source).Mathe
  else
    TMatheVarData(Dest).Mathe:=VarToStr(Variant(Source));
end;

procedure TMatheVariant.CastTo(var Dest: TVarData; const Source: TVarData;
  const AVarType: TVarType);
var Temp:TVarData;
begin
  if TMatheVarData(Source).VType=TempMatheVariant.VarType then
  begin
    fillchar(temp,sizeof(temp),0);
    Temp.VType:=varstring;
    Temp.VString:=Pointer(TMatheVarData(Source).Mathe);
    VarDataCastTo(Dest,Temp,aVarType);
  end else
    inherited;
end;

procedure TMatheVariant.Clear(var V: TVarData);
begin
  if TMatheVarData(V).VType=TempMatheVariant.VarType then
  begin
    TMatheVarData(V).VType:=varEmpty;
    TMatheVarData(V).Mathe:='';
  end else
    inherited;
end;

procedure TMatheVariant.Compare(const Left, Right: TVarData;
  var Relationship: TVarCompareResult);
var sRight:string;
begin
  if TMatheVarData(Left).VType<>TempMatheVariant.VarType then
    RaiseInvalidOp;
  if TMatheVarData(Right).VType=TempMatheVariant.VarType then
    sRight:=TMatheVarData(Right).Mathe
  else
    sRight:=VarToStr(Variant(Right));

  case Mathe.Vergleich(TMatheVarData(Left).Mathe,sRight) of
    LessThanValue: RelationShip:=crLessThan;
    EqualsValue : RelationShip:=crEqual;
    GreaterThanValue : RelationShip:=crGreaterThan;
  end;
end;

function TMatheVariant.CompareOp(const Left, Right: TVarData;
  const Operator: TVarOp): Boolean;
var sRight:string;
    Art:TVergleich;
begin
  if TMatheVarData(Left).VType<>TempMatheVariant.VarType then
    RaiseInvalidOp;
  if TMatheVarData(Right).VType=TempMatheVariant.VarType then
    sRight:=TMatheVarData(Left).Mathe
  else
    sRight:=VarToStr(Variant(Right));

  Art:=vGleich;
  case Operator of
    opCmpNE:Art:=vUngleich;
    opCmpLT:Art:=vKleiner;
    opCmpLE:Art:=vKleinerGleich;
    opCmpGT:Art:=vGroesser;
    opCmpGE:Art:=vGroesserGleich;
  end;
  result:=Mathe.Vergleich(TMatheVarData(Left).Mathe,sRight,Art);

end;

procedure TMatheVariant.Copy(var Dest: TVarData; const Source: TVarData;
  const Indirect: Boolean);
begin
  if Indirect and VarDataIsByRef(Source) then
    VarDataCopyNoInd(Dest, Source)
  else
  begin
    TMatheVarData(Dest).VType:=TempMatheVariant.VarType;
    TMatheVarData(Dest).Mathe:=TMatheVarData(Source).Mathe;
  end;

end;

function TMatheVariant.IsClear(const V: TVarData): Boolean;
begin
  result:=TMatheVarData(V).Mathe='';
end;

function TMatheVariant.LeftPromotion(const V: TVarData;
  const Operator: TVarOp; out RequiredVarType: TVarType): Boolean;
begin
  result:=inherited LeftPromotion(V,Operator,RequiredVarType);
end;

function TMatheVariant.RightPromotion(const V: TVarData;
  const Operator: TVarOp; out RequiredVarType: TVarType): Boolean;
begin
  result:=inherited RightPromotion(V,Operator, RequiredVarType);
end;

procedure TMatheVariant.UnaryOp(var Right: TVarData;
  const Operator: TVarOp);
begin
  if Right.VType = VarType then
    case Operator of
      opNegate:
        Mathe.Negieren(TMatheVarData(Right).Mathe);
    else
      RaiseInvalidOp;
    end
  else
    RaiseInvalidOp;
end;

initialization

Mathe:=TMathe.Create;
TempMatheVariant:=TMatheVariant.Create;


finalization

TempMatheVariant.Free;
TempMatheVariant:=nil;
Mathe.Free;
Mathe:=nil;

End.

Damit geht dann auch folgendes (z.B. unter Delphi 7):

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var x,z:Variant;
begin
  x:=VarMatheCreate('1200000000000000000000000000'); //um eine Initialisierung kommt man nicht herum

  //aber dann:
  x:=x+'3';
  z:=x+1;
  z:=z*2;
  memo1.lines.add(-z);
end;

[himitsu]

ab Delphi2006/TurboDelphi geht das zwar auch jetzt schon > MatheString aus StringMatheRec.pas

aber ich kann das gern ins nächste Update mit reinnehmen.
werd' es aber in eine eigene Unit legen > StringMatheVariant.pas vermutlich


PS: ich weiß nicht, ob man das merkt und es eventuell auch so rüberkommt,
aber mann muß immer nur die Unit einbinden, aus welcher man den gewünschten Typ nutzt, also

TMathe > StringMatheLib
MatheString > StringMatheRec
MatheStringX > StringMatheFloatRec (wobei ich mir grad überlegt hab das X wohl besser gegen ein F auszutauschen)

[sirius]

Zitat:

Zitat von himitsu

ab Delphi2006/TurboDelphi geht das zwar auch jetzt schon > MatheString aus StringMatheRec.pas

Deswegen meinte ich ja: für alle, die keine Class Operators nutzen können (da ja so viele, wie ich, noch D7 nutzen).

Zitat:

aber ich kann das gern ins nächste Update mit reinnehmen.
werd' es aber in eine eigene Unit legen > StringMatheVariant.pas vermutlich

Ja kannst du. Aber ich denke, der Code hier reicht auch.