RandomWeight

[bplus]

Say you want a random number in a range between 2 values and you want one end of that range to be returned many more times than from the other end. Call the value on the many side the manyValue and the value on the few side the fewValue and power to increase the weight to the manyValue side. randWeight is a simple little function that will do this as tested and demo'd here:

Code: QB64: [Select]

1. RANDOMIZE TIMER
2. SCREEN _NEWIMAGE(800, 720, 32)
3. _SCREENMOVE 100, 20
4. minN = 40
5. maxN = 10
6. IF minN > maxN THEN
7.     fini = minN: start = maxN
8. ELSE
9.     fini = maxN: start = minN
10. END IF
11. DIM c(start TO fini)
12. FOR i = 1 TO 10000
13.     t = randWeight(maxN, minN, 2)
14.     'PRINT t; ", ";
15.     c(t) = c(t) + 1
16. NEXT
17. PRINT "For 10000 tests here is the frequency distribution for randWeight("; maxN; ","; minN; ", 2) "
18. FOR i = start TO fini
19.     PRINT i, c(i)
20. NEXT
21. PRINT "Press any to see graphic with boxes: width weighted on short side, height on high side."
22. PRINT " So that generally the boxes will be mostly longer than wide."
23. SLEEP
24.  
25. FOR p = 1 TO 5
26.     cnt = 0
27.     CLS
28.     FOR i = 1 TO 100
29.         w = randWeight(maxN, minN, p): h = randWeight(minN, maxN, p) '<<<<<<<< see what happens as you play the power parameter
30.         IF w > h THEN
31.             c~& = &HFFFF0000
32.         ELSE
33.             c~& = &HFF0000FF: cnt = cnt + 1
34.         END IF
35.         LINE (780 * RND, 690 * RND)-STEP(w, h), c~&, B
36.     NEXT
37.     PRINT "For power ="; p; " there are:"; cnt; " blue boxes out of 100 that are longer than wide."
38.     _DELAY 3
39. NEXT
40.  
41. PRINT "another Demo press any to cont..."
42. horizon = .35 * _HEIGHT
43. FOR i = 0 TO horizon
44.     LINE (0, i)-(_WIDTH, i), _RGB(0, 0, .25 * i + 100)
45. NEXT
46. FOR i = horizon TO _HEIGHT
47.     LINE (0, i)-(_WIDTH, i), _RGB(0, 255 - .25 * i - 50, 0)
48. NEXT
49. FOR i = 1 TO 1000
50.     y = randWeight(horizon, _HEIGHT, 5)
51.     CIRCLE (_WIDTH * RND, y), y * .003, _RGB(255, 255, 0)
52. NEXT
53.  
54.  
55. FUNCTION randWeight (manyValue, fewValue, power)
56.     randWeight = manyValue + RND ^ power * (fewValue - manyValue)
57. END FUNCTION
58.  

[bplus]

And here is Matrix Rain #4 using randWeight to assign many smaller size drops with fewer large drops for better 3d effect plus an improvement in transparent background of letters that I don't think my last version of Matrix Rain had... whatever, I like the look much better than Matrix Rain #3.

Code: QB64: [Select]

