{$Mode ObjFpc}
{$H-} //no longstrings needed for this job
uses
SysUtils, Classes;
type
{ TPseudoRandomMultiplicator }
TPseudoRandomMultiplicator = class
strict private
FFirstNumber: integer;
FSecondNumber: integer;
FIncorrectnessFraction: Double;
FIncorrectnessMargin: Integer;
private
function CalculateResult: Int64;
function CheckAdditionOverflow(ALeft, ARight: Int64): Boolean;
function GetOffset(ARelativeTo: Int64): Integer;
function GetFirstNumber: Integer;
function GetIncorrectnessFraction: Double;
function GetIncorrectnessMargin: Integer;
function GetMultiplicationResult: Int64;
function GetSecondNumber: Integer;
procedure SetFirstNumber(AValue: Integer);
procedure SetIncorrectnessFraction(AValue: Double);
procedure SetIncorrectnessMargin(AValue: Integer);
procedure SetSecondNumber(AValue: Integer);
public
class function DefaultIncorrectnessFraction: Double;
class function DefaultIncorrectnessMargin: Integer;
public
constructor Create;
property FirstNumber: Integer read GetFirstNumber write SetFirstNumber;
property SecondNumber: Integer read GetSecondNumber write SetSecondNumber;
property IncorrectnessFraction: Double read GetIncorrectnessFraction write SetIncorrectnessFraction;
property IncorrectnessMargin: Integer read GetIncorrectnessMargin write SetIncorrectnessMargin;
property MultiplicationResult: Int64 read GetMultiplicationResult;
end;
{ TPseudoRandomMultiplicator }
function TPseudoRandomMultiplicator.CalculateResult: Int64;
var
Offset: Integer;
TempResult: Int64;
begin
Result := Int64(FirstNumber) * Int64(SecondNumber);
if (Random < IncorrectnessFraction) then
begin
Offset := GetOffset(Result);
if CheckAdditionOverflow(Result, Offset) then
Offset := -Offset;
TempResult := Result + Offset;
// sign should always be correct, so errors aren't that obvious
if ((TempResult < 0) and (Result > 0)) or
((TempResult > 0) and (Result < 0)) then
TempResult := -TempResult;
// if none of the operands is zero, the answer cannot be zero
if (TempResult = 0) and (Result <> 0) then
begin
if (Result > 0) then
begin
repeat
Inc(TempResult)
until (TempResult <> Result);
end
else
begin
repeat
Dec(TempResult)
until (TempResult <> Result);
end;
end;
Result := TempResult;
end;
end;
function TPseudoRandomMultiplicator.CheckAdditionOverflow(ALeft, ARight: Int64): Boolean;
begin
if ((ALeft >= 0) and (ARight <= 0)) or
((ALeft <= 0) and (ARight >= 0)) then
Result := False
else
begin
if (ALeft < 0) and (ARight < 0) then
begin
Result := (Low(Int64) - ALeft) >= ARight;
end
else
begin
Result := (High(Int64) - ALeft) >= ARight;
end;
end;
end;
function TPseudoRandomMultiplicator.GetOffset(ARelativeTo: Int64): Integer;
begin
if (Abs(ARelativeTo) > Abs(IncorrectnessMargin)) then
Result := Random(IncorrectnessMargin) + 1
else
Result := Random(3) + 1;
if (Odd(ARelativeTo) and not Odd(Result)) or
(Odd(Result) and not Odd(ARelativeTo)) then
Dec(Result);
if (Result = 0) then
Inc(Result, 2);
if (Random < 0.5) then
Result := -Result;
end;
function TPseudoRandomMultiplicator.GetFirstNumber: Integer;
begin
Result := FFirstNumber;
end;
function TPseudoRandomMultiplicator.GetIncorrectnessFraction: Double;
begin
Result := FIncorrectnessFraction;
end;
function TPseudoRandomMultiplicator.GetIncorrectnessMargin: Integer;
begin
Result := FIncorrectnessMargin;
end;
function TPseudoRandomMultiplicator.GetMultiplicationResult: Int64;
begin
Result := CalculateResult;
end;
function TPseudoRandomMultiplicator.GetSecondNumber: Integer;
begin
Result := FSecondNumber;
end;
procedure TPseudoRandomMultiplicator.SetFirstNumber(AValue: Integer);
begin
if (FirstNumber <> AValue) then
FFirstNumber := AValue;
end;
procedure TPseudoRandomMultiplicator.SetIncorrectnessFraction(AValue: Double);
begin
AValue := Abs(AValue);
if (IncorrectnessFraction <> AValue) and (AValue < 1.0) then
FIncorrectnessFraction := AValue;
end;
procedure TPseudoRandomMultiplicator.SetIncorrectnessMargin(AValue: Integer);
begin
AValue := Abs(AValue);
if (IncorrectnessMargin <> AValue) and (AValue > 0) then
FIncorrectnessMargin := AValue;
end;
procedure TPseudoRandomMultiplicator.SetSecondNumber(AValue: Integer);
begin
if (SecondNumber <> AValue) then
FSecondNumber := AValue;
end;
class function TPseudoRandomMultiplicator.DefaultIncorrectnessFraction: Double;
begin
Result := 0.5;
end;
class function TPseudoRandomMultiplicator.DefaultIncorrectnessMargin: Integer;
begin
Result := 50;
end;
constructor TPseudoRandomMultiplicator.Create;
begin
FFirstNumber := 0;
FSecondNumber := 0;
FIncorrectnessFraction := 0.5;//DefaultIncorrectnessFraction;
FIncorrectnessMargin := 50;//DefaultIncorrectnessMargin;
end;
function AskNumber(IsFirst: Boolean): Integer;
const
FirstOrSecond: Array[Boolean] of String = ('second','first');
var
S: String;
ErrorCode: Integer;
begin
repeat
write('Enter ',FirstOrSecond[IsFirst],' number');
if IsFirst then
write (' ');
write(': ');
readln(S);
if (CompareText(S,'MaxInt') = 0) then
begin
Result := MaxInt;
ErrorCode := 0;
end
else
begin
if (CompareText(S,'LowInt') = 0) then
begin
Result := Low(Integer);
ErrorCode := 0;
end
else
begin
Val(S, Result, ErrorCode);
if (ErrorCode <> 0) then
writeln('Invalid number: "',S,'", please try again.');
end;
end;
until (ErrorCode = 0);
end;
const
FractionOpt = '--IncorrectnessFraction';
MarginOpt = '--IncorrectnessMargin';
procedure GetOptions(out AIncorrectnessFraction: Double; out AIncorrectnessMargin: Integer);
var
ErrorCode, i: Integer;
S: String;
begin
AIncorrectnessFraction := TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
AIncorrectnessMargin := TPseudoRandomMultiplicator.DefaultIncorrectnessMargin;
for i := 1 to ParamCount do
begin
if (Pos(UpperCase(FractionOpt)+'=', UpperCase(ParamStr(i))) = 1) then
begin
S := Copy(ParamStr(i), Length(FractionOpt)+2, MaxInt);
Val(S, AIncorrectnessFraction, ErrorCode);
if (ErrorCode = 0) then
begin
AIncorrectnessFraction := Abs(AIncorrectnessFraction);
if (AIncorrectnessFraction >= 1.0) then
AIncorrectnessFraction := TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
end
else
AIncorrectnessFraction := TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
end;
if (Pos(UpperCase(MarginOpt)+'=', UpperCase(ParamStr(i))) = 1) then
begin
S := Copy(ParamStr(i), Length(MarginOpt)+2, MaxInt);
Val(S, AIncorrectnessMargin, ErrorCode);
if (ErrorCode <> 0) then
AIncorrectnessMargin := TPseudoRandomMultiplicator.DefaultIncorrectnessMargin;
end;
end;
end;
var
PseudoRandomMultiplicator: TPseudoRandomMultiplicator;
PreferredIncorrectnessFraction: Double;
PreferredIncorrectnessMargin: Integer;
begin
Randomize;
GetOptions(PreferredIncorrectnessFraction, PreferredIncorrectnessMargin);
repeat
try
PseudoRandomMultiplicator := TPseudoRandomMultiplicator.Create;
PseudoRandomMultiplicator.IncorrectnessFraction := PreferredIncorrectnessFraction;
PseudoRandomMultiplicator.IncorrectnessMargin := PreferredIncorrectnessMargin;
PseudoRandomMultiplicator.FirstNumber := AskNumber(True);
PseudoRandomMultiplicator.SecondNumber := AskNumber(False);
if (PseudoRandomMultiplicator.FirstNumber <> 0) and (PseudoRandomMultiplicator.SecondNumber <> 0) then
begin
try
writeln('Multiplying ',PseudoRandomMultiplicator.FirstNumber,' by ',PseudoRandomMultiplicator.SecondNumber,' gives ',PseudoRandomMultiplicator.MultiplicationResult);
except
on E: Exception do
begin
writeln('There was an error in the multiplication process:');
writeln(E.ClassName,': ',E.Message);
end;
end;
writeln;
end;
finally
PseudoRandomMultiplicator.Free;
end;
until (PseudoRandomMultiplicator.FirstNumber = 0) and (PseudoRandomMultiplicator.SecondNumber = 0);
writeln('Bye.');
end.