DECLARE SUB epsylon ()
DECLARE SUB pseurnd ()
DECLARE SUB random1 ()
DECLARE SUB xpos ()
DECLARE SUB ypos ()
DECLARE SUB vuldicht ()
DECLARE SUB Titel ()
COMMON SHARED nx%, ny%, dd, eps%, nt%, nn
COMMON SHARED x%(), y%(), z%(), tel%()

RANDOMIZE TIMER
SCREEN 12
Titel

Nog:
CLS
COLOR 11
PRINT "    RANDOM verdeling binnen een ruimte."
COLOR 15
PRINT : PRINT : PRINT
PRINT "      -> 1 = willekeurige verdeling"
PRINT "      -> 2 = gelijkmatige verdeling"
PRINT "      -> 3 = omtrent RANDIST"
PRINT "      -> ENTER = Stoppen"
PRINT : PRINT : PRINT : COLOR 11
PLAY "l6b-"
INPUT "      -> Keuze : ", kies$
IF kies$ = "" THEN
PLAY "l12c+egb->d"
END
END IF
IF kies$ <> "1" AND kies$ <> "2" AND kies$ <> "3" GOTO Nog

SELECT CASE kies$

CASE "1"
xpos
ypos
vuldicht
nn = nx% * ny% * dd
IF nn > 32000 THEN
nn = 32000: dd = nn / (nx% * ny%)
PRINT : COLOR 12
PRINT USING ">>> Overflow >>> maximum dichtheid ##.## nemen"; dd
PLAY "o4l12d": SLEEP 2: COLOR 15
CLS
END IF
REDIM z%(nx% * ny%)
REDIM tel%(50)
WINDOW (0, 0)-(nx% + 1, ny% * 1.05)
CLS
COLOR 12
LOCATE 1, 30
PRINT USING "dichth=##.##,  ##### = ### X ### posities"; dd; nx% * ny%; nx%; ny%
COLOR 15
random1
GOTO Nog

CASE "2"
 xpos
 ypos
 epsylon
 xx% = nx% / eps% + nx% MOD eps%     '''max. langs x,
 yy% = ny% / eps% + ny% MOD eps%     '''             y,
 nt% = xx% * yy%                     '''te verwachten max. bezetting
 REDIM x%(nt%), y%(nt%)              '''bezette posities
 CLS
 WINDOW (1, 1)-(nx% + 1, 1 + ny% * 1.05)
 pseurnd
 GOTO Nog

CASE "3"
 Titel
 GOTO Nog

END SELECT

END

SUB epsylon
eps:
PLAY "o4l12d": LOCATE 24, 1
INPUT " -> Kies min. afstand (default=3, 1 tot Nx of Ny) : ", eps%
IF eps% = 0 THEN eps% = 3
IF eps% > nx% OR eps% > ny% OR eps% < 0 THEN
LOCATE 20, 1
PRINT "                                                                    "
PLAY "o4l12d"
GOTO eps
END IF
END SUB

SUB pseurnd
LOCATE 1, 1: COLOR 14:
PRINT USING "Plaatsen:##### /Afstand:## /Max.:##### /Bezet:#####"; nx% * ny%; eps%; nt%; i%

 FOR i% = 1 TO nt%
worp2:
 x% = 1 + RND * (nx% - 1)
 y% = 1 + RND * (ny% - 1)
 IF i% = 1 THEN GOTO verder
 FOR j% = 1 TO i% - 1
 IF ABS(x% - x%(j%)) < eps% AND ABS(y% - y%(j%)) < eps% THEN
 tel1% = tel1% + 1
IF tel1% > 100 GOTO opvullen
 LOCATE 1, 60: COLOR 3: PRINT USING "Worp:###"; tel1%: COLOR 15
 GOTO worp2
 END IF
 NEXT j%

verder:
 tel% = tel% + 1
 x%(i%) = x%: y%(i%) = y%
 tel1% = 0

teken:
LOCATE 1, 47: COLOR 14: PRINT USING "#####"; i%: COLOR 15
LINE (x%, y%)-(x% + 1, y% + 1), , BF

volg:
IF INKEY$ <> "" THEN PRINT "STOP": END
NEXT i%

