Advertisement
hpolzer

Middle square method (PRNG)

Mar 31st, 2016
157
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.55 KB | None | 0 0
  1. {
  2.     middle_square_method.pas computes pseudorandom numbers starting with a number
  3.     given at the command line. (Outdated method, for educational purposes only.
  4.     Try 9319 or 12314.) To compile run "fpc middle_square_method.pas".
  5.     Copyright (C) <February 29, 2016> Henning Polzer,
  6.     send comments and error reports to: h underscore polzer at gmx dot de.
  7.  
  8.     This program is free software; you can redistribute it and/or
  9.     modify it under the terms of the GNU General Public License
  10.     as published by the Free Software Foundation; either version 2
  11.     of the License, or (at your option) any later version.
  12.  
  13.     This program is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU General Public License
  19.     along with this program; if not, write to the Free Software
  20.     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  21. }
  22.  
  23. PROGRAM quadratmittengenerator;
  24. CONST obergrenze = 50; { als sichere Abbruchbedingung }
  25. TYPE Tgz = cardinal;    { cardinal von 0 bis 2^32-1, Standard: integer }
  26.  
  27. VAR fehlercode: integer;    { muss als integer vereinbart werden }
  28.     erg, i, z: Tgz;
  29.     verlassen: boolean;
  30.  
  31.  
  32. FUNCTION qmg (zahl: Tgz): Tgz;
  33. VAR diff, links, quadrat: Tgz;
  34.  
  35.   FUNCTION zp (exp: Tgz): Tgz; { Zehnerpotenz berechnen }
  36.   VAR h, i: Tgz;
  37.  
  38.   BEGIN
  39.     h := 1;
  40.     FOR i := 1 TO exp DO
  41.       h := h * 10;
  42.     zp := h
  43.   END; { zp }
  44.  
  45.   FUNCTION stellen (wert: Tgz): Tgz; { Stellenzahl ermitteln }
  46.   BEGIN
  47.     IF z <> 0 THEN stellen := trunc ((abs (ln (wert) / ln (10)))) + 1 ELSE stellen := 1
  48.   END; { stellen }
  49.  
  50. BEGIN { qmg }
  51.   quadrat := zahl * zahl;
  52.   diff := stellen (quadrat) - stellen (zahl);
  53.   links := trunc (diff / 2);
  54.   quadrat := trunc (quadrat / zp (diff - links));
  55.   IF zahl < 4 THEN qmg := 0 ELSE
  56.     qmg := quadrat MOD zp (stellen (quadrat) - links)
  57. END; { qmg }
  58.  
  59.  
  60. BEGIN { Hauptprogramm }
  61.   val (paramstr (1), z, fehlercode);                { Standard: read (z) }
  62.   IF (paramcount = 1) AND (fehlercode = 0) AND (z > 0) THEN { genau eine Zahl > 0 eingeben }
  63.   BEGIN
  64.     i := 1;
  65.     verlassen := false;
  66.     REPEAT
  67.       erg := qmg (z);
  68.       verlassen := erg = z;
  69.       z := erg;
  70.       write (erg, ' ');
  71.       i := i + 1 { Obergrenze sichere Abbruchbedingung }
  72.     UNTIL verlassen OR (erg = 0) OR (i > obergrenze); { Groesse willkuerlich gesetzt }
  73.     writeln
  74.   END ELSE writeln ('Aufruf: qmg eine_zahl_groesser_null')
  75. END.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement