From a034fbaedcd4941106abe5b44b3e57ba930dea68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 31 Jan 2024 18:58:49 +0100 Subject: [PATCH 01/48] Added integer factorization and enumeration of dividers --- UNumberTheory.pas | 220 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 219 insertions(+), 1 deletion(-) diff --git a/UNumberTheory.pas b/UNumberTheory.pas index 99b7fd5..a247344 100644 --- a/UNumberTheory.pas +++ b/UNumberTheory.pas @@ -22,7 +22,7 @@ unit UNumberTheory; interface uses - Classes, SysUtils; + Classes, SysUtils, Generics.Collections, Math; type @@ -34,6 +34,52 @@ type class function LeastCommonMultiple(AValue1, AValue2: Int64): Int64; end; + TInt64Array = array of Int64; + + { TIntegerFactor } + + TIntegerFactor = record + Factor: Int64; + Exponent: Byte; + end; + + TIntegerFactors = specialize TList; + + { TIntegerFactorization } + + TIntegerFactorization = class + public + class function PollardsRhoAlgorithm(const AValue: Int64): TInt64Array; + class function GetNormalized(constref AIntegerFactorArray: TInt64Array): TIntegerFactors; + end; + + { TDividersEnumerator } + + TDividersEnumerator = class + private + FFactors: TIntegerFactors; + FCurrentExponents: array of Byte; + function GetCount: Integer; + public + constructor Create(constref AIntegerFactorArray: TInt64Array); + destructor Destroy; override; + function GetCurrent: Int64; + function MoveNext: Boolean; + procedure Reset; + property Current: Int64 read GetCurrent; + property Count: Integer read GetCount; + end; + + { TDividers } + + TDividers = class + private + FFactorArray: TInt64Array; + public + constructor Create(constref AIntegerFactorArray: TInt64Array); + function GetEnumerator: TDividersEnumerator; + end; + implementation { TNumberTheory } @@ -58,5 +104,177 @@ begin Result := (Abs(AValue1) div GreatestCommonDivisor(AValue1, AValue2)) * Abs(AValue2); end; +{ TIntegerFactorization } + +// https://en.wikipedia.org/wiki/Pollard%27s_rho_algorithm +class function TIntegerFactorization.PollardsRhoAlgorithm(const AValue: Int64): TInt64Array; +var + primes: specialize TList; + composites: specialize TStack; + factor, n: Int64; + i: Integer; + + function G(const AX, AC: Int64): Int64; + begin + Result := (AX * AX + AC) mod n; + end; + + function FindFactor(const AStartValue, AC: Int64): Int64; + var + x, y, d: Int64; + begin + x := AStartValue; + y := x; + d := 1; + while d = 1 do + begin + x := G(x, AC); + y := G(G(y, AC), AC); + d := TNumberTheory.GreatestCommonDivisor(Abs(x - y), n); + end; + Result := d; + end; + +begin + primes := specialize TList.Create; + composites := specialize TStack.Create; + + n := Abs(AValue); + while (n and 1) = 0 do + begin + primes.Add(2); + n := n shr 1; + end; + + composites.Push(n); + while composites.Count > 0 do + begin + n := composites.Pop; + i := 0; + repeat + factor := FindFactor(2 + (i + 1) div 2, 1 - i div 2); + if factor < n then + begin + composites.Push(factor); + composites.Push(n div factor); + end; + Inc(i); + until (factor < n) or (i > 3); + if factor = n then + primes.Add(factor); + end; + + Result := primes.ToArray; + + primes.Free; + composites.Free; +end; + +class function TIntegerFactorization.GetNormalized(constref AIntegerFactorArray: TInt64Array): TIntegerFactors; +var + i: Integer; + factor: Int64; + normal: TIntegerFactor; + found: Boolean; +begin + Result := TIntegerFactors.Create; + for factor in AIntegerFactorArray do + begin + found := False; + for i := 0 to Result.Count - 1 do + if Result[i].Factor = factor then + begin + found := True; + normal := Result[i]; + Inc(normal.Exponent); + Result[i] := normal; + Break; + end; + if not found then + begin + normal.Factor := factor; + normal.Exponent := 1; + Result.Add(normal); + end; + end; +end; + +{ TDividersEnumerator } + +function TDividersEnumerator.GetCount: Integer; +var + factor: TIntegerFactor; +begin + if FFactors.Count > 0 then + begin + Result := 1; + for factor in FFactors do + Result := Result * factor.Exponent; + Dec(Result); + end + else + Result := 0; +end; + +constructor TDividersEnumerator.Create(constref AIntegerFactorArray: TInt64Array); +begin + FFactors := TIntegerFactorization.GetNormalized(AIntegerFactorArray); + SetLength(FCurrentExponents, FFactors.Count); +end; + +destructor TDividersEnumerator.Destroy; +begin + FFactors.Free; +end; + +function TDividersEnumerator.GetCurrent: Int64; +var + i: Integer; +begin + Result := 1; + for i := Low(FCurrentExponents) to High(FCurrentExponents) do + if FCurrentExponents[i] > 0 then + Result := Result * Round(Power(FFactors[i].Factor, FCurrentExponents[i])); +end; + +function TDividersEnumerator.MoveNext: Boolean; +var + i: Integer; +begin + Result := False; + i := 0; + while (i <= High(FCurrentExponents)) and (FCurrentExponents[i] >= FFactors[i].Exponent) do + begin + FCurrentExponents[i] := 0; + Inc(i); + end; + + if i <= High(FCurrentExponents) then + begin + Inc(FCurrentExponents[i]); + Result := True; + end; +end; + +procedure TDividersEnumerator.Reset; +var + i: Integer; +begin + for i := Low(FCurrentExponents) to High(FCurrentExponents) do + FCurrentExponents[i] := 0; +end; + +{ TDividers } + +constructor TDividers.Create(constref AIntegerFactorArray: TInt64Array); +begin + FFactorArray := AIntegerFactorArray; +end; + +function TDividers.GetEnumerator: TDividersEnumerator; +begin + Result := TDividersEnumerator.Create(FFactorArray); +end; + end. From 7a6623c99ce41f6ab840573fa36efdce9d991912 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 31 Jan 2024 18:59:28 +0100 Subject: [PATCH 02/48] Added draft of TBigInt object --- AdventOfCode.lpi | 4 + UBigInt.pas | 476 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 480 insertions(+) create mode 100644 UBigInt.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index 9255b8b..ca33018 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -137,6 +137,10 @@ + + + + diff --git a/UBigInt.pas b/UBigInt.pas new file mode 100644 index 0000000..2277013 --- /dev/null +++ b/UBigInt.pas @@ -0,0 +1,476 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2022-2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UBigInt; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, Math; + +type + TDigits = array of Cardinal; + + { TBigInt } + + // This is an abbreviated reimplementation of a C# class created in 2022. + TBigInt = object + private + FDigits: TDigits; + FIsNegative: Boolean; + // Adds A and B, ignoring their signs and using ReturnNegative instead. The result is + // Sign * (Abs(A) + Abs(B)), + // where Sign is 1 for ReturnNegative = False and -1 otherwise. + class function AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + // Subtracts B from A, ignoring their signs. However, the result might be negative, and the sign can be reversed by + // setting ReturnNegative to True. The result is + // Sign * (Abs(A) - Abs(B)), + // where Sign is 1 for ReturnNegative = False and -1 otherwise. + class function SubtractAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + // Multiplies A and B, ignoring their signs and using ReturnNegative instead. This multiplication uses a recursive + // implementation of the Karatsuba algorithm. See + // https://www.geeksforgeeks.org/karatsuba-algorithm-for-fast-multiplication-using-divide-and-conquer-algorithm/ + // The result is + // Sign * (Abs(a) * Abs(b)) + // where Sign is 1 for ReturnNegative = False and -1 otherwise. + class function MultiplyAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + // Copies consecutive digits from this BigInt to create a new one. The result will be positive. Leading zeros are + // removed from the result, but AIndex + ACount must not exceed the number of digits of this BigInt. + // AIndex is the first (least significant) digit to be taken. The digit with this index will become the 0th digit of + // the new BigInt. + // ACount is the number of consecutive digits to be taken, and the number of digits of the result. + function GetSegment(const AIndex, ACount: Integer): TBigInt; + // Compares the absolute value of this TBigInt object to the absolute value of another one. Returns -1 if this + // object is less than AOther, 1 if this object is greater than AOther, and 0 if they are equal. + function CompareToAbsoluteValues(constref AOther: TBigInt): Integer; + public + property IsNegative: Boolean read FIsNegative; + constructor InitZero; + constructor Init(const AValue: Int64); + destructor Done; + function CompareTo(constref AOther: TBigInt): Integer; + end; + + operator := (const A: Int64): TBigInt; + operator + (const A, B: TBigInt): TBigInt; + operator - (const A, B: TBigInt): TBigInt; + operator * (const A: TBigInt; const B: Int64): TBigInt; + operator shl (const A: TBigInt; const B: Integer): TBigInt; + operator = (const A: TBigInt; const B: Int64): Boolean; + +implementation + +const + CBase = Cardinal.MaxValue + 1; + CMaxDigit = Cardinal.MaxValue; + CDigitSize = SizeOf(Cardinal); + CBitsPerDigit = CDigitSize * 8; + CHalfBits = CBitsPerDigit >> 1; + CHalfDigitMax = (1 << CHalfBits) - 1; + +{ TBigInt } + +class function TBigInt.AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; +var + i, lenA, lenB, len, shorter: Integer; + carry: Cardinal; +begin + lenA := Length(AA.FDigits); + lenB := Length(AB.FDigits); + + // Initializes the digits array of the result, with a simple test to try to predict a carry-over into a new digit. The + // result could still carry into new digit depending on lower digits (carry over multiple digits), which would be + // handled at the end. + if lenA = lenB then + if CMaxDigit - AA.FDigits[lenA - 1] < AB.FDigits[lenB - 1] then + // Result will carry into new digit. + SetLength(Result.FDigits, lenA + 1) + else + SetLength(Result.FDigits, lenA) + else + SetLength(Result.FDigits, Max(lenA, lenB)); + len := Length(Result.FDigits); + + // Calculates the new digits from less to more significant until the end of the shorter operand is reached. + shorter := Min(Length(AA.FDigits), Length(AB.FDigits)); + i := 0; + carry := 0; + while i < shorter do + begin + if (AB.FDigits[i] = CMaxDigit) and (carry > 0) then + begin + Result.FDigits[i] := AA.FDigits[i]; + carry := 1; + end + else + if CMaxDigit - AA.FDigits[i] < AB.FDigits[i] + carry then + begin + Result.FDigits[i] := AB.FDigits[i] + carry - 1 - (CMaxDigit - AA.FDigits[i]); + carry := 1; + end + else begin + Result.FDigits[i] := AA.FDigits[i] + AB.FDigits[i] + carry; + carry := 0; + end; + Inc(i); + end; + + // Copies the missing unchanged digits from the longer operand to the result, if any, before applying remaining + // carry-overs. This avoids additional tests for finding the shorter digit array. + if (i < lenA) or (i < lenB) then + if lenA >= lenB then + Move(AA.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)) + else + Move(AB.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)); + + // Applies the remaining carry-overs until the end of the prepared result digit array. + while (carry > 0) and (i < len) do + begin + if Result.FDigits[i] = CMaxDigit then + Result.FDigits[i] := 0 + else begin + Inc(Result.FDigits[i]); + carry := 0; + end; + Inc(i); + end; + + // Applies the carry-over into a new digit that was not anticipated in the initialization at the top (carry over + // multiple digits). + if carry > 0 then + Insert(1, Result.FDigits, 0); + Result.FIsNegative := AReturnNegative; +end; + +class function TBigInt.SubtractAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; +var + a, b: TBigInt; + carry: Cardinal; + i, lastNonZeroDigitIndex, len: Integer; +begin + // Establishes the operand order, such that Abs(a) is not less than Abs(b). + if (AA.CompareToAbsoluteValues(AB) >= 0) then + begin + a := AA; + b := AB; + Result.FIsNegative := AReturnNegative; + end + else begin + a := AB; + b := AA; + Result.FIsNegative := not AReturnNegative; + end; + + // Calculates the new digits from less to more significant until the end of the shorter operand is reached and all + // carry-overs have been applied. + len := Length(a.FDigits); + SetLength(Result.FDigits, len); + carry := 0; + // Tracks leading zeros for the trim below. + lastNonZeroDigitIndex := 0; + i := 0; + while i < Length(b.FDigits) do + begin + if (a.FDigits[i] = b.FDigits[i]) and (carry > 0) then + begin + Result.FDigits[i] := CMaxDigit; + carry := 1; + lastNonZeroDigitIndex := i; + end + else begin + if a.FDigits[i] < b.FDigits[i] then + begin + Result.FDigits[i] := CMaxDigit - (b.FDigits[i] - a.FDigits[i]) + 1 - carry; + carry := 1; + end + else begin + Result.FDigits[i] := a.FDigits[i] - b.FDigits[i] - carry; + carry := 0; + end; + if (Result.FDigits[i] > 0) then + lastNonZeroDigitIndex := i; + end; + Inc(i); + end; + while carry > 0 do + begin + if a.FDigits[i] = 0 then + begin + Result.FDigits[i] := CMaxDigit; + lastNonZeroDigitIndex := i; + end + else begin + Result.FDigits[i] := a.FDigits[i] - carry; + carry := 0; + if (Result.FDigits[i] > 0) then + lastNonZeroDigitIndex := i; + end; + Inc(i); + end; + + // Copies the missing unchanged digits from the longer operand to the result, if any. If there are none, then no trim + // needs to occur because the most significant digit is not zero. + if i < len then + Move(a.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)) + else if (lastNonZeroDigitIndex + 1 < len) then + // Trims leading zeros from the digits array. + Delete(Result.FDigits, lastNonZeroDigitIndex + 1, len - lastNonZeroDigitIndex - 1); +end; + +class function TBigInt.MultiplyAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; +var + lenA, lenB, lenMax, floorHalfLength, ceilHalfLength: Integer; + a1, a0, b1, b0, a1b1, a0b0: Cardinal; + am, bm, middle, biga1, biga0, bigb1, bigb0, biga1b1, biga0b0: TBigInt; +begin + lenA := Length(AA.FDigits); + lenB := Length(AB.FDigits); + if (lenA <= 1) and (lenB <= 1) then + begin + if (AA.FDigits[0] <= CHalfDigitMax) and (AB.FDigits[0] <= CHalfDigitMax) then + if (AA.FDigits[0] = 0) or (AB.FDigits[0] = 0) then + Result.InitZero + else begin + Result.FDigits := TDigits.Create(AA.FDigits[0] * AB.FDigits[0]); + Result.FIsNegative := AReturnNegative; + end + else begin + // a1, a0, b1, b0 use only the lower (less significant) half of the bits of a digit, so the product of any two of + // these fits in one digit. + a1 := AA.FDigits[0] >> CHalfBits; + a0 := AA.FDigits[0] and CHalfDigitMax; + b1 := AB.FDigits[0] >> CHalfBits; + b0 := AB.FDigits[0] and CHalfDigitMax; + a1b1 := a1 * b1; + a0b0 := a0 * b0; + + if a1b1 > 0 then + Result.FDigits := TDigits.Create(a0b0, a1b1) + else + Result.FDigits := TDigits.Create(a0b0); + Result.FIsNegative := AReturnNegative; + + // The result of (a1 + a0) * (b1 + b0) might not fit in one digit, so one last recursion step is necessary. + am.Init(a1 + a0); + bm.Init(b1 + b0); + middle := (MultiplyAbsoluteValues(am, bm, False) - a1b1 - a0b0) << CHalfBits; + if AReturnNegative then + Result := Result - middle + else + Result := Result + middle; + end; + end + else begin + // Calculates where to split the two numbers. + lenMax := Max(lenA, lenB); + floorHalfLength := lenMax >> 1; + ceilHalfLength := lenMax - floorHalfLength; + + // Performs one recursion step. + if ceilHalfLength < lenA then + begin + biga1 := AA.GetSegment(ceilHalfLength, lenA - ceilHalfLength); + biga0 := AA.GetSegment(0, ceilHalfLength); + + if ceilHalfLength < lenB then + begin + bigb1 := AB.GetSegment(ceilHalfLength, lenB - ceilHalfLength); + bigb0 := AB.GetSegment(0, ceilHalfLength); + biga1b1 := MultiplyAbsoluteValues(biga1, bigb1, AReturnNegative); + biga0b0 := MultiplyAbsoluteValues(biga0, bigb0, AReturnNegative); + Result := (biga1b1 << (2 * ceilHalfLength * CBitsPerDigit)) + + ((MultiplyAbsoluteValues(biga1 + biga0, bigb1 + bigb0, AReturnNegative) - biga1b1 - biga0b0) << (ceilHalfLength * CBitsPerDigit)) + + biga0b0; + end + else begin + biga0b0 := MultiplyAbsoluteValues(biga0, AB, AReturnNegative); + Result := ((MultiplyAbsoluteValues(biga1 + biga0, AB, AReturnNegative) - biga0b0) << (ceilHalfLength * CBitsPerDigit)) + biga0b0; + end; + end + else begin + bigb1 := AB.GetSegment(ceilHalfLength, lenB - ceilHalfLength); + bigb0 := AB.GetSegment(0, ceilHalfLength); + biga0b0 := MultiplyAbsoluteValues(AA, bigb0, AReturnNegative); + Result := ((MultiplyAbsoluteValues(AA, bigb1 + bigb0, AReturnNegative) - biga0b0) << (ceilHalfLength * CBitsPerDigit)) + biga0b0; + end; + end; +end; + +function TBigInt.GetSegment(const AIndex, ACount: Integer): TBigInt; +var + trimmedCount: Integer; +begin + trimmedCount := ACount; + while (trimmedCount > 1) and (FDigits[AIndex + trimmedCount - 1] = 0) do + Dec(trimmedCount); + SetLength(Result.FDigits, trimmedCount); + Move(FDigits[AIndex], Result.FDigits[0], CDigitSize * trimmedCount); + Result.FIsNegative := False; +end; + +function TBigInt.CompareToAbsoluteValues(constref AOther: TBigInt): Integer; +var + i: Integer; +begin + if Length(FDigits) < Length(AOther.FDigits) then + Result := -1 + else if Length(FDigits) > Length(AOther.FDigits) then + Result := 1 + else begin + Result := 0; + for i := High(FDigits) downto 0 do + if FDigits[i] < AOther.FDigits[i] then + begin + Result := -1; + Break; + end + else if FDigits[i] > AOther.FDigits[i] then + begin + Result := 1; + Break; + end; + end; +end; + +constructor TBigInt.InitZero; +begin + FIsNegative := False; + FDigits := TDigits.Create(0); +end; + +constructor TBigInt.Init(const AValue: Int64); +var + absVal: Int64; +begin + FIsNegative := AValue < 0; + if AValue <> Int64.MinValue then + begin + absVal := Abs(AValue); + if absVal >= CBase then + FDigits := TDigits.Create(absVal mod CBase, absVal div CBase) + else + FDigits := TDigits.Create(absVal); + end + else begin + FIsNegative := True; + FDigits := TDigits.Create(0, 1 << 31); + end; +end; + +destructor TBigInt.Done; +begin + SetLength(FDigits, 0); +end; + +function TBigInt.CompareTo(constref AOther: TBigInt): Integer; +begin + if IsNegative = AOther.IsNegative then + Result := CompareToAbsoluteValues(AOther) + else + Result := 1; + if IsNegative then + Result := -Result; +end; + +operator := (const A: Int64): TBigInt; +begin + Result.Done; + Result.Init(A); +end; + +operator + (const A, B: TBigInt): TBigInt; +begin + if A.IsNegative = B.IsNegative then + Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative) + else + Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative); +end; + +operator - (const A, B: TBigInt): TBigInt; +begin + if A.IsNegative = B.IsNegative then + Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative) + else + Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative); +end; + +operator * (const A: TBigInt; const B: Int64): TBigInt; +begin + if (a = 0) or (b = 0) then + Result.InitZero + else + Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative = (B > 0)); +end; + +operator shl(const A: TBigInt; const B: Integer): TBigInt; +var + i, j, digitShifts, bitShifts, reverseShift, len, newLength: Integer; + lastDigit: Cardinal; +begin + // Handles shift of zero. + if A = 0 then + Result.InitZero + else begin + // Determines full digit shifts and bit shifts. + DivMod(B, CBitsPerDigit, digitShifts, bitShifts); + + if bitShifts > 0 then + begin + reverseShift := CBitsPerDigit - bitShifts; + len := Length(A.FDigits); + lastDigit := A.FDigits[len - 1] >> reverseShift; + newLength := len + digitShifts; + + if lastDigit = 0 then + SetLength(Result.FDigits, newLength) + else + SetLength(Result.FDigits, newLength + 1); + + // Performs full digit shifts by shifting the access index j for A.FDigits. + Result.FDigits[digitShifts] := A.FDigits[0] << bitShifts; + j := 0; + for i := digitShifts + 1 to newLength - 1 do + begin + // Performs bit shifts. + Result.FDigits[i] := A.FDigits[j] >> reverseShift; + Inc(j); + Result.FDigits[i] := Result.FDigits[i] or (A.FDigits[j] << bitShifts); + end; + + if Length(Result.FDigits) > newLength then + Result.FDigits[newLength] := lastDigit; + end + else begin + // Performs full digit shifts by copy if there are no bit shifts. + len := Length(A.FDigits); + SetLength(Result.FDigits, len + digitShifts); + Move(A.FDigits[0], Result.FDigits[digitShifts], Length(A.FDigits)); + end; + + Result.FIsNegative := A.IsNegative; + end; +end; + +operator = (const A: TBigInt; const B: Int64): Boolean; +begin + Result := A.CompareTo(B) = 0; +end; + +end. + From bfb33673ee020e5e280dd1bceea5c406ba3a71c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 31 Jan 2024 19:20:10 +0100 Subject: [PATCH 03/48] Fixed some redundant parenthesis --- UBigInt.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 2277013..a6ce5af 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -203,7 +203,7 @@ begin Result.FDigits[i] := a.FDigits[i] - b.FDigits[i] - carry; carry := 0; end; - if (Result.FDigits[i] > 0) then + if Result.FDigits[i] > 0 then lastNonZeroDigitIndex := i; end; Inc(i); @@ -218,7 +218,7 @@ begin else begin Result.FDigits[i] := a.FDigits[i] - carry; carry := 0; - if (Result.FDigits[i] > 0) then + if Result.FDigits[i] > 0 then lastNonZeroDigitIndex := i; end; Inc(i); From 5a3c3209423af591d24ee830aba7b87326d5583e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 14 Feb 2024 11:56:11 +0100 Subject: [PATCH 04/48] Fixed TBigInt heap memory allocation (fixed memory leaks) --- UBigInt.pas | 170 +++++++++++++++++++++++++++------------------------- 1 file changed, 89 insertions(+), 81 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index a6ce5af..9fbbf3f 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -29,20 +29,36 @@ type { TBigInt } - // This is an abbreviated reimplementation of a C# class created in 2022. + // This is an abbreviated reimplementation in Freepascal of a C# class created in 2022. TBigInt = object private FDigits: TDigits; FIsNegative: Boolean; + + // Copies consecutive digits from this BigInt to create a new one. The result will be positive. Leading zeros are + // removed from the result, but AIndex + ACount must not exceed the number of digits of this BigInt. + // AIndex is the first (least significant) digit to be taken. The digit with this index will become the 0th digit of + // the new BigInt. + // ACount is the number of consecutive digits to be taken, and the number of digits of the result. + function GetSegment(const AIndex, ACount: Integer): TBigInt; + + // Compares the absolute value of this TBigInt object to the absolute value of another one. Returns -1 if this + // object is less than AOther, 1 if this object is greater than AOther, and 0 if they are equal. + function CompareToAbsoluteValues(constref AOther: TBigInt): Integer; + + class function GetZero: TBigInt; static; + // Adds A and B, ignoring their signs and using ReturnNegative instead. The result is // Sign * (Abs(A) + Abs(B)), // where Sign is 1 for ReturnNegative = False and -1 otherwise. class function AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + // Subtracts B from A, ignoring their signs. However, the result might be negative, and the sign can be reversed by // setting ReturnNegative to True. The result is // Sign * (Abs(A) - Abs(B)), // where Sign is 1 for ReturnNegative = False and -1 otherwise. class function SubtractAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + // Multiplies A and B, ignoring their signs and using ReturnNegative instead. This multiplication uses a recursive // implementation of the Karatsuba algorithm. See // https://www.geeksforgeeks.org/karatsuba-algorithm-for-fast-multiplication-using-divide-and-conquer-algorithm/ @@ -50,21 +66,11 @@ type // Sign * (Abs(a) * Abs(b)) // where Sign is 1 for ReturnNegative = False and -1 otherwise. class function MultiplyAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; - // Copies consecutive digits from this BigInt to create a new one. The result will be positive. Leading zeros are - // removed from the result, but AIndex + ACount must not exceed the number of digits of this BigInt. - // AIndex is the first (least significant) digit to be taken. The digit with this index will become the 0th digit of - // the new BigInt. - // ACount is the number of consecutive digits to be taken, and the number of digits of the result. - function GetSegment(const AIndex, ACount: Integer): TBigInt; - // Compares the absolute value of this TBigInt object to the absolute value of another one. Returns -1 if this - // object is less than AOther, 1 if this object is greater than AOther, and 0 if they are equal. - function CompareToAbsoluteValues(constref AOther: TBigInt): Integer; public property IsNegative: Boolean read FIsNegative; - constructor InitZero; - constructor Init(const AValue: Int64); - destructor Done; + class property Zero: TBigInt read GetZero; function CompareTo(constref AOther: TBigInt): Integer; + class function FromInt64(const AValue: Int64): TBigInt; static; end; operator := (const A: Int64): TBigInt; @@ -84,8 +90,48 @@ const CHalfBits = CBitsPerDigit >> 1; CHalfDigitMax = (1 << CHalfBits) - 1; + CZero: TBigInt = (FDigits: (0); FIsNegative: False); + { TBigInt } +function TBigInt.GetSegment(const AIndex, ACount: Integer): TBigInt; +var + trimmedCount: Integer; +begin + trimmedCount := ACount; + while (trimmedCount > 1) and (FDigits[AIndex + trimmedCount - 1] = 0) do + Dec(trimmedCount); + SetLength(Result.FDigits, trimmedCount); + Move(FDigits[AIndex], Result.FDigits[0], CDigitSize * trimmedCount); + Result.FIsNegative := False; +end; + +function TBigInt.CompareToAbsoluteValues(constref AOther: TBigInt): Integer; +var + i: Integer; +begin + Result := Length(FDigits) - Length(AOther.FDigits); + if Result = 0 then + begin + for i := High(FDigits) downto 0 do + if FDigits[i] < AOther.FDigits[i] then + begin + Result := -1; + Break; + end + else if FDigits[i] > AOther.FDigits[i] then + begin + Result := 1; + Break; + end; + end; +end; + +class function TBigInt.GetZero: TBigInt; +begin + Result := CZero; +end; + class function TBigInt.AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; var i, lenA, lenB, len, shorter: Integer; @@ -245,7 +291,7 @@ begin begin if (AA.FDigits[0] <= CHalfDigitMax) and (AB.FDigits[0] <= CHalfDigitMax) then if (AA.FDigits[0] = 0) or (AB.FDigits[0] = 0) then - Result.InitZero + Result := Zero else begin Result.FDigits := TDigits.Create(AA.FDigits[0] * AB.FDigits[0]); Result.FIsNegative := AReturnNegative; @@ -267,8 +313,8 @@ begin Result.FIsNegative := AReturnNegative; // The result of (a1 + a0) * (b1 + b0) might not fit in one digit, so one last recursion step is necessary. - am.Init(a1 + a0); - bm.Init(b1 + b0); + am := FromInt64(a1 + a0); + bm := FromInt64(b1 + b0); middle := (MultiplyAbsoluteValues(am, bm, False) - a1b1 - a0b0) << CHalfBits; if AReturnNegative then Result := Result - middle @@ -312,86 +358,48 @@ begin end; end; -function TBigInt.GetSegment(const AIndex, ACount: Integer): TBigInt; -var - trimmedCount: Integer; +function TBigInt.CompareTo(constref AOther: TBigInt): Integer; begin - trimmedCount := ACount; - while (trimmedCount > 1) and (FDigits[AIndex + trimmedCount - 1] = 0) do - Dec(trimmedCount); - SetLength(Result.FDigits, trimmedCount); - Move(FDigits[AIndex], Result.FDigits[0], CDigitSize * trimmedCount); - Result.FIsNegative := False; + if FIsNegative = AOther.FIsNegative then + Result := CompareToAbsoluteValues(AOther) + else + Result := 1; + if FIsNegative then + Result := -Result; end; -function TBigInt.CompareToAbsoluteValues(constref AOther: TBigInt): Integer; -var - i: Integer; -begin - if Length(FDigits) < Length(AOther.FDigits) then - Result := -1 - else if Length(FDigits) > Length(AOther.FDigits) then - Result := 1 - else begin - Result := 0; - for i := High(FDigits) downto 0 do - if FDigits[i] < AOther.FDigits[i] then - begin - Result := -1; - Break; - end - else if FDigits[i] > AOther.FDigits[i] then - begin - Result := 1; - Break; - end; - end; -end; - -constructor TBigInt.InitZero; -begin - FIsNegative := False; - FDigits := TDigits.Create(0); -end; - -constructor TBigInt.Init(const AValue: Int64); +class function TBigInt.FromInt64(const AValue: Int64): TBigInt; var absVal: Int64; begin - FIsNegative := AValue < 0; if AValue <> Int64.MinValue then begin absVal := Abs(AValue); if absVal >= CBase then - FDigits := TDigits.Create(absVal mod CBase, absVal div CBase) + Result.FDigits := TDigits.Create(absVal mod CBase, absVal div CBase) else - FDigits := TDigits.Create(absVal); + Result.FDigits := TDigits.Create(absVal); + Result.FIsNegative := AValue < 0; end else begin - FIsNegative := True; - FDigits := TDigits.Create(0, 1 << 31); + Result.FDigits := TDigits.Create(0, 1 << 31); + Result.FIsNegative := True; end; end; -destructor TBigInt.Done; -begin - SetLength(FDigits, 0); -end; - -function TBigInt.CompareTo(constref AOther: TBigInt): Integer; -begin - if IsNegative = AOther.IsNegative then - Result := CompareToAbsoluteValues(AOther) - else - Result := 1; - if IsNegative then - Result := -Result; -end; - operator := (const A: Int64): TBigInt; begin - Result.Done; - Result.Init(A); + Result := TBigInt.FromInt64(A); +end; + +operator - (const A: TBigInt): TBigInt; +var + len: Integer; +begin + len := Length(A.FDigits); + SetLength(Result.FDigits, len); + Move(A.FDigits[0], Result.FDigits[0], len); + Result.FIsNegative := not A.FIsNegative; end; operator + (const A, B: TBigInt): TBigInt; @@ -412,8 +420,8 @@ end; operator * (const A: TBigInt; const B: Int64): TBigInt; begin - if (a = 0) or (b = 0) then - Result.InitZero + if (A = 0) or (B = 0) then + Result := TBigInt.Zero else Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative = (B > 0)); end; @@ -425,7 +433,7 @@ var begin // Handles shift of zero. if A = 0 then - Result.InitZero + Result := TBigInt.Zero else begin // Determines full digit shifts and bit shifts. DivMod(B, CBitsPerDigit, digitShifts, bitShifts); From cec6985489ebcce0c5a0b16f1d3a4fb45fbb8cff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 14 Feb 2024 11:59:42 +0100 Subject: [PATCH 05/48] Updated operators --- UBigInt.pas | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 9fbbf3f..97a81fa 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -74,11 +74,12 @@ type end; operator := (const A: Int64): TBigInt; + operator - (const A: TBigInt): TBigInt; operator + (const A, B: TBigInt): TBigInt; operator - (const A, B: TBigInt): TBigInt; - operator * (const A: TBigInt; const B: Int64): TBigInt; + operator * (const A, B: TBigInt): TBigInt; operator shl (const A: TBigInt; const B: Integer): TBigInt; - operator = (const A: TBigInt; const B: Int64): Boolean; + operator = (const A, B: TBigInt): Boolean; implementation @@ -418,12 +419,12 @@ begin Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative); end; -operator * (const A: TBigInt; const B: Int64): TBigInt; +operator * (const A, B: TBigInt): TBigInt; begin - if (A = 0) or (B = 0) then + if (A = TBigInt.Zero) or (B = TBigInt.Zero) then Result := TBigInt.Zero else - Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative = (B > 0)); + Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); end; operator shl(const A: TBigInt; const B: Integer): TBigInt; @@ -475,7 +476,7 @@ begin end; end; -operator = (const A: TBigInt; const B: Int64): Boolean; +operator = (const A, B: TBigInt): Boolean; begin Result := A.CompareTo(B) = 0; end; From ef1eba4538fec5f78063261e1df11061a511f167 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 14 Feb 2024 12:00:54 +0100 Subject: [PATCH 06/48] Fixed shl operator: incorrect move for full digit shifts --- UBigInt.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/UBigInt.pas b/UBigInt.pas index 97a81fa..f943fd2 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -469,7 +469,7 @@ begin // Performs full digit shifts by copy if there are no bit shifts. len := Length(A.FDigits); SetLength(Result.FDigits, len + digitShifts); - Move(A.FDigits[0], Result.FDigits[digitShifts], Length(A.FDigits)); + Move(A.FDigits[0], Result.FDigits[digitShifts], CDigitSize * len); end; Result.FIsNegative := A.IsNegative; From 9f619adc01f1ae29dcd0c148b51cb78cce83d568 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 14 Feb 2024 12:02:13 +0100 Subject: [PATCH 07/48] Fixed addition: final carry-over was inserted at the wrong end of the number --- UBigInt.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/UBigInt.pas b/UBigInt.pas index f943fd2..6ee26d8 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -201,7 +201,7 @@ begin // Applies the carry-over into a new digit that was not anticipated in the initialization at the top (carry over // multiple digits). if carry > 0 then - Insert(1, Result.FDigits, 0); + Insert(1, Result.FDigits, len); Result.FIsNegative := AReturnNegative; end; From 44c2c845e057143c528ecd654e96503be7323e31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Wed, 14 Feb 2024 12:07:12 +0100 Subject: [PATCH 08/48] Added WIP analytical solution attempt --- solvers/UNeverTellMeTheOdds.pas | 578 +++++++++++++++++++++++-- tests/UNeverTellMeTheOddsTestCases.pas | 12 + 2 files changed, 560 insertions(+), 30 deletions(-) diff --git a/solvers/UNeverTellMeTheOdds.pas b/solvers/UNeverTellMeTheOdds.pas index 6f5c98d..b4b2e82 100644 --- a/solvers/UNeverTellMeTheOdds.pas +++ b/solvers/UNeverTellMeTheOdds.pas @@ -1,6 +1,6 @@ { Solutions to the Advent Of Code. - Copyright (C) 2023 Stefan Müller + Copyright (C) 2023-2024 Stefan Müller This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software @@ -22,26 +22,45 @@ unit UNeverTellMeTheOdds; interface uses - Classes, SysUtils, Generics.Collections, Math, USolver; + Classes, SysUtils, Generics.Collections, Math, matrix, USolver, UNumberTheory, UBigInt; type { THailstone } - THailstone = record - X, Y, Z: Int64; - VX, VY, VZ: Integer; + THailstone = class + public + Position, Velocity: Tvector3_extended; + constructor Create(const ALine: string); + constructor Create(const APosition, AVelocity: Tvector3_extended); end; - THailstones = specialize TList; + THailstones = specialize TObjectList; + + { TFirstCollisionPolynomial } + + TFirstCollisionPolynomial = class + private + FA: array[0..10] of TBigInt; + FH: array[0..6] of TBigInt; + procedure NormalizeCoefficients; + public + procedure Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1, t_2: Int64); + function EvaluateAt(const AT0: Int64): TBigInt; + function CalcPositiveIntegerRoot: Int64; + function CalcT1(const AT0: Int64): Int64; + end; { TNeverTellMeTheOdds } TNeverTellMeTheOdds = class(TSolver) private FMin, FMax: Int64; - FHailStones: THailstones; + FHailstones: THailstones; + FA: array[0..10] of Int64; + FH: array[0..6] of Int64; function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; + procedure FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer); public constructor Create(const AMin: Int64 = 200000000000000; const AMax: Int64 = 400000000000000); destructor Destroy; override; @@ -51,8 +70,452 @@ type function GetPuzzleName: string; override; end; +const + CIterationThreshold = 0.00001; + CEpsilon = 0.0000000001; + implementation +{ THailstone } + +constructor THailstone.Create(const ALine: string); +var + split: TStringArray; +begin + split := ALine.Split([',', '@']); + Position.init( + StrToFloat(Trim(split[0])), + StrToFloat(Trim(split[1])), + StrToFloat(Trim(split[2]))); + Velocity.init( + StrToFloat(Trim(split[3])), + StrToFloat(Trim(split[4])), + StrToFloat(Trim(split[5]))); +end; + +constructor THailstone.Create(const APosition, AVelocity: Tvector3_extended); +begin + Position := APosition; + Velocity := AVelocity; +end; + +{ TFirstCollisionPolynomial } + +procedure TFirstCollisionPolynomial.NormalizeCoefficients; +var + shift: Integer; + i: Low(FA)..High(FA); + //gcd: TBigInt; +begin + // Eliminates zero constant term. + shift := 0; + while (shift <= High(FA)) and (FA[shift] = 0) do + Inc(shift); + + if shift <= High(FA) then + begin + if shift > 0 then + begin + for i := Low(FA) to High(FA) - shift do + FA[i] := FA[i + shift]; + for i := High(FA) - shift + 1 to High(FA) do + FA[i] := 0; + end; + + //// Finds GCD of all coefficients. + //gcd := FA[Low(FA)]; + //for i := Low(FA) + 1 to High(FA) do + // if FA[i] <> 0 then + // gcd := TNumberTheory.GreatestCommonDivisor(gcd, FA[i]); + //WriteLn('GCD: ', gcd); + // + //for i := Low(FA) to High(FA) do + // FA[i] := FA[i] div gcd; + end; + + //WriteLn('(', FA[10], ') * x^10 + (', FA[9], ') * x^9 + (', FA[8], ') * x^8 + (', FA[7], ') * x^7 + (', + // FA[6], ') * x^6 + (', FA[5], ') * x^5 + (', FA[4], ') * x^4 + (', FA[3], ') * x^3 + (', FA[2], ') * x^2 + (', + // FA[1], ') * x + (', FA[0], ')'); +end; + +procedure TFirstCollisionPolynomial.Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1, + t_2: Int64); +var + P_00, P_01, P_02, P_10, P_11, P_12, P_20, P_21, P_22, + V_00, V_01, V_02, V_10, V_11, V_12, V_20, V_21, V_22: Int64; + k: array[0..139] of TBigInt; + // For debug calculations + act, a_1, a_2, b_0, b_1, c_0, c_1, d_0, d_1, e_0, e_1, f_0, f_1, f_2: Int64; +begin + // Solving this non-linear equation system, with velocities V_i and start positions P_i: + // V_0 * t_0 + P_0 = V_x * t_0 + P_x + // V_1 * t_1 + P_1 = V_x * t_1 + P_x + // V_2 * t_2 + P_2 = V_x * t_2 + P_x + // Which gives: + // P_x = (V_0 - V_x) * t_0 + P_0 + // V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) + // And with vertex components: + // 1: 0 = (t_1 - t_0) * (V_00 * t_0 - V_20 * t_2 + P_00 - P_20) - (t_2 - t_0) * (V_00 * t_0 - V_10 * t_1 + P_00 - P_10) + // 2: t_1 = (((V_01 - V_21) * t_2 + P_11 - P_21) * t_0 + (P_01 - P_11) * t_2) + // / ((V_01 - V_11) * t_0 + (V_11 - V_21) * t_2 + P_01 - P_21) + // 3: t_2 = (((V_02 - V_12) * t_1 + P_22 - P_12) * t_0 + (P_02 - P_22) * t_1) + // / ((V_02 - V_22) * t_0 + (V_22 - V_12) * t_1 + P_02 - P_12) + // for t_0, t_1, t_2 not pairwise equal. + // With some substitutions depending only on t_0 this gives + // 1: 0 = (t_1 - t_0) * (f_2 - V_20 * t_2) - (t_2 - t_0) * (f_1 - V_10 * t_1) + // 2: t_1 = (b_0 + b_1 * t_2) / (c_0 + c_1 * t_2) + // 3: t_2 = (d_0 + d_1 * t_1) / (e_0 + e_1 * t_1) + // And 3 in 2 gives: + // 4: g_2 * t_1^2 - g_1 * t_1 - g_0 = 0 + // Then, with 4 and 3 in 1 and lengthy calculations with many substitutions (see constants k below, now independent of + // t_0), the following polynomial can be constructed, with t_0 being a positive integer root of this polynomial. + // y = a_10 * x^10 + a_9 * x^9 + ... + a_0 + + P_00 := Round(AHailstone1.Position.data[0]); + P_01 := Round(AHailstone1.Position.data[1]); + P_02 := Round(AHailstone1.Position.data[2]); + P_10 := Round(AHailstone2.Position.data[0]); + P_11 := Round(AHailstone2.Position.data[1]); + P_12 := Round(AHailstone2.Position.data[2]); + P_20 := Round(AHailstone3.Position.data[0]); + P_21 := Round(AHailstone3.Position.data[1]); + P_22 := Round(AHailstone3.Position.data[2]); + V_00 := Round(AHailstone1.Velocity.data[0]); + V_01 := Round(AHailstone1.Velocity.data[1]); + V_02 := Round(AHailstone1.Velocity.data[2]); + V_10 := Round(AHailstone2.Velocity.data[0]); + V_11 := Round(AHailstone2.Velocity.data[1]); + V_12 := Round(AHailstone2.Velocity.data[2]); + V_20 := Round(AHailstone3.Velocity.data[0]); + V_21 := Round(AHailstone3.Velocity.data[1]); + V_22 := Round(AHailstone3.Velocity.data[2]); + + k[0] := P_00 - P_20; + k[1] := P_00 - P_10; + k[2] := P_11 - P_21; + k[3] := P_01 - P_11; + k[4] := P_01 - P_21; + k[5] := P_22 - P_12; + k[6] := P_02 - P_22; + k[7] := P_02 - P_12; + k[8] := V_11 - V_21; + k[9] := V_22 - V_12; + k[10] := V_01 - V_21; + k[11] := V_01 - V_11; + k[12] := V_02 - V_12; + k[13] := V_02 - V_22; + + FH[0] := k[11] * k[9] + k[8] * k[12]; + FH[1] := k[4] * k[9] + k[8] * k[6]; + FH[2] := k[11] * k[13] - k[10] * k[12]; + FH[3] := k[11] * k[7] + k[4] * k[13] + k[8] * k[5] - k[2] * k[9] - k[10] * k[6] - k[3] * k[12]; + FH[4] := k[4] * k[7] - k[3] * k[6]; + FH[5] := k[10] * k[5] + k[2] * k[13]; + FH[6] := k[3] * k[5] + k[2] * k[7]; + + k[14] := V_00 * k[9] - V_20 * k[12]; + k[15] := k[0] * k[9] - V_20 * k[6]; + k[16] := V_00 * k[13]; + k[17] := V_00 * k[7] + k[0] * k[13] - V_20 * k[5]; + k[18] := k[0] * k[7]; + k[19] := k[5] - k[7]; + k[20] := 2 * FH[2] * FH[3]; + k[21] := FH[3] * FH[3]; + k[22] := k[21] + 2 * FH[2] * FH[4]; + k[23] := 2 * FH[3] * FH[4]; + k[24] := 2 * FH[0] * FH[1]; + k[25] := FH[0] * FH[0]; // KILL? + k[26] := FH[5] * k[25]; // KILL? + k[126] := FH[5] * FH[0]; + k[127] := FH[5] * FH[1] + FH[6] * FH[0]; + k[128] := FH[6] * FH[1]; + k[27] := FH[5] * k[24] + FH[6] * k[25]; // KILL? + k[28] := FH[1] * FH[1]; // KILL? + k[29] := FH[5] * k[28] + FH[6] * k[24]; // KILL? + k[30] := FH[6] * k[28]; // KILL? + k[31] := FH[2] * FH[2]; + k[132] := k[20] + 4 * k[126]; + k[133] := k[22] + 4 * k[127]; + k[134] := k[23] + 4 * k[128]; + k[32] := k[31] + 4 * k[26]; // KILL? + k[33] := k[20] + 4 * k[27]; // KILL? + k[34] := k[22] + 4 * k[29]; // KILL? + k[35] := k[23] + 4 * k[30]; // KILL? + k[36] := k[31] + 2 * k[26]; // KILL? + k[37] := k[20] + 2 * k[27]; // KILL? + k[38] := k[22] + 2 * k[29]; // KILL? + k[39] := k[23] + 2 * k[30]; // KILL? + k[137] := k[20] + 2 * k[126]; + k[138] := k[22] + 2 * k[127]; + k[139] := k[23] + 2 * k[128]; + k[40] := k[14] + V_10 * (k[12] - k[9]); + k[41] := k[15] + V_10 * k[6]; + k[42] := k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00; + k[43] := k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00; + k[44] := k[18] - k[6] * k[1]; + k[45] := k[42] * FH[0] - k[40] * FH[2]; + k[46] := k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]; + k[47] := k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4]; + k[48] := k[44] * FH[1] - k[41] * FH[4]; + k[49] := k[42] * FH[2]; + k[50] := k[40] * k[31] - k[49] * FH[0]; + k[51] := k[42] * FH[3] + k[43] * FH[2]; + k[52] := k[40] * k[137] + k[41] * k[31] - k[51] * FH[0] - k[49] * FH[1]; + k[53] := k[42] * FH[4] + k[43] * FH[3] + k[44] * FH[2]; + k[54] := k[40] * k[138] + k[41] * k[137] - k[53] * FH[0] - k[51] * FH[1]; + k[55] := k[43] * FH[4] + k[44] * FH[3]; + k[56] := k[40] * k[139] + k[41] * k[138] - k[55] * FH[0] - k[53] * FH[1]; + k[57] := k[44] * FH[4]; + k[58] := FH[4] * FH[4]; + k[59] := k[40] * k[58] + k[41] * k[139] - k[57] * FH[0] - k[55] * FH[1]; + k[60] := k[41] * k[58] - k[57] * FH[1]; + k[61] := k[13] * V_00 - k[16]; + k[62] := 2 * k[25] * k[61]; + k[63] := k[13] * k[1] - k[19] * V_00 - k[17]; + k[64] := 2 * (k[24] * k[61] + k[25] * k[63]); + k[65] := - k[19] * k[1] - k[18]; + k[66] := 2 * (k[28] * k[61] + k[24] * k[63] + k[25] * k[65]); + k[67] := 2 * (k[28] * k[63] + k[24] * k[65]); + k[68] := 2 * k[28] * k[65]; + k[69] := k[50] + k[62]; + k[70] := k[52] + k[64]; + k[71] := k[54] + k[66]; + k[72] := k[56] + k[67]; + k[73] := k[59] + k[68]; + k[74] := k[45] * k[45]; + k[75] := 2 * k[45] * k[46]; + k[76] := k[46] * k[46] + 2 * k[45] * k[47]; + k[77] := 2 * (k[45] * k[48] + k[46] * k[47]); + k[78] := k[47] * k[47] + 2 * k[46] * k[48]; + k[79] := 2 * k[47] * k[48]; + k[80] := k[48] * k[48]; + + FA[0] := k[58] * k[80] - k[60] * k[60]; + FA[1] := k[134] * k[80] + k[58] * k[79] - 2 * k[73] * k[60]; + FA[2] := k[133] * k[80] + k[134] * k[79] + k[58] * k[78] - k[73] * k[73] - 2 * k[72] * k[60]; + FA[3] := k[133] * k[79] + k[134] * k[78] + k[58] * k[77] + k[132] * k[80] + - 2 * (k[71] * k[60] + k[72] * k[73]); + FA[4] := k[31] * k[80] + k[133] * k[78] + k[134] * k[77] + k[58] * k[76] + k[132] * k[79] - k[72] * k[72] + - 2 * (k[70] * k[60] + k[71] * k[73]); + FA[5] := k[31] * k[79] + k[133] * k[77] + k[134] * k[76] + k[58] * k[75] + k[132] * k[78] + - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]); + FA[6] := k[31] * k[78] + k[133] * k[76] + k[134] * k[75] + k[58] * k[74] + k[132] * k[77] - k[71] * k[71] + - 2 * (k[69] * k[73] + k[70] * k[72]); + FA[7] := k[31] * k[77] + k[133] * k[75] + k[134] * k[74] + k[132] * k[76] - 2 * (k[69] * k[72] + k[70] * k[71]); + FA[8] := k[31] * k[76] + k[132] * k[75] + k[133] * k[74] - k[70] * k[70] - 2 * k[69] * k[71]; + FA[9] := k[31] * k[75] + k[132] * k[74] - 2 * k[69] * k[70]; + FA[10] := k[31] * k[74] - k[69] * k[69]; + + // Debug calculations + //a_1 := V_00 * t_0 + P_00 - P_20; + //a_2 := V_00 * t_0 + P_00 - P_10; + //b_0 := (P_11 - P_21) * t_0; + //b_1 := (V_01 - V_21) * t_0 + P_01 - P_11; + //c_0 := (V_01 - V_11) * t_0 + P_01 - P_21; + //c_1 := V_11 - V_21; + //d_0 := (P_22 - P_12) * t_0; + //d_1 := (V_02 - V_12) * t_0 + P_02 - P_22; + //e_0 := (V_02 - V_22) * t_0 + P_02 - P_12; + //e_1 := V_22 - V_12; + //f_2 := c_0 * e_1 + c_1 * d_1; + //f_1 := c_0 * e_0 + c_1 * d_0 - b_0 * e_1 - b_1 * d_1; + //f_0 := b_1 * d_0 + b_0 * e_0; + // + //act := f_2 * t_1 * t_1 + f_1 * t_1 - f_0; + //Write('debug10: ', 0 = act, ' '); + // + //if f_2 <> 0 then + //begin + // act := Round(- f_1 / (2 * f_2) + Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2)); + // Write('debug15: ', t_1 = act); + // act := Round(- f_1 / (2 * f_2) - Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2)); + // Write(' OR ', t_1 = act, ' '); + //end; + // + //act := (e_0 + e_1 * t_1) * t_2 - (d_0 + d_1 * t_1); + //Write('debug20: ', 0 = act, ' '); + // + //act := (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * t_1 * t_1 + // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * t_1 + // + t_0 * (V_20 * d_0 - a_1 * e_0) + (e_0 * t_0 - d_0) * a_2; + //Write('debug30: ', 0 = act, ' '); + // + //act := Round((a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * (f_1 * f_1 + 2 * f_0 * f_2 - f_1 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * (- f_1 * f_2 + f_2 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // + t_0 * (V_20 * d_0 - a_1 * e_0) * 2 * f_2 * f_2 + (e_0 * t_0 - d_0) * a_2 * 2 * f_2 * f_2); + //Write('debug40: ', 0 = act, ' '); + // + //Write('debug41: ', + // a_1 * k[9] - V_20 * d_1 + // = k[14] * t_0 + k[15], ' '); + //Write('debug42: ', + // d_1 - k[9] * t_0 + // = (k[12] - k[9]) * t_0 + k[6], ' '); + //Write('debug43: ', + // a_1 * e_0 - V_20 * d_0 + // = k[16] * t_0 * t_0 + k[17] * t_0 + k[18], ' '); + //Write('debug44: ', + // d_0 - e_0 * t_0 + // = - k[13] * t_0 * t_0 + k[19] * t_0, ' '); + //Write('debug45: ', + // f_1 * f_1 + // = FH[2] * FH[2] * t_0 * t_0 * t_0 * t_0 + k[20] * t_0 * t_0 * t_0 + k[22] * t_0 * t_0 + k[23] * t_0 + FH[4] * FH[4], ' '); + //Write('debug46: ', + // f_2 * f_2 + // = FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1], ' '); + //Write('debug47: ', + // f_0 * f_2 + // = k[126] * t_0 * t_0 * t_0 + k[127] * t_0 * t_0 + k[128] * t_0, ' '); + //Write('debug48: ', + // f_1 * f_1 + 4 * f_0 * f_2 + // = k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58], ' '); + //Write('debug49: ', + // f_1 * f_1 + 2 * f_0 * f_2 + // = k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58], ' '); + // + //act := Round((k[14] * t_0 + k[15] + V_10 * ((k[12] - k[9]) * t_0 + k[6])) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // + (k[16] * t_0 * t_0 + k[17] * t_0 + k[18] - t_0 * (k[14] * t_0 + k[15]) - ((k[12] - k[9]) * t_0 + k[6]) * a_2 - V_10 * (k[13] * t_0 * t_0 - k[19] * t_0)) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])); + //Write('debug50: ', 0 = act, ' '); + // + //Write('debug53: ', + // 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // + ((k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00) * t_0 * t_0 + (k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00) * t_0 + k[18] - k[6] * k[1]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])), + // ' '); + // + //Write('debug55: ', + // 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58]) + // - (k[40] * t_0 + k[41]) * f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2) + // + (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])), + // ' '); + // + //Write('debug70: ', + // 0 = Round(((k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[0] * t_0 + FH[1]) - (k[40] * t_0 + k[41]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4])) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) + // + (k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58]) + // - (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4]) * (FH[0] * t_0 + FH[1]) + // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * (V_00 * t_0 + k[1]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]), + // ' '); +// +// Write('debug73: ', +// 0 = Round(( +// (k[42] * FH[0] - k[40] * FH[2]) * t_0 * t_0 * t_0 +// + (k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]) * t_0 * t_0 +// + (k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4]) * t_0 +// + k[44] * FH[1] - k[41] * FH[4] +// ) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) +// + (k[40] * k[31] - k[42] * FH[2] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0 +// + (k[40] * k[137] + k[41] * k[31] - k[42] * FH[3] * FH[0] - k[43] * FH[2] * FH[0] - k[42] * FH[2] * FH[1]) * t_0 * t_0 * t_0 * t_0 +// + (k[40] * k[138] + k[41] * k[137] - k[42] * FH[4] * FH[0] - k[43] * FH[3] * FH[0] - k[44] * FH[2] * FH[0] - k[42] * FH[3] * FH[1] - k[43] * FH[2] * FH[1]) * t_0 * t_0 * t_0 +// + (k[40] * k[139] + k[41] * k[138] - k[43] * FH[4] * FH[0] - k[44] * FH[3] * FH[0] - k[42] * FH[4] * FH[1] - k[43] * FH[3] * FH[1] - k[44] * FH[2] * FH[1]) * t_0 * t_0 +// + (k[40] * k[58] + k[41] * k[139] - k[44] * FH[4] * FH[0] - k[43] * FH[4] * FH[1] - k[44] * FH[3] * FH[1]) * t_0 +// + k[41] * k[58] - k[44] * FH[4] * FH[1] +// + 2 * (k[13] * V_00 * FH[0] * FH[0] - k[16] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0 +// + 2 * (k[13] * V_00 * k[24] + k[13] * k[1] * FH[0] * FH[0] - k[19] * V_00 * FH[0] * FH[0] - k[16] * k[24] - k[17] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0 +// + 2 * (k[13] * V_00 * FH[1] * FH[1] + k[13] * k[1] * k[24] - k[19] * V_00 * k[24] - k[19] * k[1] * FH[0] * FH[0] - k[16] * FH[1] * FH[1] - k[17] * k[24] - k[18] * FH[0] * FH[0]) * t_0 * t_0 * t_0 +// + 2 * (k[13] * k[1] * FH[1] * FH[1] - k[19] * V_00 * FH[1] * FH[1] - k[19] * k[1] * k[24] - k[17] * FH[1] * FH[1] - k[18] * k[24]) * t_0 * t_0 +// + 2 * (- k[19] * k[1] * FH[1] * FH[1] - k[18] * FH[1] * FH[1]) * t_0, +// ' '); +// +// Write('debug78: ', +// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) +// + (k[50] + k[62]) * t_0 * t_0 * t_0 * t_0 * t_0 + (k[52] + k[64]) * t_0 * t_0 * t_0 * t_0 + (k[54] + k[66]) * t_0 * t_0 * t_0 + (k[56] + k[67]) * t_0 * t_0 + (k[59] + k[68]) * t_0 + k[60], +// ' '); +// +// Write('debug80: ', +// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) +// + k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]), +// ' '); +// WriteLn; +// WriteLn(' 0 = ((', k[45], ') * x^3 + (', k[46], ') * x^2 + (', k[47], ') * x + (', k[48], ')) * sqrt((', k[31], ') * x^4 + (', k[132], ') * x^3 + (', k[133], ') * x^2 + (', k[134], ') * x + (', k[58], ')) + (', +// k[69], ') * x^5 + (', k[70], ') * x^4 + (', k[71], ') * x^3 + (', k[72], ') * x^2 + (', k[73], ') * x + (', k[60], ')'); + + Write('debug83: ', + (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) = + (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]) * (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]), + ' '); + Write('debug85: ', + 0 = + ( + k[45] * k[45] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + + 2 * k[45] * k[46] * t_0 * t_0 * t_0 * t_0 * t_0 + + k[46] * k[46] * t_0 * t_0 * t_0 * t_0 + + 2 * k[45] * k[47] * t_0 * t_0 * t_0 * t_0 + + 2 * k[45] * k[48] * t_0 * t_0 * t_0 + + 2 * k[46] * k[47] * t_0 * t_0 * t_0 + + k[47] * k[47] * t_0 * t_0 + + 2 * k[46] * k[48] * t_0 * t_0 + + 2 * k[47] * k[48] * t_0 + + k[48] * k[48] + ) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) + - k[69] * k[69] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + - 2 * k[69] * k[70] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + - (k[70] * k[70] + 2 * k[69] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + - 2 * (k[69] * k[72] + k[70] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + - (k[71] * k[71] + 2 * k[69] * k[73] + 2 * k[70] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 + - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0 + - (k[72] * k[72] + 2 * k[70] * k[60] + 2 * k[71] * k[73]) * t_0 * t_0 * t_0 * t_0 + - 2 * (k[71] * k[60] + k[72] * k[73]) * t_0 * t_0 * t_0 + - (k[73] * k[73] + 2 * k[72] * k[60]) * t_0 * t_0 + - 2 * k[73] * k[60] * t_0 + - k[60] * k[60], + ' '); + + WriteLn('debug96: ', EvaluateAt(t_0) = 0); + + NormalizeCoefficients; + + WriteLn('debug99: ', EvaluateAt(t_0) = 0, ' '); +end; + +function TFirstCollisionPolynomial.EvaluateAt(const AT0: Int64): TBigInt; +var + i: Low(FA)..High(FA); +begin + Result := TBigInt.Zero; + for i := High(FA) downto Low(FA) do + Result := Result * AT0 + FA[i]; +end; + +function TFirstCollisionPolynomial.CalcPositiveIntegerRoot: Int64; +var + dividers: TDividers; + factors: TInt64Array; + divider: Int64; +begin + Result := 0; + //factors := TIntegerFactorization.PollardsRhoAlgorithm(FA[0]); + //dividers := TDividers.Create(factors); + // + //try + //for divider in dividers do + //begin + // //WriteLn('Check if ', divider, ' is a root...'); + // if EvaluateAt(divider) = 0 then + // begin + // Result := divider; + // Break; + // end; + //end; + // + //finally + // dividers.Free; + //end; +end; + +function TFirstCollisionPolynomial.CalcT1(const AT0: Int64): Int64; +var + g_0, g_1, g_2: Int64; + g: Extended; +begin + //g_2 := FH[0] * AT0 + FH[1]; + //g_1 := FH[2] * AT0 * AT0 + FH[3] * AT0 + FH[4]; + //g_0 := FH[5] * AT0 * AT0 + FH[6] * AT0; + //g := - g_1 / (2 * g_2); + //Result := Round(g + sqrt(g * g + g_0)); +end; + { TNeverTellMeTheOdds } function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; @@ -60,58 +523,113 @@ var m1, m2, x, y: Double; begin Result := False; - m1 := AHailstone1.VY / AHailstone1.VX; - m2 := AHailstone2.VY / AHailstone2.VX; + m1 := AHailstone1.Velocity.data[1] / AHailstone1.Velocity.data[0]; + m2 := AHailstone2.Velocity.data[1] / AHailstone2.Velocity.data[0]; if m1 <> m2 then begin - x := (AHailstone2.Y - m2 * AHailstone2.X - AHailstone1.Y + m1 * AHailstone1.X) / (m1 - m2); + x := (AHailstone2.Position.data[1] - m2 * AHailstone2.Position.data[0] + - AHailstone1.Position.data[1] + m1 * AHailstone1.Position.data[0]) + / (m1 - m2); if (FMin <= x) and (x <= FMax) - and (x * Sign(AHailstone1.VX) >= AHailstone1.X * Sign(AHailstone1.VX)) - and (x * Sign(AHailstone2.VX) >= AHailstone2.X * Sign(AHailstone2.VX)) then + and (x * Sign(AHailstone1.Velocity.data[0]) >= AHailstone1.Position.data[0] * Sign(AHailstone1.Velocity.data[0])) + and (x * Sign(AHailstone2.Velocity.data[0]) >= AHailstone2.Position.data[0] * Sign(AHailstone2.Velocity.data[0])) + then begin - y := m1 * (x - AHailstone1.X) + AHailstone1.Y; + y := m1 * (x - AHailstone1.Position.data[0]) + AHailstone1.Position.data[1]; if (FMin <= y) and (y <= FMax) then Result := True end; end; end; +// For debug calculations: +Const + T : array[0..4] of Byte = (5, 3, 4, 6, 1); + +procedure TNeverTellMeTheOdds.FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer); +var + //i, j, k: Integer; + //x0, x1, x2: Extended; + f: TFirstCollisionPolynomial; + t0, t1: Int64; + p, v: Tvector3_extended; + test: TBigInt; +begin + WriteLn; + WriteLn(AIndex1, ' ', AIndex2, ' ', AIndex3); + f := TFirstCollisionPolynomial.Create; + f.Init(FHailstones[AIndex1], FHailstones[AIndex2], FHailstones[AIndex3], T[AIndex1], T[AIndex2], T[AIndex3]); + //t0 := f.CalcPositiveIntegerRoot; + //WriteLn('t0: ', t0, ' ', t0 = T[AIndex1]); + //t1 := f.CalcT1(t0); + //WriteLn(', t1: ', t1); + f.Free; + + //// V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) + //v := (FHailstones[AIndex1].Velocity * t0 - FHailstones[AIndex2].Velocity * t1 + // + FHailstones[AIndex1].Position - FHailstones[AIndex2].Position) / (t0 - t1); + //// P_x = (V_0 - V_x) * t_0 + P_0 + //p := (FHailstones[AIndex1].Velocity - v) * t0 + FHailstones[AIndex1].Position; + //FPart2 := Round(p.data[0]) + Round(p.data[1]) + Round(p.data[2]); + + //for i := 0 to FHailstones.Count - 3 do + // for j := i + 1 to FHailstones.Count - 2 do + // for k:= j + 1 to FHailstones.Count - 1 do + // begin + // WriteLn(i, j, k); + // solver := TRockThrowSolver.Create(FHailstones[i], FHailstones[j], FHailstones[k], 0); + // case i of + // 0: x0 := 5; + // 1: x0 := 3; + // 2: x0 := 4; + // end; + // f := solver.CalcValue(x0); + // solver.Free; + // end; + + //for i := 80 to 120 do + //begin + // solver := TRockThrowSolver.Create(FHailstones[0], FHailstones[1], FHailstones[2], 0); + // x0 := i / 20; + // f := solver.CalcValue(x0); + // WriteLn(x0, ' ', f.Valid, ' ', f.Value); + // solver.Free; + //end; +end; + constructor TNeverTellMeTheOdds.Create(const AMin: Int64; const AMax: Int64); begin FMin := AMin; FMax := AMax; - FHailStones := THailstones.Create; + FHailstones := THailstones.Create; end; destructor TNeverTellMeTheOdds.Destroy; begin - FHailStones.Free; + FHailstones.Free; inherited Destroy; end; procedure TNeverTellMeTheOdds.ProcessDataLine(const ALine: string); -var - split: TStringArray; - hailstone: THailstone; begin - split := ALine.Split([',', '@']); - hailstone.X := StrToInt64(Trim(split[0])); - hailstone.Y := StrToInt64(Trim(split[1])); - hailstone.Z := StrToInt64(Trim(split[2])); - hailstone.VX := StrToInt(Trim(split[3])); - hailstone.VY := StrToInt(Trim(split[4])); - hailstone.VZ := StrToInt(Trim(split[5])); - FHailStones.Add(hailstone); + FHailstones.Add(THailstone.Create(ALine)); end; procedure TNeverTellMeTheOdds.Finish; var - i, j: Integer; + i, j, k: Integer; begin - for i := 0 to FHailStones.Count - 2 do - for j := i + 1 to FHailStones.Count - 1 do - if AreIntersecting(FHailStones[i], FHailStones[j]) then + for i := 0 to FHailstones.Count - 2 do + for j := i + 1 to FHailstones.Count - 1 do + if AreIntersecting(FHailstones[i], FHailstones[j]) then Inc(FPart1); + + for i := 0 to FHailstones.Count - 1 do + for j := 0 to FHailstones.Count - 1 do + for k := 0 to FHailstones.Count - 1 do + if (i <> j) and (i <> k) and (j <> k) then + FindRockThrow(i, j, k); + //FindRockThrow(0, 1, 2); end; function TNeverTellMeTheOdds.GetDataFileName: string; diff --git a/tests/UNeverTellMeTheOddsTestCases.pas b/tests/UNeverTellMeTheOddsTestCases.pas index 8b5c282..a2f1235 100644 --- a/tests/UNeverTellMeTheOddsTestCases.pas +++ b/tests/UNeverTellMeTheOddsTestCases.pas @@ -33,6 +33,7 @@ type function CreateSolver: ISolver; override; published procedure TestPart1; + procedure TestPart2; end; { TNeverTellMeTheOddsExampleTestCase } @@ -42,6 +43,7 @@ type function CreateSolver: ISolver; override; published procedure TestPart1; + procedure TestPart2; end; { TNeverTellMeTheOddsTestCase } @@ -77,6 +79,11 @@ begin AssertEquals(15107, FSolver.GetResultPart1); end; +procedure TNeverTellMeTheOddsFullDataTestCase.TestPart2; +begin + AssertEquals(-1, FSolver.GetResultPart2); +end; + { TNeverTellMeTheOddsExampleTestCase } function TNeverTellMeTheOddsExampleTestCase.CreateSolver: ISolver; @@ -89,6 +96,11 @@ begin AssertEquals(2, FSolver.GetResultPart1); end; +procedure TNeverTellMeTheOddsExampleTestCase.TestPart2; +begin + AssertEquals(47, FSolver.GetResultPart2); +end; + { TNeverTellMeTheOddsTestCase } function TNeverTellMeTheOddsTestCase.CreateSolver: ISolver; From eb2b4a3f99721231832bb58a2bc77e446df6ddc9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 14 Mar 2024 11:44:28 +0100 Subject: [PATCH 09/48] Added TBigInt unequal operator --- UBigInt.pas | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/UBigInt.pas b/UBigInt.pas index 6ee26d8..56e48f9 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -73,6 +73,8 @@ type class function FromInt64(const AValue: Int64): TBigInt; static; end; + { Operators } + operator := (const A: Int64): TBigInt; operator - (const A: TBigInt): TBigInt; operator + (const A, B: TBigInt): TBigInt; @@ -80,6 +82,7 @@ type operator * (const A, B: TBigInt): TBigInt; operator shl (const A: TBigInt; const B: Integer): TBigInt; operator = (const A, B: TBigInt): Boolean; + operator <> (const A, B: TBigInt): Boolean; implementation @@ -388,6 +391,8 @@ begin end; end; +{ Operators } + operator := (const A: Int64): TBigInt; begin Result := TBigInt.FromInt64(A); @@ -427,6 +432,7 @@ begin Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); end; +// TODO: Shift operator could be implemented with a single Move call, but I do not want to change it without test cases. operator shl(const A: TBigInt; const B: Integer): TBigInt; var i, j, digitShifts, bitShifts, reverseShift, len, newLength: Integer; @@ -481,5 +487,10 @@ begin Result := A.CompareTo(B) = 0; end; +operator <> (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) <> 0; +end; + end. From 5808ec24f2dc4963d96e0175a68894d029cacb76 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 14 Mar 2024 11:42:09 +0100 Subject: [PATCH 10/48] Added polynomials --- AdventOfCode.lpi | 4 ++ UPolynomial.pas | 106 +++++++++++++++++++++++++++++++++ tests/AdventOfCodeFPCUnit.lpi | 4 ++ tests/AdventOfCodeFPCUnit.lpr | 2 +- tests/UPolynomialTestCases.pas | 94 +++++++++++++++++++++++++++++ 5 files changed, 209 insertions(+), 1 deletion(-) create mode 100644 UPolynomial.pas create mode 100644 tests/UPolynomialTestCases.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index ca33018..5174e60 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -141,6 +141,10 @@ + + + + diff --git a/UPolynomial.pas b/UPolynomial.pas new file mode 100644 index 0000000..141c838 --- /dev/null +++ b/UPolynomial.pas @@ -0,0 +1,106 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UPolynomial; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, UBigInt; + +type + TInt64Array = array of Int64; + + { TBigIntPolynomial } + + TBigIntPolynomial = object + private + FCoefficients: array of TBigInt; + public + function CalcValueAt(const AX: Int64): TBigInt; + function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; + class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; + end; + + { Operators } + + operator = (const A, B: TBigIntPolynomial): Boolean; + operator <> (const A, B: TBigIntPolynomial): Boolean; + +implementation + +{ TBigIntPolynomial } + +function TBigIntPolynomial.CalcValueAt(const AX: Int64): TBigInt; +var + i: Integer; +begin + Result := TBigInt.Zero; + for i := High(FCoefficients) downto 0 do + Result := Result * AX + FCoefficients[i]; +end; + +function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean; +var + i: Integer; +begin + if Length(FCoefficients) = Length(AOther.FCoefficients) then + begin + Result := True; + for i := 0 to Length(FCoefficients) - 1 do + if FCoefficients[i] <> AOther.FCoefficients[i] then + begin + Result := False; + Break; + end; + end + else + Result := False; +end; + +class function TBigIntPolynomial.Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; +var + high, i: integer; +begin + high := 1; + for i := Length(ACoefficients) - 1 downto 1 do + if ACoefficients[i] <> 0 then + begin + high := i; + Break; + end; + SetLength(Result.FCoefficients, high + 1); + for i := 0 to high do + Result.FCoefficients[i] := ACoefficients[i]; +end; + +{ Operators } + +operator = (const A, B: TBigIntPolynomial): Boolean; +begin + Result := A.IsEqualTo(B); +end; + +operator <> (const A, B: TBigIntPolynomial): Boolean; +begin + Result := not A.IsEqualTo(B); +end; + +end. + diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index 0c232ac..dcef8d9 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -140,6 +140,10 @@ + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index 1da4c13..eba70d8 100644 --- a/tests/AdventOfCodeFPCUnit.lpr +++ b/tests/AdventOfCodeFPCUnit.lpr @@ -9,7 +9,7 @@ uses UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases, - UNeverTellMeTheOddsTestCases; + UNeverTellMeTheOddsTestCases, UPolynomialTestCases; {$R *.res} diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas new file mode 100644 index 0000000..703f538 --- /dev/null +++ b/tests/UPolynomialTestCases.pas @@ -0,0 +1,94 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UPolynomialTestCases; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, UPolynomial, UBigInt; + +type + + { TBigIntPolynomialTestCase } + + TBigIntPolynomialTestCase = class(TTestCase) + published + procedure TestEqual; + procedure TestUnequalSameLength; + procedure TestUnequalDifferentLength; + procedure TestTrimLeadingZeros; + procedure TestBisectionRootIsolation; + end; + +implementation + +{ TBigIntPolynomialTestCase } + +procedure TBigIntPolynomialTestCase.TestEqual; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034]); + b := TBigIntPolynomial.Create([10, 7, 5, 1034]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestUnequalSameLength; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([103, 7, 5, 10]); + b := TBigIntPolynomial.Create([1034, 7, 5, 10]); + AssertTrue('Polynomials are equal.', a <> b); +end; + +procedure TBigIntPolynomialTestCase.TestUnequalDifferentLength; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([40000, 10, 7, 5, 1034]); + b := TBigIntPolynomial.Create([10, 7, 5, 1034]); + AssertTrue('Polynomials are equal.', a <> b); +end; + +procedure TBigIntPolynomialTestCase.TestTrimLeadingZeros; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034, 0, 0]); + b := TBigIntPolynomial.Create([10, 7, 5, 1034]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestBisectionRootIsolation; +var + a: TBigIntPolynomial; +begin + // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) + // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 + a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); + Fail('Not implemented'); +end; + +initialization + + RegisterTest(TBigIntPolynomialTestCase); +end. + From 71c846235897f4a1d558754d4b02cc59e8a668ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 14 Mar 2024 11:44:28 +0100 Subject: [PATCH 11/48] Added TBigInt unequal operator --- UBigInt.pas | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/UBigInt.pas b/UBigInt.pas index 6ee26d8..56e48f9 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -73,6 +73,8 @@ type class function FromInt64(const AValue: Int64): TBigInt; static; end; + { Operators } + operator := (const A: Int64): TBigInt; operator - (const A: TBigInt): TBigInt; operator + (const A, B: TBigInt): TBigInt; @@ -80,6 +82,7 @@ type operator * (const A, B: TBigInt): TBigInt; operator shl (const A: TBigInt; const B: Integer): TBigInt; operator = (const A, B: TBigInt): Boolean; + operator <> (const A, B: TBigInt): Boolean; implementation @@ -388,6 +391,8 @@ begin end; end; +{ Operators } + operator := (const A: Int64): TBigInt; begin Result := TBigInt.FromInt64(A); @@ -427,6 +432,7 @@ begin Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); end; +// TODO: Shift operator could be implemented with a single Move call, but I do not want to change it without test cases. operator shl(const A: TBigInt; const B: Integer): TBigInt; var i, j, digitShifts, bitShifts, reverseShift, len, newLength: Integer; @@ -481,5 +487,10 @@ begin Result := A.CompareTo(B) = 0; end; +operator <> (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) <> 0; +end; + end. From 0bbae0a83ed995540930e56d8bcca3486990ebaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 4 Apr 2024 20:24:56 +0200 Subject: [PATCH 12/48] Added polynomial degree and coefficients as public properties --- UPolynomial.pas | 27 ++++++++++++++++++++++----- tests/UPolynomialTestCases.pas | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 5 deletions(-) diff --git a/UPolynomial.pas b/UPolynomial.pas index 141c838..4993c3f 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -32,7 +32,11 @@ type TBigIntPolynomial = object private FCoefficients: array of TBigInt; + function GetDegree: Integer; + function GetCoefficient(const AIndex: Integer): TBigInt; public + property Degree: Integer read GetDegree; + property Coefficient[const AIndex: Integer]: TBigInt read GetCoefficient; function CalcValueAt(const AX: Int64): TBigInt; function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; @@ -47,6 +51,16 @@ implementation { TBigIntPolynomial } +function TBigIntPolynomial.GetDegree: Integer; +begin + Result := Length(FCoefficients) - 1; +end; + +function TBigIntPolynomial.GetCoefficient(const AIndex: Integer): TBigInt; +begin + Result := FCoefficients[AIndex]; +end; + function TBigIntPolynomial.CalcValueAt(const AX: Int64): TBigInt; var i: Integer; @@ -78,16 +92,19 @@ class function TBigIntPolynomial.Create(const ACoefficients: array of TBigInt): var high, i: integer; begin - high := 1; - for i := Length(ACoefficients) - 1 downto 1 do + high := -1; + for i := Length(ACoefficients) - 1 downto 0 do if ACoefficients[i] <> 0 then begin high := i; Break; end; - SetLength(Result.FCoefficients, high + 1); - for i := 0 to high do - Result.FCoefficients[i] := ACoefficients[i]; + if high >= 0 then + begin + SetLength(Result.FCoefficients, high + 1); + for i := 0 to high do + Result.FCoefficients[i] := ACoefficients[i]; + end; end; { Operators } diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas index 703f538..848caf3 100644 --- a/tests/UPolynomialTestCases.pas +++ b/tests/UPolynomialTestCases.pas @@ -29,7 +29,13 @@ type { TBigIntPolynomialTestCase } TBigIntPolynomialTestCase = class(TTestCase) + private + procedure TestCreateWithDegree(const ACoefficients: array of TBigInt; const ADegree: Integer); published + procedure TestCreate; + procedure TestCreateDegreeOne; + procedure TestCreateDegreeZero; + procedure TestCreateDegreeZeroTrim; procedure TestEqual; procedure TestUnequalSameLength; procedure TestUnequalDifferentLength; @@ -41,6 +47,34 @@ implementation { TBigIntPolynomialTestCase } +procedure TBigIntPolynomialTestCase.TestCreateWithDegree(const ACoefficients: array of TBigInt; const ADegree: Integer); +var + a: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create(ACoefficients); + AssertEquals('Degree of created polynomial incorrect.', ADegree, a.Degree); +end; + +procedure TBigIntPolynomialTestCase.TestCreate; +begin + TestCreateWithDegree([992123, 7, 20, 4550022], 3); +end; + +procedure TBigIntPolynomialTestCase.TestCreateDegreeOne; +begin + TestCreateWithDegree([4007], 0); +end; + +procedure TBigIntPolynomialTestCase.TestCreateDegreeZero; +begin + TestCreateWithDegree([], -1); +end; + +procedure TBigIntPolynomialTestCase.TestCreateDegreeZeroTrim; +begin + TestCreateWithDegree([0], -1); +end; + procedure TBigIntPolynomialTestCase.TestEqual; var a, b: TBigIntPolynomial; From 4c0ff2f23fdbeaea75a4e94bcf74996e88b1c8e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 4 Apr 2024 20:26:21 +0200 Subject: [PATCH 13/48] Added TBigIntPolynomial.ScaleVariable --- UPolynomial.pas | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/UPolynomial.pas b/UPolynomial.pas index 4993c3f..13528ff 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -39,6 +39,7 @@ type property Coefficient[const AIndex: Integer]: TBigInt read GetCoefficient; function CalcValueAt(const AX: Int64): TBigInt; function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; + function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; end; @@ -88,6 +89,26 @@ begin Result := False; end; +function TBigIntPolynomial.ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; +var + len, i: Integer; + factor: TBigInt; +begin + if AScaleFactor <> TBigInt.Zero then + begin + len := Length(FCoefficients); + SetLength(Result.FCoefficients, len); + Result.FCoefficients[0] := FCoefficients[0]; + factor := AScaleFactor; + for i := 1 to len - 1 do begin + Result.FCoefficients[i] := FCoefficients[i] * factor; + factor := factor * AScaleFactor; + end; + end + else + SetLength(Result.FCoefficients, 0); +end; + class function TBigIntPolynomial.Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; var high, i: integer; From 53827acf9b86ed04155d95f30fececb7a2829e2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 4 Apr 2024 20:34:57 +0200 Subject: [PATCH 14/48] Added new unit for polynomial root finding algorithm --- AdventOfCode.lpi | 4 ++ UPolynomialRoots.pas | 72 +++++++++++++++++++++++++++++ tests/AdventOfCodeFPCUnit.lpi | 4 ++ tests/AdventOfCodeFPCUnit.lpr | 2 +- tests/UPolynomialRootsTestCases.pas | 72 +++++++++++++++++++++++++++++ tests/UPolynomialTestCases.pas | 11 ----- 6 files changed, 153 insertions(+), 12 deletions(-) create mode 100644 UPolynomialRoots.pas create mode 100644 tests/UPolynomialRootsTestCases.pas diff --git a/AdventOfCode.lpi b/AdventOfCode.lpi index 5174e60..3061d84 100644 --- a/AdventOfCode.lpi +++ b/AdventOfCode.lpi @@ -145,6 +145,10 @@ + + + + diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas new file mode 100644 index 0000000..71ee652 --- /dev/null +++ b/UPolynomialRoots.pas @@ -0,0 +1,72 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UPolynomialRoots; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, UPolynomial, UBigInt; + +type + + { TRootIsolation } + + TRootIsolation = class + private + function CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; + public + function Bisect(constref APolynomial: TBigIntPolynomial): Int64; + end; + +implementation + +{ TRootIsolation } + +function TRootIsolation.CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; +var + i, sign: Integer; + a: TBigInt; +begin + // We need a_n > 0 here, so we use -sign(a_n) instead of actually flipping the polynomial. + // Sign is not 0 because a_n is not 0. + sign := -APolynomial.Coefficient[APolynomial.Degree].Sign; + + // This is a simplification of Cauchy's bound to avoid division. + // https://en.wikipedia.org/wiki/Geometrical_properties_of_polynomial_roots#Bounds_of_positive_real_roots + Result := TBigInt.Zero; + for i := 0 to APolynomial.Degree - 1 do begin + a := sign * APolynomial.Coefficient[i]; + if Result < a then + Result := a; + end; + Result := Result + 1; +end; + +function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): Int64; +var + bound: TBigInt; + p: TBigIntPolynomial; +begin + bound := CalcSimpleRootBound(APolynomial); + p := APolynomial.ScaleVariable(bound); +end; + +end. + diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index dcef8d9..6d98efa 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -144,6 +144,10 @@ + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index eba70d8..eddfbea 100644 --- a/tests/AdventOfCodeFPCUnit.lpr +++ b/tests/AdventOfCodeFPCUnit.lpr @@ -9,7 +9,7 @@ uses UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases, - UNeverTellMeTheOddsTestCases, UPolynomialTestCases; + UNeverTellMeTheOddsTestCases, UPolynomialTestCases, UPolynomialRootsTestCases; {$R *.res} diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas new file mode 100644 index 0000000..c7ae57c --- /dev/null +++ b/tests/UPolynomialRootsTestCases.pas @@ -0,0 +1,72 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UPolynomialRootsTestCases; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, UPolynomial, UPolynomialRoots, UBigInt; + +type + + { TPolynomialRootsTestCase } + + TPolynomialRootsTestCase = class(TTestCase) + protected + FRootIsolation: TRootIsolation; + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestBisectionRootIsolation; + end; + +implementation + +{ TPolynomialRootsTestCase } + +procedure TPolynomialRootsTestCase.SetUp; +begin + inherited SetUp; + FRootIsolation := TRootIsolation.Create; +end; + +procedure TPolynomialRootsTestCase.TearDown; +begin + FRootIsolation.Free; + inherited TearDown; +end; + +procedure TPolynomialRootsTestCase.TestBisectionRootIsolation; +var + a: TBigIntPolynomial; + r: Int64; +begin + // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) + // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 + a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); + r := FRootIsolation.Bisect(a); + AssertEquals(0, r); +end; + +initialization + + RegisterTest(TPolynomialRootsTestCase); +end. + diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas index 848caf3..b4d75a0 100644 --- a/tests/UPolynomialTestCases.pas +++ b/tests/UPolynomialTestCases.pas @@ -40,7 +40,6 @@ type procedure TestUnequalSameLength; procedure TestUnequalDifferentLength; procedure TestTrimLeadingZeros; - procedure TestBisectionRootIsolation; end; implementation @@ -111,16 +110,6 @@ begin AssertTrue('Polynomials are not equal.', a = b); end; -procedure TBigIntPolynomialTestCase.TestBisectionRootIsolation; -var - a: TBigIntPolynomial; -begin - // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) - // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 - a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); - Fail('Not implemented'); -end; - initialization RegisterTest(TBigIntPolynomialTestCase); From e11db7155a53dd33e4e2c2bd9f8b93a44d4d2dc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 13 May 2024 18:19:15 +0200 Subject: [PATCH 15/48] Added more BigInt features and fixes - Fixed some uses of Move - Added Sign, string initializers (hexadecimal and binary), explicit converter to Int64, comparison operators --- UBigInt.pas | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 150 insertions(+), 5 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 56e48f9..e90b5c6 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -35,6 +35,8 @@ type FDigits: TDigits; FIsNegative: Boolean; + function GetSign: Integer; + // Copies consecutive digits from this BigInt to create a new one. The result will be positive. Leading zeros are // removed from the result, but AIndex + ACount must not exceed the number of digits of this BigInt. // AIndex is the first (least significant) digit to be taken. The digit with this index will become the 0th digit of @@ -66,11 +68,19 @@ type // Sign * (Abs(a) * Abs(b)) // where Sign is 1 for ReturnNegative = False and -1 otherwise. class function MultiplyAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; static; + + class function FromHexOrBinString(const AValue: string; const AFromBase: Integer): TBigInt; static; + class function ConvertDigitBlock(const AValue: string; var AStartIndex: Integer; const ACharBlockSize, AFromBase: + Integer): Cardinal; public property IsNegative: Boolean read FIsNegative; + property Sign: Integer read GetSign; class property Zero: TBigInt read GetZero; function CompareTo(constref AOther: TBigInt): Integer; + function TryToInt64(out AOutput: Int64): Boolean; class function FromInt64(const AValue: Int64): TBigInt; static; + class function FromHexadecimalString(const AValue: string): TBigInt; static; + class function FromBinaryString(const AValue: string): TBigInt; static; end; { Operators } @@ -83,6 +93,10 @@ type operator shl (const A: TBigInt; const B: Integer): TBigInt; operator = (const A, B: TBigInt): Boolean; operator <> (const A, B: TBigInt): Boolean; + operator < (const A, B: TBigInt): Boolean; + operator <= (const A, B: TBigInt): Boolean; + operator > (const A, B: TBigInt): Boolean; + operator >= (const A, B: TBigInt): Boolean; implementation @@ -98,6 +112,16 @@ const { TBigInt } +function TBigInt.GetSign: Integer; +begin + if FIsNegative then + Result := -1 + else if (Length(FDigits) > 1) or (FDigits[0] <> 0) then + Result := 1 + else + Result := 0; +end; + function TBigInt.GetSegment(const AIndex, ACount: Integer): TBigInt; var trimmedCount: Integer; @@ -105,8 +129,7 @@ begin trimmedCount := ACount; while (trimmedCount > 1) and (FDigits[AIndex + trimmedCount - 1] = 0) do Dec(trimmedCount); - SetLength(Result.FDigits, trimmedCount); - Move(FDigits[AIndex], Result.FDigits[0], CDigitSize * trimmedCount); + Result.FDigits := Copy(FDigits, AIndex, trimmedCount); Result.FIsNegative := False; end; @@ -362,6 +385,65 @@ begin end; end; +class function TBigInt.FromHexOrBinString(const AValue: string; const AFromBase: Integer): TBigInt; +var + charBlockSize, offset, i, j, k, remainder: Integer; + d: Cardinal; +begin + charBlockSize := 64 div AFromBase; + if AValue[1] = '-' then + begin + offset := 2; + Result.FIsNegative := True; + end + else begin + offset := 1; + Result.FIsNegative := False; + end; + + // Calculates the first (most significant) digit d of the result. + DivMod(AValue.Length - offset, charBlockSize, i, remainder); + k := offset; + d := 0; + // Checks the first block of chars that is not a full block. + if remainder > 0 then + d := ConvertDigitBlock(AValue, k, remainder, AFromBase); + // Checks full blocks of chars for first digit. + while (d = 0) and (i > 0) do + begin + Dec(i); + d := ConvertDigitBlock(AValue, k, charBlockSize, AFromBase); + end; + + // Checks for zero. + if (d = 0) and (i = 0) then + Result := Zero + else begin + // Initializes the array of digits. + SetLength(Result.FDigits, i + 1); + Result.FDigits[i] := d; + + // Calculates the other digits. + for j := i - 1 downto 0 do + Result.FDigits[j] := ConvertDigitBlock(AValue, k, charBlockSize, AFromBase); + end; +end; + +class function TBigInt.ConvertDigitBlock(const AValue: string; var AStartIndex: Integer; const ACharBlockSize, + AFromBase: Integer): Cardinal; +var + part: string; +begin + part := Copy(AValue, AStartIndex, ACharBlockSize); + Inc(AStartIndex, ACharBlockSize); + case AFromBase of + 2: part := '%' + part; + 8: part := '&' + part; + 16: part := '$' + part; + end; + Result := StrToDWord(part); +end; + function TBigInt.CompareTo(constref AOther: TBigInt): Integer; begin if FIsNegative = AOther.FIsNegative then @@ -372,6 +454,35 @@ begin Result := -Result; end; +function TBigInt.TryToInt64(out AOutput: Int64): Boolean; +begin + AOutput := 0; + Result := False; + case Length(FDigits) of + 0: Result := True; + 1: begin + AOutput := FDigits[0]; + if FIsNegative then + AOutput := -AOutput; + Result := True; + end; + 2: begin + if FDigits[1] <= Integer.MaxValue then + begin + AOutput := FDigits[1] * CBase + FDigits[0]; + if FIsNegative then + AOutput := -AOutput; + Result := True; + end + else if (FDigits[1] = Integer.MaxValue + 1) and (FDigits[0] = 0) and FIsNegative then + begin + AOutput := Int64.MinValue; + Result := True; + end; + end; + end; +end; + class function TBigInt.FromInt64(const AValue: Int64): TBigInt; var absVal: Int64; @@ -391,6 +502,16 @@ begin end; end; +class function TBigInt.FromHexadecimalString(const AValue: string): TBigInt; +begin + Result := FromHexOrBinString(AValue, 16); +end; + +class function TBigInt.FromBinaryString(const AValue: string): TBigInt; +begin + Result := FromHexOrBinString(AValue, 2); +end; + { Operators } operator := (const A: Int64): TBigInt; @@ -403,9 +524,13 @@ var len: Integer; begin len := Length(A.FDigits); - SetLength(Result.FDigits, len); - Move(A.FDigits[0], Result.FDigits[0], len); - Result.FIsNegative := not A.FIsNegative; + if (len > 1) or (A.FDigits[0] > 0) then + begin + Result.FDigits := Copy(A.FDigits, 0, len); + Result.FIsNegative := not A.FIsNegative; + end + else + Result := TBigInt.Zero; end; operator + (const A, B: TBigInt): TBigInt; @@ -492,5 +617,25 @@ begin Result := A.CompareTo(B) <> 0; end; +operator < (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) < 0; +end; + +operator <= (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) <= 0; +end; + +operator > (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) > 0; +end; + +operator >= (const A, B: TBigInt): Boolean; +begin + Result := A.CompareTo(B) >= 0; +end; + end. From eee05a96467a4efbefac0ad085622da7245da86f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 13 May 2024 18:20:23 +0200 Subject: [PATCH 16/48] Added BigInt test cases (many broken) --- tests/AdventOfCodeFPCUnit.lpi | 16 + tests/AdventOfCodeFPCUnit.lpr | 2 +- tests/UBigIntTestCases.pas | 917 ++++++++++++++++++++++++++++++++++ 3 files changed, 934 insertions(+), 1 deletion(-) create mode 100644 tests/UBigIntTestCases.pas diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index 0c232ac..1d0b455 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -140,6 +140,22 @@ + + + + + + + + + + + + + + + + diff --git a/tests/AdventOfCodeFPCUnit.lpr b/tests/AdventOfCodeFPCUnit.lpr index 1da4c13..a1f303e 100644 --- a/tests/AdventOfCodeFPCUnit.lpr +++ b/tests/AdventOfCodeFPCUnit.lpr @@ -9,7 +9,7 @@ uses UHotSpringsTestCases, UPointOfIncidenceTestCases, UParabolicReflectorDishTestCases, ULensLibraryTestCases, UFloorWillBeLavaTestCases, UClumsyCrucibleTestCases, ULavaductLagoonTestCases, UAplentyTestCases, UPulsePropagationTestCases, UStepCounterTestCases, USandSlabsTestCases, ULongWalkTestCases, - UNeverTellMeTheOddsTestCases; + UNeverTellMeTheOddsTestCases, UBigIntTestCases; {$R *.res} diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas new file mode 100644 index 0000000..aaccfd2 --- /dev/null +++ b/tests/UBigIntTestCases.pas @@ -0,0 +1,917 @@ +{ + Solutions to the Advent Of Code. + Copyright (C) 2022-2024 Stefan Müller + + This program is free software: you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any later + version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along with + this program. If not, see . +} + +unit UBigIntTestCases; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, UBigInt; + +type + // TODO: TBigIntAbsTestCase + // TODO: TBigIntFromDecTestCase + // TestCase('80091110002223289436355210101231765016693209176113648', 10, '80091110002223289436355210101231765016693209176113648'); + // TestCase('-3201281944789146858325672846129872035678639439423746384198412894', 10, '-3201281944789146858325672846129872035678639439423746384198412894'); + // TestCase('000000000000000000000000000000000000000080091', 10, '80091'); + // TestCase('0000000000000000000000000000000000000000000000', 10, '0'); + // TestCase('-000000000000000000000000000000004687616873215464763146843215486643215', 10, '-4687616873215464763146843215486643215'); + // TestTryFromDec + // TODO: TBigIntFromOctTestCase + // OctValue, 8, DecValue: + // TestCase('3132521', 8, '832849'); + // TestCase('772350021110002226514', 8, '9123449598017875276'); + // TestCase('-247515726712721', 8, '-11520970560977'); + // TestCase('000000000000000000000000000000000000000072', 8, '58'); + // TestCase('000000000000000000000000000000000000000000000000000000000', 8, '0'); + // OctValue, HexValue: + // TestCase('7440737076307076026772', '3C83BE3E638F82DFA'); + // TestCase('1336625076203401614325664', '16F6547C8380E31ABB4'); + // TestCase('3254410316166274457257121050201413373225', '6AC84338ECBC97ABCA22840C2DF695'); + // TestCase('1441330072562106272767270117307274151276215', '642D81D5C88CBAFBAE09EC75E1A57C8D'); + // TestCase('3533665174054677131163436413756431236774257271133', '3ADED4F82CDF964E71E85FBA329EFE2BD725B'); + // TestCase('57346415317074055631627141161054073014006076155710653', '5EE686B3C782DCCE5CC271160EC18061F1B791AB'); + // TestCase('000000000000000000000000000000245745251354033134', 8, '5838773085550172'); + // TestTryFromOct + // TODO: TBigIntUnaryPlusTestCase + // TODO: TBigIntBitwiseLogicalTestCase + // TODO: TBigIntComplementTestCase + // TODO: TBigIntConversionTestCase + // TODO: TBigIntIncrementDecrementTestCase + // TODO: TBigIntQuotientTestCase + // TODO: TBigIntShiftRightTestCase + + { TBigIntSignTestCase } + + TBigIntSignTestCase = class(TTestCase) + private + procedure Test(const AHexValue: string; const AExpectedSign: Integer); + published + procedure TestZero; + procedure TestShortPositive; + procedure TestShortNegative; + procedure TestLongPositive; + procedure TestLongNegative; + end; + + { TBigIntFromInt64TestCase } + + TBigIntFromInt64TestCase = class(TTestCase) + private + procedure Test(const AValue: Int64); + published + procedure TestShortPositive; + procedure TestShortNegative; + procedure TestLongPositive; + procedure TestLongNegative; + procedure TestZero; + end; + + { TBigIntFromHexTestCase } + + TBigIntFromHexTestCase = class(TTestCase) + private + procedure TestShort(const AHexValue: string; const ADecValue: Int64); + published + procedure TestPositive; + procedure TestNegative; + procedure TestZero; + procedure TestLeadingZeros; + // TODO: TestTryFromHex + end; + + { TBigIntFromBinTestCase } + + TBigIntFromBinTestCase = class(TTestCase) + private + procedure TestShort(const ABinValue: string; const ADecValue: Int64); + published + procedure TestPositive; + procedure TestNegative; + procedure TestLeadingZeros; + // TODO: TestTryFromBin + end; + + { TBigIntUnaryMinusTestCase } + + TBigIntUnaryMinusTestCase = class(TTestCase) + private + procedure Test(const AValue: Int64); + procedure TestTwice(const AValue: Int64); + published + procedure TestZero; + procedure TestPositive; + procedure TestNegative; + procedure TestPositiveTwice; + procedure TestNegativeTwice; + end; + + { TBigIntSumTestCase } + + TBigIntSumTestCase = class(TTestCase) + private + procedure Test(const AHexValueLeft, AHexValueRight, AHexValueSum: string); + public + procedure TestShort; + procedure TestPositivePlusPositive; + procedure TestNegativePlusNegative; + procedure TestLargePositivePlusSmallNegative; + procedure TestSmallPositivePlusLargeNegative; + procedure TestLargeNegativePlusSmallPositive; + procedure TestSmallNegativePlusLargePositive; + procedure TestZeroPlusPositive; + procedure TestPositivePlusZero; + procedure TestZero; + procedure TestSumShorterLeft; + procedure TestSumShorterRight; + procedure TestSumEndsInCarry; + procedure TestSumEndsInCarryNewDigit; + procedure TestSumMultiCarry; + end; + + { TBigIntDifferenceTestCase } + + TBigIntDifferenceTestCase = class(TTestCase) + private + procedure Test(const AHexValueMinuend, AHexValueSubtrahend, AHexValueDifference: string); + published + procedure TestShort; + procedure TestLargePositiveMinusSmallPositive; + procedure TestSmallPositiveMinusLargePositive; + procedure TestLargeNegativeMinusSmallNegative; + procedure TestSmallNegativeMinusLargeNegative; + procedure TestNegativeMinusPositive; + procedure TestPositiveMinusNegative; + procedure TestLargeOperands; + procedure TestPositiveMinusZero; + procedure TestZeroMinusPositive; + procedure TestZero; + procedure TestDifferenceShorterLeft; + procedure TestDifferenceShorterRight; + procedure TestDifferenceEndsInCarry; + procedure TestDifferenceEndsInCarryLosingDigit; + procedure TestDifferenceMultiCarry; + end; + + { TBigIntProductTestCase } + + TBigIntProductTestCase = class(TTestCase) + private + procedure Test(const AHexValueLeft, AHexValueRight, AHexValueProduct: string); + published + procedure TestShort; + procedure TestLongPositiveTimesPositive; + procedure TestLongPositiveTimesNegative; + procedure TestLongNegativeTimesPositive; + procedure TestLongNegativeTimesNegative; + procedure TestZeroTimesPositive; + procedure TestZeroTimesNegative; + procedure TestZero; + end; + + { TBigIntShiftLeftTestCase } + + TBigIntShiftLeftTestCase = class(TTestCase) + private + procedure Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: string); + published + procedure TestShort; + procedure TestShortWithCarry; + procedure TestLongWithCarry; + procedure TestLongWithMultiDigitCarry; + procedure TestWithAlignedDigits; + procedure TestZero; + end; + + { TBigIntEqualityTestCase } + + TBigIntEqualityTestCase = class(TTestCase) + private + procedure TestEqual(const AValue: Int64); + procedure TestEqualHex(const AHexValue: string); + procedure TestNotEqualHex(const AHexValueLeft, AHexValueRight: string); + published + procedure TestShortEqual; + procedure TestLongEqual; + procedure TestZeroEqual; + procedure TestShortNotEqual; + procedure TestLongNotEqualSign; + procedure TestZeroNotEqual; + end; + + { TBigIntComparisonTestCase } + + TBigIntComparisonTestCase = class(TTestCase) + private + procedure TestLessThan(const AHexValueLeft, AHexValueRight: string); + procedure TestGreaterThan(const AHexValueLeft, AHexValueRight: string); + procedure TestEqual(const AHexValue: string); + published + procedure TestLessSameLength; + procedure TestLessShorterLeft; + procedure TestLessNegativeShorterRight; + procedure TestGreaterSameLength; + procedure TestGreaterShorterRight; + procedure TestGreaterNegativeShorterLeft; + procedure TestEqualPositive; + procedure TestEqualNegative; + procedure TestEqualZero; + end; + +implementation + +{ TBigIntSignTestCase } + +procedure TBigIntSignTestCase.Test(const AHexValue: string; const AExpectedSign: Integer); +var + a: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValue); + AssertEquals(AExpectedSign, a.Sign); +end; + +procedure TBigIntSignTestCase.TestZero; +begin + Test('0', 0); +end; + +procedure TBigIntSignTestCase.TestShortPositive; +begin + Test('36A', 1); +end; + +procedure TBigIntSignTestCase.TestShortNegative; +begin + Test('-29B7', -1); +end; + +procedure TBigIntSignTestCase.TestLongPositive; +begin + Test('1240168AB09ABDF8283B77124', 1); +end; + +procedure TBigIntSignTestCase.TestLongNegative; +begin + Test('-192648F1305DD04757A24C873F29F60B6184B5', -1); +end; + +{ TBigIntFromInt64TestCase } + +procedure TBigIntFromInt64TestCase.Test(const AValue: Int64); +var + a: TBigInt; + act: Int64; +begin + a := TBigInt.FromInt64(AValue); + AssertTrue('BigInt from ''' + IntToStr(AValue) + ''' could not be converted back to an Int64 value.', + a.TryToInt64(act)); + AssertEquals('BigInt from ''' + IntToStr(AValue) + ''' converted back to Int64 was not equal to initial value.', + AValue, act); +end; + +procedure TBigIntFromInt64TestCase.TestShortPositive; +begin + Test(17); + Test(4864321); + Test(Cardinal.MaxValue); +end; + +procedure TBigIntFromInt64TestCase.TestShortNegative; +begin + Test(-54876); + Test(Integer.MinValue); +end; + +procedure TBigIntFromInt64TestCase.TestLongPositive; +begin + Test(5800754643214654); + Test(Int64.MaxValue); +end; + +procedure TBigIntFromInt64TestCase.TestLongNegative; +begin + Test(-94136445555883); + Test(Int64.MinValue); +end; + +procedure TBigIntFromInt64TestCase.TestZero; +begin + Test(0); +end; + +{ TBigIntFromHexTestCase } + +procedure TBigIntFromHexTestCase.TestShort(const AHexValue: string; const ADecValue: Int64); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValue); + b := TBigInt.FromInt64(ADecValue); + AssertTrue('BigInt from hexadecimal string ''' + AHexValue + ''' was not equal to ''' + IntToStr(ADecValue) + '''.', + a = b); +end; + +procedure TBigIntFromHexTestCase.TestPositive; +begin + TestShort('91', 145); + TestShort('800E111000222', 2252766466540066); + TestShort('DE0B227802AB233', 999995000000000563); + TestShort('19C0048155000', 453000000000000); + TestShort('3B9ACA00', 1000000000); +end; + +procedure TBigIntFromHexTestCase.TestNegative; +begin + TestShort('-47', -71); + TestShort('-800E111000222', -2252766466540066); + TestShort('-4512FF3', -72429555); +end; + +procedure TBigIntFromHexTestCase.TestZero; +begin + TestShort('0', 0); + TestShort('-0', 0); +end; + +procedure TBigIntFromHexTestCase.TestLeadingZeros; +begin + TestShort('000000000000000000000000000000004B', 75); + TestShort('-00000000000000000000000000000000A2', -162); + TestShort('00000000000000000000000000000000FF452849DB01', 280672493755137); + TestShort('000000000000000000000000000000000000', 0); + TestShort('-000000000000000000000000000000000000', 0); +end; + +{ TBigIntFromBinTestCase } + +procedure TBigIntFromBinTestCase.TestShort(const ABinValue: string; const ADecValue: Int64); +var + a, b: TBigInt; +begin + a := TBigInt.FromBinaryString(ABinValue); + b := TBigInt.FromInt64(ADecValue); + AssertTrue('BigInt from binary string ''' + ABinValue + ''' was not equal to ''' + IntToStr(ADecValue) + '''.', + a = b); +end; + +procedure TBigIntFromBinTestCase.TestPositive; +begin + TestShort('110101010101101101010010110000101010100101001001010100110', 120109162101379750); +end; + +procedure TBigIntFromBinTestCase.TestNegative; +begin + TestShort('-11100100111010100111000111100011110000100110110111100101010010', -4123780452057839954); +end; + +procedure TBigIntFromBinTestCase.TestLeadingZeros; +begin + TestShort('0000000000000000000000000000000000000000000000000000000000000000000000111', 7); + TestShort('0000000000000000000000000000000000000000000000000000000000000000000000000000000', 0); +end; + +{ TBigIntUnaryMinusTestCase } + +procedure TBigIntUnaryMinusTestCase.Test(const AValue: Int64); +var + a, b: TBigInt; +begin + a := TBigInt.FromInt64(AValue); + b := TBigInt.FromInt64(-AValue); + AssertTrue('Negative BigInt from ''' + IntToStr(AValue) + ''' was not equal to the BigInt from the negative value.', + b = -a); +end; + +procedure TBigIntUnaryMinusTestCase.TestTwice(const AValue: Int64); +var + a: TBigInt; +begin + a := TBigInt.FromInt64(AValue); + AssertTrue('BigInt from ''' + IntToStr(AValue) + '''was not equal to the double negative of itself.', + a = -(-a)); +end; + +procedure TBigIntUnaryMinusTestCase.TestZero; +begin + Test(0); +end; + +procedure TBigIntUnaryMinusTestCase.TestPositive; +begin + Test(234972358233); +end; + +procedure TBigIntUnaryMinusTestCase.TestNegative; +begin + Test(-999214927400); +end; + +procedure TBigIntUnaryMinusTestCase.TestPositiveTwice; +begin + TestTwice(8647613456601); +end; + +procedure TBigIntUnaryMinusTestCase.TestNegativeTwice; +begin + TestTwice(-38600421308534); +end; + +{ TBigIntSumTestCase } + +procedure TBigIntSumTestCase.Test(const AHexValueLeft, AHexValueRight, AHexValueSum: string); +var + a, b, s: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueLeft); + b := TBigInt.FromHexadecimalString(AHexValueRight); + s := TBigInt.FromHexadecimalString(AHexValueSum); + AssertTrue('Sum of BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + + ''' was not equal to the BigInt from ''' + AHexValueSum + '''.', + s = a + b); +end; + +procedure TBigIntSumTestCase.TestShort; +begin + Test('5', '7', 'C'); +end; + +procedure TBigIntSumTestCase.TestPositivePlusPositive; +begin + Test('7000822000111', '9000911000333', '10001133000444'); +end; + +procedure TBigIntSumTestCase.TestNegativePlusNegative; +begin + Test('-129B92A84643D608141', '-4574DBA206951ECFE', '-12E10783E84A6B26E3F'); +end; + +procedure TBigIntSumTestCase.TestLargePositivePlusSmallNegative; +begin + Test('87BAD26984', '-8DCB20461', '7EDE206523'); +end; + +procedure TBigIntSumTestCase.TestSmallPositivePlusLargeNegative; +begin + Test('A58301E4006', '-9851DA0FD433', '-8DF9A9F1942D'); +end; + +procedure TBigIntSumTestCase.TestLargeNegativePlusSmallPositive; +begin + Test('-1FDB60CB5698870', '99CB1E00DE', '-1FDB572EA4B8792'); +end; + +procedure TBigIntSumTestCase.TestSmallNegativePlusLargePositive; +begin + Test('-1ED598BBFEC2', '59CD4F02ECB56', '57DFF5772CC94'); +end; + +procedure TBigIntSumTestCase.TestZeroPlusPositive; +begin + Test('0', '9BB000911FF5A000333', '9BB000911FF5A000333'); +end; + +procedure TBigIntSumTestCase.TestPositivePlusZero; +begin + Test('23009605A16BCBB294A1FD', '0', '23009605A16BCBB294A1FD'); +end; + +procedure TBigIntSumTestCase.TestZero; +begin + Test('0', '0', '0'); +end; + +procedure TBigIntSumTestCase.TestSumShorterLeft; +begin + Test('3FFFF', '9000911000222', '9000911040221'); +end; + +procedure TBigIntSumTestCase.TestSumShorterRight; +begin + Test('9000911000555', '3000EEEE', '900094100F443'); +end; + +procedure TBigIntSumTestCase.TestSumEndsInCarry; +begin + Test('4000444000220', 'FFFFFFFF', '400054400021F'); +end; + +procedure TBigIntSumTestCase.TestSumEndsInCarryNewDigit; +begin + Test('99990000', '99990055', '133320055'); +end; + +procedure TBigIntSumTestCase.TestSumMultiCarry; +begin + Test('FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF', 'FFFFFFFF', '1000000000000000000000000FFFFFFFE'); +end; + +{ TBigIntDifferenceTestCase } + +procedure TBigIntDifferenceTestCase.Test(const AHexValueMinuend, AHexValueSubtrahend, AHexValueDifference: string); +var + a, b, s: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueMinuend); + b := TBigInt.FromHexadecimalString(AHexValueSubtrahend); + s := TBigInt.FromHexadecimalString(AHexValueDifference); + AssertTrue('Difference of BigInt from ''' + AHexValueMinuend + ''' and from ''' + AHexValueSubtrahend + + ''' was not equal to the BigInt from ''' + AHexValueDifference + '''.', + s = a - b); +end; + +procedure TBigIntDifferenceTestCase.TestShort; +begin + Test('230', '6D', '1C3'); +end; + +procedure TBigIntDifferenceTestCase.TestLargePositiveMinusSmallPositive; +begin + Test('910AAD86E5002455', '72DE020F932A1', '91037FA6C406F1B4'); +end; + +procedure TBigIntDifferenceTestCase.TestSmallPositiveMinusLargePositive; +begin + Test('3127541F4C0AA', '3818CD9FBE652B', '-3506585DC9A481'); +end; + +procedure TBigIntDifferenceTestCase.TestLargeNegativeMinusSmallNegative; +begin + Test('-B12BE1E20098', '-148F3137CED396', '13DE0555ECD2FE'); +end; + +procedure TBigIntDifferenceTestCase.TestSmallNegativeMinusLargeNegative; +begin + Test('-AF3FF1EC626908C', '-18295', '-AF3FF1EC6250DF7'); +end; + +procedure TBigIntDifferenceTestCase.TestNegativeMinusPositive; +begin + Test('-E493506B19', '20508ED255', '-104E3DF3D6E'); +end; + +procedure TBigIntDifferenceTestCase.TestPositiveMinusNegative; +begin + Test('114EEC66851AFD98', '-100AA4308C5249FBBFADEB89CD6A7D9CC', '100AA4308C5249FBC0C2DA5035BC2D764'); +end; + +procedure TBigIntDifferenceTestCase.TestLargeOperands; +begin + Test('1069FC8EA3D99C39E1C07AA078B77B5CC679CB448563345A878C603D32FB0F8FEFE02AD9574A5EB6', + '1069FC8EA3D99C39E1C07AA078B77B5CC679CB448563345A878C603D32FB0F8FEFE023C522B87F8C', + '7143491DF2A'); +end; + +procedure TBigIntDifferenceTestCase.TestPositiveMinusZero; +begin + Test('8ABB000911FF5A000333', '0', '8ABB000911FF5A000333'); +end; + +procedure TBigIntDifferenceTestCase.TestZeroMinusPositive; +begin + Test('0', '243961982DDD64F81B2', '-243961982DDD64F81B2'); +end; + +procedure TBigIntDifferenceTestCase.TestZero; +begin + Test('0', '0', '0'); +end; + +procedure TBigIntDifferenceTestCase.TestDifferenceShorterLeft; +begin + Test('3FFFF', '9000911040221', '-9000911000222'); +end; + +procedure TBigIntDifferenceTestCase.TestDifferenceShorterRight; +begin + Test('900094100F443', '3000EEEE', '9000911000555'); +end; + +procedure TBigIntDifferenceTestCase.TestDifferenceEndsInCarry; +begin + Test('400054400021F', 'FFFFFFFF', '4000444000220'); +end; + +procedure TBigIntDifferenceTestCase.TestDifferenceEndsInCarryLosingDigit; +begin + Test('133320055', '99990000', '99990055'); +end; + +procedure TBigIntDifferenceTestCase.TestDifferenceMultiCarry; +begin + Test('1000000000000000000000000FFFFFFFE', 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF', 'FFFFFFFF'); +end; + +{ TBigIntProductTestCase } + +procedure TBigIntProductTestCase.Test(const AHexValueLeft, AHexValueRight, AHexValueProduct: string); +var + a, b, s: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueLeft); + b := TBigInt.FromHexadecimalString(AHexValueRight); + s := TBigInt.FromHexadecimalString(AHexValueProduct); + AssertTrue('Product of BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + + ''' was not equal to the BigInt from ''' + AHexValueProduct + '''.', + s = a + b); +end; + +procedure TBigIntProductTestCase.TestShort; +begin + Test('9', 'B', '63'); + Test('29E531A', 'DF5F299', '248E3915103E8A'); +end; + +procedure TBigIntProductTestCase.TestLongPositiveTimesPositive; +begin + Test('FFFFFFFF', 'FFFFFFFF', 'FFFFFFFE00000001'); + Test('4873B23699D07741F1544862221B1966AA84512', '4DE0013', '160A322C656DEB1DD6D721D36E35F2E29B4D2A18192056'); + Test('74FD3E6988116762', '22DB271AFC4941', 'FEDC8CD51DEE46BE83C283B5E31E2'); +end; + +procedure TBigIntProductTestCase.TestLongPositiveTimesNegative; +begin + Test('23401834190D12FF3210F0B0129123AA', '-A4C0530234', '-16AF8B019CA1436BBFD1F1FB08494FFC9EF7E09288'); +end; + +procedure TBigIntProductTestCase.TestLongNegativeTimesPositive; +begin + Test('-3ACB78882923810', 'F490B8022A4BCBFF34E01', '-382B2B9851BC93CB0308B502C3B036D71810'); +end; + +procedure TBigIntProductTestCase.TestLongNegativeTimesNegative; +begin + Test('-554923FB201', '-9834FDC032', '32B514C1BA1E774EE8432'); +end; + +procedure TBigIntProductTestCase.TestZeroTimesPositive; +begin + Test('0', '1AF5D0039B888AC00F299', '0'); +end; + +procedure TBigIntProductTestCase.TestZeroTimesNegative; +begin + Test('0', '-1AF5D0039B888AC00F299', '0'); +end; + +procedure TBigIntProductTestCase.TestZero; +begin + Test('0', '0', '0'); +end; + +{ TBigIntShiftLeftTestCase } + +procedure TBigIntShiftLeftTestCase.Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: string); +var + a, s: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueOperand); + s := TBigInt.FromHexadecimalString(AHexValueResult); + AssertTrue('BigInt from hexadecimal string ''' + AHexValueOperand + ''' shifted left by ''' + IntToStr(AShift) + + ''' was not equal to BigInt from hexadecimal string ''' + AHexValueResult + '''.', + s = (a << AShift)); +end; + +procedure TBigIntShiftLeftTestCase.TestShort; +begin + // BIN 101 + // BIN 101000 + Test('5', 3, '40'); +end; + +procedure TBigIntShiftLeftTestCase.TestShortWithCarry; +begin + // BIN 1110 1101 0111 0001 1010 1010 + // BIN 1 1101 1010 1110 0011 0101 0100 0000 0000 0000 + Test('ED71AA', 13, '1DAE354000'); +end; + +procedure TBigIntShiftLeftTestCase.TestLongWithCarry; +begin + // BIN 1 0011 0000 1011 0010 0011 1110 0100 1100 1111 1001 0101 0100 0100 0101 + // BIN 10 0110 0001 0110 0100 0111 1100 1001 1001 1111 0010 1010 1000 1000 1010 0000 0000 + Test('130B23E4CF95445', 9, '261647C99F2A88A00'); +end; + +procedure TBigIntShiftLeftTestCase.TestLongWithMultiDigitCarry; +begin + Test('C99F12A735A3B83901BF92011', 140, 'C99F12A735A3B83901BF9201100000000000000000000000000000000000'); +end; + +procedure TBigIntShiftLeftTestCase.TestWithAlignedDigits; +begin + // Shifts the left operand by a multiple of the length of full TBigInt digits, so the digits will be shifted, but not + // changed. + Test('10F0F39C5E', 32 * 4, '10F0F39C5E00000000000000000000000000000000'); +end; + +procedure TBigIntShiftLeftTestCase.TestZero; +begin + Test('0', 119, '0'); +end; + +{ TBigIntEqualityTestCase } + +procedure TBigIntEqualityTestCase.TestEqual(const AValue: Int64); +var + a, b: TBigInt; +begin + a := TBigInt.FromInt64(AValue); + b := TBigInt.FromInt64(AValue); + AssertTrue('Two BigInt from ''' + IntToStr(AValue) + ''' were not equal.', a = b); + AssertFalse('Two BigInt from ''' + IntToStr(AValue) + ''' were not equal.', a <> b); +end; + +procedure TBigIntEqualityTestCase.TestEqualHex(const AHexValue: string); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValue); + b := TBigInt.FromHexadecimalString(AHexValue); + AssertTrue('Two BigInt from ''' + AHexValue + ''' were not equal.', a = b); + AssertFalse('Two BigInt from ''' + AHexValue + ''' were not equal.', a <> b); +end; + +procedure TBigIntEqualityTestCase.TestNotEqualHex(const AHexValueLeft, AHexValueRight: string); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueLeft); + b := TBigInt.FromHexadecimalString(AHexValueRight); + AssertTrue('BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' were equal.', + a <> b); + AssertFalse('BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' were equal.', + a = b); +end; + +procedure TBigIntEqualityTestCase.TestShortEqual; +begin + TestEqual(14); + TestEqualHex('8000111000111'); +end; + +procedure TBigIntEqualityTestCase.TestLongEqual; +begin + TestEqualHex('5AB60FF292A014BF1DD0A'); +end; + +procedure TBigIntEqualityTestCase.TestZeroEqual; +begin + TestEqual(0); +end; + +procedure TBigIntEqualityTestCase.TestShortNotEqual; +begin + TestNotEqualHex('9FF99920', '100'); + TestNotEqualHex('20001110002111', '70001110007111'); +end; + +procedure TBigIntEqualityTestCase.TestLongNotEqualSign; +begin + TestNotEqualHex('48843AB320FF0041123A', '-48843AB320FF0041123A'); + TestNotEqualHex('-B13F79D842A30957DD09523667', 'B13F79D842A30957DD09523667'); +end; + +procedure TBigIntEqualityTestCase.TestZeroNotEqual; +begin + TestNotEqualHex('0', 'F'); + TestNotEqualHex('568F7', '0'); +end; + +{ TBigIntComparisonTestCase } + +procedure TBigIntComparisonTestCase.TestLessThan(const AHexValueLeft, AHexValueRight: string); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueLeft); + b := TBigInt.FromHexadecimalString(AHexValueRight); + AssertTrue('BigInt from ''' + AHexValueLeft + ''' was greater than BigInt from ''' + AHexValueRight + '''.', + a < b); + AssertTrue('BigInt from ''' + AHexValueLeft + ''' was greater or equal than BigInt from ''' + AHexValueRight + '''.', + a <= b); + AssertFalse('BigInt from ''' + AHexValueLeft + ''' was greater than BigInt from ''' + AHexValueRight + '''.', + a > b); + AssertFalse('BigInt from ''' + AHexValueLeft + ''' was greater or equal than BigInt from ''' + AHexValueRight + '''.', + a >= b); +end; + +procedure TBigIntComparisonTestCase.TestGreaterThan(const AHexValueLeft, AHexValueRight: string); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueLeft); + b := TBigInt.FromHexadecimalString(AHexValueRight); + AssertFalse('BigInt from ''' + AHexValueLeft + ''' was less than BigInt from ''' + AHexValueRight + '''.', + a < b); + AssertFalse('BigInt from ''' + AHexValueLeft + ''' was less or equal than BigInt from ''' + AHexValueRight + '''.', + a <= b); + AssertTrue('BigInt from ''' + AHexValueLeft + ''' was less than BigInt from ''' + AHexValueRight + '''.', + a > b); + AssertTrue('BigInt from ''' + AHexValueLeft + ''' was less or equal than BigInt from ''' + AHexValueRight + '''.', + a >= b); +end; + +procedure TBigIntComparisonTestCase.TestEqual(const AHexValue: string); +var + a, b: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValue); + b := TBigInt.FromHexadecimalString(AHexValue); + AssertFalse('First BigInt from ''' + AHexValue + ''' was less than the second.', + a < b); + AssertTrue('First BigInt from ''' + AHexValue + ''' was greater than the second.', + a <= b); + AssertFalse('First BigInt from ''' + AHexValue + ''' was greater than the second.', + a > b); + AssertTrue('First BigInt from ''' + AHexValue + ''' was less than the second.', + a >= b); +end; + +procedure TBigIntComparisonTestCase.TestLessSameLength; +begin + TestLessThan('104234FF2B29100C012', '234867AB261F1003429103C'); + TestLessThan('-9812FB2964AC7632865238BBD3', '294625DF51B2A842582244C18163490'); + TestLessThan('-12834653A2856DF8', '-A946C2BF89401B8'); + TestLessThan('-2F846', '0'); + TestLessThan('0', 'FF67B'); +end; + +procedure TBigIntComparisonTestCase.TestLessShorterLeft; +begin + TestLessThan('34FF2B29100C012', '234867AB261F1003429103C'); + TestLessThan('0', 'BFF008112BA00012'); +end; + +procedure TBigIntComparisonTestCase.TestLessNegativeShorterRight; +begin + TestLessThan('-9B72844AC', '1F3486B'); + TestLessThan('-BB884F022111190', '0'); +end; + +procedure TBigIntComparisonTestCase.TestGreaterSameLength; +begin + TestGreaterThan('B042104234FF2B29100C012', '23867AB261F1003429103C'); + TestGreaterThan('1294B77', '-611F3B93'); + TestGreaterThan('-782163498326593562D548AAF715B4DC9143E42C68F39A29BB2', '-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF'); + TestGreaterThan('783BDA0', '0'); + TestGreaterThan('0', '-99B6D'); +end; + +procedure TBigIntComparisonTestCase.TestGreaterShorterRight; +begin + TestGreaterThan('102343234423FF67278B11ADD345F6BB21232C9129100C012', '234867AB261F1003429103C'); + TestGreaterThan('249D00F63BBAA8668B23', '0'); +end; + +procedure TBigIntComparisonTestCase.TestGreaterNegativeShorterLeft; +begin + TestGreaterThan('81F2A7B78B812', '-23490D7F19F247F91A365B1893BB701'); + TestGreaterThan('0', '-80F88242B34127'); +end; + +procedure TBigIntComparisonTestCase.TestEqualPositive; +begin + TestEqual('A44B80191059CA123318921A219BB'); +end; + +procedure TBigIntComparisonTestCase.TestEqualNegative; +begin + TestEqual('-28912798DD1246DAC9FB4269908012D496896812FF3A8D071B32'); +end; + +procedure TBigIntComparisonTestCase.TestEqualZero; +begin + TestEqual('0'); +end; + +initialization + + RegisterTest(TBigIntSignTestCase); + RegisterTest(TBigIntFromInt64TestCase); + RegisterTest(TBigIntFromHexTestCase); + RegisterTest(TBigIntFromBinTestCase); + RegisterTest(TBigIntUnaryMinusTestCase); + RegisterTest(TBigIntSumTestCase); + RegisterTest(TBigIntDifferenceTestCase); + RegisterTest(TBigIntProductTestCase); + RegisterTest(TBigIntShiftLeftTestCase); + RegisterTest(TBigIntEqualityTestCase); + RegisterTest(TBigIntComparisonTestCase); +end. + From 1caee9ae6eecf807e8ded128871fa1741d6dfbd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 14 May 2024 16:52:09 +0200 Subject: [PATCH 17/48] Fixed BigInt string initializers --- UBigInt.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index e90b5c6..74dc5fa 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -390,7 +390,12 @@ var charBlockSize, offset, i, j, k, remainder: Integer; d: Cardinal; begin - charBlockSize := 64 div AFromBase; + // 2 ^ (32 / charBlockSize) = AFromBase + case AFromBase of + 2: charBlockSize := 32; + 16: charBlockSize := 8; + end; + if AValue[1] = '-' then begin offset := 2; @@ -402,7 +407,7 @@ begin end; // Calculates the first (most significant) digit d of the result. - DivMod(AValue.Length - offset, charBlockSize, i, remainder); + DivMod(AValue.Length - offset + 1, charBlockSize, i, remainder); k := offset; d := 0; // Checks the first block of chars that is not a full block. From df8b5c32fdc89fd5f0dc719dc6653974ab006b27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Tue, 14 May 2024 16:52:32 +0200 Subject: [PATCH 18/48] Fixed BigInt test cases --- tests/UBigIntTestCases.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas index aaccfd2..1ecc16e 100644 --- a/tests/UBigIntTestCases.pas +++ b/tests/UBigIntTestCases.pas @@ -127,7 +127,7 @@ type TBigIntSumTestCase = class(TTestCase) private procedure Test(const AHexValueLeft, AHexValueRight, AHexValueSum: string); - public + published procedure TestShort; procedure TestPositivePlusPositive; procedure TestNegativePlusNegative; @@ -691,7 +691,7 @@ procedure TBigIntShiftLeftTestCase.TestShort; begin // BIN 101 // BIN 101000 - Test('5', 3, '40'); + Test('5', 3, '28'); end; procedure TBigIntShiftLeftTestCase.TestShortWithCarry; @@ -734,7 +734,7 @@ begin a := TBigInt.FromInt64(AValue); b := TBigInt.FromInt64(AValue); AssertTrue('Two BigInt from ''' + IntToStr(AValue) + ''' were not equal.', a = b); - AssertFalse('Two BigInt from ''' + IntToStr(AValue) + ''' were not equal.', a <> b); + AssertFalse('Two BigInt from ''' + IntToStr(AValue) + ''' were un-equal.', a <> b); end; procedure TBigIntEqualityTestCase.TestEqualHex(const AHexValue: string); @@ -744,7 +744,7 @@ begin a := TBigInt.FromHexadecimalString(AHexValue); b := TBigInt.FromHexadecimalString(AHexValue); AssertTrue('Two BigInt from ''' + AHexValue + ''' were not equal.', a = b); - AssertFalse('Two BigInt from ''' + AHexValue + ''' were not equal.', a <> b); + AssertFalse('Two BigInt from ''' + AHexValue + ''' were un-equal.', a <> b); end; procedure TBigIntEqualityTestCase.TestNotEqualHex(const AHexValueLeft, AHexValueRight: string); @@ -753,7 +753,7 @@ var begin a := TBigInt.FromHexadecimalString(AHexValueLeft); b := TBigInt.FromHexadecimalString(AHexValueRight); - AssertTrue('BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' were equal.', + AssertTrue('BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' were not un-equal.', a <> b); AssertFalse('BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' were equal.', a = b); From 7630bdddeb8cf4142bfdaf4fd0aedd790ca4f321 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 16 May 2024 17:08:05 +0200 Subject: [PATCH 19/48] Fixed array init in BigInt shift and replaced Move --- UBigInt.pas | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 74dc5fa..a49ea16 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -161,7 +161,7 @@ end; class function TBigInt.AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; var - i, lenA, lenB, len, shorter: Integer; + i, j, lenA, lenB, len, shorter: Integer; carry: Cardinal; begin lenA := Length(AA.FDigits); @@ -208,9 +208,11 @@ begin // carry-overs. This avoids additional tests for finding the shorter digit array. if (i < lenA) or (i < lenB) then if lenA >= lenB then - Move(AA.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)) + for j := i to len - 1 do + Result.FDigits[j] := AA.FDigits[j] else - Move(AB.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)); + for j := i to len - 1 do + Result.FDigits[j] := AB.FDigits[j]; // Applies the remaining carry-overs until the end of the prepared result digit array. while (carry > 0) and (i < len) do @@ -235,7 +237,7 @@ class function TBigInt.SubtractAbsoluteValues(constref AA, AB: TBigInt; const AR var a, b: TBigInt; carry: Cardinal; - i, lastNonZeroDigitIndex, len: Integer; + i, j, lastNonZeroDigitIndex, len: Integer; begin // Establishes the operand order, such that Abs(a) is not less than Abs(b). if (AA.CompareToAbsoluteValues(AB) >= 0) then @@ -300,7 +302,8 @@ begin // Copies the missing unchanged digits from the longer operand to the result, if any. If there are none, then no trim // needs to occur because the most significant digit is not zero. if i < len then - Move(a.FDigits[i], Result.FDigits[i], CDigitSize * (len - i)) + for j := i to len - 1 do + Result.FDigits[j] := a.FDigits[j] else if (lastNonZeroDigitIndex + 1 < len) then // Trims leading zeros from the digits array. Delete(Result.FDigits, lastNonZeroDigitIndex + 1, len - lastNonZeroDigitIndex - 1); @@ -605,7 +608,10 @@ begin // Performs full digit shifts by copy if there are no bit shifts. len := Length(A.FDigits); SetLength(Result.FDigits, len + digitShifts); - Move(A.FDigits[0], Result.FDigits[digitShifts], CDigitSize * len); + for i := 0 to digitShifts - 1 do + Result.FDigits[i] := 0; + for i := 0 to len - 1 do + Result.FDigits[i + digitShifts] := A.FDigits[i]; end; Result.FIsNegative := A.IsNegative; From 62887ad1d7be5332182c068253f52f932ecb8ab7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 16 May 2024 17:08:44 +0200 Subject: [PATCH 20/48] Fixed BigInt multiplication test cases --- tests/UBigIntTestCases.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas index 1ecc16e..4cba54d 100644 --- a/tests/UBigIntTestCases.pas +++ b/tests/UBigIntTestCases.pas @@ -628,7 +628,7 @@ begin s := TBigInt.FromHexadecimalString(AHexValueProduct); AssertTrue('Product of BigInt from ''' + AHexValueLeft + ''' and from ''' + AHexValueRight + ''' was not equal to the BigInt from ''' + AHexValueProduct + '''.', - s = a + b); + s = a * b); end; procedure TBigIntProductTestCase.TestShort; From 18de900a38f2d06da4265175b512dd2648939c61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 00:56:22 +0200 Subject: [PATCH 21/48] Fixed BigInt subtraction for equal operands --- UBigInt.pas | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index a49ea16..4c8505e 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -237,10 +237,17 @@ class function TBigInt.SubtractAbsoluteValues(constref AA, AB: TBigInt; const AR var a, b: TBigInt; carry: Cardinal; - i, j, lastNonZeroDigitIndex, len: Integer; + compare, i, j, lastNonZeroDigitIndex, len: Integer; begin // Establishes the operand order, such that Abs(a) is not less than Abs(b). - if (AA.CompareToAbsoluteValues(AB) >= 0) then + compare := AA.CompareToAbsoluteValues(AB); + if compare = 0 then + begin + Result := Zero; + Exit; + end; + + if compare > 0 then begin a := AA; b := AB; From 9c951073d9ed5e8b4c683e883184b93f9ab878f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 00:56:52 +0200 Subject: [PATCH 22/48] Removed irrelevant todo --- UBigInt.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/UBigInt.pas b/UBigInt.pas index 4c8505e..7d22c07 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -572,7 +572,6 @@ begin Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); end; -// TODO: Shift operator could be implemented with a single Move call, but I do not want to change it without test cases. operator shl(const A: TBigInt; const B: Integer): TBigInt; var i, j, digitShifts, bitShifts, reverseShift, len, newLength: Integer; From 2ca960f19c69e64e4cf5751476655df7d69b494f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 00:59:40 +0200 Subject: [PATCH 23/48] Added TBigInt.ToString for debugging --- UBigInt.pas | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/UBigInt.pas b/UBigInt.pas index 7d22c07..5a31b72 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -78,6 +78,8 @@ type class property Zero: TBigInt read GetZero; function CompareTo(constref AOther: TBigInt): Integer; function TryToInt64(out AOutput: Int64): Boolean; + // TODO: ToString is currently for debug output only. + function ToString: string; class function FromInt64(const AValue: Int64): TBigInt; static; class function FromHexadecimalString(const AValue: string): TBigInt; static; class function FromBinaryString(const AValue: string): TBigInt; static; @@ -498,6 +500,21 @@ begin end; end; +function TBigInt.ToString: string; +var + i: Integer; +begin + if FIsNegative then + Result := '-' + else + Result := ''; + for i := 0 to Length(FDigits) - 2 do + Result := Result + '(' + IntToStr(FDigits[i]) + ' + 2^32 * '; + Result := Result + IntToStr(FDigits[Length(FDigits) - 1]); + for i := 0 to Length(FDigits) - 2 do + Result := Result + ')'; +end; + class function TBigInt.FromInt64(const AValue: Int64): TBigInt; var absVal: Int64; From 7ac4a3519ae45c851d7c66bf27795722b0d5fe9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 01:04:18 +0200 Subject: [PATCH 24/48] Added TBigIntPolynomial.ToString --- UPolynomial.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/UPolynomial.pas b/UPolynomial.pas index 13528ff..9a4374f 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -40,6 +40,7 @@ type function CalcValueAt(const AX: Int64): TBigInt; function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; + function ToString: string; class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; end; @@ -109,6 +110,18 @@ begin SetLength(Result.FCoefficients, 0); end; +function TBigIntPolynomial.ToString: string; +var + i: Integer; +begin + Result := FCoefficients[0].ToString; + for i := 1 to Length(FCoefficients) - 1 do + if i > 1 then + Result := Result + ' + ' + FCoefficients[i].ToString + ' * x^' + IntToStr(i) + else + Result := Result + ' + ' + FCoefficients[i].ToString + ' * x'; +end; + class function TBigIntPolynomial.Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; var high, i: integer; From afefbf46e3e6582c456a2fad7aedca4d77990c88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 01:05:16 +0200 Subject: [PATCH 25/48] Removed main project unit refs from FPCUnit project --- tests/AdventOfCodeFPCUnit.lpi | 8 -------- 1 file changed, 8 deletions(-) diff --git a/tests/AdventOfCodeFPCUnit.lpi b/tests/AdventOfCodeFPCUnit.lpi index 1d0b455..e34e993 100644 --- a/tests/AdventOfCodeFPCUnit.lpi +++ b/tests/AdventOfCodeFPCUnit.lpi @@ -40,10 +40,6 @@ - - - - @@ -144,10 +140,6 @@ - - - - From 52cee7312394324503c85d8c095e69a2926f1c64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 20 May 2024 15:03:54 +0200 Subject: [PATCH 26/48] Added TBigInt.GetMostSignificantBitIndex and tests --- UBigInt.pas | 33 +++++++++++++++++++++++++++++ tests/UBigIntTestCases.pas | 43 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+) diff --git a/UBigInt.pas b/UBigInt.pas index 5a31b72..699145f 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -76,6 +76,10 @@ type property IsNegative: Boolean read FIsNegative; property Sign: Integer read GetSign; class property Zero: TBigInt read GetZero; + + // Returns the index of the most significant bit, i.e. returns integer k, where 2^k is the largest power of 2 that + // is less than or equal to the absolute value of the number itself. Returns -1 if the given number is 0. + function GetMostSignificantBitIndex: Int64; function CompareTo(constref AOther: TBigInt): Integer; function TryToInt64(out AOutput: Int64): Boolean; // TODO: ToString is currently for debug output only. @@ -461,6 +465,21 @@ begin Result := StrToDWord(part); end; +function TBigInt.GetMostSignificantBitIndex: Int64; +var + high, i: Integer; +begin + high := Length(FDigits) - 1; + if (high = 0) and (FDigits[0] = 0) then + Result := -1 + else begin + i := CBitsPerDigit - 1; + while ((1 << i) and FDigits[high]) = 0 do + Dec(i); + Result := high * CBitsPerDigit + i; + end; +end; + function TBigInt.CompareTo(constref AOther: TBigInt): Integer; begin if FIsNegative = AOther.FIsNegative then @@ -549,6 +568,7 @@ end; operator := (const A: Int64): TBigInt; begin Result := TBigInt.FromInt64(A); + //WriteLn(':=a op: ', Result.ToString); end; operator - (const A: TBigInt): TBigInt; @@ -563,6 +583,8 @@ begin end else Result := TBigInt.Zero; + //WriteLn(' a: ', A.ToString); + //WriteLn('-a op: ', Result.ToString); end; operator + (const A, B: TBigInt): TBigInt; @@ -571,6 +593,9 @@ begin Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative) else Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative); + //WriteLn(' a: ', A.ToString); + //WriteLn(' b: ', B.ToString); + //WriteLn('a+b op: ', Result.ToString); end; operator - (const A, B: TBigInt): TBigInt; @@ -579,6 +604,9 @@ begin Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative) else Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative); + //WriteLn(' a: ', A.ToString); + //WriteLn(' b: ', B.ToString); + //WriteLn('a-b op: ', Result.ToString); end; operator * (const A, B: TBigInt): TBigInt; @@ -587,6 +615,9 @@ begin Result := TBigInt.Zero else Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); + //WriteLn(' a: ', A.ToString); + //WriteLn(' b: ', B.ToString); + //WriteLn('a*b op: ', Result.ToString); end; operator shl(const A: TBigInt; const B: Integer): TBigInt; @@ -639,6 +670,8 @@ begin Result.FIsNegative := A.IsNegative; end; + //WriteLn(' a: ', A.ToString); + //WriteLn('a<< op: ', Result.ToString); end; operator = (const A, B: TBigInt): Boolean; diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas index 4cba54d..2457462 100644 --- a/tests/UBigIntTestCases.pas +++ b/tests/UBigIntTestCases.pas @@ -70,6 +70,17 @@ type procedure TestLongNegative; end; + { TBigIntMostSignificantBitIndexTestCase } + + TBigIntMostSignificantBitIndexTestCase = class(TTestCase) + private + procedure Test(const ABinValue: string; const AExpectedIndex: Int64); + published + procedure TestZero; + procedure TestShort; + procedure TestLong; + end; + { TBigIntFromInt64TestCase } TBigIntFromInt64TestCase = class(TTestCase) @@ -271,6 +282,37 @@ begin Test('-192648F1305DD04757A24C873F29F60B6184B5', -1); end; +{ TBigIntMostSignificantBitIndexTestCase } + +procedure TBigIntMostSignificantBitIndexTestCase.Test(const ABinValue: string; const AExpectedIndex: Int64); +var + a: TBigInt; +begin + a := TBigInt.FromBinaryString(ABinValue); + AssertEquals('BigInt from binary string ''' + ABinValue + ''' did not have its most significant bit at index ''' + + IntToStr(AExpectedIndex) + '''.', + AExpectedIndex, a.GetMostSignificantBitIndex); +end; + +procedure TBigIntMostSignificantBitIndexTestCase.TestZero; +begin + Test('0', -1); +end; + +procedure TBigIntMostSignificantBitIndexTestCase.TestShort; +begin + Test('1', 0); + Test('11111101111001', 13); + Test('10010111101100001110110101111000', 31); +end; + +procedure TBigIntMostSignificantBitIndexTestCase.TestLong; +begin + Test('111100010101010100011101010100011', 32); + Test('11101001101010111101000101010001010101010101111111001010101010010100101000101011111001000111001001100011', 103); + Test('111101100011110110111011010111100000000001010111101110101101101100101010110111101011010101001100', 95); +end; + { TBigIntFromInt64TestCase } procedure TBigIntFromInt64TestCase.Test(const AValue: Int64); @@ -903,6 +945,7 @@ end; initialization RegisterTest(TBigIntSignTestCase); + RegisterTest(TBigIntMostSignificantBitIndexTestCase); RegisterTest(TBigIntFromInt64TestCase); RegisterTest(TBigIntFromHexTestCase); RegisterTest(TBigIntFromBinTestCase); From fad6e496c01b388c87cd063d05d98a64a460a122 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 21:06:33 +0200 Subject: [PATCH 27/48] Removed unintentional WriteLn comments --- UBigInt.pas | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 699145f..fd34585 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -568,7 +568,6 @@ end; operator := (const A: Int64): TBigInt; begin Result := TBigInt.FromInt64(A); - //WriteLn(':=a op: ', Result.ToString); end; operator - (const A: TBigInt): TBigInt; @@ -583,8 +582,6 @@ begin end else Result := TBigInt.Zero; - //WriteLn(' a: ', A.ToString); - //WriteLn('-a op: ', Result.ToString); end; operator + (const A, B: TBigInt): TBigInt; @@ -593,9 +590,6 @@ begin Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative) else Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative); - //WriteLn(' a: ', A.ToString); - //WriteLn(' b: ', B.ToString); - //WriteLn('a+b op: ', Result.ToString); end; operator - (const A, B: TBigInt): TBigInt; @@ -604,9 +598,6 @@ begin Result := TBigInt.SubtractAbsoluteValues(A, B, A.IsNegative) else Result := TBigInt.AddAbsoluteValues(A, B, A.IsNegative); - //WriteLn(' a: ', A.ToString); - //WriteLn(' b: ', B.ToString); - //WriteLn('a-b op: ', Result.ToString); end; operator * (const A, B: TBigInt): TBigInt; @@ -615,9 +606,6 @@ begin Result := TBigInt.Zero else Result := TBigInt.MultiplyAbsoluteValues(A, B, A.IsNegative <> B.IsNegative); - //WriteLn(' a: ', A.ToString); - //WriteLn(' b: ', B.ToString); - //WriteLn('a*b op: ', Result.ToString); end; operator shl(const A: TBigInt; const B: Integer): TBigInt; @@ -670,8 +658,6 @@ begin Result.FIsNegative := A.IsNegative; end; - //WriteLn(' a: ', A.ToString); - //WriteLn('a<< op: ', Result.ToString); end; operator = (const A, B: TBigInt): Boolean; From cfb74da86b00d78d54acf13e931ab86f8731119f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 21:07:11 +0200 Subject: [PATCH 28/48] Added TBigInt.One --- UBigInt.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/UBigInt.pas b/UBigInt.pas index fd34585..cd2fb7c 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -49,6 +49,7 @@ type function CompareToAbsoluteValues(constref AOther: TBigInt): Integer; class function GetZero: TBigInt; static; + class function GetOne: TBigInt; static; // Adds A and B, ignoring their signs and using ReturnNegative instead. The result is // Sign * (Abs(A) + Abs(B)), @@ -76,6 +77,7 @@ type property IsNegative: Boolean read FIsNegative; property Sign: Integer read GetSign; class property Zero: TBigInt read GetZero; + class property One: TBigInt read GetOne; // Returns the index of the most significant bit, i.e. returns integer k, where 2^k is the largest power of 2 that // is less than or equal to the absolute value of the number itself. Returns -1 if the given number is 0. @@ -115,6 +117,7 @@ const CHalfDigitMax = (1 << CHalfBits) - 1; CZero: TBigInt = (FDigits: (0); FIsNegative: False); + COne: TBigInt = (FDigits: (1); FIsNegative: False); { TBigInt } @@ -165,6 +168,11 @@ begin Result := CZero; end; +class function TBigInt.GetOne: TBigInt; +begin + Result := COne; +end; + class function TBigInt.AddAbsoluteValues(constref AA, AB: TBigInt; const AReturnNegative: Boolean): TBigInt; var i, j, lenA, lenB, len, shorter: Integer; From 18f432bdfe27abeb46abc7e72c618fd6ccc6c7a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 21:08:01 +0200 Subject: [PATCH 29/48] Added parenthesis in TBigInt.ToString for negative values --- UBigInt.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/UBigInt.pas b/UBigInt.pas index cd2fb7c..a672b9a 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -532,7 +532,7 @@ var i: Integer; begin if FIsNegative then - Result := '-' + Result := '(-' else Result := ''; for i := 0 to Length(FDigits) - 2 do @@ -540,6 +540,8 @@ begin Result := Result + IntToStr(FDigits[Length(FDigits) - 1]); for i := 0 to Length(FDigits) - 2 do Result := Result + ')'; + if FIsNegative then + Result := Result + ')' end; class function TBigInt.FromInt64(const AValue: Int64): TBigInt; From 4329041353378e4b88cbad00523ef0ee7104ed08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 22:00:45 +0200 Subject: [PATCH 30/48] Added TBigInt shift right operator and tests --- UBigInt.pas | 55 ++++++++++++++++++++++++++++ tests/UBigIntTestCases.pas | 74 +++++++++++++++++++++++++++++++++++++- 2 files changed, 128 insertions(+), 1 deletion(-) diff --git a/UBigInt.pas b/UBigInt.pas index a672b9a..907ec6b 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -99,6 +99,7 @@ type operator - (const A, B: TBigInt): TBigInt; operator * (const A, B: TBigInt): TBigInt; operator shl (const A: TBigInt; const B: Integer): TBigInt; + operator shr (const A: TBigInt; const B: Integer): TBigInt; operator = (const A, B: TBigInt): Boolean; operator <> (const A, B: TBigInt): Boolean; operator < (const A, B: TBigInt): Boolean; @@ -670,6 +671,60 @@ begin end; end; +operator shr(const A: TBigInt; const B: Integer): TBigInt; +var + i, j, digitShifts, bitShifts, reverseShift, len, newLength: Integer; + lastDigit: Cardinal; +begin + // Handles shift of zero. + if A = 0 then + begin + Result := TBigInt.Zero; + Exit; + end; + + // Determines full digit shifts and bit shifts. + DivMod(B, CBitsPerDigit, digitShifts, bitShifts); + + // Handles shift to zero. + if digitShifts >= Length(A.FDigits) then + begin + Result := TBigInt.Zero; + Exit; + end; + + if bitShifts > 0 then + begin + reverseShift := CBitsPerDigit - bitShifts; + len := Length(A.FDigits); + lastDigit := A.FDigits[len - 1] >> bitShifts; + newLength := len - digitShifts; + + if lastDigit = 0 then + SetLength(Result.FDigits, newLength - 1) + else + SetLength(Result.FDigits, newLength); + + // Performs full digit shifts by shifting the access index j for A.FDigits. + j := digitShifts; + for i := 0 to newLength - 2 do + begin + // Performs bit shifts. + Result.FDigits[i] := A.FDigits[j] >> bitShifts; + Inc(j); + Result.FDigits[i] := Result.FDigits[i] or (A.FDigits[j] << reverseShift); + end; + + if lastDigit > 0 then + Result.FDigits[newLength - 1] := lastDigit; + end + else + // Performs full digit shifts by copy if there are no bit shifts. + Result.FDigits := Copy(A.FDigits, digitShifts, Length(A.FDigits) - digitShifts); + + Result.FIsNegative := A.IsNegative; +end; + operator = (const A, B: TBigInt): Boolean; begin Result := A.CompareTo(B) = 0; diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas index 2457462..06019b1 100644 --- a/tests/UBigIntTestCases.pas +++ b/tests/UBigIntTestCases.pas @@ -55,7 +55,6 @@ type // TODO: TBigIntConversionTestCase // TODO: TBigIntIncrementDecrementTestCase // TODO: TBigIntQuotientTestCase - // TODO: TBigIntShiftRightTestCase { TBigIntSignTestCase } @@ -210,6 +209,21 @@ type procedure TestZero; end; + { TBigIntShiftRightTestCase } + + TBigIntShiftRightTestCase = class(TTestCase) + private + procedure Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: string); + published + procedure TestShort; + procedure TestShortWithCarry; + procedure TestLongWithCarry; + procedure TestLongWithMultiDigitCarry; + procedure TestWithAlignedDigits; + procedure TestShiftToZero; + procedure TestZero; + end; + { TBigIntEqualityTestCase } TBigIntEqualityTestCase = class(TTestCase) @@ -767,6 +781,63 @@ begin Test('0', 119, '0'); end; +{ TBigIntShiftRightTestCase } + +procedure TBigIntShiftRightTestCase.Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: + string); +var + a, s: TBigInt; +begin + a := TBigInt.FromHexadecimalString(AHexValueOperand); + s := TBigInt.FromHexadecimalString(AHexValueResult); + AssertTrue('BigInt from hexadecimal string ''' + AHexValueOperand + ''' shifted right by ''' + IntToStr(AShift) + + ''' was not equal to BigInt from hexadecimal string ''' + AHexValueResult + '''.', + s = (a >> AShift)); +end; + +procedure TBigIntShiftRightTestCase.TestShort; +begin + // BIN 100110101 + // BIN 10011 + Test('135', 4, '13'); +end; + +procedure TBigIntShiftRightTestCase.TestShortWithCarry; +begin + // BIN 1 1101 1010 1110 1001 1000 0111 0000 0000 0000 1111 + // BIN 11 1011 0101 1101 0011 0000 1110 + Test('1DAE987000F', 15, '3B5D30E'); +end; + +procedure TBigIntShiftRightTestCase.TestLongWithCarry; +begin + // BIN 10 0110 0001 0110 0100 0111 1100 1001 1001 1111 0010 1010 1000 1000 1010 0010 0010 1101 1101 + // BIN 100 1100 0010 1100 1000 1111 1001 0011 0011 1110 0101 0101 0001 0001 0100 0100 + Test('261647C99F2A88A22DD', 11, '4C2C8F933E551144'); +end; + +procedure TBigIntShiftRightTestCase.TestLongWithMultiDigitCarry; +begin + Test('647C99F12A088A22FF6DD02187345A3B839401BFB9272', 104, '647C99F12A088A22FF6'); +end; + +// Shifts the left operand by a multiple of the length of full TBigInt digits, so the digits will be shifted, but not +// changed. +procedure TBigIntShiftRightTestCase.TestWithAlignedDigits; +begin + Test('C5E10F0F39000AA2000C020000010000000000000F00000007', 32 * 5, 'C5E10F0F39'); +end; + +procedure TBigIntShiftRightTestCase.TestShiftToZero; +begin + Test('B5D10F0F39882F', 150, '0'); +end; + +procedure TBigIntShiftRightTestCase.TestZero; +begin + Test('0', 3, '0'); +end; + { TBigIntEqualityTestCase } procedure TBigIntEqualityTestCase.TestEqual(const AValue: Int64); @@ -954,6 +1025,7 @@ initialization RegisterTest(TBigIntDifferenceTestCase); RegisterTest(TBigIntProductTestCase); RegisterTest(TBigIntShiftLeftTestCase); + RegisterTest(TBigIntShiftRightTestCase); RegisterTest(TBigIntEqualityTestCase); RegisterTest(TBigIntComparisonTestCase); end. From 2df8266d42dcb2364268ed479d36127e2665383f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 22:01:25 +0200 Subject: [PATCH 31/48] Added some improvements for TBigInt shift left operator --- UBigInt.pas | 78 +++++++++++++++++++------------------- tests/UBigIntTestCases.pas | 3 +- 2 files changed, 42 insertions(+), 39 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 907ec6b..421368d 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -626,49 +626,51 @@ var begin // Handles shift of zero. if A = 0 then - Result := TBigInt.Zero - else begin - // Determines full digit shifts and bit shifts. - DivMod(B, CBitsPerDigit, digitShifts, bitShifts); + begin + Result := TBigInt.Zero; + Exit; + end; - if bitShifts > 0 then + // Determines full digit shifts and bit shifts. + DivMod(B, CBitsPerDigit, digitShifts, bitShifts); + + if bitShifts > 0 then + begin + reverseShift := CBitsPerDigit - bitShifts; + len := Length(A.FDigits); + lastDigit := A.FDigits[len - 1] >> reverseShift; + newLength := len + digitShifts; + + if lastDigit = 0 then + SetLength(Result.FDigits, newLength) + else + SetLength(Result.FDigits, newLength + 1); + + // Performs full digit shifts by shifting the access index j for A.FDigits. + Result.FDigits[digitShifts] := A.FDigits[0] << bitShifts; + j := 0; + for i := digitShifts + 1 to newLength - 1 do begin - reverseShift := CBitsPerDigit - bitShifts; - len := Length(A.FDigits); - lastDigit := A.FDigits[len - 1] >> reverseShift; - newLength := len + digitShifts; - - if lastDigit = 0 then - SetLength(Result.FDigits, newLength) - else - SetLength(Result.FDigits, newLength + 1); - - // Performs full digit shifts by shifting the access index j for A.FDigits. - Result.FDigits[digitShifts] := A.FDigits[0] << bitShifts; - j := 0; - for i := digitShifts + 1 to newLength - 1 do - begin - // Performs bit shifts. - Result.FDigits[i] := A.FDigits[j] >> reverseShift; - Inc(j); - Result.FDigits[i] := Result.FDigits[i] or (A.FDigits[j] << bitShifts); - end; - - if Length(Result.FDigits) > newLength then - Result.FDigits[newLength] := lastDigit; - end - else begin - // Performs full digit shifts by copy if there are no bit shifts. - len := Length(A.FDigits); - SetLength(Result.FDigits, len + digitShifts); - for i := 0 to digitShifts - 1 do - Result.FDigits[i] := 0; - for i := 0 to len - 1 do - Result.FDigits[i + digitShifts] := A.FDigits[i]; + // Performs bit shifts. + Result.FDigits[i] := A.FDigits[j] >> reverseShift; + Inc(j); + Result.FDigits[i] := Result.FDigits[i] or (A.FDigits[j] << bitShifts); end; - Result.FIsNegative := A.IsNegative; + if lastDigit > 0 then + Result.FDigits[newLength] := lastDigit; + end + else begin + // Performs full digit shifts by copy if there are no bit shifts. + len := Length(A.FDigits); + SetLength(Result.FDigits, len + digitShifts); + for i := 0 to digitShifts - 1 do + Result.FDigits[i] := 0; + for i := 0 to len - 1 do + Result.FDigits[i + digitShifts] := A.FDigits[i]; end; + + Result.FIsNegative := A.IsNegative; end; operator shr(const A: TBigInt; const B: Integer): TBigInt; diff --git a/tests/UBigIntTestCases.pas b/tests/UBigIntTestCases.pas index 06019b1..9639ac6 100644 --- a/tests/UBigIntTestCases.pas +++ b/tests/UBigIntTestCases.pas @@ -732,7 +732,8 @@ end; { TBigIntShiftLeftTestCase } -procedure TBigIntShiftLeftTestCase.Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: string); +procedure TBigIntShiftLeftTestCase.Test(const AHexValueOperand: string; const AShift: Integer; const AHexValueResult: + string); var a, s: TBigInt; begin From 37309d2817d146a8f01a11242b0470f708301583 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 22:07:58 +0200 Subject: [PATCH 32/48] Moved TBigIntPolynomial.IsEqualTo within the class --- UPolynomial.pas | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/UPolynomial.pas b/UPolynomial.pas index 9a4374f..aa3467d 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -38,8 +38,8 @@ type property Degree: Integer read GetDegree; property Coefficient[const AIndex: Integer]: TBigInt read GetCoefficient; function CalcValueAt(const AX: Int64): TBigInt; - function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; + function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; function ToString: string; class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; end; @@ -72,24 +72,6 @@ begin Result := Result * AX + FCoefficients[i]; end; -function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean; -var - i: Integer; -begin - if Length(FCoefficients) = Length(AOther.FCoefficients) then - begin - Result := True; - for i := 0 to Length(FCoefficients) - 1 do - if FCoefficients[i] <> AOther.FCoefficients[i] then - begin - Result := False; - Break; - end; - end - else - Result := False; -end; - function TBigIntPolynomial.ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; var len, i: Integer; @@ -110,6 +92,24 @@ begin SetLength(Result.FCoefficients, 0); end; +function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean; +var + i: Integer; +begin + if Length(FCoefficients) = Length(AOther.FCoefficients) then + begin + Result := True; + for i := 0 to Length(FCoefficients) - 1 do + if FCoefficients[i] <> AOther.FCoefficients[i] then + begin + Result := False; + Break; + end; + end + else + Result := False; +end; + function TBigIntPolynomial.ToString: string; var i: Integer; From aef4f28f46a1b94651a3ec8dd55ac6ead8dc95ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 22:11:22 +0200 Subject: [PATCH 33/48] Changed zero polynomial resulting from scaling to have one coefficient --- UPolynomial.pas | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/UPolynomial.pas b/UPolynomial.pas index aa3467d..c4fd23b 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -88,8 +88,10 @@ begin factor := factor * AScaleFactor; end; end - else - SetLength(Result.FCoefficients, 0); + else begin + SetLength(Result.FCoefficients, 1); + Result.FCoefficients[0] := TBigInt.Zero; + end; end; function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean; From cbaffbf55e92a6d961b86003c682799d596dcf85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Thu, 23 May 2024 22:15:31 +0200 Subject: [PATCH 34/48] Added TBigIntPolynomial methods needed for bisection algorithm --- UPolynomial.pas | 116 +++++++++++++++++++++++++++++++++ tests/UPolynomialTestCases.pas | 70 ++++++++++++++++++++ 2 files changed, 186 insertions(+) diff --git a/UPolynomial.pas b/UPolynomial.pas index c4fd23b..035cb09 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -38,7 +38,29 @@ type property Degree: Integer read GetDegree; property Coefficient[const AIndex: Integer]: TBigInt read GetCoefficient; function CalcValueAt(const AX: Int64): TBigInt; + function CalcSignVariations: Integer; + + // Returns 2^n * f(x), given a polynomial f(x) and exponent n. + function ScaleByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial; + + // Returns f(s * x), given a polynomial f(x) and scale factor s. function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; + + // Returns f(x / 2), given a polynomial f(x). + function ScaleVariableByHalf: TBigIntPolynomial; + + // Returns f(x + 1), given a polynomial f(x). + function TranslateVariableByOne: TBigIntPolynomial; + + // Returns a polynomial with the reverse order of coefficients, i.e. the polynomial + // a_0 * x^n + a_1 * x^(n - 1) + ... + a_(n - 1) * x + a_n, + // given a polynomial + // a_n * x^n + a_(n - 1) * x^(n - 1) + ... + a_1 * x + a_0. + function RevertOrderOfCoefficients: TBigIntPolynomial; + + // Returns a polynomial with all coefficents shifted down one position, and the constant term removed. This should + // only be used when the constant term is zero and is then equivalent to a division of polynomial f(x) by x. + function DivideByVariable: TBigIntPolynomial; function IsEqualTo(const AOther: TBigIntPolynomial): Boolean; function ToString: string; class function Create(const ACoefficients: array of TBigInt): TBigIntPolynomial; static; @@ -72,6 +94,34 @@ begin Result := Result * AX + FCoefficients[i]; end; +function TBigIntPolynomial.CalcSignVariations: Integer; +var + current, last, i: Integer; +begin + Result := 0; + last := 0; + for i := 0 to Length(FCoefficients) - 1 do + begin + current := FCoefficients[i].Sign; + if (current <> 0) and (last <> current) then + begin + if last <> 0 then + Inc(Result); + last := current + end; + end; +end; + +function TBigIntPolynomial.ScaleByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial; +var + len, i: Integer; +begin + len := Length(FCoefficients); + SetLength(Result.FCoefficients, len); + for i := 0 to len - 1 do + Result.FCoefficients[i] := FCoefficients[i] << AExponent; +end; + function TBigIntPolynomial.ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; var len, i: Integer; @@ -94,6 +144,72 @@ begin end; end; +function TBigIntPolynomial.ScaleVariableByHalf: TBigIntPolynomial; +var + len, i: Integer; +begin + len := Length(FCoefficients); + SetLength(Result.FCoefficients, len); + Result.FCoefficients[0] := FCoefficients[0]; + for i := 1 to len - 1 do + Result.FCoefficients[i] := FCoefficients[i] >> i; +end; + +function TBigIntPolynomial.TranslateVariableByOne: TBigIntPolynomial; +var + len, i, j: Integer; + factors: array of Cardinal; +begin + len := Length(FCoefficients); + SetLength(Result.FCoefficients, len); + SetLength(factors, len); + for i := 0 to len - 1 do + begin + Result.FCoefficients[i] := TBigInt.Zero; + factors[i] := 1; + end; + + // Calculates new coefficients. + for i := 0 to len - 1 do + begin + for j := 0 to len - i - 1 do + begin + if (i <> 0) and (j <> 0) then + factors[j] := factors[j] + factors[j - 1]; + Result.FCoefficients[i] := Result.FCoefficients[i] + factors[j] * FCoefficients[j + i]; + end; + end; +end; + +function TBigIntPolynomial.RevertOrderOfCoefficients: TBigIntPolynomial; +var + len, skip, i: Integer; +begin + // Counts the trailing zeros to skip. + len := Length(FCoefficients); + skip := 0; + while (skip < len) and (FCoefficients[skip] = 0) do + Inc(skip); + + // Copies the other coefficients in reverse order. + SetLength(Result.FCoefficients, len - skip); + for i := skip to len - 1 do + Result.FCoefficients[len - i - 1] := FCoefficients[i]; +end; + +function TBigIntPolynomial.DivideByVariable: TBigIntPolynomial; +var + len: Integer; +begin + len := Length(FCoefficients); + if len > 1 then + Result.FCoefficients := Copy(FCoefficients, 1, len - 1) + else begin + SetLength(Result.FCoefficients, 1); + Result.FCoefficients[0] := TBigInt.Zero; + end; +end; + function TBigIntPolynomial.IsEqualTo(const AOther: TBigIntPolynomial): Boolean; var i: Integer; diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas index b4d75a0..c0e9e91 100644 --- a/tests/UPolynomialTestCases.pas +++ b/tests/UPolynomialTestCases.pas @@ -40,6 +40,13 @@ type procedure TestUnequalSameLength; procedure TestUnequalDifferentLength; procedure TestTrimLeadingZeros; + procedure TestCalcValueAt; + procedure TestSignVariations; + procedure TestScaleByPowerOfTwo; + procedure TestScaleVariable; + procedure TestTranslateVariableByOne; + procedure TestRevertOrderOfCoefficients; + procedure TestDivideByVariable; end; implementation @@ -110,6 +117,69 @@ begin AssertTrue('Polynomials are not equal.', a = b); end; +procedure TBigIntPolynomialTestCase.TestCalcValueAt; +var + a: TBigIntPolynomial; + exp: TBigInt; +begin + a := TBigIntPolynomial.Create([80, 892477222, 0, 921556, 7303]); + exp:= TBigInt.FromInt64(16867124285); + AssertTrue('Polynomial evaluation unexpected.', a.CalcValueAt(15) = exp); +end; + +procedure TBigIntPolynomialTestCase.TestSignVariations; +var + a: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([-10, 15, 0, 10, -20, -15, 0, 0, 5, 10, -10]); + AssertEquals(4, a.CalcSignVariations); +end; + +procedure TBigIntPolynomialTestCase.TestScaleByPowerOfTwo; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleByPowerOfTwo(7); + b := TBigIntPolynomial.Create([128 * 10, 128 * 7, 128 * 5, 128 * 1034]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestScaleVariable; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleVariable(TBigInt.FromInt64(10)); + b := TBigIntPolynomial.Create([10, 70, 500, 1034000]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestTranslateVariableByOne; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034]).TranslateVariableByOne; + b := TBigIntPolynomial.Create([1056, 3119, 3107, 1034]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestRevertOrderOfCoefficients; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([0, 10, 7, 5, 1034]).RevertOrderOfCoefficients; + b := TBigIntPolynomial.Create([1034, 5, 7, 10]); + AssertTrue('Polynomials are not equal.', a = b); +end; + +procedure TBigIntPolynomialTestCase.TestDivideByVariable; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([0, 10, 7, 5, 1034]).DivideByVariable; + b := TBigIntPolynomial.Create([10, 7, 5, 1034]); + AssertTrue('Polynomials are not equal.', a = b); +end; + initialization RegisterTest(TBigIntPolynomialTestCase); From 53e3922654b2267a20377353630d56f572ba7058 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Fri, 24 May 2024 20:20:28 +0200 Subject: [PATCH 35/48] Updated bisection root finding algorithm and test case --- UPolynomialRoots.pas | 104 ++++++++++++++++++++++++---- tests/UPolynomialRootsTestCases.pas | 20 +++++- 2 files changed, 109 insertions(+), 15 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index 71ee652..acf15f1 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -22,17 +22,29 @@ unit UPolynomialRoots; interface uses - Classes, SysUtils, UPolynomial, UBigInt; + Classes, SysUtils, Generics.Collections, UPolynomial, UBigInt; type + { TIsolatingInterval } + + // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A / 2^K, B / 2^K] in + // respect to [0, bound], with A = C * bound and B = (C + H) * bound. + TIsolatingInterval = record + C, K, H: Cardinal; + Bound, A, B: TBigInt; + end; + + TIsolatingIntervals = specialize TList; + { TRootIsolation } TRootIsolation = class private function CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; + function GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; public - function Bisect(constref APolynomial: TBigIntPolynomial): Int64; + function Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; end; implementation @@ -42,30 +54,96 @@ implementation function TRootIsolation.CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; var i, sign: Integer; - a: TBigInt; + an, ai, max: TBigInt; + numeratorBit, denominatorBit: Int64; begin // We need a_n > 0 here, so we use -sign(a_n) instead of actually flipping the polynomial. // Sign is not 0 because a_n is not 0. - sign := -APolynomial.Coefficient[APolynomial.Degree].Sign; + an := APolynomial.Coefficient[APolynomial.Degree]; + sign := -an.Sign; - // This is a simplification of Cauchy's bound to avoid division. + // This is a simplification of Cauchy's bound to avoid division and make it a power of two. // https://en.wikipedia.org/wiki/Geometrical_properties_of_polynomial_roots#Bounds_of_positive_real_roots - Result := TBigInt.Zero; + max := TBigInt.Zero; for i := 0 to APolynomial.Degree - 1 do begin - a := sign * APolynomial.Coefficient[i]; - if Result < a then - Result := a; + ai := sign * APolynomial.Coefficient[i]; + if max < ai then + max := ai; end; - Result := Result + 1; + numeratorBit := max.GetMostSignificantBitIndex + 1; + denominatorBit := an.GetMostSignificantBitIndex; + Result := TBigInt.One << (numeratorBit - denominatorBit); end; -function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): Int64; +function TRootIsolation.GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; +begin + Result.C := AC; + Result.K := AK; + Result.H := AH; + Result.Bound := ABound; + Result.A := AC * ABound; + Result.B := (AC + AH) * ABound; +end; + +// This is adapted from +// https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method +function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; +type + TWorkItem = record + C, K: Cardinal; + P: TBigIntPolynomial; + end; + TWorkStack = specialize TStack; var bound: TBigInt; - p: TBigIntPolynomial; + item: TWorkItem; + stack: TWorkStack; + n, v: Integer; + varq: TBigIntPolynomial; begin + Result := TIsolatingIntervals.Create; + stack := TWorkStack.Create; + bound := CalcSimpleRootBound(APolynomial); - p := APolynomial.ScaleVariable(bound); + n := item.P.Degree; + + item.C := 0; + item.K := 0; + item.P := APolynomial.ScaleVariable(bound); + stack.Push(item); + + while stack.Count > 0 do + begin + item := stack.Pop; + if item.P.Coefficient[0] = TBigInt.Zero then + begin + // Found an integer root at 0. + item.P := item.P.DivideByVariable; + Dec(n); + Result.Add(GetIsolatingInterval(item.C, item.K, 0, bound)); + end; + + varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; + v := varq.CalcSignVariations; + if v = 1 then + begin + // Found isolating interval. + Result.Add(GetIsolatingInterval(item.C, item.K, 1, bound)); + end + else if v > 1 then + begin + // Bisects, first new work item is (2c, k + 1, 2^n * q(x/2)). + item.C := item.C << 1; + Inc(item.K); + item.P := item.P.ScaleVariableByHalf.ScaleByPowerOfTwo(n); + stack.Push(item); + // ... second new work item is (2c + 1, k + 1, 2^n * q((x+1)/2)). + item.C := item.C + 1; + item.P := item.P.TranslateVariableByOne; + stack.Push(item); + end; + end; + stack.Free; end; end. diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index c7ae57c..81cb8fb 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -54,15 +54,31 @@ begin end; procedure TPolynomialRootsTestCase.TestBisectionRootIsolation; +const + expRoots: array of Cardinal = (34000, 23017, 5); var + exp: Cardinal; a: TBigIntPolynomial; - r: Int64; + r: TIsolatingIntervals; + ri: TIsolatingInterval; + found: Boolean; begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); r := FRootIsolation.Bisect(a); - AssertEquals(0, r); + AssertEquals(Length(expRoots), r.Count); + for exp in expRoots do + begin + found := False; + for ri in r do + if (ri.A <= exp) and (exp <= ri.B) then + begin + found := True; + Break; + end; + AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); + end; end; initialization From baa1f8f31fa60e7526b847468b7ff5da3b5b90e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Fri, 24 May 2024 20:47:52 +0200 Subject: [PATCH 36/48] Added bisection root finding algorithm with custom upper bound --- UPolynomialRoots.pas | 20 ++++++---- tests/UPolynomialRootsTestCases.pas | 61 +++++++++++++++++++++-------- 2 files changed, 57 insertions(+), 24 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index acf15f1..a4b029a 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -45,6 +45,7 @@ type function GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; public function Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; + function Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals; end; implementation @@ -85,9 +86,17 @@ begin Result.B := (AC + AH) * ABound; end; +function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; +var + bound: TBigInt; +begin + bound := CalcSimpleRootBound(APolynomial); + Result := Bisect(APolynomial, bound); +end; + // This is adapted from // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method -function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; +function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals; type TWorkItem = record C, K: Cardinal; @@ -95,7 +104,6 @@ type end; TWorkStack = specialize TStack; var - bound: TBigInt; item: TWorkItem; stack: TWorkStack; n, v: Integer; @@ -104,12 +112,10 @@ begin Result := TIsolatingIntervals.Create; stack := TWorkStack.Create; - bound := CalcSimpleRootBound(APolynomial); n := item.P.Degree; - item.C := 0; item.K := 0; - item.P := APolynomial.ScaleVariable(bound); + item.P := APolynomial.ScaleVariable(ABound); stack.Push(item); while stack.Count > 0 do @@ -120,7 +126,7 @@ begin // Found an integer root at 0. item.P := item.P.DivideByVariable; Dec(n); - Result.Add(GetIsolatingInterval(item.C, item.K, 0, bound)); + Result.Add(GetIsolatingInterval(item.C, item.K, 0, ABound)); end; varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; @@ -128,7 +134,7 @@ begin if v = 1 then begin // Found isolating interval. - Result.Add(GetIsolatingInterval(item.C, item.K, 1, bound)); + Result.Add(GetIsolatingInterval(item.C, item.K, 1, ABound)); end else if v > 1 then begin diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index 81cb8fb..3ae8ffe 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -29,18 +29,43 @@ type { TPolynomialRootsTestCase } TPolynomialRootsTestCase = class(TTestCase) + private + procedure AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref AExpectedRoots: + array of Cardinal); protected FRootIsolation: TRootIsolation; procedure SetUp; override; procedure TearDown; override; published - procedure TestBisectionRootIsolation; + procedure TestBisectNoBound; + procedure TestBisectWithBound; end; implementation { TPolynomialRootsTestCase } +procedure TPolynomialRootsTestCase.AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref + AExpectedRoots: array of Cardinal); +var + exp: Cardinal; + ri: TIsolatingInterval; + found: Boolean; +begin + AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), AIsolatingIntervals.Count); + for exp in AExpectedRoots do + begin + found := False; + for ri in AIsolatingIntervals do + if (ri.A <= exp) and (exp <= ri.B) then + begin + found := True; + Break; + end; + AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); + end; +end; + procedure TPolynomialRootsTestCase.SetUp; begin inherited SetUp; @@ -53,32 +78,34 @@ begin inherited TearDown; end; -procedure TPolynomialRootsTestCase.TestBisectionRootIsolation; +procedure TPolynomialRootsTestCase.TestBisectNoBound; const expRoots: array of Cardinal = (34000, 23017, 5); var - exp: Cardinal; a: TBigIntPolynomial; r: TIsolatingIntervals; - ri: TIsolatingInterval; - found: Boolean; begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); r := FRootIsolation.Bisect(a); - AssertEquals(Length(expRoots), r.Count); - for exp in expRoots do - begin - found := False; - for ri in r do - if (ri.A <= exp) and (exp <= ri.B) then - begin - found := True; - Break; - end; - AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); - end; + AssertBisectResult(r, expRoots); + r.Free; +end; + +procedure TPolynomialRootsTestCase.TestBisectWithBound; +const + expRoots: array of Cardinal = (23017, 5); +var + a: TBigIntPolynomial; + r: TIsolatingIntervals; +begin + // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) + // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 + a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); + r := FRootIsolation.Bisect(a, TBigInt.One << 15); + AssertBisectResult(r, expRoots); + r.Free; end; initialization From fa5616f3cca597fb4398f7d9ab5ebf1bc904fad7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 25 May 2024 02:35:55 +0200 Subject: [PATCH 37/48] Fixed initializer of zero polynomial --- UPolynomial.pas | 4 ++++ tests/UPolynomialTestCases.pas | 16 +++------------- 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/UPolynomial.pas b/UPolynomial.pas index 035cb09..5d33937 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -256,6 +256,10 @@ begin SetLength(Result.FCoefficients, high + 1); for i := 0 to high do Result.FCoefficients[i] := ACoefficients[i]; + end + else begin + SetLength(Result.FCoefficients, 1); + Result.FCoefficients[0] := TBigInt.Zero; end; end; diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas index c0e9e91..e260f97 100644 --- a/tests/UPolynomialTestCases.pas +++ b/tests/UPolynomialTestCases.pas @@ -33,9 +33,7 @@ type procedure TestCreateWithDegree(const ACoefficients: array of TBigInt; const ADegree: Integer); published procedure TestCreate; - procedure TestCreateDegreeOne; procedure TestCreateDegreeZero; - procedure TestCreateDegreeZeroTrim; procedure TestEqual; procedure TestUnequalSameLength; procedure TestUnequalDifferentLength; @@ -66,19 +64,11 @@ begin TestCreateWithDegree([992123, 7, 20, 4550022], 3); end; -procedure TBigIntPolynomialTestCase.TestCreateDegreeOne; -begin - TestCreateWithDegree([4007], 0); -end; - procedure TBigIntPolynomialTestCase.TestCreateDegreeZero; begin - TestCreateWithDegree([], -1); -end; - -procedure TBigIntPolynomialTestCase.TestCreateDegreeZeroTrim; -begin - TestCreateWithDegree([0], -1); + TestCreateWithDegree([4007], 0); + TestCreateWithDegree([], 0); + TestCreateWithDegree([0], 0); end; procedure TBigIntPolynomialTestCase.TestEqual; From 748964c8718eb13a5ee0eab08dafd2e9fe0badf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 25 May 2024 02:37:34 +0200 Subject: [PATCH 38/48] Fixed broken polynomial degree in bisection algorithm --- UPolynomialRoots.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index a4b029a..b2636f8 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -112,11 +112,11 @@ begin Result := TIsolatingIntervals.Create; stack := TWorkStack.Create; - n := item.P.Degree; item.C := 0; item.K := 0; item.P := APolynomial.ScaleVariable(ABound); stack.Push(item); + n := item.P.Degree; while stack.Count > 0 do begin From ae30889bbba139ed49a3a848170e1514efcec29d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sat, 25 May 2024 02:50:24 +0200 Subject: [PATCH 39/48] Fixed calculation of root-isolating intervals and tests --- UPolynomialRoots.pas | 8 ++++---- tests/UPolynomialRootsTestCases.pas | 8 +++++--- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index b2636f8..3d9fafa 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -28,8 +28,8 @@ type { TIsolatingInterval } - // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A / 2^K, B / 2^K] in - // respect to [0, bound], with A = C * bound and B = (C + H) * bound. + // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A, B] in respect to + // [0, bound], with A = C * bound / 2^K and B = (C + H) * bound / 2^K. TIsolatingInterval = record C, K, H: Cardinal; Bound, A, B: TBigInt; @@ -82,8 +82,8 @@ begin Result.K := AK; Result.H := AH; Result.Bound := ABound; - Result.A := AC * ABound; - Result.B := (AC + AH) * ABound; + Result.A := (AC * ABound) >> AK; + Result.B := ((AC + AH) * ABound) >> AK; end; function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index 3ae8ffe..e1d765d 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -49,20 +49,22 @@ procedure TPolynomialRootsTestCase.AssertBisectResult(constref AIsolatingInterva AExpectedRoots: array of Cardinal); var exp: Cardinal; - ri: TIsolatingInterval; found: Boolean; + i, foundIndex: Integer; begin AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), AIsolatingIntervals.Count); for exp in AExpectedRoots do begin found := False; - for ri in AIsolatingIntervals do - if (ri.A <= exp) and (exp <= ri.B) then + for i := 0 to AIsolatingIntervals.Count - 1 do + if (AIsolatingIntervals[i].A <= exp) and (exp <= AIsolatingIntervals[i].B) then begin found := True; + foundIndex := i; Break; end; AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); + AIsolatingIntervals.Delete(foundIndex); end; end; From ab453b347d30d5dc30afa7104c9bbd4ac90b7ee9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 14:23:31 +0200 Subject: [PATCH 40/48] Renamed root finding class and methods, now class methods --- UPolynomialRoots.pas | 33 ++++++++++++++++------------- tests/UPolynomialRootsTestCases.pas | 20 ++--------------- 2 files changed, 20 insertions(+), 33 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index 3d9fafa..2a522f0 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -37,22 +37,23 @@ type TIsolatingIntervals = specialize TList; - { TRootIsolation } + { TPolynomialRoots } - TRootIsolation = class + TPolynomialRoots = class private - function CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; - function GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; + class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; + class function CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; public - function Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; - function Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals; + class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; + class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): + TIsolatingIntervals; end; implementation -{ TRootIsolation } +{ TPolynomialRoots } -function TRootIsolation.CalcSimpleRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; +class function TPolynomialRoots.CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; var i, sign: Integer; an, ai, max: TBigInt; @@ -76,7 +77,8 @@ begin Result := TBigInt.One << (numeratorBit - denominatorBit); end; -function TRootIsolation.GetIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; +class function TPolynomialRoots.CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): + TIsolatingInterval; begin Result.C := AC; Result.K := AK; @@ -86,17 +88,18 @@ begin Result.B := ((AC + AH) * ABound) >> AK; end; -function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; +class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; var bound: TBigInt; begin - bound := CalcSimpleRootBound(APolynomial); - Result := Bisect(APolynomial, bound); + bound := CalcUpperRootBound(APolynomial); + Result := BisectIsolation(APolynomial, bound); end; // This is adapted from // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method -function TRootIsolation.Bisect(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): TIsolatingIntervals; +class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): + TIsolatingIntervals; type TWorkItem = record C, K: Cardinal; @@ -126,7 +129,7 @@ begin // Found an integer root at 0. item.P := item.P.DivideByVariable; Dec(n); - Result.Add(GetIsolatingInterval(item.C, item.K, 0, ABound)); + Result.Add(CreateIsolatingInterval(item.C, item.K, 0, ABound)); end; varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; @@ -134,7 +137,7 @@ begin if v = 1 then begin // Found isolating interval. - Result.Add(GetIsolatingInterval(item.C, item.K, 1, ABound)); + Result.Add(CreateIsolatingInterval(item.C, item.K, 1, ABound)); end else if v > 1 then begin diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index e1d765d..03faa50 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -32,10 +32,6 @@ type private procedure AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref AExpectedRoots: array of Cardinal); - protected - FRootIsolation: TRootIsolation; - procedure SetUp; override; - procedure TearDown; override; published procedure TestBisectNoBound; procedure TestBisectWithBound; @@ -68,18 +64,6 @@ begin end; end; -procedure TPolynomialRootsTestCase.SetUp; -begin - inherited SetUp; - FRootIsolation := TRootIsolation.Create; -end; - -procedure TPolynomialRootsTestCase.TearDown; -begin - FRootIsolation.Free; - inherited TearDown; -end; - procedure TPolynomialRootsTestCase.TestBisectNoBound; const expRoots: array of Cardinal = (34000, 23017, 5); @@ -90,7 +74,7 @@ begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); - r := FRootIsolation.Bisect(a); + r := TPolynomialRoots.BisectIsolation(a); AssertBisectResult(r, expRoots); r.Free; end; @@ -105,7 +89,7 @@ begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); - r := FRootIsolation.Bisect(a, TBigInt.One << 15); + r := TPolynomialRoots.BisectIsolation(a, TBigInt.One << 15); AssertBisectResult(r, expRoots); r.Free; end; From 04e1702a2e1caa47470b89ee2913248ac2548103 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 16:59:16 +0200 Subject: [PATCH 41/48] Added TBigIntPolynomial.ScaleVariableByPowerOfTwo --- UPolynomial.pas | 18 ++++++++++++++++++ tests/UPolynomialTestCases.pas | 10 ++++++++++ 2 files changed, 28 insertions(+) diff --git a/UPolynomial.pas b/UPolynomial.pas index 5d33937..f4cec85 100644 --- a/UPolynomial.pas +++ b/UPolynomial.pas @@ -46,6 +46,9 @@ type // Returns f(s * x), given a polynomial f(x) and scale factor s. function ScaleVariable(const AScaleFactor: TBigInt): TBigIntPolynomial; + // Returns f(2^n * x), given a polynomial f(x) and an exponent n. + function ScaleVariableByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial; + // Returns f(x / 2), given a polynomial f(x). function ScaleVariableByHalf: TBigIntPolynomial; @@ -144,6 +147,21 @@ begin end; end; +function TBigIntPolynomial.ScaleVariableByPowerOfTwo(const AExponent: Cardinal): TBigIntPolynomial; +var + len, i: Integer; + shift: Cardinal; +begin + len := Length(FCoefficients); + SetLength(Result.FCoefficients, len); + Result.FCoefficients[0] := FCoefficients[0]; + shift := AExponent; + for i := 1 to len - 1 do begin + Result.FCoefficients[i] := FCoefficients[i] << shift; + Inc(shift, AExponent); + end; +end; + function TBigIntPolynomial.ScaleVariableByHalf: TBigIntPolynomial; var len, i: Integer; diff --git a/tests/UPolynomialTestCases.pas b/tests/UPolynomialTestCases.pas index e260f97..28c92dc 100644 --- a/tests/UPolynomialTestCases.pas +++ b/tests/UPolynomialTestCases.pas @@ -42,6 +42,7 @@ type procedure TestSignVariations; procedure TestScaleByPowerOfTwo; procedure TestScaleVariable; + procedure TestScaleVariableByPowerOfTwo; procedure TestTranslateVariableByOne; procedure TestRevertOrderOfCoefficients; procedure TestDivideByVariable; @@ -143,6 +144,15 @@ begin AssertTrue('Polynomials are not equal.', a = b); end; +procedure TBigIntPolynomialTestCase.TestScaleVariableByPowerOfTwo; +var + a, b: TBigIntPolynomial; +begin + a := TBigIntPolynomial.Create([10, 7, 5, 1034]).ScaleVariableByPowerOfTwo(5); + b := TBigIntPolynomial.Create([10, 7 * 32, 5 * 32 * 32, 1034 * 32 * 32 * 32]); + AssertTrue('Polynomials are not equal.', a = b); +end; + procedure TBigIntPolynomialTestCase.TestTranslateVariableByOne; var a, b: TBigIntPolynomial; From 8d4a5c2ed8b1fed523d5481e6bd7dc5a953cdee4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 17:05:02 +0200 Subject: [PATCH 42/48] Changed root finder to use base-2 exponent of bound Since the root isolation algorithm uses a power of two as bound anyway, it makes sense to use it's exponent in method interfaces and throughout the algorithm. This simplifies multiplications to cheap shifts and will make it easier to detect when the isolating interval size is 1. Also added some method documentation. --- UPolynomialRoots.pas | 50 ++++++++++++++++++----------- tests/UPolynomialRootsTestCases.pas | 2 +- 2 files changed, 32 insertions(+), 20 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index 2a522f0..6853b80 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -29,10 +29,10 @@ type { TIsolatingInterval } // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A, B] in respect to - // [0, bound], with A = C * bound / 2^K and B = (C + H) * bound / 2^K. + // [0, 2^boundexp], with A = C * 2^boundexp / 2^K and B = (C + H) * 2^boundexp / 2^K. TIsolatingInterval = record - C, K, H: Cardinal; - Bound, A, B: TBigInt; + C, K, H, BoundExp: Cardinal; + A, B: TBigInt; end; TIsolatingIntervals = specialize TList; @@ -41,11 +41,16 @@ type TPolynomialRoots = class private - class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; - class function CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): TIsolatingInterval; + // Returns the exponent (base two) of an upper bound for the roots of the given polynomial, i.e. all real roots of + // the given polynomial are less or equal than 2^b, where b is the returned positive integer. + class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): Cardinal; + class function CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABoundExp: Cardinal): + TIsolatingInterval; public + // Returns root-isolating intervals for non-negative, non-multiple roots. class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; - class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): + // Returns root-isolating intervals for non-multiple roots in the interval [0, 2^boundexp]. + class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): TIsolatingIntervals; end; @@ -53,7 +58,7 @@ implementation { TPolynomialRoots } -class function TPolynomialRoots.CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): TBigInt; +class function TPolynomialRoots.CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): Cardinal; var i, sign: Integer; an, ai, max: TBigInt; @@ -74,31 +79,38 @@ begin end; numeratorBit := max.GetMostSignificantBitIndex + 1; denominatorBit := an.GetMostSignificantBitIndex; - Result := TBigInt.One << (numeratorBit - denominatorBit); + Result := numeratorBit - denominatorBit; end; -class function TPolynomialRoots.CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABound: TBigInt): +class function TPolynomialRoots.CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABoundExp: Cardinal): TIsolatingInterval; begin Result.C := AC; Result.K := AK; Result.H := AH; - Result.Bound := ABound; - Result.A := (AC * ABound) >> AK; - Result.B := ((AC + AH) * ABound) >> AK; + Result.BoundExp := ABoundExp; + if ABoundExp >= AK then + begin + Result.A := AC << (ABoundExp - AK); + Result.B := (AC + AH) << (ABoundExp - AK); + end + else begin + Result.A := AC << (ABoundExp - AK); + Result.B := (AC + AH) << (ABoundExp - AK); + end; end; class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; var - bound: TBigInt; + boundExp: Cardinal; begin - bound := CalcUpperRootBound(APolynomial); - Result := BisectIsolation(APolynomial, bound); + boundExp := CalcUpperRootBound(APolynomial); + Result := BisectIsolation(APolynomial, boundExp); end; // This is adapted from // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method -class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABound: TBigInt): +class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): TIsolatingIntervals; type TWorkItem = record @@ -117,7 +129,7 @@ begin item.C := 0; item.K := 0; - item.P := APolynomial.ScaleVariable(ABound); + item.P := APolynomial.ScaleVariableByPowerOfTwo(ABoundExp); stack.Push(item); n := item.P.Degree; @@ -129,7 +141,7 @@ begin // Found an integer root at 0. item.P := item.P.DivideByVariable; Dec(n); - Result.Add(CreateIsolatingInterval(item.C, item.K, 0, ABound)); + Result.Add(CreateIsolatingInterval(item.C, item.K, 0, ABoundExp)); end; varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; @@ -137,7 +149,7 @@ begin if v = 1 then begin // Found isolating interval. - Result.Add(CreateIsolatingInterval(item.C, item.K, 1, ABound)); + Result.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); end else if v > 1 then begin diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index 03faa50..cfd9e47 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -89,7 +89,7 @@ begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); - r := TPolynomialRoots.BisectIsolation(a, TBigInt.One << 15); + r := TPolynomialRoots.BisectIsolation(a, 15); AssertBisectResult(r, expRoots); r.Free; end; From 7db8f948c5fcba0d367d9a9857c5f3d0a9bd3fc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 17:34:18 +0200 Subject: [PATCH 43/48] Changed TPolynomialRoots.BisectIsolation return type to array --- UPolynomialRoots.pas | 19 ++++++++++++------- tests/UPolynomialRootsTestCases.pas | 22 ++++++++++------------ 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index 6853b80..fa1280c 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -37,6 +37,8 @@ type TIsolatingIntervals = specialize TList; + TIsolatingIntervalArray = array of TIsolatingInterval; + { TPolynomialRoots } TPolynomialRoots = class @@ -48,10 +50,10 @@ type TIsolatingInterval; public // Returns root-isolating intervals for non-negative, non-multiple roots. - class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; + class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervalArray; // Returns root-isolating intervals for non-multiple roots in the interval [0, 2^boundexp]. class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): - TIsolatingIntervals; + TIsolatingIntervalArray; end; implementation @@ -100,7 +102,7 @@ begin end; end; -class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervals; +class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervalArray; var boundExp: Cardinal; begin @@ -111,7 +113,7 @@ end; // This is adapted from // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): - TIsolatingIntervals; + TIsolatingIntervalArray; type TWorkItem = record C, K: Cardinal; @@ -123,8 +125,9 @@ var stack: TWorkStack; n, v: Integer; varq: TBigIntPolynomial; + iso: TIsolatingIntervals; begin - Result := TIsolatingIntervals.Create; + iso := TIsolatingIntervals.Create; stack := TWorkStack.Create; item.C := 0; @@ -141,7 +144,7 @@ begin // Found an integer root at 0. item.P := item.P.DivideByVariable; Dec(n); - Result.Add(CreateIsolatingInterval(item.C, item.K, 0, ABoundExp)); + iso.Add(CreateIsolatingInterval(item.C, item.K, 0, ABoundExp)); end; varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; @@ -149,7 +152,7 @@ begin if v = 1 then begin // Found isolating interval. - Result.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); + iso.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); end else if v > 1 then begin @@ -164,6 +167,8 @@ begin stack.Push(item); end; end; + Result := iso.ToArray; + iso.Free; stack.Free; end; diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index cfd9e47..91c29d3 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -30,7 +30,7 @@ type TPolynomialRootsTestCase = class(TTestCase) private - procedure AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref AExpectedRoots: + procedure AssertBisectIntervals(AIsolatingIntervals: TIsolatingIntervalArray; constref AExpectedRoots: array of Cardinal); published procedure TestBisectNoBound; @@ -41,18 +41,18 @@ implementation { TPolynomialRootsTestCase } -procedure TPolynomialRootsTestCase.AssertBisectResult(constref AIsolatingIntervals: TIsolatingIntervals; constref - AExpectedRoots: array of Cardinal); +procedure TPolynomialRootsTestCase.AssertBisectIntervals(AIsolatingIntervals: TIsolatingIntervalArray; + constref AExpectedRoots: array of Cardinal); var exp: Cardinal; found: Boolean; i, foundIndex: Integer; begin - AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), AIsolatingIntervals.Count); + AssertEquals('Unexpected number of isolating intervals.', Length(AExpectedRoots), Length(AIsolatingIntervals)); for exp in AExpectedRoots do begin found := False; - for i := 0 to AIsolatingIntervals.Count - 1 do + for i := 0 to Length(AIsolatingIntervals) - 1 do if (AIsolatingIntervals[i].A <= exp) and (exp <= AIsolatingIntervals[i].B) then begin found := True; @@ -60,7 +60,7 @@ begin Break; end; AssertTrue('No isolating interval for expected root ' + IntToStr(exp) + ' found.', found); - AIsolatingIntervals.Delete(foundIndex); + Delete(AIsolatingIntervals, foundIndex, 1); end; end; @@ -69,14 +69,13 @@ const expRoots: array of Cardinal = (34000, 23017, 5); var a: TBigIntPolynomial; - r: TIsolatingIntervals; + r: TIsolatingIntervalArray; begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); r := TPolynomialRoots.BisectIsolation(a); - AssertBisectResult(r, expRoots); - r.Free; + AssertBisectIntervals(r, expRoots); end; procedure TPolynomialRootsTestCase.TestBisectWithBound; @@ -84,14 +83,13 @@ const expRoots: array of Cardinal = (23017, 5); var a: TBigIntPolynomial; - r: TIsolatingIntervals; + r: TIsolatingIntervalArray; begin // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); r := TPolynomialRoots.BisectIsolation(a, 15); - AssertBisectResult(r, expRoots); - r.Free; + AssertBisectIntervals(r, expRoots); end; initialization From 5f93ad78695febc4d1b6a5dfaf9e8997c0d6cebb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 18:59:47 +0200 Subject: [PATCH 44/48] Added bisection variant for integers instead of intervals --- UBigInt.pas | 2 ++ UPolynomialRoots.pas | 52 +++++++++++++++++++++++------ tests/UPolynomialRootsTestCases.pas | 39 ++++++++++++++++++++++ 3 files changed, 83 insertions(+), 10 deletions(-) diff --git a/UBigInt.pas b/UBigInt.pas index 421368d..5d7dd29 100644 --- a/UBigInt.pas +++ b/UBigInt.pas @@ -91,6 +91,8 @@ type class function FromBinaryString(const AValue: string): TBigInt; static; end; + TBigIntArray = array of TBigInt; + { Operators } operator := (const A: Int64): TBigInt; diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index fa1280c..a05c9fa 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -52,8 +52,11 @@ type // Returns root-isolating intervals for non-negative, non-multiple roots. class function BisectIsolation(constref APolynomial: TBigIntPolynomial): TIsolatingIntervalArray; // Returns root-isolating intervals for non-multiple roots in the interval [0, 2^boundexp]. - class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): - TIsolatingIntervalArray; + class function BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal; + const AFindIntegers: Boolean = False): TIsolatingIntervalArray; + // Returns non-negative, non-multiple, integer roots in the interval [0, 2^boundexp]. + class function BisectInteger(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): + TBigIntArray; end; implementation @@ -112,8 +115,8 @@ end; // This is adapted from // https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method -class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): - TIsolatingIntervalArray; +class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal; + const AFindIntegers: Boolean): TIsolatingIntervalArray; type TWorkItem = record C, K: Cardinal; @@ -149,12 +152,11 @@ begin varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; v := varq.CalcSignVariations; - if v = 1 then - begin - // Found isolating interval. - iso.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); - end - else if v > 1 then + //WriteLn; + //WriteLn('var((x+1)^n*q(1/(x+1))): ', v); + + if (v > 1) + or ((v = 1) and AFindIntegers and (item.K < ABoundExp)) then begin // Bisects, first new work item is (2c, k + 1, 2^n * q(x/2)). item.C := item.C << 1; @@ -165,6 +167,12 @@ begin item.C := item.C + 1; item.P := item.P.TranslateVariableByOne; stack.Push(item); + end + else if v = 1 then + begin + // Found isolating interval. + //WriteLn('Found isolating interval (' + IntToStr(item.C) + ', ' + IntToStr(item.K) + ', 1).'); + iso.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); end; end; Result := iso.ToArray; @@ -172,5 +180,29 @@ begin stack.Free; end; +class function TPolynomialRoots.BisectInteger(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal): + TBigIntArray; +var + intervals: TIsolatingIntervalArray; + i: TIsolatingInterval; + r: specialize TList; + value: Int64; +begin + // Calculates isolating intervals. + intervals := BisectIsolation(APolynomial, ABoundExp, True); + r := specialize TList.Create; + + for i in intervals do + if i.H = 0 then + r.Add(i.A) + else if i.A.TryToInt64(value) and (APolynomial.CalcValueAt(value) = 0) then + r.Add(value) + else if i.B.TryToInt64(value) and (APolynomial.CalcValueAt(value) = 0) then + r.Add(value); + + Result := r.ToArray; + r.Free; +end; + end. diff --git a/tests/UPolynomialRootsTestCases.pas b/tests/UPolynomialRootsTestCases.pas index 91c29d3..91ae105 100644 --- a/tests/UPolynomialRootsTestCases.pas +++ b/tests/UPolynomialRootsTestCases.pas @@ -32,9 +32,11 @@ type private procedure AssertBisectIntervals(AIsolatingIntervals: TIsolatingIntervalArray; constref AExpectedRoots: array of Cardinal); + procedure AssertBisectIntegers(ARoots: TBigIntArray; constref AExpectedRoots: array of Cardinal); published procedure TestBisectNoBound; procedure TestBisectWithBound; + procedure TestBisectInteger; end; implementation @@ -64,6 +66,29 @@ begin end; end; +procedure TPolynomialRootsTestCase.AssertBisectIntegers(ARoots: TBigIntArray; constref AExpectedRoots: + array of Cardinal); +var + exp: Cardinal; + found: Boolean; + i, foundIndex: Integer; +begin + AssertEquals('Unexpected number of integer roots.', Length(AExpectedRoots), Length(ARoots)); + for exp in AExpectedRoots do + begin + found := False; + for i := 0 to Length(ARoots) - 1 do + if ARoots[i] = exp then + begin + found := True; + foundIndex := i; + Break; + end; + AssertTrue('Expected root ' + IntToStr(exp) + ' not found.', found); + Delete(ARoots, foundIndex, 1); + end; +end; + procedure TPolynomialRootsTestCase.TestBisectNoBound; const expRoots: array of Cardinal = (34000, 23017, 5); @@ -92,6 +117,20 @@ begin AssertBisectIntervals(r, expRoots); end; +procedure TPolynomialRootsTestCase.TestBisectInteger; +const + expRoots: array of Cardinal = (23017, 5); +var + a: TBigIntPolynomial; + r: TBigIntArray; +begin + // y = 3 * (x - 34000) * (x - 23017) * (x - 5) * (x^2 - 19) * (x + 112) + // = 3 * x^6 - 170730 * x^5 + 2329429920 * x^4 + 251300082690 * x^3 - 1270471872603 * x^2 + 4774763204640 * x - 24979889760000 + a := TBigIntPolynomial.Create([-24979889760000, 4774763204640, -1270471872603, 251300082690, 2329429920, -170730, 3]); + r := TPolynomialRoots.BisectInteger(a, 15); + AssertBisectIntegers(r, expRoots); +end; + initialization RegisterTest(TPolynomialRootsTestCase); From 1784e41c0f94c84eccf2b75bd298addf745a1947 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 19:28:04 +0200 Subject: [PATCH 45/48] Fixed root isolation interval data types --- UPolynomialRoots.pas | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index a05c9fa..a8c13b1 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -31,7 +31,8 @@ type // Represents an isolating interval of the form [C / 2^K, (C + H) / 2^K] in respect to [0, 1] or [A, B] in respect to // [0, 2^boundexp], with A = C * 2^boundexp / 2^K and B = (C + H) * 2^boundexp / 2^K. TIsolatingInterval = record - C, K, H, BoundExp: Cardinal; + C: TBigInt; + K, H, BoundExp: Cardinal; A, B: TBigInt; end; @@ -46,7 +47,7 @@ type // Returns the exponent (base two) of an upper bound for the roots of the given polynomial, i.e. all real roots of // the given polynomial are less or equal than 2^b, where b is the returned positive integer. class function CalcUpperRootBound(constref APolynomial: TBigIntPolynomial): Cardinal; - class function CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABoundExp: Cardinal): + class function CreateIsolatingInterval(constref AC: TBigInt; const AK, AH: Cardinal; constref ABoundExp: Cardinal): TIsolatingInterval; public // Returns root-isolating intervals for non-negative, non-multiple roots. @@ -87,8 +88,8 @@ begin Result := numeratorBit - denominatorBit; end; -class function TPolynomialRoots.CreateIsolatingInterval(const AC, AK, AH: Cardinal; constref ABoundExp: Cardinal): - TIsolatingInterval; +class function TPolynomialRoots.CreateIsolatingInterval(constref AC: TBigInt; const AK, AH: Cardinal; + constref ABoundExp: Cardinal): TIsolatingInterval; begin Result.C := AC; Result.K := AK; @@ -119,7 +120,8 @@ class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPol const AFindIntegers: Boolean): TIsolatingIntervalArray; type TWorkItem = record - C, K: Cardinal; + C: TBigInt; + K: Cardinal; P: TBigIntPolynomial; end; TWorkStack = specialize TStack; From 44caf3e21c2d0bc647ed635c0d1efa04deab6737 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Sun, 26 May 2024 19:57:10 +0200 Subject: [PATCH 46/48] Fixed comments --- UPolynomialRoots.pas | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/UPolynomialRoots.pas b/UPolynomialRoots.pas index a8c13b1..fc244e5 100644 --- a/UPolynomialRoots.pas +++ b/UPolynomialRoots.pas @@ -114,8 +114,7 @@ begin Result := BisectIsolation(APolynomial, boundExp); end; -// This is adapted from -// https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method +// This is adapted from https://en.wikipedia.org/wiki/Real-root_isolation#Bisection_method class function TPolynomialRoots.BisectIsolation(constref APolynomial: TBigIntPolynomial; constref ABoundExp: Cardinal; const AFindIntegers: Boolean): TIsolatingIntervalArray; type @@ -154,9 +153,6 @@ begin varq := item.P.RevertOrderOfCoefficients.TranslateVariableByOne; v := varq.CalcSignVariations; - //WriteLn; - //WriteLn('var((x+1)^n*q(1/(x+1))): ', v); - if (v > 1) or ((v = 1) and AFindIntegers and (item.K < ABoundExp)) then begin @@ -173,7 +169,6 @@ begin else if v = 1 then begin // Found isolating interval. - //WriteLn('Found isolating interval (' + IntToStr(item.C) + ', ' + IntToStr(item.K) + ', 1).'); iso.Add(CreateIsolatingInterval(item.C, item.K, 1, ABoundExp)); end; end; From 3e3e1d45d336a2bcd2312b2595b120bb6bd4a25f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 27 May 2024 02:29:49 +0200 Subject: [PATCH 47/48] Added solution "Day 24: Never Tell Me The Odds", part 2 --- solvers/UNeverTellMeTheOdds.pas | 773 +++++++++++-------------- tests/UNeverTellMeTheOddsTestCases.pas | 2 +- 2 files changed, 332 insertions(+), 443 deletions(-) diff --git a/solvers/UNeverTellMeTheOdds.pas b/solvers/UNeverTellMeTheOdds.pas index b4b2e82..793a7aa 100644 --- a/solvers/UNeverTellMeTheOdds.pas +++ b/solvers/UNeverTellMeTheOdds.pas @@ -22,7 +22,7 @@ unit UNeverTellMeTheOdds; interface uses - Classes, SysUtils, Generics.Collections, Math, matrix, USolver, UNumberTheory, UBigInt; + Classes, SysUtils, Generics.Collections, Math, USolver, UNumberTheory, UBigInt, UPolynomial, UPolynomialRoots; type @@ -30,26 +30,15 @@ type THailstone = class public - Position, Velocity: Tvector3_extended; + P0, P1, P2: Int64; + V0, V1, V2: Integer; constructor Create(const ALine: string); - constructor Create(const APosition, AVelocity: Tvector3_extended); + constructor Create; end; THailstones = specialize TObjectList; - { TFirstCollisionPolynomial } - - TFirstCollisionPolynomial = class - private - FA: array[0..10] of TBigInt; - FH: array[0..6] of TBigInt; - procedure NormalizeCoefficients; - public - procedure Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1, t_2: Int64); - function EvaluateAt(const AT0: Int64): TBigInt; - function CalcPositiveIntegerRoot: Int64; - function CalcT1(const AT0: Int64): Int64; - end; + TInt64Array = array of Int64; { TNeverTellMeTheOdds } @@ -57,10 +46,15 @@ type private FMin, FMax: Int64; FHailstones: THailstones; - FA: array[0..10] of Int64; - FH: array[0..6] of Int64; + FA: array[0..10] of TBigInt; + FH: array[0..6] of TBigInt; function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; - procedure FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer); + function FindRockThrow(const AIndex0, AIndex1, AIndex2: Integer): Int64; + procedure CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out OPolynomial0, + OPolynomial1: TBigIntPolynomial); + function CalcRockThrowCollisionOptions(constref AHailstone0, AHailstone1, AHailstone2: THailstone): TInt64Array; + function ValidateRockThrow(constref AHailstone0, AHailstone1, AHailstone2: THailstone; const AT0, AT1: Int64): + Int64; public constructor Create(const AMin: Int64 = 200000000000000; const AMax: Int64 = 400000000000000); destructor Destroy; override; @@ -70,10 +64,6 @@ type function GetPuzzleName: string; override; end; -const - CIterationThreshold = 0.00001; - CEpsilon = 0.0000000001; - implementation { THailstone } @@ -83,69 +73,71 @@ var split: TStringArray; begin split := ALine.Split([',', '@']); - Position.init( - StrToFloat(Trim(split[0])), - StrToFloat(Trim(split[1])), - StrToFloat(Trim(split[2]))); - Velocity.init( - StrToFloat(Trim(split[3])), - StrToFloat(Trim(split[4])), - StrToFloat(Trim(split[5]))); + P0 := StrToInt64(Trim(split[0])); + P1 := StrToInt64(Trim(split[1])); + P2 := StrToInt64(Trim(split[2])); + V0 := StrToInt(Trim(split[3])); + V1 := StrToInt(Trim(split[4])); + V2 := StrToInt(Trim(split[5])); end; -constructor THailstone.Create(const APosition, AVelocity: Tvector3_extended); +constructor THailstone.Create; begin - Position := APosition; - Velocity := AVelocity; + end; -{ TFirstCollisionPolynomial } +{ TNeverTellMeTheOdds } -procedure TFirstCollisionPolynomial.NormalizeCoefficients; +function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; var - shift: Integer; - i: Low(FA)..High(FA); - //gcd: TBigInt; + m1, m2, x, y: Double; begin - // Eliminates zero constant term. - shift := 0; - while (shift <= High(FA)) and (FA[shift] = 0) do - Inc(shift); - - if shift <= High(FA) then + Result := False; + m1 := AHailstone1.V1 / AHailstone1.V0; + m2 := AHailstone2.V1 / AHailstone2.V0; + if m1 <> m2 then begin - if shift > 0 then + x := (AHailstone2.P1 - m2 * AHailstone2.P0 + - AHailstone1.P1 + m1 * AHailstone1.P0) + / (m1 - m2); + if (FMin <= x) and (x <= FMax) + and (x * Sign(AHailstone1.V0) >= AHailstone1.P0 * Sign(AHailstone1.V0)) + and (x * Sign(AHailstone2.V0) >= AHailstone2.P0 * Sign(AHailstone2.V0)) + then begin - for i := Low(FA) to High(FA) - shift do - FA[i] := FA[i + shift]; - for i := High(FA) - shift + 1 to High(FA) do - FA[i] := 0; + y := m1 * (x - AHailstone1.P0) + AHailstone1.P1; + if (FMin <= y) and (y <= FMax) then + Result := True end; - - //// Finds GCD of all coefficients. - //gcd := FA[Low(FA)]; - //for i := Low(FA) + 1 to High(FA) do - // if FA[i] <> 0 then - // gcd := TNumberTheory.GreatestCommonDivisor(gcd, FA[i]); - //WriteLn('GCD: ', gcd); - // - //for i := Low(FA) to High(FA) do - // FA[i] := FA[i] div gcd; end; - - //WriteLn('(', FA[10], ') * x^10 + (', FA[9], ') * x^9 + (', FA[8], ') * x^8 + (', FA[7], ') * x^7 + (', - // FA[6], ') * x^6 + (', FA[5], ') * x^5 + (', FA[4], ') * x^4 + (', FA[3], ') * x^3 + (', FA[2], ') * x^2 + (', - // FA[1], ') * x + (', FA[0], ')'); end; -procedure TFirstCollisionPolynomial.Init(constref AHailstone1, AHailstone2, AHailstone3: THailstone; const t_0, t_1, - t_2: Int64); +function TNeverTellMeTheOdds.FindRockThrow(const AIndex0, AIndex1, AIndex2: Integer): Int64; +var + t0, t1: TInt64Array; + i, j: Int64; +begin + t0 := CalcRockThrowCollisionOptions(FHailstones[AIndex0], FHailstones[AIndex1], FHailstones[AIndex2]); + t1 := CalcRockThrowCollisionOptions(FHailstones[AIndex1], FHailstones[AIndex0], FHailstones[AIndex2]); + + Result := 0; + for i in t0 do + begin + for j in t1 do + begin + Result := ValidateRockThrow(FHailstones[AIndex0], FHailstones[AIndex1], FHailstones[AIndex2], i, j); + if Result > 0 then + Break; + end; + if Result > 0 then + Break; + end; +end; + +procedure TNeverTellMeTheOdds.CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out + OPolynomial0, OPolynomial1: TBigIntPolynomial); var - P_00, P_01, P_02, P_10, P_11, P_12, P_20, P_21, P_22, - V_00, V_01, V_02, V_10, V_11, V_12, V_20, V_21, V_22: Int64; k: array[0..139] of TBigInt; - // For debug calculations - act, a_1, a_2, b_0, b_1, c_0, c_1, d_0, d_1, e_0, e_1, f_0, f_1, f_2: Int64; begin // Solving this non-linear equation system, with velocities V_i and start positions P_i: // V_0 * t_0 + P_0 = V_x * t_0 + P_x @@ -155,55 +147,88 @@ begin // P_x = (V_0 - V_x) * t_0 + P_0 // V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) // And with vertex components: - // 1: 0 = (t_1 - t_0) * (V_00 * t_0 - V_20 * t_2 + P_00 - P_20) - (t_2 - t_0) * (V_00 * t_0 - V_10 * t_1 + P_00 - P_10) - // 2: t_1 = (((V_01 - V_21) * t_2 + P_11 - P_21) * t_0 + (P_01 - P_11) * t_2) + // 1: 0 = (t_1 - t_0) * (V_00 * t_0 - V_20 * t_2 + P_00 - P_20) + // - (t_2 - t_0) * (V_00 * t_0 - V_10 * t_1 + P_00 - P_10) + // 2: t_1 = (((V_01 - V_21) * t_2 + P_11 - P_21) * t_0 + (P_01 - P_11) * t_2) // / ((V_01 - V_11) * t_0 + (V_11 - V_21) * t_2 + P_01 - P_21) - // 3: t_2 = (((V_02 - V_12) * t_1 + P_22 - P_12) * t_0 + (P_02 - P_22) * t_1) + // 3: t_2 = (((V_02 - V_12) * t_1 + P_22 - P_12) * t_0 + (P_02 - P_22) * t_1) // / ((V_02 - V_22) * t_0 + (V_22 - V_12) * t_1 + P_02 - P_12) // for t_0, t_1, t_2 not pairwise equal. // With some substitutions depending only on t_0 this gives - // 1: 0 = (t_1 - t_0) * (f_2 - V_20 * t_2) - (t_2 - t_0) * (f_1 - V_10 * t_1) - // 2: t_1 = (b_0 + b_1 * t_2) / (c_0 + c_1 * t_2) - // 3: t_2 = (d_0 + d_1 * t_1) / (e_0 + e_1 * t_1) + // 1: 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) + // 2: t_1 = (b_0 + b_1 * t_2) / (c_0 + c_1 * t_2) + // 3: t_2 = (d_0 + d_1 * t_1) / (e_0 + e_1 * t_1) // And 3 in 2 gives: - // 4: g_2 * t_1^2 - g_1 * t_1 - g_0 = 0 - // Then, with 4 and 3 in 1 and lengthy calculations with many substitutions (see constants k below, now independent of - // t_0), the following polynomial can be constructed, with t_0 being a positive integer root of this polynomial. - // y = a_10 * x^10 + a_9 * x^9 + ... + a_0 + // 4: f_2 * t_1^2 + f_1 * t_1 - f_0 = 0 + // Then, with 4 and 3 in 1 and many substitutions (see constants k below, now independent of t_0), the equation + // 5: 0 = p_0(t_0) + p_1(t_0) * sqrt(p_2(t_0)) + // can be constructed, where p_0, p_1, and p_2 are polynomials in t_0. Since we are searching for an integer solution, + // we assume that there is an integer t_0 that is a root of both p_0 and p_1, which would solve the equation. - P_00 := Round(AHailstone1.Position.data[0]); - P_01 := Round(AHailstone1.Position.data[1]); - P_02 := Round(AHailstone1.Position.data[2]); - P_10 := Round(AHailstone2.Position.data[0]); - P_11 := Round(AHailstone2.Position.data[1]); - P_12 := Round(AHailstone2.Position.data[2]); - P_20 := Round(AHailstone3.Position.data[0]); - P_21 := Round(AHailstone3.Position.data[1]); - P_22 := Round(AHailstone3.Position.data[2]); - V_00 := Round(AHailstone1.Velocity.data[0]); - V_01 := Round(AHailstone1.Velocity.data[1]); - V_02 := Round(AHailstone1.Velocity.data[2]); - V_10 := Round(AHailstone2.Velocity.data[0]); - V_11 := Round(AHailstone2.Velocity.data[1]); - V_12 := Round(AHailstone2.Velocity.data[2]); - V_20 := Round(AHailstone3.Velocity.data[0]); - V_21 := Round(AHailstone3.Velocity.data[1]); - V_22 := Round(AHailstone3.Velocity.data[2]); + // Subsitutions depending on t_0: + // a_1 = V_00 * t_0 + P_00 - P_20 + // a_2 = V_00 * t_0 + P_00 - P_10 + // b_0 = (P_11 - P_21) * t_0 + // b_1 = (V_01 - V_21) * t_0 + P_01 - P_11 + // c_0 = (V_01 - V_11) * t_0 + P_01 - P_21 + // c_1 = V_11 - V_21 + // d_0 = (P_22 - P_12) * t_0 + // d_1 = (V_02 - V_12) * t_0 + P_02 - P_22 + // e_0 = (V_02 - V_22) * t_0 + P_02 - P_12 + // e_1 = V_22 - V_12 + // f_0 = b_1 * d_0 + b_0 * e_0 + // f_1 = c_0 * e_0 + c_1 * d_0 - b_0 * e_1 - b_1 * d_1 + // f_2 = c_0 * e_1 + c_1 * d_1 - k[0] := P_00 - P_20; - k[1] := P_00 - P_10; - k[2] := P_11 - P_21; - k[3] := P_01 - P_11; - k[4] := P_01 - P_21; - k[5] := P_22 - P_12; - k[6] := P_02 - P_22; - k[7] := P_02 - P_12; - k[8] := V_11 - V_21; - k[9] := V_22 - V_12; - k[10] := V_01 - V_21; - k[11] := V_01 - V_11; - k[12] := V_02 - V_12; - k[13] := V_02 - V_22; + // Calculations for equation 5 (4 and 3 in 1). + // 1: 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) + // 3: (e_0 + e_1 * t_1) * t_2 = (d_0 + d_1 * t_1) + // 0 = (t_1 - t_0) * (a_1 - V_20 * t_2) - (t_2 - t_0) * (a_2 - V_10 * t_1) + // = (t_1 - t_0) * (a_1 * (e_0 + e_1 * t_1) - V_20 * (e_0 + e_1 * t_1) * t_2) - ((e_0 + e_1 * t_1) * t_2 - (e_0 + e_1 * t_1) * t_0) * (a_2 - V_10 * t_1) + // = (t_1 - t_0) * (a_1 * (e_0 + e_1 * t_1) - V_20 * (d_0 + d_1 * t_1)) - ((d_0 + d_1 * t_1) - (e_0 + e_1 * t_1) * t_0) * (a_2 - V_10 * t_1) + // = (t_1 - t_0) * (a_1 * e_0 + a_1 * e_1 * t_1 - V_20 * d_0 - V_20 * d_1 * t_1) - (d_0 + d_1 * t_1 - e_0 * t_0 - e_1 * t_1 * t_0) * (a_2 - V_10 * t_1) + // = (a_1 * e_1 - V_20 * d_1) * t_1^2 + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1)) * t_1 - t_0 * (a_1 * e_0 - V_20 * d_0) + // - ( - V_10 * (d_1 - e_1 * t_0) * t_1^2 + ((d_1 - e_1 * t_0) * a_2 - V_10 * (d_0 - e_0 * t_0)) * t_1 + (d_0 - e_0 * t_0) * a_2) + // = (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * t_1^2 + // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * t_1 + // + t_0 * (V_20 * d_0 - a_1 * e_0) + (e_0 * t_0 - d_0) * a_2 + // Inserting 4, solved for t_0: t_1 = - f_1 / (2 * f_2) + sqrt((f_1 / (2 * f_2))^2 + f_0 / f_2) + // = (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * (f_1^2 + 2 * f_0 * f_2 - f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * (- f_1 * f_2 + f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + t_0 * (V_20 * d_0 - a_1 * e_0) * 2 * f_2^2 + (e_0 * t_0 - d_0) * a_2 * 2 * f_2^2 + + // a_1 = V_00 * t_0 + k_0 + // a_2 = V_00 * t_0 + k_1 + // b_0 = k_2 * t_0 + // b_1 = k_10 * t_0 + k_3 + // c_0 = k_11 * t_0 + k_4 + // d_0 = k_5 * t_0 + // d_1 = k_12 * t_0 + k_6 + // e_0 = k_13 * t_0 + k_7 + // f_2 = (k_11 * t_0 + k_4) * k_9 + k_8 * (k_12 * t_0 + k_6) + // = (k_11 * k_9 + k_8 * k_12) * t_0 + k_4 * k_9 + k_8 * k_6 + // = FH_0 * t_0 + FH_1 + // f_1 = (k_11 * t_0 + k_4) * (k_13 * t_0 + k_7) + k_8 * k_5 * t_0 - k_2 * t_0 * k_9 - (k_10 * t_0 + k_3) * (k_12 * t_0 + k_6) + // = (k_11 * k_13 - k_10 * k_12) * t_0^2 + (k_11 * k_7 + k_4 * k_12 + k_8 * k_5 - k_2 * k_9 - k_10 * k_6 - k_3 * k_12) * t_0 + k_4 * k_7 - k_3 * k_6 + // = FH_2 * t_0^2 + FH_3 * t_0 + FH_4 + // f_0 = (k_10 * t_0 + k_3) * k_5 * t_0 + k_2 * t_0 * (k_13 * t_0 + k_7) + // = (k_10 * k_5 + k_2 * k_13) * t_0^2 + (k_3 * k_5 + k_2 * k_7) * t_0 + // = FH_5 * t_0^2 + FH_6 * t_0 + + k[0] := AHailstone0.P0 - AHailstone2.P0; + k[1] := AHailstone0.P0 - AHailstone1.P0; + k[2] := AHailstone1.P1 - AHailstone2.P1; + k[3] := AHailstone0.P1 - AHailstone1.P1; + k[4] := AHailstone0.P1 - AHailstone2.P1; + k[5] := AHailstone2.P2 - AHailstone1.P2; + k[6] := AHailstone0.P2 - AHailstone2.P2; + k[7] := AHailstone0.P2 - AHailstone1.P2; + k[8] := AHailstone1.V1 - AHailstone2.V1; + k[9] := AHailstone2.V2 - AHailstone1.V2; + k[10] := AHailstone0.V1 - AHailstone2.V1; + k[11] := AHailstone0.V1 - AHailstone1.V1; + k[12] := AHailstone0.V2 - AHailstone1.V2; + k[13] := AHailstone0.V2 - AHailstone2.V2; FH[0] := k[11] * k[9] + k[8] * k[12]; FH[1] := k[4] * k[9] + k[8] * k[6]; @@ -213,10 +238,45 @@ begin FH[5] := k[10] * k[5] + k[2] * k[13]; FH[6] := k[3] * k[5] + k[2] * k[7]; - k[14] := V_00 * k[9] - V_20 * k[12]; - k[15] := k[0] * k[9] - V_20 * k[6]; - k[16] := V_00 * k[13]; - k[17] := V_00 * k[7] + k[0] * k[13] - V_20 * k[5]; + // Additional substitutions. + // a_1 * k_9 - V_20 * d_1 + // = (V_00 * t_0 + k_0) * k_9 - V_20 * (k_12 * t_0 + k_6) + // = (V_00 * k_9 - V_20 * k_12) * t_0 + k_0 * k_9 - V_20 * k_6 + // = k_14 * t_0 + k_15 + // d_1 - k_9 * t_0 + // = k_12 * t_0 + k_6 - k_9 * t_0 + // = (k_12 - k_9) * t_0 + k_6 + // a_1 * e_0 - V_20 * d_0 + // = (V_00 * t_0 + k_0) * (k_13 * t_0 + k_7) - V_20 * k_5 * t_0 + // = V_00 * k_13 * t_0^2 + (V_00 * k_7 + k_0 * k_13 - V_20 * k_5) * t_0 + k_0 * k_7 + // = k_16 * t_0^2 + k_17 * t_0 + k_18 + // d_0 - e_0 * t_0 + // = k_5 * t_0 - k_13 * t_0^2 - k_7 * t_0 + // = - k_13 * t_0^2 + k_19 * t_0 + // f_1^2 + // = (FH_2 * t_0^2 + FH_3 * t_0 + FH_4)^2 + // = FH_2^2 * t_0^4 + FH_3^2 * t_0^2 + FH_4^2 + 2 * FH_2 * t_0^2 * FH_3 * t_0 + 2 * FH_2 * t_0^2 * FH_4 + 2 * FH_3 * t_0 * FH_4 + // = FH_2^2 * t_0^4 + 2 * FH_2 * FH_3 * t_0^3 + (FH_3^2 + 2 * FH_2 * FH_4) * t_0^2 + 2 * FH_3 * FH_4 * t_0 + FH_4^2 + // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + // f_2^2 + // = (FH_0 * t_0 + FH_1)^2 + // = FH_0^2 * t_0^2 + 2 * FH_0 * FH_1 * t_0 + FH_1^2 + // = FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2 + // f_0 * f_2 + // = (FH_5 * t_0^2 + FH_6 * t_0) * (FH_0 * t_0 + FH_1) + // = FH_5 * FH_0 * t_0^3 + (FH_5 * FH_1 + FH_6 * FH_0) * t_0^2 + FH_6 * FH_1 * t_0 + // = k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0 + // f_1^2 + 4 * f_0 * f_2 + // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + 4 * (k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0) + // = k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58 + // f_1^2 + 2 * f_0 * f_2 + // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + 2 * (k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0) + // = k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 + + k[14] := AHailstone0.V0 * k[9] - AHailstone2.V0 * k[12]; + k[15] := k[0] * k[9] - AHailstone2.V0 * k[6]; + k[16] := AHailstone0.V0 * k[13]; + k[17] := AHailstone0.V0 * k[7] + k[0] * k[13] - AHailstone2.V0 * k[5]; k[18] := k[0] * k[7]; k[19] := k[5] - k[7]; k[20] := 2 * FH[2] * FH[3]; @@ -224,34 +284,19 @@ begin k[22] := k[21] + 2 * FH[2] * FH[4]; k[23] := 2 * FH[3] * FH[4]; k[24] := 2 * FH[0] * FH[1]; - k[25] := FH[0] * FH[0]; // KILL? - k[26] := FH[5] * k[25]; // KILL? + k[25] := FH[0] * FH[0]; k[126] := FH[5] * FH[0]; k[127] := FH[5] * FH[1] + FH[6] * FH[0]; k[128] := FH[6] * FH[1]; - k[27] := FH[5] * k[24] + FH[6] * k[25]; // KILL? - k[28] := FH[1] * FH[1]; // KILL? - k[29] := FH[5] * k[28] + FH[6] * k[24]; // KILL? - k[30] := FH[6] * k[28]; // KILL? + k[28] := FH[1] * FH[1]; k[31] := FH[2] * FH[2]; - k[132] := k[20] + 4 * k[126]; - k[133] := k[22] + 4 * k[127]; - k[134] := k[23] + 4 * k[128]; - k[32] := k[31] + 4 * k[26]; // KILL? - k[33] := k[20] + 4 * k[27]; // KILL? - k[34] := k[22] + 4 * k[29]; // KILL? - k[35] := k[23] + 4 * k[30]; // KILL? - k[36] := k[31] + 2 * k[26]; // KILL? - k[37] := k[20] + 2 * k[27]; // KILL? - k[38] := k[22] + 2 * k[29]; // KILL? - k[39] := k[23] + 2 * k[30]; // KILL? k[137] := k[20] + 2 * k[126]; k[138] := k[22] + 2 * k[127]; k[139] := k[23] + 2 * k[128]; - k[40] := k[14] + V_10 * (k[12] - k[9]); - k[41] := k[15] + V_10 * k[6]; - k[42] := k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00; - k[43] := k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00; + k[40] := k[14] + AHailstone1.V0 * (k[12] - k[9]); + k[41] := k[15] + AHailstone1.V0 * k[6]; + k[42] := k[16] - k[14] - AHailstone1.V0 * k[13] - (k[12] - k[9]) * AHailstone0.V0; + k[43] := k[17] - k[15] + AHailstone1.V0 * k[19] - (k[12] - k[9]) * k[1] - k[6] * AHailstone0.V0; k[44] := k[18] - k[6] * k[1]; k[45] := k[42] * FH[0] - k[40] * FH[2]; k[46] := k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]; @@ -269,9 +314,9 @@ begin k[58] := FH[4] * FH[4]; k[59] := k[40] * k[58] + k[41] * k[139] - k[57] * FH[0] - k[55] * FH[1]; k[60] := k[41] * k[58] - k[57] * FH[1]; - k[61] := k[13] * V_00 - k[16]; + k[61] := k[13] * AHailstone0.V0 - k[16]; k[62] := 2 * k[25] * k[61]; - k[63] := k[13] * k[1] - k[19] * V_00 - k[17]; + k[63] := k[13] * k[1] - k[19] * AHailstone0.V0 - k[17]; k[64] := 2 * (k[24] * k[61] + k[25] * k[63]); k[65] := - k[19] * k[1] - k[18]; k[66] := 2 * (k[28] * k[61] + k[24] * k[63] + k[25] * k[65]); @@ -282,319 +327,167 @@ begin k[71] := k[54] + k[66]; k[72] := k[56] + k[67]; k[73] := k[59] + k[68]; - k[74] := k[45] * k[45]; - k[75] := 2 * k[45] * k[46]; - k[76] := k[46] * k[46] + 2 * k[45] * k[47]; - k[77] := 2 * (k[45] * k[48] + k[46] * k[47]); - k[78] := k[47] * k[47] + 2 * k[46] * k[48]; - k[79] := 2 * k[47] * k[48]; - k[80] := k[48] * k[48]; + // Unused, they are part of the polynomial inside the square root. + //k[132] := k[20] + 4 * k[126]; + //k[133] := k[22] + 4 * k[127]; + //k[134] := k[23] + 4 * k[128]; - FA[0] := k[58] * k[80] - k[60] * k[60]; - FA[1] := k[134] * k[80] + k[58] * k[79] - 2 * k[73] * k[60]; - FA[2] := k[133] * k[80] + k[134] * k[79] + k[58] * k[78] - k[73] * k[73] - 2 * k[72] * k[60]; - FA[3] := k[133] * k[79] + k[134] * k[78] + k[58] * k[77] + k[132] * k[80] - - 2 * (k[71] * k[60] + k[72] * k[73]); - FA[4] := k[31] * k[80] + k[133] * k[78] + k[134] * k[77] + k[58] * k[76] + k[132] * k[79] - k[72] * k[72] - - 2 * (k[70] * k[60] + k[71] * k[73]); - FA[5] := k[31] * k[79] + k[133] * k[77] + k[134] * k[76] + k[58] * k[75] + k[132] * k[78] - - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]); - FA[6] := k[31] * k[78] + k[133] * k[76] + k[134] * k[75] + k[58] * k[74] + k[132] * k[77] - k[71] * k[71] - - 2 * (k[69] * k[73] + k[70] * k[72]); - FA[7] := k[31] * k[77] + k[133] * k[75] + k[134] * k[74] + k[132] * k[76] - 2 * (k[69] * k[72] + k[70] * k[71]); - FA[8] := k[31] * k[76] + k[132] * k[75] + k[133] * k[74] - k[70] * k[70] - 2 * k[69] * k[71]; - FA[9] := k[31] * k[75] + k[132] * k[74] - 2 * k[69] * k[70]; - FA[10] := k[31] * k[74] - k[69] * k[69]; + // Continuing calculations for equation 5. + // 0 = (k_14 * t_0 + k_15 + V_10 * ((k_12 - k_9) * t_0 + k_6)) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + (k_16 * t_0^2 + k_17 * t_0 + k_18 - t_0 * (k_14 * t_0 + k_15) - ((k_12 - k_9) * t_0 + k_6) * a_2 - V_10 * (k_13 * t_0^2 - k_19 * t_0)) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + ((k_16 - k_14 - V_10 * k_13 - (k_12 - k_9) * V_00) * t_0^2 + (k_17 - k_15 + V_10 * k_19 - (k_12 - k_9) * k_1 - k_6 * V_00) * t_0 + k_18 - k_6 * k_1) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) + // -+ (k_40 * t_0 + k_41) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_42 * t_0^2 + k_43 * t_0 + k_44) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) + // -+ (k_40 * t_0 + k_41) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) + // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_1 * f_2 + // +- (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_2 * sqrt(f_1^2 + 4 * f_0 * f_2) + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = +- ((k_42 * t_0^2 + k_43 * t_0 + k_44) * f_2 - (k_40 * t_0 + k_41) * f_1) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) + // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_1 * f_2 + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = +- ((k_42 * t_0^2 + k_43 * t_0 + k_44) * (FH_0 * t_0 + FH_1) - (k_40 * t_0 + k_41) * (FH_2 * t_0^2 + FH_3 * t_0 + FH_4)) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) + // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * (FH_2 * t_0^2 + FH_3 * t_0 + FH_4) * (FH_0 * t_0 + FH_1) + // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * (V_00 * t_0 + k_1) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = +- ( + // (k_42 * FH_0 - k_40 * FH_2) * t_0^3 + // + (k_42 * FH_1 + k_43 * FH_0 - k_41 * FH_2 - k_40 * FH_3) * t_0^2 + // + (k_43 * FH_1 + k_44 * FH_0 - k_41 * FH_3 - k_40 * FH_4) * t_0 + // + k_44 * FH_1 - k_41 * FH_4 + // ) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_40 * k_31 - k_42 * FH_2 * FH_0) * t_0^5 + // + (k_40 * k_137 + k_41 * k_31 - k_42 * FH_3 * FH_0 - k_43 * FH_2 * FH_0 - k_42 * FH_2 * FH_1) * t_0^4 + // + (k_40 * k_138 + k_41 * k_137 - k_42 * FH_4 * FH_0 - k_43 * FH_3 * FH_0 - k_44 * FH_2 * FH_0 - k_42 * FH_3 * FH_1 - k_43 * FH_2 * FH_1) * t_0^3 + // + (k_40 * k_139 + k_41 * k_138 - k_43 * FH_4 * FH_0 - k_44 * FH_3 * FH_0 - k_42 * FH_4 * FH_1 - k_43 * FH_3 * FH_1 - k_44 * FH_2 * FH_1) * t_0^2 + // + (k_40 * k_58 + k_41 * k_139 - k_44 * FH_4 * FH_0 - k_43 * FH_4 * FH_1 - k_44 * FH_3 * FH_1) * t_0 + // + k_41 * k_58 - k_44 * FH_4 * FH_1 + // + 2 * (k_13 * V_00 * FH_0^2 - k_16 * FH_0^2) * t_0^5 + // + 2 * (k_13 * V_00 * k_24 + k_13 * k_1 * FH_0^2 - k_19 * V_00 * FH_0^2 - k_16 * k_24 - k_17 * FH_0^2) * t_0^4 + // + 2 * (k_13 * V_00 * FH_1^2 + k_13 * k_1 * k_24 - k_19 * V_00 * k_24 - k_19 * k_1 * FH_0^2 - k_16 * FH_1^2 - k_17 * k_24 - k_18 * FH_0^2) * t_0^3 + // + 2 * (k_13 * k_1 * FH_1^2 - k_19 * V_00 * FH_1^2 - k_19 * k_1 * k_24 - k_17 * FH_1^2 - k_18 * k_24) * t_0^2 + // + 2 * (- k_19 * k_1 * FH_1^2 - k_18 * FH_1^2) * t_0 + // 0 = +- (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_50 + k_62) * t_0^5 + (k_52 + k_64) * t_0^4 + (k_54 + k_66) * t_0^3 + (k_56 + k_67) * t_0^2 + (k_59 + k_68) * t_0 + k_60 + // 0 = +- (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) + // + k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60 - // Debug calculations - //a_1 := V_00 * t_0 + P_00 - P_20; - //a_2 := V_00 * t_0 + P_00 - P_10; - //b_0 := (P_11 - P_21) * t_0; - //b_1 := (V_01 - V_21) * t_0 + P_01 - P_11; - //c_0 := (V_01 - V_11) * t_0 + P_01 - P_21; - //c_1 := V_11 - V_21; - //d_0 := (P_22 - P_12) * t_0; - //d_1 := (V_02 - V_12) * t_0 + P_02 - P_22; - //e_0 := (V_02 - V_22) * t_0 + P_02 - P_12; - //e_1 := V_22 - V_12; - //f_2 := c_0 * e_1 + c_1 * d_1; - //f_1 := c_0 * e_0 + c_1 * d_0 - b_0 * e_1 - b_1 * d_1; - //f_0 := b_1 * d_0 + b_0 * e_0; - // - //act := f_2 * t_1 * t_1 + f_1 * t_1 - f_0; - //Write('debug10: ', 0 = act, ' '); - // - //if f_2 <> 0 then - //begin - // act := Round(- f_1 / (2 * f_2) + Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2)); - // Write('debug15: ', t_1 = act); - // act := Round(- f_1 / (2 * f_2) - Sqrt((f_1 / (2 * f_2)) * (f_1 / (2 * f_2)) + f_0 / f_2)); - // Write(' OR ', t_1 = act, ' '); - //end; - // - //act := (e_0 + e_1 * t_1) * t_2 - (d_0 + d_1 * t_1); - //Write('debug20: ', 0 = act, ' '); - // - //act := (a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * t_1 * t_1 - // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * t_1 - // + t_0 * (V_20 * d_0 - a_1 * e_0) + (e_0 * t_0 - d_0) * a_2; - //Write('debug30: ', 0 = act, ' '); - // - //act := Round((a_1 * e_1 - V_20 * d_1 + V_10 * (d_1 - e_1 * t_0)) * (f_1 * f_1 + 2 * f_0 * f_2 - f_1 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // + (a_1 * e_0 - V_20 * d_0 - t_0 * (a_1 * e_1 - V_20 * d_1) - (d_1 - e_1 * t_0) * a_2 + V_10 * (d_0 - e_0 * t_0)) * (- f_1 * f_2 + f_2 * Sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // + t_0 * (V_20 * d_0 - a_1 * e_0) * 2 * f_2 * f_2 + (e_0 * t_0 - d_0) * a_2 * 2 * f_2 * f_2); - //Write('debug40: ', 0 = act, ' '); - // - //Write('debug41: ', - // a_1 * k[9] - V_20 * d_1 - // = k[14] * t_0 + k[15], ' '); - //Write('debug42: ', - // d_1 - k[9] * t_0 - // = (k[12] - k[9]) * t_0 + k[6], ' '); - //Write('debug43: ', - // a_1 * e_0 - V_20 * d_0 - // = k[16] * t_0 * t_0 + k[17] * t_0 + k[18], ' '); - //Write('debug44: ', - // d_0 - e_0 * t_0 - // = - k[13] * t_0 * t_0 + k[19] * t_0, ' '); - //Write('debug45: ', - // f_1 * f_1 - // = FH[2] * FH[2] * t_0 * t_0 * t_0 * t_0 + k[20] * t_0 * t_0 * t_0 + k[22] * t_0 * t_0 + k[23] * t_0 + FH[4] * FH[4], ' '); - //Write('debug46: ', - // f_2 * f_2 - // = FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1], ' '); - //Write('debug47: ', - // f_0 * f_2 - // = k[126] * t_0 * t_0 * t_0 + k[127] * t_0 * t_0 + k[128] * t_0, ' '); - //Write('debug48: ', - // f_1 * f_1 + 4 * f_0 * f_2 - // = k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58], ' '); - //Write('debug49: ', - // f_1 * f_1 + 2 * f_0 * f_2 - // = k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58], ' '); - // - //act := Round((k[14] * t_0 + k[15] + V_10 * ((k[12] - k[9]) * t_0 + k[6])) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // + (k[16] * t_0 * t_0 + k[17] * t_0 + k[18] - t_0 * (k[14] * t_0 + k[15]) - ((k[12] - k[9]) * t_0 + k[6]) * a_2 - V_10 * (k[13] * t_0 * t_0 - k[19] * t_0)) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])); - //Write('debug50: ', 0 = act, ' '); - // - //Write('debug53: ', - // 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58] - f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // + ((k[16] - k[14] - V_10 * k[13] - (k[12] - k[9]) * V_00) * t_0 * t_0 + (k[17] - k[15] + V_10 * k[19] - (k[12] - k[9]) * k[1] - k[6] * V_00) * t_0 + k[18] - k[6] * k[1]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])), - // ' '); - // - //Write('debug55: ', - // 0 = Round((k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58]) - // - (k[40] * t_0 + k[41]) * f_1 * sqrt(f_1 * f_1 + 4 * f_0 * f_2) - // + (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (- f_1 * f_2 + f_2 * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * a_2 * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1])), - // ' '); - // - //Write('debug70: ', - // 0 = Round(((k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[0] * t_0 + FH[1]) - (k[40] * t_0 + k[41]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4])) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) - // + (k[40] * t_0 + k[41]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[137] * t_0 * t_0 * t_0 + k[138] * t_0 * t_0 + k[139] * t_0 + k[58]) - // - (k[42] * t_0 * t_0 + k[43] * t_0 + k[44]) * (FH[2] * t_0 * t_0 + FH[3] * t_0 + FH[4]) * (FH[0] * t_0 + FH[1]) - // - 2 * t_0 * (k[16] * t_0 * t_0 + k[17] * t_0 + k[18]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]) + 2 * (k[13] * t_0 * t_0 - k[19] * t_0) * (V_00 * t_0 + k[1]) * (FH[0] * FH[0] * t_0 * t_0 + k[24] * t_0 + FH[1] * FH[1]), - // ' '); -// -// Write('debug73: ', -// 0 = Round(( -// (k[42] * FH[0] - k[40] * FH[2]) * t_0 * t_0 * t_0 -// + (k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]) * t_0 * t_0 -// + (k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4]) * t_0 -// + k[44] * FH[1] - k[41] * FH[4] -// ) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) -// + (k[40] * k[31] - k[42] * FH[2] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0 -// + (k[40] * k[137] + k[41] * k[31] - k[42] * FH[3] * FH[0] - k[43] * FH[2] * FH[0] - k[42] * FH[2] * FH[1]) * t_0 * t_0 * t_0 * t_0 -// + (k[40] * k[138] + k[41] * k[137] - k[42] * FH[4] * FH[0] - k[43] * FH[3] * FH[0] - k[44] * FH[2] * FH[0] - k[42] * FH[3] * FH[1] - k[43] * FH[2] * FH[1]) * t_0 * t_0 * t_0 -// + (k[40] * k[139] + k[41] * k[138] - k[43] * FH[4] * FH[0] - k[44] * FH[3] * FH[0] - k[42] * FH[4] * FH[1] - k[43] * FH[3] * FH[1] - k[44] * FH[2] * FH[1]) * t_0 * t_0 -// + (k[40] * k[58] + k[41] * k[139] - k[44] * FH[4] * FH[0] - k[43] * FH[4] * FH[1] - k[44] * FH[3] * FH[1]) * t_0 -// + k[41] * k[58] - k[44] * FH[4] * FH[1] -// + 2 * (k[13] * V_00 * FH[0] * FH[0] - k[16] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0 * t_0 -// + 2 * (k[13] * V_00 * k[24] + k[13] * k[1] * FH[0] * FH[0] - k[19] * V_00 * FH[0] * FH[0] - k[16] * k[24] - k[17] * FH[0] * FH[0]) * t_0 * t_0 * t_0 * t_0 -// + 2 * (k[13] * V_00 * FH[1] * FH[1] + k[13] * k[1] * k[24] - k[19] * V_00 * k[24] - k[19] * k[1] * FH[0] * FH[0] - k[16] * FH[1] * FH[1] - k[17] * k[24] - k[18] * FH[0] * FH[0]) * t_0 * t_0 * t_0 -// + 2 * (k[13] * k[1] * FH[1] * FH[1] - k[19] * V_00 * FH[1] * FH[1] - k[19] * k[1] * k[24] - k[17] * FH[1] * FH[1] - k[18] * k[24]) * t_0 * t_0 -// + 2 * (- k[19] * k[1] * FH[1] * FH[1] - k[18] * FH[1] * FH[1]) * t_0, -// ' '); -// -// Write('debug78: ', -// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(f_1 * f_1 + 4 * f_0 * f_2)) -// + (k[50] + k[62]) * t_0 * t_0 * t_0 * t_0 * t_0 + (k[52] + k[64]) * t_0 * t_0 * t_0 * t_0 + (k[54] + k[66]) * t_0 * t_0 * t_0 + (k[56] + k[67]) * t_0 * t_0 + (k[59] + k[68]) * t_0 + k[60], -// ' '); -// -// Write('debug80: ', -// 0 = Round((k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * sqrt(k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) -// + k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]), -// ' '); -// WriteLn; -// WriteLn(' 0 = ((', k[45], ') * x^3 + (', k[46], ') * x^2 + (', k[47], ') * x + (', k[48], ')) * sqrt((', k[31], ') * x^4 + (', k[132], ') * x^3 + (', k[133], ') * x^2 + (', k[134], ') * x + (', k[58], ')) + (', -// k[69], ') * x^5 + (', k[70], ') * x^4 + (', k[71], ') * x^3 + (', k[72], ') * x^2 + (', k[73], ') * x + (', k[60], ')'); + OPolynomial0 := TBigIntPolynomial.Create([k[60], k[73], k[72], k[71], k[70], k[69]]); + OPolynomial1 := TBigIntPolynomial.Create([k[48], k[47], k[46], k[45]]); - Write('debug83: ', - (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[45] * t_0 * t_0 * t_0 + k[46] * t_0 * t_0 + k[47] * t_0 + k[48]) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) = - (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]) * (k[69] * t_0 * t_0 * t_0 * t_0 * t_0 + k[70] * t_0 * t_0 * t_0 * t_0 + k[71] * t_0 * t_0 * t_0 + k[72] * t_0 * t_0 + k[73] * t_0 + k[60]), - ' '); - Write('debug85: ', - 0 = - ( - k[45] * k[45] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - + 2 * k[45] * k[46] * t_0 * t_0 * t_0 * t_0 * t_0 - + k[46] * k[46] * t_0 * t_0 * t_0 * t_0 - + 2 * k[45] * k[47] * t_0 * t_0 * t_0 * t_0 - + 2 * k[45] * k[48] * t_0 * t_0 * t_0 - + 2 * k[46] * k[47] * t_0 * t_0 * t_0 - + k[47] * k[47] * t_0 * t_0 - + 2 * k[46] * k[48] * t_0 * t_0 - + 2 * k[47] * k[48] * t_0 - + k[48] * k[48] - ) * (k[31] * t_0 * t_0 * t_0 * t_0 + k[132] * t_0 * t_0 * t_0 + k[133] * t_0 * t_0 + k[134] * t_0 + k[58]) - - k[69] * k[69] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - - 2 * k[69] * k[70] * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - - (k[70] * k[70] + 2 * k[69] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - - 2 * (k[69] * k[72] + k[70] * k[71]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - - (k[71] * k[71] + 2 * k[69] * k[73] + 2 * k[70] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0 * t_0 - - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]) * t_0 * t_0 * t_0 * t_0 * t_0 - - (k[72] * k[72] + 2 * k[70] * k[60] + 2 * k[71] * k[73]) * t_0 * t_0 * t_0 * t_0 - - 2 * (k[71] * k[60] + k[72] * k[73]) * t_0 * t_0 * t_0 - - (k[73] * k[73] + 2 * k[72] * k[60]) * t_0 * t_0 - - 2 * k[73] * k[60] * t_0 - - k[60] * k[60], - ' '); + // Squaring that formula eliminates the square root, but may lead to a polynomial with all coefficients zero in some + // cases. Therefore this part is merely included for the interested reader. + // -+ (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) = + // k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60 + // (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48)^2 * (k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) = + // (k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60)^2 + // 0 = + // (k_45^2 * t_0^6 + // + 2 * k_45 * k_46 * t_0^5 + // + k_46^2 * t_0^4 + 2 * k_45 * k_47 * t_0^4 + // + 2 * k_45 * k_48 * t_0^3 + 2 * k_46 * k_47 * t_0^3 + // + k_47^2 * t_0^2 + 2 * k_46 * k_48 * t_0^2 + // + 2 * k_47 * k_48 * t_0 + // + k_48^2 + // ) * (k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) + // - k_69^2 * t_0^10 + // - 2 * k_69 * k_70 * t_0^9 + // - (k_70^2 + 2 * k_69 * k_71) * t_0^8 + // - 2 * (k_69 * k_72 + k_70 * k_71) * t_0^7 + // - (k_71^2 + 2 * k_69 * k_73 + 2 * k_70 * k_72) * t_0^6 + // - 2 * (k_69 * k_60 + k_70 * k_73 + k_71 * k_72) * t_0^5 + // - (k_72^2 + 2 * k_70 * k_60 + 2 * k_71 * k_73) * t_0^4 + // - 2 * (k_71 * k_60 + k_72 * k_73) * t_0^3 + // - (k_73^2 + 2 * k_72 * k_60) * t_0^2 + // - 2 * k_73 * k_60 * t_0 + // - k_60^2 + // 0 = ak_10 * t_0^10 + ak_9 * t_0^9 + ak_8 * t_0^8 + ak_7 * t_0^7 + ak_6 * t_0^6 + ak_5 * t_0^5 + ak_4 * t_0^4 + ak_3 * t_0^3 + ak_2 * t_0^2 + ak_1 * t_0 + ak_0 - WriteLn('debug96: ', EvaluateAt(t_0) = 0); - - NormalizeCoefficients; - - WriteLn('debug99: ', EvaluateAt(t_0) = 0, ' '); + //k[74] := k[45] * k[45]; + //k[75] := 2 * k[45] * k[46]; + //k[76] := k[46] * k[46] + 2 * k[45] * k[47]; + //k[77] := 2 * (k[45] * k[48] + k[46] * k[47]); + //k[78] := k[47] * k[47] + 2 * k[46] * k[48]; + //k[79] := 2 * k[47] * k[48]; + //k[80] := k[48] * k[48]; + //ak[0] := k[58] * k[80] - k[60] * k[60]; + //ak[1] := k[134] * k[80] + k[58] * k[79] - 2 * k[73] * k[60]; + //ak[2] := k[133] * k[80] + k[134] * k[79] + k[58] * k[78] - k[73] * k[73] - 2 * k[72] * k[60]; + //ak[3] := k[133] * k[79] + k[134] * k[78] + k[58] * k[77] + k[132] * k[80] + // - 2 * (k[71] * k[60] + k[72] * k[73]); + //ak[4] := k[31] * k[80] + k[133] * k[78] + k[134] * k[77] + k[58] * k[76] + k[132] * k[79] - k[72] * k[72] + // - 2 * (k[70] * k[60] + k[71] * k[73]); + //ak[5] := k[31] * k[79] + k[133] * k[77] + k[134] * k[76] + k[58] * k[75] + k[132] * k[78] + // - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]); + //ak[6] := k[31] * k[78] + k[133] * k[76] + k[134] * k[75] + k[58] * k[74] + k[132] * k[77] - k[71] * k[71] + // - 2 * (k[69] * k[73] + k[70] * k[72]); + //ak[7] := k[31] * k[77] + k[133] * k[75] + k[134] * k[74] + k[132] * k[76] - 2 * (k[69] * k[72] + k[70] * k[71]); + //ak[8] := k[31] * k[76] + k[132] * k[75] + k[133] * k[74] - k[70] * k[70] - 2 * k[69] * k[71]; + //ak[9] := k[31] * k[75] + k[132] * k[74] - 2 * k[69] * k[70]; + //ak[10] := k[31] * k[74] - k[69] * k[69]; end; -function TFirstCollisionPolynomial.EvaluateAt(const AT0: Int64): TBigInt; +function TNeverTellMeTheOdds.CalcRockThrowCollisionOptions(constref AHailstone0, AHailstone1, AHailstone2: THailstone): + TInt64Array; var - i: Low(FA)..High(FA); + a0, a1: TBigIntPolynomial; + a0Roots, a1Roots: TBigIntArray; + options: specialize TList; + i, j: TBigInt; + val: Int64; begin - Result := TBigInt.Zero; - for i := High(FA) downto Low(FA) do - Result := Result * AT0 + FA[i]; + CalcCollisionPolynomials(AHailstone0, AHailstone1, AHailstone2, a0, a1); + a0Roots := TPolynomialRoots.BisectInteger(a0, 64); + a1Roots := TPolynomialRoots.BisectInteger(a1, 64); + + options := specialize TList.Create; + for i in a0Roots do + for j in a1Roots do + if (i = j) and i.TryToInt64(val) then + options.Add(val); + Result := options.ToArray; + options.Free; end; -function TFirstCollisionPolynomial.CalcPositiveIntegerRoot: Int64; +function TNeverTellMeTheOdds.ValidateRockThrow(constref AHailstone0, AHailstone1, AHailstone2: THailstone; const AT0, + AT1: Int64): Int64; var - dividers: TDividers; - factors: TInt64Array; - divider: Int64; + divisor, t: Int64; + rock: THailstone; begin - Result := 0; - //factors := TIntegerFactorization.PollardsRhoAlgorithm(FA[0]); - //dividers := TDividers.Create(factors); - // - //try - //for divider in dividers do - //begin - // //WriteLn('Check if ', divider, ' is a root...'); - // if EvaluateAt(divider) = 0 then - // begin - // Result := divider; - // Break; - // end; - //end; - // - //finally - // dividers.Free; - //end; -end; + // V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) + divisor := AT0 - AT1; + rock := THailstone.Create; + rock.V0 := (AHailstone0.V0 * AT0 - AHailstone1.V0 * AT1 + AHailstone0.P0 - AHailstone1.P0) div divisor; + rock.V1 := (AHailstone0.V1 * AT0 - AHailstone1.V1 * AT1 + AHailstone0.P1 - AHailstone1.P1) div divisor; + rock.V2 := (AHailstone0.V2 * AT0 - AHailstone1.V2 * AT1 + AHailstone0.P2 - AHailstone1.P2) div divisor; -function TFirstCollisionPolynomial.CalcT1(const AT0: Int64): Int64; -var - g_0, g_1, g_2: Int64; - g: Extended; -begin - //g_2 := FH[0] * AT0 + FH[1]; - //g_1 := FH[2] * AT0 * AT0 + FH[3] * AT0 + FH[4]; - //g_0 := FH[5] * AT0 * AT0 + FH[6] * AT0; - //g := - g_1 / (2 * g_2); - //Result := Round(g + sqrt(g * g + g_0)); -end; + // P_x = (V_0 - V_x) * t_0 + P_0 + rock.P0 := (AHailstone0.V0 - rock.V0) * AT0 + AHailstone0.P0; + rock.P1 := (AHailstone0.V1 - rock.V1) * AT0 + AHailstone0.P1; + rock.P2 := (AHailstone0.V2 - rock.V2) * AT0 + AHailstone0.P2; -{ TNeverTellMeTheOdds } + Result := rock.P0 + rock.P1 + rock.P2; -function TNeverTellMeTheOdds.AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; -var - m1, m2, x, y: Double; -begin - Result := False; - m1 := AHailstone1.Velocity.data[1] / AHailstone1.Velocity.data[0]; - m2 := AHailstone2.Velocity.data[1] / AHailstone2.Velocity.data[0]; - if m1 <> m2 then - begin - x := (AHailstone2.Position.data[1] - m2 * AHailstone2.Position.data[0] - - AHailstone1.Position.data[1] + m1 * AHailstone1.Position.data[0]) - / (m1 - m2); - if (FMin <= x) and (x <= FMax) - and (x * Sign(AHailstone1.Velocity.data[0]) >= AHailstone1.Position.data[0] * Sign(AHailstone1.Velocity.data[0])) - and (x * Sign(AHailstone2.Velocity.data[0]) >= AHailstone2.Position.data[0] * Sign(AHailstone2.Velocity.data[0])) - then - begin - y := m1 * (x - AHailstone1.Position.data[0]) + AHailstone1.Position.data[1]; - if (FMin <= y) and (y <= FMax) then - Result := True - end; + // Checks collision with the third hailstone. + if ((AHailstone2.V0 = rock.V0) and (AHailstone2.P0 <> rock.P0)) + or ((AHailstone2.V1 = rock.V1) and (AHailstone2.P1 <> rock.P1)) + or ((AHailstone2.V2 = rock.V2) and (AHailstone2.P2 <> rock.P2)) then + Result := 0 + else begin + t := (AHailstone2.P0 - rock.P0) div (rock.V0 - AHailstone2.V0); + if (t <> (AHailstone2.P1 - rock.P1) div (rock.V1 - AHailstone2.V1)) + or (t <> (AHailstone2.P2 - rock.P2) div (rock.V2 - AHailstone2.V2)) then + Result := 0; end; -end; -// For debug calculations: -Const - T : array[0..4] of Byte = (5, 3, 4, 6, 1); - -procedure TNeverTellMeTheOdds.FindRockThrow(const AIndex1, AIndex2, AIndex3: Integer); -var - //i, j, k: Integer; - //x0, x1, x2: Extended; - f: TFirstCollisionPolynomial; - t0, t1: Int64; - p, v: Tvector3_extended; - test: TBigInt; -begin - WriteLn; - WriteLn(AIndex1, ' ', AIndex2, ' ', AIndex3); - f := TFirstCollisionPolynomial.Create; - f.Init(FHailstones[AIndex1], FHailstones[AIndex2], FHailstones[AIndex3], T[AIndex1], T[AIndex2], T[AIndex3]); - //t0 := f.CalcPositiveIntegerRoot; - //WriteLn('t0: ', t0, ' ', t0 = T[AIndex1]); - //t1 := f.CalcT1(t0); - //WriteLn(', t1: ', t1); - f.Free; - - //// V_x = (V_0 * t_0 - V_1 * t_1 + P_0 - P_1) / (t_0 - t_1) - //v := (FHailstones[AIndex1].Velocity * t0 - FHailstones[AIndex2].Velocity * t1 - // + FHailstones[AIndex1].Position - FHailstones[AIndex2].Position) / (t0 - t1); - //// P_x = (V_0 - V_x) * t_0 + P_0 - //p := (FHailstones[AIndex1].Velocity - v) * t0 + FHailstones[AIndex1].Position; - //FPart2 := Round(p.data[0]) + Round(p.data[1]) + Round(p.data[2]); - - //for i := 0 to FHailstones.Count - 3 do - // for j := i + 1 to FHailstones.Count - 2 do - // for k:= j + 1 to FHailstones.Count - 1 do - // begin - // WriteLn(i, j, k); - // solver := TRockThrowSolver.Create(FHailstones[i], FHailstones[j], FHailstones[k], 0); - // case i of - // 0: x0 := 5; - // 1: x0 := 3; - // 2: x0 := 4; - // end; - // f := solver.CalcValue(x0); - // solver.Free; - // end; - - //for i := 80 to 120 do - //begin - // solver := TRockThrowSolver.Create(FHailstones[0], FHailstones[1], FHailstones[2], 0); - // x0 := i / 20; - // f := solver.CalcValue(x0); - // WriteLn(x0, ' ', f.Valid, ' ', f.Value); - // solver.Free; - //end; + rock.Free; end; constructor TNeverTellMeTheOdds.Create(const AMin: Int64; const AMax: Int64); @@ -617,19 +510,15 @@ end; procedure TNeverTellMeTheOdds.Finish; var - i, j, k: Integer; + i, j: Integer; begin for i := 0 to FHailstones.Count - 2 do for j := i + 1 to FHailstones.Count - 1 do if AreIntersecting(FHailstones[i], FHailstones[j]) then Inc(FPart1); - for i := 0 to FHailstones.Count - 1 do - for j := 0 to FHailstones.Count - 1 do - for k := 0 to FHailstones.Count - 1 do - if (i <> j) and (i <> k) and (j <> k) then - FindRockThrow(i, j, k); - //FindRockThrow(0, 1, 2); + if FHailstones.Count >= 3 then + FPart2 := FindRockThrow(0, 1, 2); end; function TNeverTellMeTheOdds.GetDataFileName: string; diff --git a/tests/UNeverTellMeTheOddsTestCases.pas b/tests/UNeverTellMeTheOddsTestCases.pas index a2f1235..2f56a79 100644 --- a/tests/UNeverTellMeTheOddsTestCases.pas +++ b/tests/UNeverTellMeTheOddsTestCases.pas @@ -81,7 +81,7 @@ end; procedure TNeverTellMeTheOddsFullDataTestCase.TestPart2; begin - AssertEquals(-1, FSolver.GetResultPart2); + AssertEquals(856642398547748, FSolver.GetResultPart2); end; { TNeverTellMeTheOddsExampleTestCase } From b27b14a1539d324ed801d43c6671237e87767e8c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Stefan=20M=C3=BCller?= Date: Mon, 27 May 2024 02:52:22 +0200 Subject: [PATCH 48/48] Fixed day 24 helper variable indices --- solvers/UNeverTellMeTheOdds.pas | 350 ++++++++++++++++---------------- 1 file changed, 174 insertions(+), 176 deletions(-) diff --git a/solvers/UNeverTellMeTheOdds.pas b/solvers/UNeverTellMeTheOdds.pas index 793a7aa..af87de3 100644 --- a/solvers/UNeverTellMeTheOdds.pas +++ b/solvers/UNeverTellMeTheOdds.pas @@ -46,8 +46,6 @@ type private FMin, FMax: Int64; FHailstones: THailstones; - FA: array[0..10] of TBigInt; - FH: array[0..6] of TBigInt; function AreIntersecting(constref AHailstone1, AHailstone2: THailstone): Boolean; function FindRockThrow(const AIndex0, AIndex1, AIndex2: Integer): Int64; procedure CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out OPolynomial0, @@ -137,7 +135,7 @@ end; procedure TNeverTellMeTheOdds.CalcCollisionPolynomials(constref AHailstone0, AHailstone1, AHailstone2: THailstone; out OPolynomial0, OPolynomial1: TBigIntPolynomial); var - k: array[0..139] of TBigInt; + k: array[0..74] of TBigInt; begin // Solving this non-linear equation system, with velocities V_i and start positions P_i: // V_0 * t_0 + P_0 = V_x * t_0 + P_x @@ -207,13 +205,13 @@ begin // e_0 = k_13 * t_0 + k_7 // f_2 = (k_11 * t_0 + k_4) * k_9 + k_8 * (k_12 * t_0 + k_6) // = (k_11 * k_9 + k_8 * k_12) * t_0 + k_4 * k_9 + k_8 * k_6 - // = FH_0 * t_0 + FH_1 + // = k_14 * t_0 + k_15 // f_1 = (k_11 * t_0 + k_4) * (k_13 * t_0 + k_7) + k_8 * k_5 * t_0 - k_2 * t_0 * k_9 - (k_10 * t_0 + k_3) * (k_12 * t_0 + k_6) // = (k_11 * k_13 - k_10 * k_12) * t_0^2 + (k_11 * k_7 + k_4 * k_12 + k_8 * k_5 - k_2 * k_9 - k_10 * k_6 - k_3 * k_12) * t_0 + k_4 * k_7 - k_3 * k_6 - // = FH_2 * t_0^2 + FH_3 * t_0 + FH_4 + // = k_16 * t_0^2 + k_17 * t_0 + k_18 // f_0 = (k_10 * t_0 + k_3) * k_5 * t_0 + k_2 * t_0 * (k_13 * t_0 + k_7) // = (k_10 * k_5 + k_2 * k_13) * t_0^2 + (k_3 * k_5 + k_2 * k_7) * t_0 - // = FH_5 * t_0^2 + FH_6 * t_0 + // = k_19 * t_0^2 + k_20 * t_0 k[0] := AHailstone0.P0 - AHailstone2.P0; k[1] := AHailstone0.P0 - AHailstone1.P0; @@ -230,207 +228,207 @@ begin k[12] := AHailstone0.V2 - AHailstone1.V2; k[13] := AHailstone0.V2 - AHailstone2.V2; - FH[0] := k[11] * k[9] + k[8] * k[12]; - FH[1] := k[4] * k[9] + k[8] * k[6]; - FH[2] := k[11] * k[13] - k[10] * k[12]; - FH[3] := k[11] * k[7] + k[4] * k[13] + k[8] * k[5] - k[2] * k[9] - k[10] * k[6] - k[3] * k[12]; - FH[4] := k[4] * k[7] - k[3] * k[6]; - FH[5] := k[10] * k[5] + k[2] * k[13]; - FH[6] := k[3] * k[5] + k[2] * k[7]; + k[14] := k[11] * k[9] + k[8] * k[12]; + k[15] := k[4] * k[9] + k[8] * k[6]; + k[16] := k[11] * k[13] - k[10] * k[12]; + k[17] := k[11] * k[7] + k[4] * k[13] + k[8] * k[5] - k[2] * k[9] - k[10] * k[6] - k[3] * k[12]; + k[18] := k[4] * k[7] - k[3] * k[6]; + k[19] := k[10] * k[5] + k[2] * k[13]; + k[20] := k[3] * k[5] + k[2] * k[7]; // Additional substitutions. // a_1 * k_9 - V_20 * d_1 // = (V_00 * t_0 + k_0) * k_9 - V_20 * (k_12 * t_0 + k_6) // = (V_00 * k_9 - V_20 * k_12) * t_0 + k_0 * k_9 - V_20 * k_6 - // = k_14 * t_0 + k_15 + // = k_21 * t_0 + k_22 // d_1 - k_9 * t_0 // = k_12 * t_0 + k_6 - k_9 * t_0 // = (k_12 - k_9) * t_0 + k_6 // a_1 * e_0 - V_20 * d_0 // = (V_00 * t_0 + k_0) * (k_13 * t_0 + k_7) - V_20 * k_5 * t_0 // = V_00 * k_13 * t_0^2 + (V_00 * k_7 + k_0 * k_13 - V_20 * k_5) * t_0 + k_0 * k_7 - // = k_16 * t_0^2 + k_17 * t_0 + k_18 + // = k_23 * t_0^2 + k_24 * t_0 + k_25 // d_0 - e_0 * t_0 // = k_5 * t_0 - k_13 * t_0^2 - k_7 * t_0 - // = - k_13 * t_0^2 + k_19 * t_0 + // = - k_13 * t_0^2 + k_26 * t_0 // f_1^2 - // = (FH_2 * t_0^2 + FH_3 * t_0 + FH_4)^2 - // = FH_2^2 * t_0^4 + FH_3^2 * t_0^2 + FH_4^2 + 2 * FH_2 * t_0^2 * FH_3 * t_0 + 2 * FH_2 * t_0^2 * FH_4 + 2 * FH_3 * t_0 * FH_4 - // = FH_2^2 * t_0^4 + 2 * FH_2 * FH_3 * t_0^3 + (FH_3^2 + 2 * FH_2 * FH_4) * t_0^2 + 2 * FH_3 * FH_4 * t_0 + FH_4^2 - // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + // = (k_16 * t_0^2 + k_17 * t_0 + k_18)^2 + // = k_16^2 * t_0^4 + k_17^2 * t_0^2 + k_18^2 + 2 * k_16 * t_0^2 * k_17 * t_0 + 2 * k_16 * t_0^2 * k_18 + 2 * k_17 * t_0 * k_18 + // = k_16^2 * t_0^4 + 2 * k_16 * k_17 * t_0^3 + (k_17^2 + 2 * k_16 * k_18) * t_0^2 + 2 * k_17 * k_18 * t_0 + k_18^2 + // = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 // f_2^2 - // = (FH_0 * t_0 + FH_1)^2 - // = FH_0^2 * t_0^2 + 2 * FH_0 * FH_1 * t_0 + FH_1^2 - // = FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2 + // = (k_14 * t_0 + k_15)^2 + // = k_14^2 * t_0^2 + 2 * k_14 * k_15 * t_0 + k_15^2 + // = k_14^2 * t_0^2 + k_31 * t_0 + k_15^2 // f_0 * f_2 - // = (FH_5 * t_0^2 + FH_6 * t_0) * (FH_0 * t_0 + FH_1) - // = FH_5 * FH_0 * t_0^3 + (FH_5 * FH_1 + FH_6 * FH_0) * t_0^2 + FH_6 * FH_1 * t_0 - // = k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0 + // = (k_19 * t_0^2 + k_20 * t_0) * (k_14 * t_0 + k_15) + // = k_19 * k_14 * t_0^3 + (k_19 * k_15 + k_20 * k_14) * t_0^2 + k_20 * k_15 * t_0 + // = k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0 // f_1^2 + 4 * f_0 * f_2 - // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + 4 * (k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0) - // = k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58 + // = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 + 4 * (k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0) + // = k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59 // f_1^2 + 2 * f_0 * f_2 - // = FH_2^2 * t_0^4 + k_20 * t_0^3 + k_22 * t_0^2 + k_23 * t_0 + FH_4^2 + 2 * (k_126 * t_0^3 + k_127 * t_0^2 + k_128 * t_0) - // = k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 + // = k_16^2 * t_0^4 + k_27 * t_0^3 + k_29 * t_0^2 + k_30 * t_0 + k_18^2 + 2 * (k_33 * t_0^3 + k_34 * t_0^2 + k_35 * t_0) + // = k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 - k[14] := AHailstone0.V0 * k[9] - AHailstone2.V0 * k[12]; - k[15] := k[0] * k[9] - AHailstone2.V0 * k[6]; - k[16] := AHailstone0.V0 * k[13]; - k[17] := AHailstone0.V0 * k[7] + k[0] * k[13] - AHailstone2.V0 * k[5]; - k[18] := k[0] * k[7]; - k[19] := k[5] - k[7]; - k[20] := 2 * FH[2] * FH[3]; - k[21] := FH[3] * FH[3]; - k[22] := k[21] + 2 * FH[2] * FH[4]; - k[23] := 2 * FH[3] * FH[4]; - k[24] := 2 * FH[0] * FH[1]; - k[25] := FH[0] * FH[0]; - k[126] := FH[5] * FH[0]; - k[127] := FH[5] * FH[1] + FH[6] * FH[0]; - k[128] := FH[6] * FH[1]; - k[28] := FH[1] * FH[1]; - k[31] := FH[2] * FH[2]; - k[137] := k[20] + 2 * k[126]; - k[138] := k[22] + 2 * k[127]; - k[139] := k[23] + 2 * k[128]; - k[40] := k[14] + AHailstone1.V0 * (k[12] - k[9]); - k[41] := k[15] + AHailstone1.V0 * k[6]; - k[42] := k[16] - k[14] - AHailstone1.V0 * k[13] - (k[12] - k[9]) * AHailstone0.V0; - k[43] := k[17] - k[15] + AHailstone1.V0 * k[19] - (k[12] - k[9]) * k[1] - k[6] * AHailstone0.V0; - k[44] := k[18] - k[6] * k[1]; - k[45] := k[42] * FH[0] - k[40] * FH[2]; - k[46] := k[42] * FH[1] + k[43] * FH[0] - k[41] * FH[2] - k[40] * FH[3]; - k[47] := k[43] * FH[1] + k[44] * FH[0] - k[41] * FH[3] - k[40] * FH[4]; - k[48] := k[44] * FH[1] - k[41] * FH[4]; - k[49] := k[42] * FH[2]; - k[50] := k[40] * k[31] - k[49] * FH[0]; - k[51] := k[42] * FH[3] + k[43] * FH[2]; - k[52] := k[40] * k[137] + k[41] * k[31] - k[51] * FH[0] - k[49] * FH[1]; - k[53] := k[42] * FH[4] + k[43] * FH[3] + k[44] * FH[2]; - k[54] := k[40] * k[138] + k[41] * k[137] - k[53] * FH[0] - k[51] * FH[1]; - k[55] := k[43] * FH[4] + k[44] * FH[3]; - k[56] := k[40] * k[139] + k[41] * k[138] - k[55] * FH[0] - k[53] * FH[1]; - k[57] := k[44] * FH[4]; - k[58] := FH[4] * FH[4]; - k[59] := k[40] * k[58] + k[41] * k[139] - k[57] * FH[0] - k[55] * FH[1]; - k[60] := k[41] * k[58] - k[57] * FH[1]; - k[61] := k[13] * AHailstone0.V0 - k[16]; - k[62] := 2 * k[25] * k[61]; - k[63] := k[13] * k[1] - k[19] * AHailstone0.V0 - k[17]; - k[64] := 2 * (k[24] * k[61] + k[25] * k[63]); - k[65] := - k[19] * k[1] - k[18]; - k[66] := 2 * (k[28] * k[61] + k[24] * k[63] + k[25] * k[65]); - k[67] := 2 * (k[28] * k[63] + k[24] * k[65]); - k[68] := 2 * k[28] * k[65]; - k[69] := k[50] + k[62]; - k[70] := k[52] + k[64]; - k[71] := k[54] + k[66]; - k[72] := k[56] + k[67]; - k[73] := k[59] + k[68]; + k[21] := AHailstone0.V0 * k[9] - AHailstone2.V0 * k[12]; + k[22] := k[0] * k[9] - AHailstone2.V0 * k[6]; + k[23] := AHailstone0.V0 * k[13]; + k[24] := AHailstone0.V0 * k[7] + k[0] * k[13] - AHailstone2.V0 * k[5]; + k[25] := k[0] * k[7]; + k[26] := k[5] - k[7]; + k[27] := 2 * k[16] * k[17]; + k[28] := k[17] * k[17]; + k[29] := k[28] + 2 * k[16] * k[18]; + k[30] := 2 * k[17] * k[18]; + k[31] := 2 * k[14] * k[15]; + k[32] := k[14] * k[14]; + k[33] := k[19] * k[14]; + k[34] := k[19] * k[15] + k[20] * k[14]; + k[35] := k[20] * k[15]; + k[36] := k[15] * k[15]; + k[37] := k[16] * k[16]; + k[38] := k[27] + 2 * k[33]; + k[39] := k[29] + 2 * k[34]; + k[40] := k[30] + 2 * k[35]; + k[41] := k[21] + AHailstone1.V0 * (k[12] - k[9]); + k[42] := k[22] + AHailstone1.V0 * k[6]; + k[43] := k[23] - k[21] - AHailstone1.V0 * k[13] - (k[12] - k[9]) * AHailstone0.V0; + k[44] := k[24] - k[22] + AHailstone1.V0 * k[26] - (k[12] - k[9]) * k[1] - k[6] * AHailstone0.V0; + k[45] := k[25] - k[6] * k[1]; + k[46] := k[43] * k[14] - k[41] * k[16]; + k[47] := k[43] * k[15] + k[44] * k[14] - k[42] * k[16] - k[41] * k[17]; + k[48] := k[44] * k[15] + k[45] * k[14] - k[42] * k[17] - k[41] * k[18]; + k[49] := k[45] * k[15] - k[42] * k[18]; + k[50] := k[43] * k[16]; + k[51] := k[41] * k[37] - k[50] * k[14]; + k[52] := k[43] * k[17] + k[44] * k[16]; + k[53] := k[41] * k[38] + k[42] * k[37] - k[52] * k[14] - k[50] * k[15]; + k[54] := k[43] * k[18] + k[44] * k[17] + k[45] * k[16]; + k[55] := k[41] * k[39] + k[42] * k[38] - k[54] * k[14] - k[52] * k[15]; + k[56] := k[44] * k[18] + k[45] * k[17]; + k[57] := k[41] * k[40] + k[42] * k[39] - k[56] * k[14] - k[54] * k[15]; + k[58] := k[45] * k[18]; + k[59] := k[18] * k[18]; + k[60] := k[41] * k[59] + k[42] * k[40] - k[58] * k[14] - k[56] * k[15]; + k[61] := k[42] * k[59] - k[58] * k[15]; + k[62] := k[13] * AHailstone0.V0 - k[23]; + k[63] := 2 * k[32] * k[62]; + k[64] := k[13] * k[1] - k[26] * AHailstone0.V0 - k[24]; + k[65] := 2 * (k[31] * k[62] + k[32] * k[64]); + k[66] := - k[26] * k[1] - k[25]; + k[67] := 2 * (k[36] * k[62] + k[31] * k[64] + k[32] * k[66]); + k[68] := 2 * (k[36] * k[64] + k[31] * k[66]); + k[69] := 2 * k[36] * k[66]; + k[70] := k[51] + k[63]; + k[71] := k[53] + k[65]; + k[72] := k[55] + k[67]; + k[73] := k[57] + k[68]; + k[74] := k[60] + k[69]; // Unused, they are part of the polynomial inside the square root. - //k[132] := k[20] + 4 * k[126]; - //k[133] := k[22] + 4 * k[127]; - //k[134] := k[23] + 4 * k[128]; + //k[75] := k[27] + 4 * k[33]; + //k[76] := k[29] + 4 * k[34]; + //k[77] := k[30] + 4 * k[35]; // Continuing calculations for equation 5. - // 0 = (k_14 * t_0 + k_15 + V_10 * ((k_12 - k_9) * t_0 + k_6)) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) - // + (k_16 * t_0^2 + k_17 * t_0 + k_18 - t_0 * (k_14 * t_0 + k_15) - ((k_12 - k_9) * t_0 + k_6) * a_2 - V_10 * (k_13 * t_0^2 - k_19 * t_0)) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) - // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) - // + ((k_16 - k_14 - V_10 * k_13 - (k_12 - k_9) * V_00) * t_0^2 + (k_17 - k_15 + V_10 * k_19 - (k_12 - k_9) * k_1 - k_6 * V_00) * t_0 + k_18 - k_6 * k_1) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) - // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) - // -+ (k_40 * t_0 + k_41) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) - // + (k_42 * t_0^2 + k_43 * t_0 + k_44) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) - // 0 = (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) - // -+ (k_40 * t_0 + k_41) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) - // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_1 * f_2 - // +- (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_2 * sqrt(f_1^2 + 4 * f_0 * f_2) - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) - // 0 = +- ((k_42 * t_0^2 + k_43 * t_0 + k_44) * f_2 - (k_40 * t_0 + k_41) * f_1) * sqrt(f_1^2 + 4 * f_0 * f_2) - // + (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) - // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * f_1 * f_2 - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * a_2 * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) - // 0 = +- ((k_42 * t_0^2 + k_43 * t_0 + k_44) * (FH_0 * t_0 + FH_1) - (k_40 * t_0 + k_41) * (FH_2 * t_0^2 + FH_3 * t_0 + FH_4)) * sqrt(f_1^2 + 4 * f_0 * f_2) - // + (k_40 * t_0 + k_41) * (k_31 * t_0^4 + k_137 * t_0^3 + k_138 * t_0^2 + k_139 * t_0 + k_58) - // - (k_42 * t_0^2 + k_43 * t_0 + k_44) * (FH_2 * t_0^2 + FH_3 * t_0 + FH_4) * (FH_0 * t_0 + FH_1) - // - 2 * t_0 * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + 2 * (k_13 * t_0^2 - k_19 * t_0) * (V_00 * t_0 + k_1) * (FH_0^2 * t_0^2 + k_24 * t_0 + FH_1^2) + // 0 = (k_21 * t_0 + k_22 + V_10 * ((k_12 - k_9) * t_0 + k_6)) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + (k_23 * t_0^2 + k_24 * t_0 + k_25 - t_0 * (k_21 * t_0 + k_22) - ((k_12 - k_9) * t_0 + k_6) * a_2 - V_10 * (k_13 * t_0^2 - k_26 * t_0)) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + // 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59 -+ f_1 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // + ((k_23 - k_21 - V_10 * k_13 - (k_12 - k_9) * V_00) * t_0^2 + (k_24 - k_22 + V_10 * k_26 - (k_12 - k_9) * k_1 - k_6 * V_00) * t_0 + k_25 - k_6 * k_1) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + // 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59) + // -+ (k_41 * t_0 + k_42) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_43 * t_0^2 + k_44 * t_0 + k_45) * (- f_1 * f_2 +- f_2 * sqrt(f_1^2 + 4 * f_0 * f_2)) + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + // 0 = (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59) + // -+ (k_41 * t_0 + k_42) * f_1 * sqrt(f_1^2 + 4 * f_0 * f_2) + // - (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_1 * f_2 + // +- (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_2 * sqrt(f_1^2 + 4 * f_0 * f_2) + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + // 0 = +- ((k_43 * t_0^2 + k_44 * t_0 + k_45) * f_2 - (k_41 * t_0 + k_42) * f_1) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59) + // - (k_43 * t_0^2 + k_44 * t_0 + k_45) * f_1 * f_2 + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * a_2 * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + // 0 = +- ((k_43 * t_0^2 + k_44 * t_0 + k_45) * (k_14 * t_0 + k_15) - (k_41 * t_0 + k_42) * (k_16 * t_0^2 + k_17 * t_0 + k_18)) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_41 * t_0 + k_42) * (k_37 * t_0^4 + k_38 * t_0^3 + k_39 * t_0^2 + k_40 * t_0 + k_59) + // - (k_43 * t_0^2 + k_44 * t_0 + k_45) * (k_16 * t_0^2 + k_17 * t_0 + k_18) * (k_14 * t_0 + k_15) + // - 2 * t_0 * (k_23 * t_0^2 + k_24 * t_0 + k_25) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) + 2 * (k_13 * t_0^2 - k_26 * t_0) * (V_00 * t_0 + k_1) * (k_14^2 * t_0^2 + k_31 * t_0 + k_15^2) // 0 = +- ( - // (k_42 * FH_0 - k_40 * FH_2) * t_0^3 - // + (k_42 * FH_1 + k_43 * FH_0 - k_41 * FH_2 - k_40 * FH_3) * t_0^2 - // + (k_43 * FH_1 + k_44 * FH_0 - k_41 * FH_3 - k_40 * FH_4) * t_0 - // + k_44 * FH_1 - k_41 * FH_4 + // (k_43 * k_14 - k_41 * k_16) * t_0^3 + // + (k_43 * k_15 + k_44 * k_14 - k_42 * k_16 - k_41 * k_17) * t_0^2 + // + (k_44 * k_15 + k_45 * k_14 - k_42 * k_17 - k_41 * k_18) * t_0 + // + k_45 * k_15 - k_42 * k_18 // ) * sqrt(f_1^2 + 4 * f_0 * f_2) - // + (k_40 * k_31 - k_42 * FH_2 * FH_0) * t_0^5 - // + (k_40 * k_137 + k_41 * k_31 - k_42 * FH_3 * FH_0 - k_43 * FH_2 * FH_0 - k_42 * FH_2 * FH_1) * t_0^4 - // + (k_40 * k_138 + k_41 * k_137 - k_42 * FH_4 * FH_0 - k_43 * FH_3 * FH_0 - k_44 * FH_2 * FH_0 - k_42 * FH_3 * FH_1 - k_43 * FH_2 * FH_1) * t_0^3 - // + (k_40 * k_139 + k_41 * k_138 - k_43 * FH_4 * FH_0 - k_44 * FH_3 * FH_0 - k_42 * FH_4 * FH_1 - k_43 * FH_3 * FH_1 - k_44 * FH_2 * FH_1) * t_0^2 - // + (k_40 * k_58 + k_41 * k_139 - k_44 * FH_4 * FH_0 - k_43 * FH_4 * FH_1 - k_44 * FH_3 * FH_1) * t_0 - // + k_41 * k_58 - k_44 * FH_4 * FH_1 - // + 2 * (k_13 * V_00 * FH_0^2 - k_16 * FH_0^2) * t_0^5 - // + 2 * (k_13 * V_00 * k_24 + k_13 * k_1 * FH_0^2 - k_19 * V_00 * FH_0^2 - k_16 * k_24 - k_17 * FH_0^2) * t_0^4 - // + 2 * (k_13 * V_00 * FH_1^2 + k_13 * k_1 * k_24 - k_19 * V_00 * k_24 - k_19 * k_1 * FH_0^2 - k_16 * FH_1^2 - k_17 * k_24 - k_18 * FH_0^2) * t_0^3 - // + 2 * (k_13 * k_1 * FH_1^2 - k_19 * V_00 * FH_1^2 - k_19 * k_1 * k_24 - k_17 * FH_1^2 - k_18 * k_24) * t_0^2 - // + 2 * (- k_19 * k_1 * FH_1^2 - k_18 * FH_1^2) * t_0 - // 0 = +- (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(f_1^2 + 4 * f_0 * f_2) - // + (k_50 + k_62) * t_0^5 + (k_52 + k_64) * t_0^4 + (k_54 + k_66) * t_0^3 + (k_56 + k_67) * t_0^2 + (k_59 + k_68) * t_0 + k_60 - // 0 = +- (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) - // + k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60 + // + (k_41 * k_37 - k_43 * k_16 * k_14) * t_0^5 + // + (k_41 * k_38 + k_42 * k_37 - k_43 * k_17 * k_14 - k_44 * k_16 * k_14 - k_43 * k_16 * k_15) * t_0^4 + // + (k_41 * k_39 + k_42 * k_38 - k_43 * k_18 * k_14 - k_44 * k_17 * k_14 - k_45 * k_16 * k_14 - k_43 * k_17 * k_15 - k_44 * k_16 * k_15) * t_0^3 + // + (k_41 * k_40 + k_42 * k_39 - k_44 * k_18 * k_14 - k_45 * k_17 * k_14 - k_43 * k_18 * k_15 - k_44 * k_17 * k_15 - k_45 * k_16 * k_15) * t_0^2 + // + (k_41 * k_59 + k_42 * k_40 - k_45 * k_18 * k_14 - k_44 * k_18 * k_15 - k_45 * k_17 * k_15) * t_0 + // + k_42 * k_59 - k_45 * k_18 * k_15 + // + 2 * (k_13 * V_00 * k_14^2 - k_23 * k_14^2) * t_0^5 + // + 2 * (k_13 * V_00 * k_31 + k_13 * k_1 * k_14^2 - k_26 * V_00 * k_14^2 - k_23 * k_31 - k_24 * k_14^2) * t_0^4 + // + 2 * (k_13 * V_00 * k_15^2 + k_13 * k_1 * k_31 - k_26 * V_00 * k_31 - k_26 * k_1 * k_14^2 - k_23 * k_15^2 - k_24 * k_31 - k_25 * k_14^2) * t_0^3 + // + 2 * (k_13 * k_1 * k_15^2 - k_26 * V_00 * k_15^2 - k_26 * k_1 * k_31 - k_24 * k_15^2 - k_25 * k_31) * t_0^2 + // + 2 * (- k_26 * k_1 * k_15^2 - k_25 * k_15^2) * t_0 + // 0 = +- (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(f_1^2 + 4 * f_0 * f_2) + // + (k_51 + k_63) * t_0^5 + (k_53 + k_65) * t_0^4 + (k_55 + k_67) * t_0^3 + (k_57 + k_68) * t_0^2 + (k_60 + k_69) * t_0 + k_61 + // 0 = +- (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) + // + k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61 - OPolynomial0 := TBigIntPolynomial.Create([k[60], k[73], k[72], k[71], k[70], k[69]]); - OPolynomial1 := TBigIntPolynomial.Create([k[48], k[47], k[46], k[45]]); + OPolynomial0 := TBigIntPolynomial.Create([k[61], k[74], k[73], k[72], k[71], k[70]]); + OPolynomial1 := TBigIntPolynomial.Create([k[49], k[48], k[47], k[46]]); // Squaring that formula eliminates the square root, but may lead to a polynomial with all coefficients zero in some // cases. Therefore this part is merely included for the interested reader. - // -+ (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48) * sqrt(k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) = - // k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60 - // (k_45 * t_0^3 + k_46 * t_0^2 + k_47 * t_0 + k_48)^2 * (k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) = - // (k_69 * t_0^5 + k_70 * t_0^4 + k_71 * t_0^3 + k_72 * t_0^2 + k_73 * t_0 + k_60)^2 + // -+ (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49) * sqrt(k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) = + // k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61 + // (k_46 * t_0^3 + k_47 * t_0^2 + k_48 * t_0 + k_49)^2 * (k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) = + // (k_70 * t_0^5 + k_71 * t_0^4 + k_72 * t_0^3 + k_73 * t_0^2 + k_74 * t_0 + k_61)^2 // 0 = - // (k_45^2 * t_0^6 - // + 2 * k_45 * k_46 * t_0^5 - // + k_46^2 * t_0^4 + 2 * k_45 * k_47 * t_0^4 - // + 2 * k_45 * k_48 * t_0^3 + 2 * k_46 * k_47 * t_0^3 - // + k_47^2 * t_0^2 + 2 * k_46 * k_48 * t_0^2 - // + 2 * k_47 * k_48 * t_0 - // + k_48^2 - // ) * (k_31 * t_0^4 + k_132 * t_0^3 + k_133 * t_0^2 + k_134 * t_0 + k_58) - // - k_69^2 * t_0^10 - // - 2 * k_69 * k_70 * t_0^9 - // - (k_70^2 + 2 * k_69 * k_71) * t_0^8 - // - 2 * (k_69 * k_72 + k_70 * k_71) * t_0^7 - // - (k_71^2 + 2 * k_69 * k_73 + 2 * k_70 * k_72) * t_0^6 - // - 2 * (k_69 * k_60 + k_70 * k_73 + k_71 * k_72) * t_0^5 - // - (k_72^2 + 2 * k_70 * k_60 + 2 * k_71 * k_73) * t_0^4 - // - 2 * (k_71 * k_60 + k_72 * k_73) * t_0^3 - // - (k_73^2 + 2 * k_72 * k_60) * t_0^2 - // - 2 * k_73 * k_60 * t_0 - // - k_60^2 + // (k_46^2 * t_0^6 + // + 2 * k_46 * k_47 * t_0^5 + // + k_47^2 * t_0^4 + 2 * k_46 * k_48 * t_0^4 + // + 2 * k_46 * k_49 * t_0^3 + 2 * k_47 * k_48 * t_0^3 + // + k_48^2 * t_0^2 + 2 * k_47 * k_49 * t_0^2 + // + 2 * k_48 * k_49 * t_0 + // + k_49^2 + // ) * (k_37 * t_0^4 + k_75 * t_0^3 + k_76 * t_0^2 + k_77 * t_0 + k_59) + // - k_70^2 * t_0^10 + // - 2 * k_70 * k_71 * t_0^9 + // - (k_71^2 + 2 * k_70 * k_72) * t_0^8 + // - 2 * (k_70 * k_73 + k_71 * k_72) * t_0^7 + // - (k_72^2 + 2 * k_70 * k_74 + 2 * k_71 * k_73) * t_0^6 + // - 2 * (k_70 * k_61 + k_71 * k_74 + k_72 * k_73) * t_0^5 + // - (k_73^2 + 2 * k_71 * k_61 + 2 * k_72 * k_74) * t_0^4 + // - 2 * (k_72 * k_61 + k_73 * k_74) * t_0^3 + // - (k_74^2 + 2 * k_73 * k_61) * t_0^2 + // - 2 * k_74 * k_61 * t_0 + // - k_61^2 // 0 = ak_10 * t_0^10 + ak_9 * t_0^9 + ak_8 * t_0^8 + ak_7 * t_0^7 + ak_6 * t_0^6 + ak_5 * t_0^5 + ak_4 * t_0^4 + ak_3 * t_0^3 + ak_2 * t_0^2 + ak_1 * t_0 + ak_0 - //k[74] := k[45] * k[45]; - //k[75] := 2 * k[45] * k[46]; - //k[76] := k[46] * k[46] + 2 * k[45] * k[47]; - //k[77] := 2 * (k[45] * k[48] + k[46] * k[47]); - //k[78] := k[47] * k[47] + 2 * k[46] * k[48]; - //k[79] := 2 * k[47] * k[48]; - //k[80] := k[48] * k[48]; - //ak[0] := k[58] * k[80] - k[60] * k[60]; - //ak[1] := k[134] * k[80] + k[58] * k[79] - 2 * k[73] * k[60]; - //ak[2] := k[133] * k[80] + k[134] * k[79] + k[58] * k[78] - k[73] * k[73] - 2 * k[72] * k[60]; - //ak[3] := k[133] * k[79] + k[134] * k[78] + k[58] * k[77] + k[132] * k[80] - // - 2 * (k[71] * k[60] + k[72] * k[73]); - //ak[4] := k[31] * k[80] + k[133] * k[78] + k[134] * k[77] + k[58] * k[76] + k[132] * k[79] - k[72] * k[72] - // - 2 * (k[70] * k[60] + k[71] * k[73]); - //ak[5] := k[31] * k[79] + k[133] * k[77] + k[134] * k[76] + k[58] * k[75] + k[132] * k[78] - // - 2 * (k[69] * k[60] + k[70] * k[73] + k[71] * k[72]); - //ak[6] := k[31] * k[78] + k[133] * k[76] + k[134] * k[75] + k[58] * k[74] + k[132] * k[77] - k[71] * k[71] - // - 2 * (k[69] * k[73] + k[70] * k[72]); - //ak[7] := k[31] * k[77] + k[133] * k[75] + k[134] * k[74] + k[132] * k[76] - 2 * (k[69] * k[72] + k[70] * k[71]); - //ak[8] := k[31] * k[76] + k[132] * k[75] + k[133] * k[74] - k[70] * k[70] - 2 * k[69] * k[71]; - //ak[9] := k[31] * k[75] + k[132] * k[74] - 2 * k[69] * k[70]; - //ak[10] := k[31] * k[74] - k[69] * k[69]; + //k[78] := k[46] * k[46]; + //k[79] := 2 * k[46] * k[47]; + //k[80] := k[47] * k[47] + 2 * k[46] * k[48]; + //k[81] := 2 * (k[46] * k[49] + k[47] * k[48]); + //k[82] := k[48] * k[48] + 2 * k[47] * k[49]; + //k[83] := 2 * k[48] * k[49]; + //k[84] := k[49] * k[49]; + //ak[0] := k[59] * k[84] - k[61] * k[61]; + //ak[1] := k[77] * k[84] + k[59] * k[83] - 2 * k[74] * k[61]; + //ak[2] := k[76] * k[84] + k[77] * k[83] + k[59] * k[82] - k[74] * k[74] - 2 * k[73] * k[61]; + //ak[3] := k[76] * k[83] + k[77] * k[82] + k[59] * k[81] + k[75] * k[84] + // - 2 * (k[72] * k[61] + k[73] * k[74]); + //ak[4] := k[37] * k[84] + k[76] * k[82] + k[77] * k[81] + k[59] * k[80] + k[75] * k[83] - k[73] * k[73] + // - 2 * (k[71] * k[61] + k[72] * k[74]); + //ak[5] := k[37] * k[83] + k[76] * k[81] + k[77] * k[80] + k[59] * k[79] + k[75] * k[82] + // - 2 * (k[70] * k[61] + k[71] * k[74] + k[72] * k[73]); + //ak[6] := k[37] * k[82] + k[76] * k[80] + k[77] * k[79] + k[59] * k[78] + k[75] * k[81] - k[72] * k[72] + // - 2 * (k[70] * k[74] + k[71] * k[73]); + //ak[7] := k[37] * k[81] + k[76] * k[79] + k[77] * k[78] + k[75] * k[80] - 2 * (k[70] * k[73] + k[71] * k[72]); + //ak[8] := k[37] * k[80] + k[75] * k[79] + k[76] * k[78] - k[71] * k[71] - 2 * k[70] * k[72]; + //ak[9] := k[37] * k[79] + k[75] * k[78] - 2 * k[70] * k[71]; + //ak[10] := k[37] * k[78] - k[70] * k[70]; end; function TNeverTellMeTheOdds.CalcRockThrowCollisionOptions(constref AHailstone0, AHailstone1, AHailstone2: THailstone):