1. _TITLE "Matrix Rain 4" 'B+ started 2019-03-16
2. ' from Matrix Rain 2019-03-14
3. ' or QB64 Purple Rain!
4.  
5. '>>> Save this file as: Matrix Rain 4.bas, so the program can load the strings from it.  <<<
6.  
7. '2019-03-15 This will attempt to spin the drops as they fall
8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
10.  
11. '2019-03-19 Matrix Rain 4
12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
13. ' + draw letters on a transparent background so the background of the letter does not cover
14. '   the drops behind it.
15.  
16.  
17. RANDOMIZE TIMER
18. CONST xmax = 1280
19. CONST ymax = 740
20. CONST nDrops = 500
21. TYPE dropType
22.     x AS SINGLE
23.     sz AS SINGLE
24.     curY AS INTEGER
25.     dxs AS SINGLE 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
26. END TYPE
27.  
28. SCREEN _NEWIMAGE(xmax, ymax, 32)
29. _SCREENMOVE 80, 0 'for snap shot
30. '_FULLSCREEN 'as screen saver
31.  
32. REDIM SHARED fileStrings$(1000) 'container for these program lines that will be dangling
33. OPEN "Matrix Rain 4.bas" FOR INPUT AS #1
34. WHILE NOT EOF(1)
35.     LINE INPUT #1, fs$
36.     IF LEN(LTRIM$(fs$)) <> 0 THEN 'less empty spaces
37.         fileStrings$(i) = LTRIM$(fs$)
38.         i = i + 1
39.     END IF
40. WEND
41. CLOSE #1
42. REDIM _PRESERVE fileStrings$(i - 1)
43. ' check loading
44. 'FOR i = 0 TO UBOUND(fileStrings$)
45. '    PRINT i, fileStrings$(i)
46. 'NEXT
47. 'END
48.  
49. 'setup drops
50. DIM SHARED drop(nDrops) AS dropType
51. DIM SHARED s$(nDrops)
52.  
53. FOR i = 0 TO nDrops
54.     newDrop i, 1
55. NEXT
56.  
57. WHILE _KEYDOWN(27) = 0
58.     CLS
59.     FOR i = 0 TO nDrops
60.         drawDrop (i)
61.         drop(i).curY = drop(i).curY + 1
62.         IF drop(i).curY > LEN(s$(i)) THEN newDrop i, 0
63.     NEXT
64.     _DISPLAY
65.     _LIMIT 25
66. WEND
67.  
68. SUB newDrop (i, start)
69.     drop(i).x = RND * xmax 'set location
70.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
71.     'length of text string can fit on screen
72.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
73.     randLine = INT(RND * UBOUND(fileStrings$)) 'pick a random program line
74.     s$(i) = MID$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
75.     WHILE LEN(s$(i)) < charLength
76.         IF randLine + 1 > UBOUND(fileStrings$) THEN randLine = 0 ELSE randLine = randLine + 1
77.         s$(i) = MID$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
78.     WEND
79.     IF start <> 0 THEN drop(i).curY = INT(RND * (charLength)) + 1 ELSE drop(i).curY = 1 'flat and readable at curY
80.     drop(i).dxs = 1 / (INT(RND * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
81.     IF RND < .5 THEN drop(i).dxs = -drop(i).dxs
82. END SUB
83.  
84. SUB drawDrop (i)
85.     FOR j = 1 TO drop(i).curY
86.         d = drop(i).curY - j
87.         IF d = 0 THEN
88.             c~& = _RGBA32(255, 100, 255, 225)
89.         ELSEIF d = 1 THEN
90.             c~& = _RGBA32(255, 50, 255, 205)
91.         ELSEIF d = 2 THEN
92.             c~& = _RGBA32(255, 25, 255, 180)
93.         ELSEIF d >= 3 THEN
94.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
95.         END IF
96.         rot = 1: dir = -1
97.         FOR k = 0 TO d
98.             rot = rot + drop(i).dxs * dir
99.             IF rot > 1 THEN dir = -1 * dir: rot = 1 + drop(i).dxs * dir
100.             IF rot < -1 THEN dir = dir * -1: rot = -1 + drop(i).dxs * dir
101.         NEXT
102.         drwChar MID$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
103.     NEXT
104. END SUB
105.  
106. SUB drwChar (char$, c AS _UNSIGNED LONG, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
107.     I& = _NEWIMAGE(8, 16, 32)
108.     _DEST I&
109.     COLOR c, _RGBA32(0, 0, 0, 0)
110.     _PRINTSTRING (0, 0), char$
111.     _DEST 0
112.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
113.     _FREEIMAGE I&
114. END SUB
115.  
116. SUB RotoZoom2 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, Rotation AS SINGLE)
117.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
118.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
119.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
120.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
121.     sinr! = SIN(-Rotation): cosr! = COS(-Rotation)
122.     FOR i& = 0 TO 3
123.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
124.         px(i&) = x2&: py(i&) = y2&
125.     NEXT
126.     _MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
127.     _MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
128. END SUB
129.  
130. FUNCTION randWeight (manyValue, fewValue, power)
131.     randWeight = manyValue + RND ^ power * (fewValue - manyValue)
132. END FUNCTION
133.  
134.  

EDIT: remove attachment tag in the code, I wondered where that went. :D

[jack]

nice bplus :)