Recent

Author Topic: Pascal  (Read 2839 times)

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: Pascal
« Reply #15 on: October 27, 2020, 12:23:16 pm »
All it rests now is to find some useful application for such a class  :D

Other than passing a grade, of course 8-)
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

cdbc

  • Hero Member
  • *****
  • Posts: 1025
    • http://www.cdbc.dk
Re: Pascal
« Reply #16 on: October 27, 2020, 03:38:15 pm »
Hi
@Bart: ...so you couldn't resist  ;D
Cool, good on you mate, me likey  ;)
I had a good laugh, thank you  ;)
Regards Benny
If it ain't broke, don't fix it ;)
PCLinuxOS(rolling release) 64bit -> KDE5 -> FPC 3.2.2 -> Lazarus 2.2.6 up until Jan 2024 from then on it's: KDE5/QT5 -> FPC 3.3.1 -> Lazarus 3.0

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Pascal
« Reply #17 on: October 27, 2020, 05:46:54 pm »
All it rests now is to find some useful application for such a class  :D

Well, of course the applicaton should be able to set some properties (IncorrectnessFraction and IncorrectnessMargin) of that class.
So, it needs to handle options on the commandline.
Yet another excercise for TS (or me, if I'm bored).

Bart

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Pascal
« Reply #18 on: October 27, 2020, 06:35:35 pm »
Yet another excercise for TS (or me, if I'm bored).

Seems I'm bored.
New and improved version:
Code: Pascal  [Select][+][-]
  1. {$Mode ObjFpc}
  2. {$H-} //no longstrings needed for this job
  3. uses
  4.   SysUtils, Classes;
  5.  
  6. type
  7.  
  8.   { TPseudoRandomMultiplicator }
  9.  
  10.   TPseudoRandomMultiplicator = class
  11.   strict private
  12.     FFirstNumber: integer;
  13.     FSecondNumber: integer;
  14.     FIncorrectnessFraction: Double;
  15.     FIncorrectnessMargin: Integer;
  16.   private
  17.     function CalculateResult: Int64;
  18.     function CheckAdditionOverflow(ALeft, ARight: Int64): Boolean;
  19.     function GetOffset(ARelativeTo: Int64): Integer;
  20.     function GetFirstNumber: Integer;
  21.     function GetIncorrectnessFraction: Double;
  22.     function GetIncorrectnessMargin: Integer;
  23.     function GetMultiplicationResult: Int64;
  24.     function GetSecondNumber: Integer;
  25.     procedure SetFirstNumber(AValue: Integer);
  26.     procedure SetIncorrectnessFraction(AValue: Double);
  27.     procedure SetIncorrectnessMargin(AValue: Integer);
  28.     procedure SetSecondNumber(AValue: Integer);
  29.   public
  30.     class function DefaultIncorrectnessFraction: Double;
  31.     class function DefaultIncorrectnessMargin: Integer;
  32.   public
  33.     constructor Create;
  34.     property FirstNumber: Integer read GetFirstNumber write SetFirstNumber;
  35.     property SecondNumber: Integer read GetSecondNumber write SetSecondNumber;
  36.     property IncorrectnessFraction: Double read GetIncorrectnessFraction write SetIncorrectnessFraction;
  37.     property IncorrectnessMargin: Integer read GetIncorrectnessMargin write SetIncorrectnessMargin;
  38.     property MultiplicationResult: Int64 read GetMultiplicationResult;
  39.   end;
  40.  
  41. { TPseudoRandomMultiplicator }
  42.  
  43. function TPseudoRandomMultiplicator.CalculateResult: Int64;
  44. var
  45.   Offset: Integer;
  46.   TempResult: Int64;
  47. begin
  48.   Result := Int64(FirstNumber) * Int64(SecondNumber);
  49.   if (Random < IncorrectnessFraction) then
  50.   begin
  51.     Offset := GetOffset(Result);
  52.     if CheckAdditionOverflow(Result, Offset) then
  53.       Offset := -Offset;
  54.     TempResult := Result + Offset;
  55.     // sign should always be correct, so errors aren't that obvious
  56.     if ((TempResult < 0) and (Result > 0)) or
  57.        ((TempResult > 0) and (Result < 0)) then
  58.        TempResult := -TempResult;
  59.     // if none of the operands is zero, the answer cannot be zero
  60.     if (TempResult = 0) and (Result <> 0) then
  61.     begin
  62.       if (Result > 0) then
  63.       begin
  64.         repeat
  65.           Inc(TempResult)
  66.         until (TempResult <> Result);
  67.       end
  68.       else
  69.       begin
  70.         repeat
  71.           Dec(TempResult)
  72.         until (TempResult <> Result);
  73.       end;
  74.     end;
  75.     Result := TempResult;
  76.   end;
  77. end;
  78.  
  79. function TPseudoRandomMultiplicator.CheckAdditionOverflow(ALeft, ARight: Int64): Boolean;
  80. begin
  81.   if ((ALeft >= 0) and (ARight <= 0)) or
  82.      ((ALeft <= 0) and (ARight >= 0)) then
  83.      Result := False
  84.   else
  85.   begin
  86.     if (ALeft < 0) and (ARight < 0) then
  87.     begin
  88.       Result := (Low(Int64) - ALeft) >= ARight;
  89.     end
  90.     else
  91.     begin
  92.       Result := (High(Int64) - ALeft) >= ARight;
  93.     end;
  94.   end;
  95. end;
  96.  
  97. function TPseudoRandomMultiplicator.GetOffset(ARelativeTo: Int64): Integer;
  98. begin
  99.   if (Abs(ARelativeTo) > Abs(IncorrectnessMargin)) then
  100.     Result := Random(IncorrectnessMargin) + 1
  101.   else
  102.     Result := Random(3) + 1;
  103.   if (Odd(ARelativeTo) and not Odd(Result)) or
  104.      (Odd(Result) and not Odd(ARelativeTo)) then
  105.      Dec(Result);
  106.   if (Result = 0) then
  107.     Inc(Result, 2);
  108.   if (Random < 0.5) then
  109.     Result := -Result;
  110. end;
  111.  
  112. function TPseudoRandomMultiplicator.GetFirstNumber: Integer;
  113. begin
  114.   Result := FFirstNumber;
  115. end;
  116.  
  117. function TPseudoRandomMultiplicator.GetIncorrectnessFraction: Double;
  118. begin
  119.   Result :=  FIncorrectnessFraction;
  120. end;
  121.  
  122. function TPseudoRandomMultiplicator.GetIncorrectnessMargin: Integer;
  123. begin
  124.   Result := FIncorrectnessMargin;
  125. end;
  126.  
  127. function TPseudoRandomMultiplicator.GetMultiplicationResult: Int64;
  128. begin
  129.   Result := CalculateResult;
  130. end;
  131.  
  132. function TPseudoRandomMultiplicator.GetSecondNumber: Integer;
  133. begin
  134.   Result := FSecondNumber;
  135. end;
  136.  
  137. procedure TPseudoRandomMultiplicator.SetFirstNumber(AValue: Integer);
  138. begin
  139.   if (FirstNumber <> AValue) then
  140.     FFirstNumber := AValue;
  141. end;
  142.  
  143. procedure TPseudoRandomMultiplicator.SetIncorrectnessFraction(AValue: Double);
  144. begin
  145.   AValue := Abs(AValue);
  146.   if (IncorrectnessFraction <> AValue) and (AValue < 1.0) then
  147.     FIncorrectnessFraction := AValue;
  148. end;
  149.  
  150. procedure TPseudoRandomMultiplicator.SetIncorrectnessMargin(AValue: Integer);
  151. begin
  152.   AValue := Abs(AValue);
  153.   if (IncorrectnessMargin <> AValue) and (AValue > 0) then
  154.     FIncorrectnessMargin := AValue;
  155. end;
  156.  
  157. procedure TPseudoRandomMultiplicator.SetSecondNumber(AValue: Integer);
  158. begin
  159.   if (SecondNumber <> AValue) then
  160.     FSecondNumber := AValue;
  161. end;
  162.  
  163. class function TPseudoRandomMultiplicator.DefaultIncorrectnessFraction: Double;
  164. begin
  165.   Result := 0.5;
  166. end;
  167.  
  168. class function TPseudoRandomMultiplicator.DefaultIncorrectnessMargin: Integer;
  169. begin
  170.   Result := 50;
  171. end;
  172.  
  173. constructor TPseudoRandomMultiplicator.Create;
  174. begin
  175.   FFirstNumber := 0;
  176.   FSecondNumber := 0;
  177.   FIncorrectnessFraction := 0.5;//DefaultIncorrectnessFraction;
  178.   FIncorrectnessMargin := 50;//DefaultIncorrectnessMargin;
  179. end;
  180.  
  181.  
  182. function AskNumber(IsFirst: Boolean): Integer;
  183. const
  184.   FirstOrSecond: Array[Boolean] of String = ('second','first');
  185. var
  186.   S: String;
  187.   ErrorCode: Integer;
  188. begin
  189.   repeat
  190.     write('Enter ',FirstOrSecond[IsFirst],' number');
  191.     if IsFirst then
  192.       write (' ');
  193.     write(': ');
  194.     readln(S);
  195.     if (CompareText(S,'MaxInt') = 0) then
  196.     begin
  197.       Result := MaxInt;
  198.       ErrorCode := 0;
  199.     end
  200.     else
  201.     begin
  202.       if (CompareText(S,'LowInt') = 0) then
  203.       begin
  204.         Result := Low(Integer);
  205.         ErrorCode := 0;
  206.       end
  207.       else
  208.       begin
  209.       Val(S, Result, ErrorCode);
  210.       if (ErrorCode <> 0) then
  211.         writeln('Invalid number: "',S,'", please try again.');
  212.       end;
  213.     end;
  214.   until (ErrorCode = 0);
  215. end;
  216.  
  217. const
  218.   FractionOpt = '--IncorrectnessFraction';
  219.   MarginOpt = '--IncorrectnessMargin';
  220.  
  221. procedure GetOptions(out AIncorrectnessFraction: Double; out AIncorrectnessMargin: Integer);
  222. var
  223.   ErrorCode, i: Integer;
  224.   S: String;
  225. begin
  226.   AIncorrectnessFraction :=  TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
  227.   AIncorrectnessMargin :=  TPseudoRandomMultiplicator.DefaultIncorrectnessMargin;
  228.   for i := 1 to ParamCount do
  229.   begin
  230.     if (Pos(UpperCase(FractionOpt)+'=', UpperCase(ParamStr(i))) = 1) then
  231.     begin
  232.       S := Copy(ParamStr(i), Length(FractionOpt)+2, MaxInt);
  233.       Val(S, AIncorrectnessFraction, ErrorCode);
  234.       if (ErrorCode = 0) then
  235.       begin
  236.         AIncorrectnessFraction := Abs(AIncorrectnessFraction);
  237.         if (AIncorrectnessFraction >= 1.0) then
  238.           AIncorrectnessFraction := TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
  239.       end
  240.       else
  241.         AIncorrectnessFraction := TPseudoRandomMultiplicator.DefaultIncorrectnessFraction;
  242.     end;
  243.     if (Pos(UpperCase(MarginOpt)+'=', UpperCase(ParamStr(i))) = 1) then
  244.     begin
  245.       S := Copy(ParamStr(i), Length(MarginOpt)+2, MaxInt);
  246.       Val(S, AIncorrectnessMargin, ErrorCode);
  247.       if (ErrorCode <> 0) then
  248.         AIncorrectnessMargin :=  TPseudoRandomMultiplicator.DefaultIncorrectnessMargin;
  249.     end;
  250.   end;
  251. end;
  252.  
  253. var
  254.   PseudoRandomMultiplicator: TPseudoRandomMultiplicator;
  255.   PreferredIncorrectnessFraction: Double;
  256.   PreferredIncorrectnessMargin: Integer;
  257.  
  258. begin
  259.   Randomize;
  260.   GetOptions(PreferredIncorrectnessFraction, PreferredIncorrectnessMargin);
  261.   repeat
  262.     try
  263.       PseudoRandomMultiplicator := TPseudoRandomMultiplicator.Create;
  264.       PseudoRandomMultiplicator.IncorrectnessFraction := PreferredIncorrectnessFraction;
  265.       PseudoRandomMultiplicator.IncorrectnessMargin := PreferredIncorrectnessMargin;
  266.       PseudoRandomMultiplicator.FirstNumber := AskNumber(True);
  267.       PseudoRandomMultiplicator.SecondNumber := AskNumber(False);
  268.       if (PseudoRandomMultiplicator.FirstNumber <> 0) and (PseudoRandomMultiplicator.SecondNumber <> 0) then
  269.       begin
  270.         try
  271.         writeln('Multiplying ',PseudoRandomMultiplicator.FirstNumber,' by ',PseudoRandomMultiplicator.SecondNumber,' gives ',PseudoRandomMultiplicator.MultiplicationResult);
  272.         except
  273.           on E: Exception do
  274.           begin
  275.             writeln('There was an error in the multiplication process:');
  276.             writeln(E.ClassName,': ',E.Message);
  277.           end;
  278.         end;
  279.         writeln;
  280.       end;
  281.     finally
  282.       PseudoRandomMultiplicator.Free;
  283.     end;
  284.   until (PseudoRandomMultiplicator.FirstNumber = 0) and (PseudoRandomMultiplicator.SecondNumber = 0);
  285.   writeln('Bye.');
  286. end.

Bart

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: Pascal
« Reply #19 on: October 27, 2020, 06:55:44 pm »
I meant "usefull application" as in "doing something useful with it" or "some knowledge field where it might come in handy", not as in "some program that uses it". ;D
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

Bart

  • Hero Member
  • *****
  • Posts: 5275
    • Bart en Mariska's Webstek
Re: Pascal
« Reply #20 on: October 27, 2020, 10:30:42 pm »
I meant "usefull application" as in "doing something useful with it" or "some knowledge field where it might come in handy", not as in "some program that uses it". ;D

Of course, I got that.
It's just that I realized the program as such wasn't finisshed, so my next lines really were a reaction to the first part of that sentence: "All it rests now", meaning to state that "to find some useful application for such a class" wasn't the only thing left to do.
(Are you still with me?)

There are still things to do to make it more "enterprisy".
It definitively needs a factory and probably it needs an interface.
Also it's pedgree should be something like TObject->TCustomAbstractPseudoRandomMultiplicator->TCustomPseudoRandomMultiplicator->TPseudoRandomMultiplicator.
And logging is a must also then.

Finding a usecase for this class, might be kind of a challenge though  O:-)

Bart

 

TinyPortal © 2005-2018