opvullen:                     '''gaten zoeken en vullen
 tel1% = 0
 i% = i% - 1
 ii% = i%
 LOCATE 1, 60:  COLOR 3: PRINT "Opvullen...": COLOR 15
PLAY "o4l12d"
FOR y% = 1 TO ny%
FOR x% = 1 TO nx%
 FOR j% = 1 TO i%
 IF ABS(x% - x%(j%)) < eps% AND ABS(y% - y%(j%)) < eps% GOTO volg2
 NEXT j%
i% = i% + 1
IF i% > nt% THEN i% = nt%: GOTO statist2
 x%(i%) = x%: y%(i%) = y%
 tel1% = tel1% + 1

teken2:
PLAY "o4l12d"
LOCATE 1, 47: COLOR 14: PRINT USING "#####"; i%: COLOR 15
LOCATE 1, 60:  COLOR 3: PRINT USING "Opvullen: ####"; tel1%: COLOR 15
LINE (x%, y%)-(x% + 1, y% + 1), 3, BF

volg2:
 NEXT x%
 NEXT y%

statist2:
LOCATE 1, 60: COLOR 11: PRINT "-> Toets...     "
PLAY "o2l6a>l12fedc+"
SLEEP: a$ = INKEY$
CLS
PRINT USING "Vulstatistiek van de ##### bezettingen"; i%
PRINT : PRINT : COLOR 15
PRINT "                 Aantal posities : "; nx% * ny%
PRINT "                gewenste afstand : "; eps%
PRINT "                  max. bezetting : "; nt%
PRINT "werkelijke bezetting door worpen : "; ii%
PRINT "         bezetting door opvullen : "; i% - ii%
PRINT "        totaal bekomen bezetting : "; i%
PRINT "             equivalente afstand : "; SQR(nx% * ny% / ii%)
PRINT : PRINT : PRINT
COLOR 11: PRINT " -> Toets..."
COLOR 15
PLAY "l6d<a"
SLEEP: a$ = INKEY$

END SUB

SUB random1
FOR i% = 0 TO nn
testx% = INT(RND * nx%): testy% = INT(RND * ny%)
COLOR 14: LOCATE 1, 1: PRINT i%: COLOR 15
LINE (testx%, testy%)-(testx% + 1, testy% + 1), , BF
test% = testy% * nx% + testx%
z%(test%) = z%(test%) + 1
NEXT i%

FOR i% = 0 TO nx% * ny%
tel%(z%(i%)) = tel%(z%(i%)) + 1
NEXT i%

COLOR 11: LOCATE 1, 15: PRINT "-> Toets...": COLOR 15
PLAY "o2l6a>l12fedc+"
SLEEP: a$ = INKEY$
CLS : COLOR 11
PRINT USING "Vulstatistiek van de ##### posities (##### worpen)"; nx% * ny%; nx% * ny% * dd
PRINT : PRINT : COLOR 15
FOR i% = 0 TO 20
PRINT USING "##.# percent ####  maal geselecteerd"; tel%(i%) / (.01 * nx% * ny%); i%
NEXT i%
PRINT : PRINT : PRINT
COLOR 11: PRINT " -> Toets..."
COLOR 15
PLAY "l6d<a"
SLEEP: a$ = INKEY$
END SUB

SUB Titel
CLS
COLOR 11
PRINT "    RANDOM verdeling binnen een ruimte.        (1/3) -> Toets..."
COLOR 15
PRINT : PRINT : PRINT
PRINT "Is een willekeurige verdeling van materie in de ruimte gelijkmatig?"
PRINT "Is een gelijkmatige verdeling willekeurig?"
PRINT
PRINT "In dit programma maakt u kennis met twee soorten verdeling, beide"
PRINT "kennelijk willekeurig."
PRINT "Onze ruimte in kwestie beslaat een veld van (x,y) posities, "
PRINT "aantal vooraf te bepalen. Elke worp (x,y) is volledig willekeurig."
PRINT
PRINT "De eerste verdeling accepteert elke worp. Het gevolg is dat bepaalde"
PRINT "posities meermaals bezet kunnen worden (wat met materie niet het geval is)."
PRINT "Andere posities kunnen leeg blijven. Het resultaat kan nogal verschillen"
PRINT "naargelang de verhouding tussen het aantal 'worpen' en het aantal beschikbare"
PRINT "plaatsen. "
PRINT
PRINT "De tweede verdeling accepteert slechts worpen die een gegeven afstand"
PRINT "met de reeds bezette posities respecteren. Hier geen dubbele bezettingen:"
PRINT "het is een deeltjeszwerm waar elk deeltje zegt: afstand houden!"
PRINT
PRINT "Met welke bezetting komt de spreiding van materie in de ruimte het best"
PRINT "overeen? En moeten we dan al dat gezoek naar structuur in de massaverdeling"
PRINT "in het heelal, met clusters en gaten, niet enigszins relativeren?"
LOCATE 28, 1: COLOR 10: PRINT "    Credits: Guido Wuyts 1996"
PLAY "o2l6a>l12fedc+"
COLOR 11
SLEEP: a$ = INKEY$
CLS
COLOR 11
PRINT "    RANDOM verdeling binnen een ruimte.        (2/3) -> Toets..."
COLOR 15: PRINT : PRINT : PRINT
PRINT "    1. Willekeurige verdeling."
PRINT
PRINT "Neem een ruimte van N = Nx.Ny posities, gerangschikt volgens een"
PRINT "x- en een y-richting (Nx en Ny plaatsen)."
PRINT "Bezet plaatsen in deze ruimte met willekeurige worpen (x,y)."
PRINT "Elke worp met gelijke kans."
PRINT
PRINT "Doe N maal D worpen: D = vuldichtheid (verhouding tussen aantal"
PRINT "worpen en aantal beschikbare plaatsen. Vraag u volgende zaken af:"
PRINT
PRINT " -> hoeveel percent plaatsen wordt 1, 2, 3... maal geselecteerd?"
PRINT " -> hoeveel percent plaatsen wordt niet geselecteerd?"
PRINT " -> vanaf ongeveer welke dichtheid D praktisch volledige vulling?"
PRINT
PRINT " Merk voor kleinere dichtheden pseudostructuren op in de vorm van"
PRINT " clusters, voor grotere in de vorm van gaten: een random-verdeling"
PRINT " betekent Niet een regelmatige spreiding! Overigens is dit een"
PRINT " fractale eigenschap die geldt voor alle schalen waarin materie"
PRINT " geacht wordt zich te kunnen verdelen: nevels, galaxie‰n,"
PRINT " clusters, superclusters,..."
LOCATE 28, 1: COLOR 10: PRINT "    Credits: Guido Wuyts 1996"
PLAY "l6d"
SLEEP: a$ = INKEY$
CLS
COLOR 11
PRINT "    RANDOM verdeling binnen een ruimte.        (3/3) -> Toets..."
COLOR 15: PRINT : PRINT : PRINT
PRINT "    2. Gelijkmatige verdeling."
PRINT
PRINT "Dezelfde ruimte van Nx.Ny = N posities. Alle worpen (x,y) eveneens"
PRINT "willekeurig. Ditmaal echter aanvaarden we enkel bezetting van (x,y)"
PRINT "indien de afstand tot alle vorige bezettingen niet onder een gekozen"
PRINT "minimum ligt. Zoniet wordt de worp afgekeurd en een volgende worp gedaan."
PRINT
PRINT "Zodra het aantal 'vergeefse' worpen voor een bezetting boven honderd"
PRINT "uitkomt, is de bezettingsdichtheid al zo groot dat de kans op een"
PRINT "willekeurige, maar 'goede' worp snel afneemt. In deze faze veranderen"
PRINT "we van strategie. We lopen alle posities systematisch af en checken"
PRINT "elkeen op bezetbaarheid. Op deze wijze bereiken we de maximum bezetting"
PRINT "die -nog- mogelijk is na het random begin."
PRINT
PRINT "Meestal bereiken we zo niet de maximaal mogelijke bezetting, gegeven"
PRINT "de minimum afstand: die komt overeen met een regelmatige rooster-"
PRINT "verdeling. Onze gelijkmatige verdeling behoudt dus toch een element"
PRINT "van willekeurigheid. Een statistiekje vergelijkt de vereiste en "
PRINT "gerealiseerde afstand, en overeenkomstige aantallen bezettingen."
LOCATE 28, 1: COLOR 10: PRINT "    Credits: Guido Wuyts 1996"
PLAY "<l6a"
SLEEP: a$ = INKEY$


END SUB

SUB vuldicht
vul:
PLAY "o4l12d": LOCATE 24, 1
INPUT " -> Kies vuldichtheid (default=.25, 0+ tot 10) : ", dd
IF dd = 0 THEN dd = .25
IF dd < 0 OR dd > 10 THEN
LOCATE 24, 1
PRINT "                                                                    "
PLAY "o4l12d"
GOTO vul
END IF
END SUB

SUB xpos
xpos:
PLAY "o4l12d": LOCATE 20, 1
INPUT " -> Kies aantal x-posities (default=65, 10 tot 200) : ", nx%
IF nx% = 0 THEN nx% = 65
IF nx% < 10 OR nx% > 200 THEN
LOCATE 20, 1
PRINT "                                                                    "
PLAY "o4l12d"
GOTO xpos
END IF
END SUB

SUB ypos
ypos:
PLAY "o4l12d": LOCATE 22, 1
INPUT " -> Kies aantal y-posities (default=40, 5 tot 150) : ", ny%
IF ny% = 0 THEN ny% = 40
IF ny% < 5 OR ny% > 150 THEN
LOCATE 22, 1
PRINT "                                                                    "
PLAY "o4l12d"
GOTO ypos
END IF
END SUB