Autor |
Beitrag |
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Di 13.12.05 15:31
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456:
|
unit UBruchRechnung;
interface uses windows, sysutils; type TBruch = record Zaehler, Nenner: int64; end; TBruchG = record Zahl: int64; Bruch: TBruch; end; TPrimfaktor = array of int64; function p_ggT(a, b: int64): int64; function p_kgv(a, b: int64): int64; function p_primfaktor(a: int64): TPrimfaktor;
procedure p_kuerzen(var Bruch: TBruch); function p_add(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; function p_sub(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch;
function p_multi(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; function p_div(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch;
function p_compare(Bruch1, Bruch2: TBruch): boolean;
function ToBruch(zaehler, nenner: int64): TBruch;
function BruchToFloat(Bruch: TBruch): Extended; function FloatToBruch(const a: Extended): TBruch; overload; function FloatToBruch(const a, toleranz: Extended): TBruch; overload;
function BruchToStr(Bruch: TBruch): string; function StrToBruch(const s: string; toleranz: Extended = -1; kuerzen: boolean = true): TBruch;
function BruchToBruchG(Bruch: TBruch; kuerzen: boolean = true): TBruchG;
function BruchGToBruch(BruchG: TBruchG; kuerzen: boolean = true): TBruch;
function BruchGToStr(BruchG: TBruchG): string;
implementation
function p_ggT(a, b: int64): int64; var r: int64; begin if (a = 0) or (b = 0) then begin result := 0; exit; end; repeat r := b; b := a mod b; a := r; until b = 0; result := a; end;
function p_kgv(a, b: int64): int64; begin result := (a * b) div p_ggT(a, b); end;
function p_primfaktor(a: int64): TPrimfaktor; var Teiler: Int64; begin if a < 0 then begin SetLength(result, 1); result[0] := -1; a := -a; end; while (a and 1) = 0 do begin setlength(result, length(result) + 1); Result[high(Result)] := 2; a := a shr 1; end; if a >= 2 then begin Teiler := 3; while a mod Teiler = 0 do begin setlength(result, length(result) + 1); Result[high(Result)] := Teiler; a := a div Teiler; end; Inc(Teiler, 2); while Teiler <= Trunc(SQRT(1.0 * a)) do begin while a mod Teiler = 0 do begin setlength(result, length(result) + 1); Result[high(Result)] := Teiler; a := a div Teiler; end; Inc(Teiler, 2); while a mod Teiler = 0 do begin setlength(result, length(result) + 1); Result[high(Result)] := Teiler; a := a div Teiler; end; Inc(Teiler, 4); end; end; if a <> 1 then begin setlength(result, length(result) + 1); Result[high(Result)] := a; end; end;
procedure p_kuerzen(var Bruch: TBruch); var ggt: int64; begin if Bruch.Zaehler = 0 then begin Bruch.Nenner := 1; exit; end; ggt := p_ggt(Bruch.Zaehler, Bruch.Nenner); if ggt = 1 then exit; Bruch.Zaehler := Bruch.Zaehler div ggt; Bruch.Nenner := Bruch.Nenner div ggt; end;
function p_add(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; begin result.Nenner := Bruch1.Nenner * Bruch2.Nenner; result.Zaehler := Bruch1.Zaehler * Bruch2.Nenner + Bruch2.Zaehler * Bruch1.Nenner; if kuerzen then p_kuerzen(result); end;
function p_sub(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; begin result.Nenner := Bruch1.Nenner * Bruch2.Nenner; result.Zaehler := Bruch1.Zaehler * Bruch2.Nenner - Bruch2.Zaehler * Bruch1.Nenner; if kuerzen then p_kuerzen(result); end;
function p_multi(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; begin result.Nenner := Bruch1.Nenner * Bruch2.Nenner; result.Zaehler := Bruch1.Zaehler * Bruch2.Zaehler; if kuerzen then p_kuerzen(result); end;
function p_div(Bruch1, Bruch2: TBruch; kuerzen: boolean = true): TBruch; begin result.Nenner := Bruch1.Nenner * Bruch2.Zaehler; result.Zaehler := Bruch1.Zaehler * Bruch2.Nenner; if kuerzen then p_kuerzen(result); end;
function p_compare(Bruch1, Bruch2: TBruch): boolean; begin result := Bruch1.Zaehler * Bruch2.Nenner = Bruch2.Zaehler * Bruch1.Nenner; end;
function ToBruch(zaehler, nenner: int64): TBruch; begin result.zaehler := zaehler; result.Nenner := nenner; end;
function BruchToFloat(Bruch: TBruch): Extended; begin result := Bruch.Zaehler / Bruch.Nenner; end;
function FloatToBruch(const a: Extended): TBruch; overload; var Faktor: int64; i: integer; begin Faktor := 1; for i := 1 to length(floattostr(frac(a))) do Faktor := Faktor * 10; result.Zaehler := round(a * Faktor); result.Nenner := Faktor; p_kuerzen(result); end;
function FloatToBruch(const a, toleranz: Extended): TBruch; overload; var p, lastp, q, lastq, ptemp, qtemp, u, err, d: Extended; begin p := 1; q := 0; lastp := 0; lastq := 1; u := a; repeat d := round(u); u := u - d; ptemp := p * d + lastp; qtemp := q * d + lastq; lastp := p; lastq := q; p := ptemp; q := qtemp; err := abs(p / q - a); if (u = 0) or (err < toleranz) or (a + err / 4 = a) then break; u := 1 / u; until false; if (p > high(Int64)) or (p < low(Int64)) then exit; if (q > high(Int64)) or (q < low(Int64)) then exit; if q < 0 then result.Zaehler := - Trunc(p) else result.Zaehler := Trunc(p); result.Nenner := abs(Trunc(q)); end;
function BruchToStr(Bruch: TBruch): string; begin result := Format('%d/%d', [Bruch.Zaehler, Bruch.Nenner]); end;
function StrToBruch(const s: string; toleranz: Extended = -1; kuerzen: boolean = true): TBruch; var p : integer; begin p := pos('/', s); if p = 0 then begin if toleranz = -1 then result := FloatToBruch(strtofloat(trim(s))) else result := FloatToBruch(strtofloat(trim(s)), toleranz); end else begin result.Zaehler := StrToInt64Def(trim(copy(s, 1, p - 1)), 0); result.Nenner := StrToInt64Def(trim(copy(s, p + 1, Length(s))), 1); end; if kuerzen then p_kuerzen(result); end;
function BruchToBruchG(Bruch: TBruch; kuerzen: boolean = true): TBruchG; begin if kuerzen then p_kuerzen(Bruch); result.Zahl := 0; result.Bruch := Bruch; if Bruch.Zaehler < Bruch.Nenner then exit; result.Zahl := Bruch.Zaehler div Bruch.Nenner; result.Bruch.Zaehler := Bruch.Zaehler mod Bruch.Nenner; end;
function BruchGToBruch(BruchG: TBruchG; kuerzen: boolean = true): TBruch; begin result.Zaehler := BruchG.Bruch.Zaehler + BruchG.Zahl * BruchG.Bruch.Nenner; result.Nenner := BruchG.Bruch.Nenner; if kuerzen then p_kuerzen(result); end;
function BruchGToStr(BruchG: TBruchG): string; begin result := Format('%d %d/%d', [BruchG.Zahl, BruchG.Bruch.Zaehler, BruchG.Bruch.Nenner]); end;
end. |
Die Primfaktor zerlegung gibt an der ersten Stelle eine -1 aus, wenn die Zahl negativ ist.
Zuletzt bearbeitet von F34r0fTh3D4rk am Sa 22.04.06 10:12, insgesamt 22-mal bearbeitet
|
|
Martin1966
Beiträge: 1068
Win 2000, Win XP
Delphi 7, Delphi 2005
|
Verfasst: Mo 19.12.05 11:10
Super, danke für das Veröffentlichen diseser Unit. Wenn ich mal Zeit habe dann teste ich die Funktionen!!
Wofür steht das p_ vor den meisten Funktionen?
Wäre es nicht sinnvoll die beiden Funktionen FloatToBruch und FloatToBruch2 die gleiche Bezeichnung zu verpassen und dann als overload zu deklarieren?
Lg Martin
_________________ Ein Nutzer der Ecke
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Mo 19.12.05 15:20
das mit overload ist keine schlechte idee, das p_ stand ursprünglich mal für procedure, ich benutze es, um zu verhindern, dass ich einen funktionsnamen wähle den es schon gibt
|
|
Kroko
Beiträge: 1284
W98 W2k WXP
Turbo D
|
Verfasst: Mo 19.12.05 15:29
_________________ Die F1-Taste steht nicht unter Naturschutz und darf somit regelmäßig und oft benutzt werden! oder Wer lesen kann, ist klar im Vorteil!
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Mo 19.12.05 15:36
|
|
Kroko
Beiträge: 1284
W98 W2k WXP
Turbo D
|
Verfasst: Mo 19.12.05 18:55
Bruchrechnung Klasse 5
a/b = c/d , wenn gilt a*d=b*c
_________________ Die F1-Taste steht nicht unter Naturschutz und darf somit regelmäßig und oft benutzt werden! oder Wer lesen kann, ist klar im Vorteil!
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Mo 19.12.05 20:07
aso ja, hast recht ^^ ändere ich sofort
ist ja das gleiche wie ac/dc
|
|
beshig
Beiträge: 110
Erhaltene Danke: 1
WIN 2000, WIN XP, WIN 2003, Debian Linux
Delphi 7 Personal, Delphi 2005 Personal
|
Verfasst: Sa 25.02.06 14:52
da sieht man mal, wie schnell man auch beim Programmieren auf Musik kommt *AC/DV Fan bin*.
Mir gefällt diese Unit, habe sie heute schon einmal benutzt in einem Programm !
_________________ Was ist ein Moderatorenteam in einem recht bekannten Programmierer-Forum ? Viele Meinungen, eine zählt - Mehr ist ja auch nicht notwendig...
|
|
LLCoolDave
Beiträge: 212
Win XP
Delphi 2005
|
Verfasst: Sa 25.02.06 15:04
beshig hat folgendes geschrieben: | da sieht man mal, wie schnell man auch beim Programmieren auf Musik kommt *AC/DV Fan bin*. |
Nur dass das für Alternating current/Direct current steht
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Sa 25.02.06 15:37
Die Initialie Zuweisung von 0\0 bei den meisten Grundrechenarten kann entfallen. Müsste Dir der Compiler aber eigentlich ansagen.
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Sa 25.02.06 17:22
hab ich selbst gemerkt, aber ich habs lieber gelassen
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Sa 25.02.06 17:39
Was überflüssig ist, sollte man wenn möglich auch entfernen.
Übrigens: Export brauchst Du nicht anzugeben, hat unter allen Delphi-Versionen ab D2 eh keine Auswirkung mehr.
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Sa 25.02.06 17:40
man muss ja abwärts kompatibel bleiben werde ich bei gelegenheit ändern, danke
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Sa 25.02.06 18:04
Auf Grund der dynamischen Arrays läuft dein Source eh erst ab D4 ... Von daher ist das eh egal ...
BTW: Könntest Du noch eine Funktion zum Zusammenfassen der Primfaktor-Zerlegung zu Potenzen einbauen???
Sprich:
Delphi-Quelltext 1:
| 64 = 2*2*2*2*2*2 = 2 ^ 6 |
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Sa 25.02.06 19:28
wäre machbar, werd ich bei gelegenheit mal versuchen
|
|
wp_xxyyzz
Beiträge: 40
|
Verfasst: So 26.02.06 16:31
Bin gerade dabei, diese schöne und nützliche Unit zu testen. Beim Berechnen der Summe von 1/2 und -1/2 gab es aber eine Division durch null, da ggt(0)=0 ist. Die "kuerzen"-Routine, in der durch den ggT dividiert wird, solltest du folgendermaßen ergänzen:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10:
| function kuerzen(Bruch:TBruch) : TBruch; begin if Bruch.Zaehler=0 then begin result.Zaehler := 0; result.Nenner := 1; exit; end; result := Bruch; end; |
Nützlich erscheinen mir auch:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18:
| function BruchToStr(Bruch:TBruch) : string; begin result := Format('%d / %d', [Bruch.Zaehler, Bruch.Nenner]); end;
function StrToBruch(const s:string) : TBruch; var p : integer; begin p := pos('/', s); if p=0 then begin result.Zaehler := StrToInt64(trim(s)); result.Nenner := 1; end else begin result.Zaehler := StrToInt64(trim(copy(s, 1, p-1))); result.Nenner := StrToInt64(trim(copy(s, p+1, Length(s)))); end; end; |
Gruß, Werner
|
|
wp_xxyyzz
Beiträge: 40
|
Verfasst: So 26.02.06 17:15
Ach ja, und die Primfaktorzerlegung findet bei negativen Zahlen kein Ende. Ich habe an den Anfang der Routine folgendes gesetzt:
Delphi-Quelltext 1: 2: 3: 4: 5: 6:
| if a<0 then begin SetLength(result, 1); result[0] := -1; a := -a; end; |
Gruß, Werner
|
|
F34r0fTh3D4rk
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: So 26.02.06 17:25
danke, werde ich überarbeiten
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: So 26.02.06 17:49
wp_xxyyzz hat folgendes geschrieben: | Nützlich erscheinen mir auch:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18:
| function BruchToStr(Bruch:TBruch) : string; begin result := Format('%d / %d', [Bruch.Zaehler, Bruch.Nenner]); end;
function StrToBruch(const s:string) : TBruch; var p : integer; begin p := pos('/', s); if p=0 then begin result.Zaehler := StrToInt64(trim(s)); result.Nenner := 1; end else begin result.Zaehler := StrToInt64(trim(copy(s, 1, p-1))); result.Nenner := StrToInt64(trim(copy(s, p+1, Length(s)))); end; end; |
Gruß, Werner |
Sollte die 2. Routine nicht, wenn kein Bruchstrich vorkommt, FloatToBruch aufrufen? Fänd ich logischer...
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
wp_xxyyzz
Beiträge: 40
|
Verfasst: So 26.02.06 18:13
BenBE hat folgendes geschrieben: |
Sollte die 2. Routine nicht, wenn kein Bruchstrich vorkommt, FloatToBruch aufrufen? Fänd ich logischer... |
Wenn kein Bruchstrich vorkommt, muss es sich um eine ganze Zahl handeln, da TBruch nur aus ganzen Zahlen zusammengesetzt ist.
|
|
|