Would you like to make this site your homepage? It's fast and easy...
Yes, Please make this my home page!
COMPAKB (B.A.S.I.C.) Program Code
100 REM =========================================================
110 REM 1MATOP
120 REM =========================================================
130 REM These subroutines deal with single 2-d matrix
140 REM operations. MATRIX PRINT sends matrix data to the
150 REM screen in ordered rows and columns, MATRIX SCALAR
160 REM MULTIPLICATION multiplies each matrix element by
170 REM a constant value, and MATRIX TRANSPOSITION exchanges
180 REM matrix rows and columns.
190 REM =========================================================
200 REM Variable Descriptions
210 REM D: full row counter
220 REM F: flag to print transposed matrix
230 REM M: scalar multiplication factor
240 REM X(n,n): matrix 1 to hold primary & multiplied data
250 REM Y(n,n): matrix 2 to hold transposed data
260 REM J1: loop index, pointer to matrix rows
270 REM J2: loop index, pointer to matrix columns
280 REM K9: subroutine loop index
290 REM L9: subroutine loop index
300 REM =========================================================
310 REM ================== DRIVER PROGRAM =======================
320 REM =========================================================
330 DIM X(8,8),Y(8,8)
340 D = 0
350 F = 0
360 M = 8
370 PRINT "A 2-DIMENTIONAL MATRIX OF SEQUENTIAL NUMBERS --"
380 FOR J1 = 1 TO 8
390 FOR J2 = 1 TO 8
400 X(J1,J2) = J2 + D
410 NEXT J2
420 D = D + 8
430 NEXT J1
440 GOSUB 1000 '<< call matrix print
450 PRINT
460 GOSUB 2010 '<< call matrix scalar multiplication
470 PRINT
480 PRINT "MATRIX MULTIPLIED BY 8 --"
490 GOSUB 1000 '<< call matrix print
500 PRINT
510 GOSUB 3010 '<< call matrix transposition
520 PRINT
530 PRINT "TRANSPOSED MATRIX (ROWS & COLUMNS EXCHANGED) --"
540 GOSUB 1000 '<< call matrix print
550 PRINT
560 GOSUB 4000 '<< call matrix reset
570 PRINT "MATRICES RESET TO ZERO --"
580 GOSUB 1000
590 END
1000 REM ========================================================
1010 REM ******************>> MATRIX PRINT <<********************
1020 REM ========================================================
1030 FOR K9 = 1 TO 8
1040 FOR L9 = 1 TO 8
1050 IF F = 0 THEN PRINT TAB(8*(L9-1))X(K9,L9); ELSE PRINT TAB(8*(L9-1))Y(K9,L9);
1060 NEXT L9
1070 PRINT
1080 NEXT K9
1090 RETURN
2000 REM ========================================================
2010 REM **********>> MATRIX SCALAR MULTIPLICATION <<***********
2020 REM ========================================================
2030 FOR K9 = 1 TO 8
2040 FOR L9 = 1 TO 8
2050 X(K9,L9) = X(K9,L9) * M
2060 NEXT L9
2070 NEXT K9
2080 RETURN
3000 REM ========================================================
3010 REM *************>> MATRIX TRANSPOSITION <<****************
3020 REM ========================================================
3030 FOR K9 = 1 TO 8
3040 FOR L9 = 1 TO 8
3050 Y(K9,L9) = X(L9,K9)
3060 NEXT L9
3070 NEXT K9
3080 F = 1
3090 RETURN
4000 REM ========================================================
4010 REM ********************>> ZEROMAT <<***********************
4020 REM ========================================================
4030 REM This subroutine resets all matrix addresses to 0
4040 REM for further processing, or for initialization if
4050 REM required by your particular system.
4060 REM ========================================================
4070 FOR K9 = 1 TO 8
4080 FOR L9 = 1 TO 8
4090 X(K9,L9) = 0
4100 Y(K9,L9) = 0
4110 NEXT L9
4120 NEXT K9
4130 RETURN
100 REM =========================================================
110 REM 2MATOP
120 REM =========================================================
130 REM These subroutines deal with operations on
140 REM two discrete matrices. MATRIX PRINT sends
150 REM each matrix to the screen, ADD MATRICES
160 REM adds corresponding address contents, and
170 REM MULTIPLY MATRICES multiplies address contents.
180 REM =========================================================
190 REM Variable Descriptions
200 REM
210 REM D: full row counter
220 REM X(n,n): matrix 1
230 REM Y(n,n): matrix 2
240 REM Z(n,n): matrix holding operation result
250 REM J1: driver loop index, pointer to matrix rows
260 REM J2: driver loop index, pointer to matrix columns
270 REM K9: subroutine loop index
280 REM L9: subroutine loop index
290 REM
300 REM =========================================================
310 REM ==================== DRIVER PROGRAM =====================
320 REM =========================================================
330 DIM X(10,10),Y(10,10),Z(10,10)
340 D = 0
350 FOR J1 = 1 TO 10
360 FOR J2 = 1 TO 10
370 X(J1,J2) = J2+D '<< fill with numbers 1-100
380 Y(J1,J2) = J2+D+100 '<< fill with nums 101-200
390 NEXT J2
400 D = D + 10
410 NEXT J1
420 GOSUB 1000 '<< print original matrices
430 PRINT
440 GOSUB 2000 '<< add matrix x to matrix y and print
450 PRINT
460 GOSUB 3000 '<< multiply matrix x by matrix y and print
470 END
1000 REM ========================================================
1010 REM ******************>> MATRIX PRINT <<********************
1020 REM ========================================================
1030 PRINT "MATRIX X --"
1040 FOR K9 = 1 TO 10
1050 FOR L9 = 1 TO 10
1060 PRINT TAB(8*(L9-1))X(K9,L9);
1070 NEXT L9
1080 PRINT
1090 NEXT K9
1100 PRINT
1110 PRINT "MATRIX Y --"
1120 FOR K9 = 1 TO 10
1130 FOR L9 = 1 TO 10
1140 PRINT TAB(8*(L9-1))Y(K9,L9);
1150 NEXT L9
1160 PRINT
1170 NEXT K9
1180 RETURN
2000 REM ========================================================
2010 REM ****************>> ADD MATRICES <<**********************
2020 REM ========================================================
2030 PRINT "THE SUM OF MATRICES X & Y --"
2040 FOR K9 = 1 TO 10
2050 FOR L9 = 1 TO 10
2060 Z(K9,L9) = X(K9,L9) + Y(K9,L9)
2070 PRINT TAB(8*(L9-1))Z(K9,L9);
2080 NEXT L9
2090 PRINT
2100 NEXT K9
2110 RETURN
3000 REM ========================================================
3010 REM ****************>> MULTIPLY MATRICES <<*****************
3020 REM ========================================================
3030 PRINT "THE PRODUCT OF MATRICES X AND Y --"
3040 FOR K9 = 1 TO 10
3050 FOR L9 = 1 TO 10
3060 Z(K9,L9) = X(K9,L9) * Y(K9,L9)
3070 PRINT TAB(8*(L9-1))Z(K9,L9);
3080 NEXT L9
3090 NEXT K9
3100 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
111 REM (Addshufl)
120 REM =========================================================
130 DIM TABLE(20),X(20)
140 TOTAL = 20
150 FOR J = 1 TO TOTAL
160 TABLE(J) = J '<< fill array with number sequence
170 X(J) = J '<< load pointer array
180 NEXT J
190 GOSUB 1000
200 FOR J = 1 TO TOTAL
210 PRINT TABLE(X(J));'<<send randomized table to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM *********************>> ADDSHUFL <<*********************
1020 REM ========================================================
1030 REM This subroutine randomizes (shuffles) a list of
1040 REM pointers to a reference array. The original list
1050 REM of values remains unchanged for future access.
1060 REM Thus, many random reorderings may be accomplished
1070 REM without destroying the original list's prime order.
1080 REM =======================================================
1090 REM Variable Descriptions
1100 REM
1110 REM Entering -
1120 REM TOTAL: number of values in the list
1130 REM X(): array of ordered address pointers
1140 REM Exiting -
1150 REM X(): randomized array of pointers to list
1160 REM Local -
1170 REM R9: random number
1180 REM S9: temporary storage variable
1190 REM K9: loop index, pointer to array X()
1200 REM
1210 REM ========================================================
1220 RANDOMIZE
1230 FOR K9 = 1 TO TOTAL
1240 R9 = INT(RND * TOTAL) + 1
1250 S9 = X(K9)
1260 X(K9) = X(R9)
1270 X(R9) = S9
1280 NEXT K9
1290 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (ALINTSEQ)
130 REM =========================================================
140 DIM INTSET(11),PCLASS(12)
150 TOTAL = 5
160 RANDOMIZE(212)
170 FOR J = 1 TO 11
180 INTSET(J) = (J)
190 NEXT J
200 FOR J = 1 TO TOTAL
210 GOSUB 2000 '<< call interval array shuffler
220 PRINT "RANDOM-ORDER INTERVALCLASS SERIES # ";J ":"
230 FOR J1 = 1 TO 11
240 PRINT INTSET(J1);
250 NEXT J1
260 PRINT
270 GOSUB 1000 '<< call interval to pitchclass mapping
280 PRINT "--- MAPPED TO PITCHCLASS NUMBERS ---"
290 FOR J1 = 0 TO 11
300 PRINT PCLASS(J1);
310 NEXT J1
320 PRINT
330 NEXT J
340 END
1000 REM ========================================================
1010 REM ********************>> ALINTSEQ <<**********************
1020 REM ========================================================
1030 REM This subroutine maps a set of 11 unique intervals
1040 REM (in semitones, size 1-11) to the pitchclasses of
1050 REM the chromatic scale. Although the interval set is
1060 REM non-redundant, there is a high probability that
1070 REM the resultant pitchclass sequence will contain at
1080 REM least one repeated tone, thus producing a 12-note
1090 REM sequence rather than a 12-note series.
1100 REM ========================================================
1110 REM Variable Descriptions
1120 REM Entering -
1130 REM INTSET(): array of unique interval-sizes 1-11
1140 REM Exiting -
1150 REM PCLASS(): pitchclass sequence array
1160 REM Local -
1170 REM K9: loop index, pointer to intset(),PCLASS()
1180 REM ========================================================
1190 PCLASS(0)=0
1200 FOR K9 = 1 TO 11
1210 PCLASS(K9) = (PCLASS(K9-1) + INTSET(K9)) MOD 12
1220 NEXT K9
1230 RETURN
2000 REM ========================================================
2010 REM ********************>> CONSHUFL) <<*********************
2020 REM (adapted to program specs)
2030 REM ========================================================
2040 FOR K9 = 1 TO 11
2050 R9 = INT(RND * 11) + 1
2060 S9 = INTSET(K9)
2070 INTSET(K9) = INTSET(R9)
2080 INTSET(R9) = S9
2090 NEXT K9
2100 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (ALINTSET)
130 REM =========================================================
140 DIM PCLASS(12),PCUM(12),ICUM(12),TEMP(12),ALSET$(10)
150 TOTAL = 10
160 SETCOUNT = 0
170 RANDOMIZE(-1923)
180 FOR J = 1 TO TOTAL
190 PRINT "COMPUTING -- ALL-INTERVAL 12-TONE SET #";J
200 GOSUB 1000
210 IF FLAG = 1 THEN PRINT ALSET$(SETCOUNT)ELSE GOSUB 1000
220 NEXT J
230 END
1000 REM =======================================================
1010 REM ********************>> ALINTSET <<*********************
1020 REM =======================================================
1030 REM This subroutine generates all-interval 12-note
1040 REM series by the sample-test-discard/keep method.
1050 REM Although this "brute force" approach is rather
1060 REM slow, it can produce satisfactory results over
1070 REM short runs. Runs approaching 100 output sets
1080 REM can best be achieved by executing a compiled
1090 REM version of the program.
1100 REM =======================================================
1110 REM Variable Descriptions
1120 REM Entering -
1130 REM none
1140 REM Exiting -
1150 REM PCLASS(): array holding all-interval series
1160 REM Local -
1170 REM PCUM(): array of note redundancy flags
1180 REM ICUM(): array of interval redundancy flags
1190 REM TEMP(): array holding temporary trial series
1200 REM INTSIZE: interval (in 1/2-steps) between notes
1210 REM R9: random integer for test series
1220 REM K9: loop index, pointer to TEMP()
1230 REM L9: loop index, pointer to TEMP(), PCLASS()
1240 REM M9: loop index, pointer to TEMP(), PCLASS()
1250 REM =======================================================
1260 PCLASS(1) = 1 : PCLASS(12) = 7
1270 FOR K9 = 2 TO 11
1280 R9 = INT(RND * 11) + 2
1290 IF R9 = 7 THEN 1280
1300 IF PCUM(R9) = 1 THEN 1280
1310 TEMP(K9) = R9
1320 PCUM(R9) = 1
1330 NEXT K9
1340 FOR L9 = 2 TO 12
1350 FOR M9 = 2 TO 11
1360 IF TEMP(M9) > 0
THEN INTSIZE = TEMP(M9) - PCLASS(L9-1)
ELSE 1390
1370 IF INTSIZE < 0 THEN INTSIZE = 12 + INTSIZE
1380 IF ICUM(INTSIZE) < 1
THEN PCLASS(L9) = TEMP(M9) : TEMP(M9) = 0 : ICUM(INTSIZE) = 1 : GOTO 1410
ELSE 1390
1390 NEXT M9
1400 IF PCLASS(L9) = 0
THEN GOSUB 2000 : GOTO 1200
1410 NEXT L9
1420 GOSUB 3000 : GOSUB 2000
1430 RETURN 210
2000 REM ========================================================
2010 REM *********************>> ZEROMAT <<**********************
2020 REM ========================================================
2030 FOR L9 = 1 TO 12
2040 PCUM(L9) = 0 : ICUM(L9) = 0 : PCLASS(L9) = 0
2050 NEXT L9
2060 RETURN
3000 REM ========================================================
3010 REM ********************>> SETSTORE <<**********************
3020 REM ========================================================
3030 REM This subroutine stores and maintains an identity
3040 REM check on the all-interval series generated by the
3050 REM subroutine ALINTSET. Each output set is converted
3060 REM to a character string, tested against all prev-
3070 REM iously stored sets for uniqueness, then put in
3080 REM an character string array.
3090 REM ========================================================
3100 REM Variable Descriptions
3110 REM Entering -
3120 REM PCLASS(): holds current pitchclass (integer) set
3130 REM Exiting -
3140 REM ALSET$(): string array holding all unique sets
3150 REM SETCOUNT: index of unique all-interval sets
3160 REM FLAG: indicator of set uniqueness
3170 REM Local -
3180 REM L9: loop index, pointer to PCLASS()
3190 REM CURSET$: string buffer holding current set
3200 REM ========================================================
3210 CURSET$ = ""
3220 FOR L9=1 TO 12
3230 CURSET$ = CURSET$ + STR$(PCLASS(L9)-1)
3240 NEXT L9
3250 SETCOUNT = SETCOUNT + 1
3260 FOR L9 = 1 TO SETCOUNT - 1
3270 IF ALSET$(L9) = CURSET$ THEN FLAG = 0 : RETURN
3280 NEXT L9
3290 ALSET$(SETCOUNT)=CURSET$
3300 FLAG = 1
3310 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Alterseq)
130 REM =========================================================
140 DIM X(12),Y(12)
150 RANDOMIZE
160 TOTAL = 12
170 LOW = 22
180 HIGH = 66
190 RANGE = HIGH - LOW + 1
200 INTSIZE = 5
210 PRINT "A RANDOM-ORDER SEQUENCE --"
220 FOR J = 1 TO TOTAL
230 X(J) = INT(RND * RANGE)+ LOW
240 PRINT X(J); '<< send prime sequence to screen
250 NEXT J
260 PRINT : PRINT
270 FOR J = 1 TO 2
280 PRINT "PASS";J
290 PRINT "ALTERATION INTEGER =";INTSIZE"
300 PRINT "ALTERED SEQUENCE --"
310 GOSUB 1000
320 FOR J1 = 1 TO TOTAL
330 PRINT Y(J1); '<< send altered sequence to screen
340 NEXT J1
350 INTSIZE = - 5
360 PRINT
370 NEXT J
380 END
1000 REM ========================================================
1010 REM *********************>> ALTERSEQ <<*********************
1020 REM ========================================================
1030 REM This subroutine alters a value sequence by interval
1040 REM expansion or contraction. Positive integers expand
1050 REM the sequence, negative integers contract it.
1060 REM ========================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM X(): primary value sequence
1100 REM TOTAL: length of sequence
1110 REM INTSIZE: size of alteration interval in units
1120 REM Exiting -
1130 REM X(): primary value sequence
1140 REM Y(): altered value sequence
1150 REM Local -
1160 REM INTDIR: direction of alteration
1170 REM INTVAL: altered interval
1180 REM K9: loop index, pointer to X(),Y()
1190 REM ========================================================
1200 Y(1) = X(1)
1210 FOR K9 = 2 TO TOTAL
1220 IF X(K9) <> X(K9-1)THEN 1230 ELSE Y(K9) = Y(K9-1) : GOTO 1270
1230 INTDIR = SGN(X(K9)-X(K9-1))
1240 INTVAL=ABS(X(K9)-X(K9-1))+INTSIZE
1250 IF INTVAL <1 THEN INTVAL = 1
1260 Y(K9)=Y(K9-1)+INTDIR * INTVAL
1270 NEXT K9
1280 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Beta)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 PROB0 = .4
180 PROB1 = .2
190 GOSUB 1000 '<< call Eulerian Beta distribution
200 FOR J = 1 TO TOTAL
210 PRINT X(J); '<< sequence to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM **********************>> BETA <<************************
1020 REM ========================================================
1030 REM The Eulerian Beta Distribution Function
1040 REM generates continuous, random-order values
1050 REM > 0 & < 1. The shape of its curve changes
1060 REM with the values of its controlling parameters
1070 REM PROB0 and PROB1.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM
1110 REM Entering -
1120 REM TOTAL: length of sequence
1130 REM PROB0: controls occurrence of values nearer to 0
1140 REM PROB1: controls occurrence of values nearer to 1
1150 REM Exiting -
1160 REM X(): array holding BETA distribution
1170 REM Local -
1180 REM R8: random number 1
1190 REM R9: random number 2
1200 REM T1: computed probability 1
1210 REM T2: computed probability 2
1220 REM SUM: total of probabilities 1 & 2
1230 REM K9: loop index, pointer to array X()
1240 REM ========================================================
1250 PROB0 = 1 / PROB0
1260 PROB1 = 1 / PROB1
1270 FOR K9 = 1 TO TOTAL
1280 R8 = RND
1290 R9 = RND
1300 T1 = R8 ^ PROB0
1310 T2 = R9 ^ PROB1
1320 SUM = T1 + T2
1330 IF SUM > 1 THEN 1280 ELSE X(K9) = T1 / SUM
1340 NEXT K9
1350 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Bilexp)
130 REM =========================================================
140 DIM X(100)
150 RANDOMIZE
160 TOTAL = 100
170 SPREAD = 1.5
180 GOSUB 1010 '<< bilateral exponential distribution
190 FOR J = 1 TO TOTAL
200 PRINT X(J); '<< sequence to screen
210 NEXT J
220 END
1000 REM ========================================================
1010 REM *********************>> BILEXP <<***********************
1020 REM (D)=====================================================
1030 REM The Bilateral Exponential Distribution Function
1040 REM generates random-order negative and positive
1050 REM real numbers centered about zero. Horizontal
1060 REM scale is controlled by the variable, SPREAD,
1070 REM which increase the range of generated values in
1080 REM inverse proportion to its magnitude (must be > 0).
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM TOTAL: sequence length
1130 REM SPREAD: horizontal scaling value
1140 REM Exiting -
1150 REM X(): array holding BILEXP real numbers sequence
1160 REM Local -
1170 REM R9: random number > 0 & < 2
1180 REM K9: loop index, pointer to array X()
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 R9 = 2 * RND
1220 IF R9 > 1 THEN R9 = 2 - R9
1230 X(K9) = LOG(R9)/SPREAD
1240 NEXT K9
1250 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Cauchy)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
165 SPREAD = 2
170 GOSUB 1000 '<< call Cauchy distribution function
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM *********************>> CAUCHY <<***********************
1020 REM ========================================================
1030 REM The Cauchy Probability Distribution Function
1040 REM generates random-order, continuous, real numbers
1050 REM centered about zero. The variable SPREAD controls
1060 REM the range of generated values.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM TOTAL: length of sequence
1110 REM SPREAD: scaling parameter
1120 REM Exiting -
1130 REM X(): array holding cauchy distribution
1140 REM Local -
1150 REM R9: uniform random number
1160 REM K9: loop index, pointer to array X()
1170 REM ========================================================
1171 PI = 3.1415927#
1180 FOR K9 = 1 TO TOTAL
1200 R9# = RND
1210 IF R9# = .5 THEN 1200
1220 R9# = R9# * PI
1230 X(K9) = SPREAD * TAN(R9#)
1240 NEXT K9
1250 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Combntot)
130 REM =========================================================
140 ELEMENTS = 10
150 MANY = 2
160 FOR J = 1 TO 10
170 GOSUB 1000 '<< call combinations
180 PRINT "COMBINATIONS OF";ELEMENTS;"THINGS TAKEN";MANY;"AT A TIME IS";COMBINS
190 ELEMENTS= ELEMENTS+ 3
200 MANY = MANY + 3
210 NEXT J
220 END
1000 REM SS2ST5 =================================================
1010 REM ********************>> COMBINS <<***********************
1020 REM ========================================================
1030 REM This subroutine computes the number of possible
1040 REM combinations of n elements taken n at a time.
1050 REM It relies on Stirling's approximation to calculate
1060 REM the requisite factorials.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM ELEMENTS: nunber of items
1110 REM MANY: taken at a time
1120 REM Exiting -
1130 REM COMBINS : combination of ELEMENTS, taken MANY at
1140 REM a time
1150 REM Local -
1160 REM NUM:
1170 REM ELEMFACT: log of ELEMENTS factorial
1180 REM MANYFACT: log of MANY factorial
1190 REM DIFFACT : log of (ELEMFACT - MANYFACT) factorial
1200 REM ========================================================
1210 NUM = ELEMENTS
1220 GOSUB 2000 '<< call Stirling's approximation
1230 ELEMFACT = APPR
1240 NUM = MANY
1250 GOSUB 2000 '<< call Stirling's approximation
1260 MANYFACT = APPR
1270 NUM = ELEMENTS - MANY
1280 GOSUB 2000 '<< call Stirling's approximation
1290 DIFFACT = APPR
1300 COMBINS = INT(EXP(ELEMFACT-(MANYFACT+DIFFACT))+.5)
1310 RETURN
2000 REM ========================================================
2010 REM ********************>> STIRLING <<**********************
2020 REM ========================================================
2030 APPR = 1
2040 IF NUM <= 0 THEN APPR = 0 : RETURN
2050 FOR K9 = 1 TO 10
2060 APPR = APPR * K9
2070 IF NUM = K9 THEN APPR = LOG(APPR) : RETURN
2080 NEXT K9
2090 APPR = LOG(6.283186)/2+LOG(NUM)*(NUM+.5)-NUM+1/(12*NUM)
2100 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Conshufl)
130 REM =========================================================
140 DIM X(20)
150 TOTAL = 20
160 FOR J = 1 TO TOTAL
170 X(J) = J '<< fill array with number sequence
180 NEXT J
190 GOSUB 1000
200 FOR J = 1 TO TOTAL
210 PRINT X(J); '<< send shuffled array to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM ********************>> CONSHUFL <<**********************
1020 REM ========================================================
1030 REM This subroutine shuffles array contents by first
1040 REM generating a random sequence of address pointers,
1050 REM then swapping corresponding address contents.
1060 REM However, in the shuffling process, original
1070 REM prime order is destroyed. (See subroutine
1080 REM ADDSHUF for non-disruptive randomization.)
1090 REM =======================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM X(): array of sequential values
1130 REM TOTAL: length of list (array)
1140 REM Exiting -
1150 REM X(): randomized array of values
1160 REM Local -
1170 REM R9: random number
1180 REM S9: temporary storage variable
1190 REM K9: loop index, pointer to array X()
1200 REM ========================================================
1210 RANDOMIZE
1220 FOR K9 = 1 TO TOTAL
1230 R9 = INT(RND * TOTAL) + 1
1240 REM+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1250 REM a more thorough shuffling can be achieved with
1260 REM the next statement substitiuted for line 1250
1270 REM R9 = INT(RND * (TOTAL - (K9 - 1)))+K9
1280 REM Why is this true?
1290 REM+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1300 S9 = X(K9)
1310 X(K9) = X(R9)
1320 X(R9) = S9
1330 NEXT K9
1340 RETURN
100 REM =========================================================
110 REM CURVES
120 REM =========================================================
130 REM The subroutines LINCURVE, EXPCURVE, and LOGCURVE
140 REM return positive values along three discrete curves:
150 REM linear, exponential, and logarithmic. Control
160 REM parameters are starting and ending values, and
170 REM number of values to be included in the curve.
180 REM =========================================================
190 REM Variable Descriptions
200 REM DRIVER
210 REM S: starting curve value
220 REM E: ending curve value
230 REM N: number of values contained in curve
240 REM J1: loop index, pointer to subroutines
250 REM J2: loop index, pointer to array X()
260 REM X(): array holding curve values
270 REM
280 REM SUBROUTINES 1000,2000,3000
290 REM Entering -
300 REM S: starting curve value
310 REM E: ending curve value
320 REM N: number of values contained in curve
330 REM Exiting -
340 REM X(): array holding curve values
350 REM Local -
360 REM K9: loop index
370 REM L9: loop index, pointer to array X()
380 REM =========================================================
390 REM ==================== DRIVER PROGRAM =====================
400 REM =========================================================
410 DIM X(100)
420 S = 1
430 E = 100
440 N = 100
450 FOR J1 = 1 TO 3
460 REM >> sequentially call LINCURVE, EXPCURVE, LOGCURVE subrs.
470 ON J1 GOSUB 1000,2000,3000
480 FOR J2 = 1 TO N
490 PRINT X(J2); '<< send curve values to screen
500 NEXT J2
510 PRINT
520 NEXT J1
530 END
1000 REM ========================================================
1010 REM ********************>> LINCURVE <<**********************
1020 REM ========================================================
1030 PRINT "LINEAR CURVE:"
1040 FOR K9 = 1 TO N STEP 10
1050 FOR L9 = K9 TO K9 + 9
1060 REM >> store current computed curve value
1070 X(L9) = ABS(S + INT(((L9-1)/(N-1)) * (E-S)+.5))
1080 IF L9 = N THEN 1100
1090 NEXT L9
1100 NEXT K9
1110 RETURN
2000 REM ========================================================
2010 REM ********************>> EXPCURVE <<**********************
2020 REM ========================================================
2030 PRINT "EXPONENTIAL CURVE:"
2040 FOR K9 = 1 TO N STEP 10
2050 FOR L9 = K9 TO K9 + 9
2060 REM >> store current computed curve value
2070 X(L9) = ABS(S+INT((((L9-1)^2)/((N-1)^2))*(E-S)+.5))
2080 IF L9 = N THEN 2100
2090 NEXT L9
2100 NEXT K9
2110 RETURN
3000 REM ========================================================
3010 REM ********************>> LOGCURVE <<**********************
3020 REM ========================================================
3030 PRINT "LOGARITHMIC CURVE:"
3040 FOR K9 = 1 TO N STEP 10
3050 FOR L9 = K9 TO K9 + 9
3060 REM >> store current computed curve value
3070 X(L9)=ABS(S + INT(((LOG(L9))/(LOG(N)))*(E-S)+.5))
3080 IF L9 = N THEN 3100
3090 NEXT L9
3100 NEXT K9
3110 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM CYCLTEXT
130 REM =========================================================
140 PRINT "ORIGINAL LINE OF TEXT:"
150 LIN$ = "apples sound beautiful"
160 PRINT LIN$
170 PRINT
180 PNUM = 13 '<< a prime number smaller than length of LIN$
190 NUM2 = 8 '<< an integer between 1 and length of LIN$
200 GOSUB 1000 '<< call cyclical text shifter
210 PRINT "PRIME-SHIFTED TEXT:"
220 PRINT NEWLIN$
230 END
1000 REM ==================================================CTB5.9
1010 REM *********************>> CYCLTEXT <<*********************
1020 REM ========================================================
1030 REM Cyclical (prime number) Text Shift Subroutine
1040 REM ========================================================
1050 REM Variable Desciptions
1060 REM Entering -
1070 REM LIN$: line of text to be shifted
1080 REM PNUM: prime number smaller than length of LIN$
1090 REM NUM2: an integer between 1 and length of LIN$
1100 REM Exiting:
1110 REM NEWLINE$: shifted line of text
1120 REM Local -
1130 REM SHIFTCHAR: LINE$ substring pointer
1140 REM NUMCHARS: length of LIN$
1150 REM POSNUM: loop index, NEWLINE$ substring pointer
1160 REM ========================================================
1170 SHIFTCHAR = NUM2 - PNUM
1180 NUMCHARS = LEN(LIN$)
1190 IF NUMCHARS-INT(NUMCHARS/PNUM)*PNUM = 0
THEN NUMCHARS=NUMCHARS+1
1200 NEWLIN$ = STRING$(NUMCHARS," ")
1210 FOR POSNUM = 1 TO NUMCHARS
1220 SHIFTCHAR = SHIFTCHAR + PNUM
1230 IF SHIFTCHAR > NUMCHARS
THEN SHIFTCHAR = SHIFTCHAR - NUMCHARS
1240 MID$(NEWLIN$,POSNUM,1) = MID$(LIN$,SHIFTCHAR,1)
1250 NEXT POSNUM
1260 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (DecBiDec)
130 REM =========================================================
140 DIM X(10),X$(10)
150 PRINT "AN ARRAY OF DECIMAL NUMBERS --"
160 FOR J = 1 TO 10
170 DECNUM = J * 10
180 X(J) = DECNUM
190 PRINT X(J);" "; '<< send to screen
200 NEXT J
210 PRINT
220 PRINT "THE ARRAY CONVERTED TO BINARY NUMBERS --"
230 GOSUB 1000 '<< call decimal-to-binary conversion
240 FOR J = 1 TO 10
250 PRINT X$(J);" "; '<< send to screen
260 NEXT J
270 PRINT
280 GOSUB 1250 '<< call binary-to-decimal conversion
290 PRINT "THE BINARY NUMBERS CONVERTED BACK TO DECIMAL --"
300 FOR J = 1 TO 10
310 PRINT X(J);" "; '<< send to screen
320 NEXT J
330 END
1000 REM SS1MA1 =================================================
1010 REM ********************>> DEC-BIN <<***********************
1020 REM ========================================================
1030 REM This subroutine converts positive decimal integers
1040 REM to their binary equivalents, which are placed in
1050 REM a character array as successions of "0" and "1"
1060 REM characters.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1091 REM X(): array holding decimal integers
1092 REM Exiting -
1093 REM X$(): array holding string representation of
1094 REM binary numbers corresponding to decimal
1095 REM integers.
1096 REM Local -
1097 REM P9: temporary version of decimal integer,
1098 REM successively divided by 2.
1099 REM Q9: quotient of P9/2
1100 REM R9: remainder of X9/2
1101 REM K9: loop index, pointer to array X$()
1110 REM ========================================================
1120 FOR K9 = 1 TO 10
1130 P9=X(K9)
1140 BINUM$ = ""
1150 Q9 = P9
1160 WHILE Q9 > 0
1170 Q9=INT(P9/2)
1180 R9 = P9 - 2 * Q9
1190 BINUM$=MID$("01",R9+1,1)+BINUM$
1200 P9=Q9
1210 WEND
1220 X$(K9) = BINUM$
1230 NEXT K9
1240 RETURN
1250 REM SS2MA1 =================================================
1260 REM ********************>> BIN-DEC <<***********************
1270 REM ========================================================
1280 REM This subroutine converts binary numbers (stored as
1290 REM character strings) to their decimal equivalents.
1300 REM The INSTR function is used to ascertain the value
1310 REM and location of each binary bit within the number
1320 REM string. Line ----- examines the first bit: if it
1330 REM is "0" then DECNUM is set to 0; if it is "1",
1340 REM DECNUM is 1. The remaining bits are scanned, and
1350 REM as long as there is another bit, DECNUM is doubled
1360 REM and a 1 or 0 is added to it.
1370 REM ========================================================
1380 REM Variable Descriptions
1390 REM Entering -
1400 REM X$(): array of binary numbers stored as character
1410 REM strings of 1s and 0s
1420 REM Exiting -
1430 REM X(): array of converted decimal integers
1440 REM Local -
1450 REM DECNUM: decimal integer
1460 REM K9: loop index, pointer to array X()
1470 REM L9: loop index
1480 REM ========================================================
1490 FOR K9 = 1 TO 10
1500 DECNUM = 0
1510 FOR L9 = 1 TO LEN(X$(K9))
1520 DECNUM = INSTR("01",MID$(X$(K9),L9,1)) - 1 + DECNUM + DECNUM
1530 NEXT L9
1540 X(K9) = DECNUM
1550 NEXT K9
1560 RETURN100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Decfrac)
130 REM =========================================================
140 DIM X(50),FRACTION$(50)
150 RANDOMIZE(22321)
160 TOTAL = 50
170 FOR J = 1 TO TOTAL
180 X(J)= (INT(RND * 99)+1)/100'<<< load decimal values
190 PRINT X(J), '<<< send to screen
200 NEXT J
210 PRINT
220 GOSUB 1000 '<<< call decimal to fraction conversion
230 FOR J = 1 TO TOTAL
240 PRINT FRACTION$(J), '<<< send to screen
250 NEXT J
260 END
1000 REM ========================================================
1010 REM ********************>> DECFRAC <<***********************
1020 REM ========================================================
1030 REM This subroutine converts decimal values (%) to
1040 REM fractions for use as rhythmic durations.
1050 REM ========================================================
1060 REM
1070 REM Variable Descriptions
1080 REM
1090 REM Entering -
1100 REM X(): array of decimal values to be converted
1110 REM
1120 REM Exiting -
1130 REM FRACTION$(): character string array of fractions
1140 REM
1150 REM Local -
1160 REM B9: temporary storage of computation result
1170 REM C9: holds integer computation result
1180 REM D9: holds non-integer portion of decimal value
1190 REM E9: temporary storage of real number result
1200 REM F9: temporary storage of integer computation
1210 REM K9: loop index, pointer to array X()
1220 REM ========================================================
1230 FOR K9 = 1 TO TOTAL
1240 B9= 0
1250 C9 = 1
1260 D9= ABS(X(K9)-INT(X(K9)))
1270 IF D9 = 0 THEN 1340
1280 E9 = 1 / D9
1290 F9 = C9
1300 C9 = INT(E9) * C9 + B9
1310 B9 = F9
1320 D9 = E9 - INT(E9)
1330 IF X(K9) * C9 <> INT(X(K9) * C9) THEN 1280
1340 FRACTION$(K9)=STR$(X(K9) * C9)+"/"+STR$(C9)
1350 NEXT K9
1360 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (DELREPL)
130 REM =========================================================
140 DIM X(50)
150 TOTAL = 50
160 RANDOMIZE
170 PRINT "ARRAY OF RANDOM-ORDER REAL NUMBERS (RANGE 0-1) --"
180 FOR J = 1 TO TOTAL
190 X(J) = RND
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "ARRAY SORTED IN ASCENDING ORDER --"
240 GOSUB 1000 '<< call delayed replacement sort
250 FOR J = 1 TO TOTAL
260 PRINT X(J); '<< list to screen
270 NEXT J
280 END
1000 REM SS2TM1 =================================================
1010 REM *********************>> DELREPL <<**********************
1020 REM ========================================================
1030 REM This Delayed Replacement Sort subroutine is an
1040 REM improved version of the standard replacement sort.
1050 REM In this case, the switch between two items is
1060 REM delayed until that item is confirmed to be the
1070 REM smallest. The savings in time is one-half.
1080 REM However, for long lists either replacement sort
1090 REM is less appropriate than other sorts, because as
1100 REM the number of items to be sorted grows linearly,
1110 REM sorting time increases exponentially.
1120 REM ========================================================
1130 REM Variable Descriptions
1140 REM Entering -
1150 REM X(): array of values to be sorted
1160 REM TOTAL: length of array X()
1170 REM Exiting -
1180 REM X(): array sorted in ascending order
1190 REM Local -
1200 REM K9: loop index, pointer to X()
1210 REM L9: loop index, pointer to X()
1220 REM COMPVAL: indicator for switch of values
1230 REM =======================================================
1240 FOR K9=1 TO TOTAL - 1
1250 COMPVAL= K9
1260 FOR L9=K9+1 TO TOTAL
1270 IF X(L9) < X(COMPVAL) THEN COMPVAL=L9
1280 NEXT L9
1290 IF K9 <> COMPVAL THEN SWAP X(K9),X(COMPVAL)
1300 NEXT K9
1310 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Displace)
130 REM =========================================================
140 DIM P$(84)
150 DIM X(20),Y(20)
160 DIM DISP(20)
170 RANDOMIZE
180 GOSUB 530 '<< call pitch table
190 TOTAL = 10
200 FOR J= 1 TO TOTAL
210 X(J) = INT(RND * 12) + 1 '<< load random pitches
220 DISP(J) = INT(RND * 6)+1'<< load random octave displ.
230 PRINT P$(X(J));" WILL BE DISPLACED BY ";DISP(J);"OCTAVE(S)"
240 NEXT J
250 GOSUB 300 '<< call registral displacement
260 FOR J = 1 TO TOTAL
270 PRINT P$(Y(J));" ";
280 NEXT J
290 END
300 REM =========================================================
310 REM *******************>> DISPLACE <<************************
320 REM =========================================================
330 REM This subroutine (individually) displaces the pitches
340 REM of an input sequence by a specific number of octaves.
350 REM =========================================================
360 REM Variable Descriptions
370 REM Entering -
380 REM X(): array holding undisplaced pitch sequence
390 REM DISP(): array holding individual pitch displacements
400 REM TOTAL: sequence length
430 REM Exiting -
440 REM Y(): array containing octave-displaced pitches
450 REM Local -
460 REM K9: loop index, pointer to DISP(),X(),Y()
470 REM ========================================================
480 REM
490 FOR K9 = 1 TO TOTAL
500 Y(K9)=X(K9) + 12 * DISP(K9)
510 NEXT K9
520 RETURN
530 REM ========================================================
540 REM ********************>> PITCHTAB <<***********************
550 REM =========================================================
560 NOTE$ = " CC# DD# E FF# GG# AA# B"
570 OCTAVE$ = "1234567"
600 FOR K9 = 1 TO 7
610 FOR L9 = 1 TO 12
620 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
630 NEXT L9
640 NEXT K9
650 RETURN
100 REM =========================================================
110 REM =================== DRIVER PROGRAM ======================
120 REM =========================================================
130 DIM X(50),Y(50),FRACTION$(50)
140 TOTAL = 50
150 CLS
160 RANDOMIZE
170 REM >> randomly choose fractions between 1/50 & 50/1
180 FOR J= 1 TO TOTAL
190 X(J) = INT(RND * TOTAL)+1 '<< load numerators
200 Y(J) = 32 '<< load denominators
210 PRINT X(J);"/";Y(J), '<< send to screen
220 NEXT J
230 PRINT:PRINT
240 GOSUB 1000 '<<< call fraction reduction
250 FOR J = 1 TO TOTAL
260 PRINT FRACTION$(J), '<<send fraction to screen
270 NEXT J
280 END
1000 REM ========================================================
1010 REM *****************>> DURRED <<***************************
1020 REM ========================================================
1030 REM This subroutine reduces fractions in a manner
1040 REM consistent with rhythmic pulse subdivision.
1050 REM For instance, a fractional duration such as
1060 REM 6/12 will be reduced to 3/6 (as opposed to
1070 REM 1/2) in order to preserve subdivisional clarity.
1080 REM This results in duration patterns which are
1090 REM metrically simpler to reconcile when output is to be
1100 REM transcribed for standard musical instruments
1110 REM ========================================================
1120 REM Variable Descriptions
1130 REM Entering -
1140 REM X(): array of fraction numerators
1150 REM Y(): array of fraction denominators
1160 REM TOTAL: number of fractions to be converted
1170 REM
1180 REM Exiting -
1190 REM FRACTION$(): character string array of fractions
1210 REM
1220 REM Local -
1230 REM K9: loop index, pointer to arrays X(),Y(),FRACTION$
1240 REM ========================================================
1250 FOR K9 = 1 TO TOTAL
1260 IF X(K9) / 2 <> INT(X(K9) / 2)OR Y(K9) / 2 <> INT(Y(K9) / 2)THEN 1280
1270 X(K9) = X(K9) / 2 : Y(K9) = Y(K9) / 2 : GOTO 1260
1280 FRACTION$(K9) = STR$(X(K9)) + "/" + STR$(Y(K9))
1285 NEXT K9
1290 RETURN
100 REM =========================================================
110 REM =================== DRIVER PROGRAM ======================
120 REM =========================================================
130 DIM X(50),Y(50),FRACTION$(50)
140 TOTAL = 50
150 CLS
160 RANDOMIZE
170 REM >> randomly choose fractions between 1/50 & 50/1
180 FOR J= 1 TO TOTAL
190 X(J) = INT(RND * TOTAL)+1 '<< load numerators
200 Y(J) = 32 '<< load denominators
210 PRINT X(J);"/";Y(J), '<< send fraction to screen
220 NEXT J
230 PRINT
240 GOSUB 1000 '<<< call fraction reduction
250 FOR J = 1 TO TOTAL
260 PRINT FRACTION$(J), '<< send fraction to screen
270 NEXT J
280 END
1000 REM ========================================================
1010 REM ********************>> EUCREDUC <<**********************
1020 REM ========================================================
1030 REM This subroutine uses Euclid's algorithm to reduce
1040 REM rhythmic duration fractions to absolute lowest terms.
1050 REM It does not preserve metrical pulse consistency, in
1060 REM that a fraction such as 9/12 will convert to 3/4.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM X(): array of fraction numerators
1110 REM Y(): array of fraction denominators
1120 REM TOTAL: number of fractions to be reduced
1130 REM
1140 REM Exiting -
1150 REM FRACTION$(): character string array of fractions
1160 REM
1170 REM Local -
1180 REM K9: loop index, pointer to arrays X(),Y(),FRACTION$
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 IF Y(K9) = 1 THEN 1330
1220 A9 = X(K9)
1230 B9 = Y(K9)
1240 IF A9 > B9 THEN SWAP A9,B9
1250 WHILE A9 > 0
1260 C9 = INT(B9/A9)
1270 D9 = B9-A9*C9
1280 B9 = A9
1290 A9 = D9
1300 WEND
1310 REM >> convert fraction to char string and load in array
1320 FRACTION$(K9) = STR$(X(K9)/B9) + "/" + STR$(Y(K9)/B9)
1330 NEXT K9
1340 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Expon)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 SPREAD = 2
180 GOSUB 1000 '<< call exponential distribution function
190 FOR J = 1 TO TOTAL
200 PRINT X(J); '<< sequence to screen
210 NEXT J
220 END
1000 REM ========================================================
1010 REM ********************>> EXPON <<************************
1020 REM (L)=====================================================
1030 REM The Exponential Distribution Function generates
1040 REM continuous, random-order real numbers > 0 & < 1.
1050 REM Results closer to 0 are most likely to occur,
1060 REM with probability of higher numbers falling off
1070 REM exponentially. The variable SPREAD controls
1080 REM horizontal value scaling.
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM SPREAD: horizontal scaling parameter
1130 REM TOTAL: length of sequence
1140 REM Exiting -
1150 REM X(): array holding exponential distribution
1160 REM Local -
1170 REM R9 : uniform random number
1180 REM K9: loop index, pointer to array X()
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 R9 = RND
1220 X(K9) = -LOG(R9) / SPREAD
1230 NEXT K9
1240 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM X(50),Y(50),Z(50)
140 TOTAL = 50
150 CLS
160 RANDOMIZE
170 FOR J= 1 TO TOTAL
180 X(J) = INT(RND * TOTAL)+1 '<< random numerators
190 Y(J) = INT(RND * TOTAL)+1 '<< random denominators
200 NEXT J
210 GOSUB 1000 '<<< call fraction to decimal conversion
220 FOR J = 1 TO TOTAL
230 PRINT X(J);"/";Y(J);"=";'<<send fraction to screen
240 PRINT Z(J) '<<send decimal equivalent to screen
250 NEXT J
260 PRINT "SUM OF DURATIONS =";SUM;"WHOLE NOTES"
270 END
1000 REM ========================================================
1010 REM *******************>> FRACDEC <<***********************
1020 REM ========================================================
1030 REM This subroutine converts fractional values to
1040 REM decimal for use in rhythmic applications. It also
1050 REM computes the total of all durations in whole notes.
1060 REM ========================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM X(): array of fraction numerators
1100 REM Y(): array of fraction denominators
1110 REM TOTAL: number of fractions to be converted
1120 REM Exiting -
1130 REM Z(): array of decimal equivalents
1140 REM SUM: sum of all durations in decimal
1150 REM Local -
1160 REM K9: loop index, pointer to arrays X(),Y()
1170 REM ========================================================
1180 SUM = 0
1190 FOR K9 = 1 TO TOTAL
1200 Z(K9) = X(K9) / Y(K9) '<< load decimal equivalent
1210 SUM = SUM + Z(K9)
1220 NEXT K9
1230 RETURN
100 REM ========================================================
110 REM ================= DRIVER PROGRAM =======================
120 REM ========================================================
130 DIM X(50)
140 TOTAL = 50
150 CLS
160 PRINT "HERE IS A SERIES OF DURATION FRACTIONS:"
170 FOR J = 1 TO TOTAL
180 X(J) = J '<<< load denominators in array
190 PRINT "1/";X(J), '<<< send to screen as fractions
200 NEXT J
210 PRINT : PRINT
220 GOSUB 1000 '<<< call duration tabulation
230 PRINT "SUM OF DURATIONS IS:";SUM#;"WHOLE NOTES"
240 END
1000 REM =======================================================
1010 REM ******************>> FRACTAB <<**********************
1020 REM =======================================================
1030 REM This subroutine tabulates rhythmic duration values
1040 REM in cases where each value can be expressed as a
1050 REM fraction which has 1 as the numerator (e.g. 1/8).
1060 REM The sum of all durations is returned in decimal
1070 REM (e.g., 4.499205391854048 whole notes).
1080 REM =======================================================
1100 REM Variable Descriptions
1120 REM Entering -
1140 REM X(): array of fraction denominators to be summed
1150 REM TOTAL: number of elements in array X()
1160 REM
1170 REM Exiting -
1190 REM SUM#: (double precision) decimal sum of
1200 REM durations, expressed in whole notes
1210 REM
1220 REM Local -
1240 REM K9: loop index, pointer to array X()
1260 REM =======================================================
1280 SUM# = 0
1290 FOR K9 = 1 TO TOTAL
1300 SUM# = SUM# + 1 / X(K9)
1310 NEXT K9
1320 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Fractsum)
130 REM =========================================================
140 REM The subroutines below have a number of individual
150 REM uses; they are grouped together in this program
160 REM for the purpose of totaling a sequence of rhythm
170 REM duration fractions.
180 REM
190 REM An alternative subroutine, FRACDEC, (presented
200 REM elsewhere) sums fractions and expresses the
210 REM the result in decimal in decimal whole note
220 REM values, e.g., 1.23143.
230 REM
240 REM Contrastingly, FRACTSUM places no restriction
250 REM on fraction type, and produces fractional, not
260 REM decimal, output, e.g., 2/1 + 11/16 = 2 11/16.
270 REM The subroutine LCM (Least Common Multiple) is
280 REM coupled with EUCREDUC (which is Euclid's Algorithm
290 REM for finding the Greatest Common Divisor of two
300 REM numbers) to do the work of summing the fraction
310 REM sequence. However, there is one serious drawback
320 REM to FRACTSUM - when a computer with a small word
330 REM size is used, overflow condition is quickly reached.
340 REM =========================================================
350 DIM X(20),Y(20)
360 RANDOMIZE
370 PRINT "ARRAY OF DURATION FRACTIONS TO BE TOTALED -- "
380 FOR J = 0 TO 20
390 X(J) = INT(RND * 10)+1
400 Y(J) = INT(RND * 10)+1
410 PRINT X(J);"/";Y(J), '<< send fraction to screen
420 NEXT J
430 PRINT
440 PRINT
450 FOR J = 1 TO 20
460 GOSUB 1000
470 X(0) = NUM
480 Y(0) = DEN
490 NEXT J
500 IF NUM MOD DEN = 0
THEN PRINT NUM/DEN
ELSE IF NUM > DEN
THEN PRINT INT(NUM/DEN);"+";NUM MOD DEN;"/";DEN;
ELSE PRINT NUM;"/";DEN;
510 END
1000 REM SS1MA5 =================================================
1010 REM ***********************>> LCM <<************************
1020 REM ========================================================
1030 REM This subroutine determines the least common
1040 REM multiple of two integers by calling the
1050 REM greatest common divisor subroutine to supply
1060 REM that value, then divides the product of the
1070 REM two integers by the gcd.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM X(0): current fraction numerator sum
1120 REM X(n): next fraction numerator
1130 REM Y(0): current fraction denominator sum
1140 REM Y(n): next fraction denominator
1150 REM LCM: least common multiple
1160 REM Exiting -
1170 REM NUM: reduced fraction numerator total
1180 REM DEN: reduced fraction denominator total
1190 REM Local -
1200 REM M9: temp storage for denominator total
1210 REM N9: temp storage for next denominator
1220 REM GCD: greatest common divisor
1230 REM LCM: least common multiple
1240 REM ========================================================
1250 M9 = Y(0)
1260 N9 = Y(J)
1270 GOSUB 2000 '<< call Greatest Common Divisor
1280 LCM = M9 * N9 / GCD
1290 M9 = LCM / Y(0)
1300 N9 = LCM / Y(J)
1310 NUM = (X(0) * M9) + (X(J) * N9)
1320 DEN = LCM
1330 M9 = NUM
1340 N9 = DEN
1350 GOSUB 2000 '<< call Greatest Common Divisor
1360 NUM = M9 / GCD
1370 DEN = N9 / GCD
1380 RETURN
2000 REM ========================================================
2010 REM ***********************>> GCD <<************************
2020 REM (EUCREDUC adapted to program specs.)
2030 REM ========================================================
2040 A9 = M9
2050 B9 = N9
2060 IF A9 > B9 THEN SWAP A9,B9
2070 WHILE A9 > 0
2080 C9=INT(B9/A9)
2090 D9 = B9 - A9 * C9
2100 B9 = A9
2110 A9 = D9
2120 WEND
2130 GCD = B9
2140 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
130 REM (Gamma)
140 REM =========================================================
150 DIM X(50)
160 RANDOMIZE
170 TOTAL = 50
180 SPREAD = 5
190 GOSUB 1000 '<< call gamma distribution function
200 FOR J = 1 TO TOTAL
210 PRINT X(J); '<< sequence to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM **********************>> GAMMA <<***********************
1020 REM ========================================================
1030 REM The Gamma Probability Distribution Function returns
1040 REM random-order, continuous real numbers over an
1050 REM assymetrical curve. It has particular usefulness
1060 REM in rhythmic applications, where it can produce a
1070 REM sense of 'rubato'.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM TOTAL: length of sequence
1120 REM SPREAD: control parameter
1130 REM Exiting -
1140 REM X(): array holding gamma distribution
1150 REM Local -
1160 REM SUM: accumulator
1170 REM GAMMA: current distribution value
1180 REM K9: loop index, pointer to array X()
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 SUM = 1
1220 FOR L9 = 1 TO SPREAD
1230 SUM = SUM * RND
1240 NEXT L9
1250 X(K9) = -LOG(SUM)
1260 NEXT K9
1270 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Gauss)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 DEV = 2
180 MEAN = 10
190 GOSUB 1000 '<< call gaussian distribution function
200 FOR J = 1 TO TOTAL
210 PRINT X(J); '<< sequence to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM **********************>> GAUSS <<***********************
1020 REM ========================================================
1030 REM The Gaussian Probability Distribution Function
1040 REM is also referred to as the 'normal distribution'.
1050 REM Its curve is bell-shaped, and is arrived at by
1060 REM an approximation resulting from the summation of
1070 REM uniform random numbers. The standard deviation -
1080 REM DEV - and the mean - MEAN - are the control
1090 REM parameters. It generates random-order real
1100 REM numbers centered about the mean.
1110 REM ========================================================
1120 REM Variable Descriptions
1130 REM Entering -
1140 REM TOTAL: length of sequence
1150 REM DEV: statistical standard deviation
1160 REM MEAN: statistical mean
1170 REM Exiting -
1180 REM X(): array holding gaussian distribution
1190 REM Local -
1200 REM NUM: number of random values used in computation
1210 REM HALFNUM: NUM / 2
1220 REM SCALE: scaling factor (varies with NUM as
1230 REM SCALE = 1 / SQR(NUM/12)
1240 REM K9: loop index, pointer to array X()
1250 REM ========================================================
1260 NUM = 12
1270 HALFNUM = NUM/2
1280 SCALE=1
1290 FOR K9= 1 TO TOTAL
1300 SUM=0
1310 FOR L9 = 1 TO NUM
1320 SUM = SUM + RND
1330 NEXT L9
1340 X(K9) = DEV * SCALE * (SUM - HALFNUM) + MEAN
1350 NEXT K9
1360 RETURN
1 REM in text explain how forms contain info for eol & eop (-1)
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM Gen-con
130 REM =========================================================
140 REM This group of subroutines composes 4 poems (somewhat
150 REM resembling Haiku), then maps the ASCII values of the
160 REM constituent letters onto the pitch domain.
170 REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
180 DIM P$(84),VOCAB$(300),W(15),SET(300)
190 REM >>> assign parts of speech totals (see DATA categories)
200 AR = 2
210 AD = 72
220 NO = 103
230 VE = 55
240 PR = 15
250 WORDTOT = AR + AD + NO + VE + PR
260 GOSUB 4000 '<< initialize pitch data table
270 RANDOMIZE
280 PRINT "EACH LINE OF EACH POEM WILL BE PRINTED, THEN " :
PRINT "CONVERTED TO CORRESPONDING PITCH SEQUENCE"
290 FOR J = 1 TO 4
300 PRINT "POEM ";J
310 GOSUB 1000 '<< call poem generator
320 PRINT:PRINT
330 NEXT J
340 END
1000 REM ================================================== CTB5.8
1010 REM ******************>> GENPOEM <<**************************
1020 REM =========================================================
1030 REM This subroutine generates 3-line poems which bear
1040 REM a resemblance to Haiku. It consults 1 of four
1050 REM poem form schemes to provide proper syntax, then
1060 REM randomly selects conforming words from program
1070 REM vocabulary. Words can be added to the DATA state-
1080 REM ments, but be sure to change DRIVER PROGRAM variable
1090 REM values accordingly (or mayhem will result).
1100 REM =========================================================
1110 REM Variable Descriptions
1120 REM Entering -
1130 REM J: flag from DRIVER to load program vocabulary
1140 REM WORDTOT: vocabulary size
1150 REM AR: number of articles in vocabulary
1160 REM AD: number of adjectives in vocabulary
1170 REM NO: number of nouns in vocabulary
1180 REM VE: number of verbs in vocabulary
1190 REM PR: number of prepositions in vocabulary
1200 REM Exiting -
1210 REM LIN$: full poem line
1220 REM Local -
1230 REM VOCAB$(): array of program vocabulary
1240 REM SET(): flag array to prevent word repetition
1250 REM W(): array storing current poem formal structure
1260 REM W: current part of speech, or blank space
1270 REM L: low end vocabulary delimiter
1280 REM S: range span for parts of speech categories
1290 REM RNDWRD: randomly selected word
1300 REM K9: loop index, pointer to W()
1310 REM ========================================================
1320 LIN$ = ""
1330 IF J > 1 THEN 1370
1340 FOR K9 = 1 TO WORDTOT
1350 READ VOCAB$(K9) '<< load vocabulary
1360 NEXT K9
1370 FOR K9 = 1 TO 15
1380 READ W(K9) '<< load 1 of 4 unique poem forms
1390 NEXT K9
1400 FOR K9 = 1 TO 15
1410 W = W(K9)
1420 REM << if end-of-text (W=-1) or end-of-line (W=0), call >>
1430 REM << article-checking subroutine, print line of text, >>
1440 REM << call text-to-pitch conversion subroutine to print >>
1450 REM << resulting pitch sequence. >>
1460 IF W = -1 THEN GOSUB 2000 :
PRINT LIN$ : GOSUB 3000 :
RETURN
1470 IF W = 0 THEN GOSUB 2000 :
PRINT LIN$ : GOSUB 3000 :
LIN$= "" : GOTO 1550
1480 REM >>> locate vocab range for selected part of speech
1490 IF W=1 THEN L=1:S=AR
ELSE IF W=2 THEN L=AR+1:S=AD
ELSE IF W=3 THEN L=AR+AD+1:S=NO
ELSE IF W=4 THEN L=AR+AD+NO+1:S=VE
ELSE L=AR+AD+NO+VE+1:S=PR
1500 RNDWRD = INT(RND * S) + L
1510 IF RNDWRD <= AR THEN 1540 '<<permit article repetit.
1520 IF SET(RNDWRD) = 1 THEN 1500 '<<prevent word repetit.
1530 SET(RNDWRD) = 1
1540 LIN$ = LIN$ + " " + VOCAB$(RNDWRD) '<< build a line
1550 NEXT K9
1560 RETURN
2000 REM =================================================== CTB5.9
2010 REM ********************>> ARTCHECK <<************************
2020 REM ==========================================================
2030 REM This subroutine checks for article-adjective agreement.
2040 REM It scans the line of poetry most recently created by
2050 REM subroutine GENPOEM. If it finds the article A before
2060 REM a vowel, it changes it to the article AN.
2070 REM ==========================================================
2080 REM Variable Descriptions
2090 REM Entering -
2100 REM LIN$: uncorrected line of text
2110 REM Exiting -
2120 REM LIN$: text line after article checking/correction
2130 REM Local -
2140 REM B$: stores indicator to add letter N to article
2150 REM I: loop index, pointer to LIN$ substring
2160 REM ==========================================================
2170 FOR I = 1 TO LEN(LIN$) - 2
2180 IF MID$(LIN$,I,3) = " A " THEN B$ = MID$(LIN$,I+3,1)ELSE 2200
2190 IF B$="A" OR B$="E" OR B$="I" OR B$="O" OR B$="U"
THEN LIN$ = LEFT$(LIN$,I+1) + "N" + MID$(LIN$,I+2)
2200 NEXT I
2210 RETURN
3000 REM ================================================= CTB5.2
3010 REM ********************>> SNDTEXT2 <<**********************
3020 REM (Adapted to program specs)
3030 REM ========================================================
3040 LINELENGTH = LEN(LIN$)
3050 FOR M9 = 1 TO LINELENGTH
3060 NOTENUM = ASC(MID$(LIN$,M9,1))-32 '<<convert to int
3070 PRINT P$(NOTENUM);" "; '<< convert to pitch
3080 NEXT M9
3090 PRINT
3100 RETURN
4000 REM ================================================= CTB1.3
4010 REM ********************>> PITCHTAB <<**********************
4020 REM (Adapted to program specs)
4030 REM ========================================================
4040 P$(0) = " R " '<< blank spaces will print as rests
4050 NOTE$ = " CC# DD# E FF# GG# AA# B"
4060 OCTAVE$ = "1234567"
4070 FOR K9 = 1 TO 7
4080 FOR L9 = 1 TO 12
4090 P$(L9+(K9-1) * 12) = MID$(NOTE$,(L9*2-1),2) + MID$(OCTAVE$,K9,1)
4100 NEXT L9
4110 NEXT K9
4120 RETURN
4130 REM =========================================================
5000 REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
5010 REM PROGRAM VOCABULARY
5020 REM ++++++++++++++++++
5030 REM
5040 REM ARTICLES
5050 REM +++++++++++++++++++
5060 DATA A,THE
5070 REM +++++++++++++++++++
5080 REM ADJECTIVES
5090 REM +++++++++++++++++++
5100 DATA AUTUMN,HIDDEN,BITTER, MISTY,SILENT,EMPTY,VERDANT
5110 DATA DRY,DARK,SUMMER,ICY,DELICATE,QUIET,BEMUSED,DIMPLED
5120 DATA WHITE,COOL,SPRING,WINTER,DAPPLED,MOLTEN,FLORAL,DAMP
5130 DATA TWILIGHT,DAWN,CRIMSON,WISPY,AZURE,FRIGID,ASHEN,WHITE
5140 DATA BLUE,BILLOWING,BROKEN,COLD,DAMP,FALLING,INDIGO,SILKEN
5150 DATA FROSTY,GREEN,LONG,LATE,LINGERING,LIMPID,DUSTY,MIDNIGHT
5160 DATA LITTLE,EVENING,MUDDY,OLD,RED,ROUGH,TRANQUILL,WISTFUL
5170 DATA STILL,SMALL,SPARKLING,THROBBING,VERMILION,SOUR,LEMON
5180 DATA WANDERING,WITHERED,WILD,BLACK,YOUNG,STRICKEN,FLEECY
5190 DATA RADIANT,TENDER,DARK
5200 REM +++++++++++++++++++
5210 REM NOUNS
5220 REM +++++++++++++++++++
5230 DATA WATERFALL,RIVER,BREEZE,MOON,CAVE,MOON,DREAMSCAPE,DEER
5240 DATA RAIN,WIND,SEA,TABLEAU,SNOWFLAKE,LAKE,SUNSET,SAND-GRAIN
5250 DATA PINE,SHADOW,LEAF,DAWN,GROTTO,FOREST,TROUT,POOL,WIND,ASH
5260 DATA HILL,CLOUD,MEADOW,SUN,GLADE,BIRD,BROOK,MILKWEED,WILLOW
5270 DATA BUTTERFLY,BUSH,DEW,STORMCLOUD,FIELD,FIR,BRANCH,FLAME
5280 DATA FLOWER,FIREFLY,FEATHER,GRASSBED,HAZE,MOUNTAIN,HONEYDEW
5290 DATA NIGHT,POND,SHADE,SNOWFLAKE,DRAGONFLY,LAUREL,COMET,STAR
5300 DATA SILENCE,SOUND,SKY,SHAPE,SURF,THUNDERCLAP,MEADOW,GLOW
5310 DATA VIOLET,PLUME,WILDFLOWER,WAVE,SPIRIT,TWILIGHT,HALO,OWL
5320 DATA SPIDER WEB,LONLINESS,MIST,IVY,DREAM,LIGHT,WOOD,SEASHELL
5330 DATA SWAN,CEDAR,ICE,ROSE,THORN,SUNBEAM,BLOSSOM,GULL,PETAL
5340 DATA STONE,BEE,LEAF,HORIZON,SHOWER,AIR,ROOT,LILAC,HEART
5350 DATA WHISPER,BREATH,SCENT
5360 REM ++++++++++++++++++
5370 REM VERBS
5380 REM ++++++++++++++++++
5390 DATA SHAKES,DRIFTS,HAS STOPPED,STRUGGLES,IS DEPARTING
5400 DATA HAS FALLEN,HAS PASSED,SLEEPS,CREEPS,RECLINES,SIGHS
5410 DATA FLUTTERS,HAS RISEN,IS FALLING,IS TRICKLING,DAMPENS
5420 DATA DRINKS IN,TREMBLES,SWALLOWS,TRANSCENDS,MOCKS,LINGERS
5430 DATA MURMURS,IS FLOATING,DREAMS,RETURNS,WAS GLEAMING,RESTS
5440 DATA IS SWEETENING,FLICKERS,SHIVERS,VANISHES,SPARKS,WEAVES
5450 DATA IS GLOWING,HAS EMBARKED,IS PLUNGING,SHINES,IS PRAYING
5460 DATA HAS HIDDEN,DROWNS,BEAMS DOWN,TWITTERS,HAS DANCED,GLIDES
5470 DATA IS WHISPERING,HAS BURNT,BREATHES,EMBRACES,DRONES,DESCENDS
5480 DATA LIFTS,CREEPS,DWELLS,FLICKERS
5490 REM ++++++++++++++++++
5500 REM PREPOSITIONS
5510 REM ++++++++++++++++++
5520 DATA ON,IN,FROM,UNDER,OVER,NEAR,BENEATH,ATOP,WITH,ACROSS
5530 DATA BESIDE,ASTRIDE,IMMERSED IN,INSIDE,THROUGH
5540 REM ++++++++++++++++++
5550 REM FORMAL STRUCTURES
5560 REM ++++++++++++++++++
5570 DATA 1,2,3,0,1,3,4,5,1,3,0,2,2,3,-1
5580 DATA 3,5,1,3,0,1,2,3,5,1,3,0,2,3,-1
5590 DATA 1,2,3,0,5,1,2,3,0,1,3,4,-1,-1,-1
5600 DATA 1,2,3,4,0,1,2,2,3,0,5,1,2,3,-1
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Grafplot)
130 REM =========================================================
140 DIM X(50),Y(50)
150 SUM = 0
160 TOTAL = 21 '<< num of array elements in X() + Y()
170 C$ = "o" '<< character for graph
180 FOR J = 1 TO TOTAL
190 X(J) = SUM '<< load x-axis array
200 Y(J) = SIN(X(J)) '<< load y-axis array
210 SUM = SUM + .314159
220 NEXT J
230 PRINT "0 <= x <= 2pi : sin(x)"
240 GOSUB 1000 '<< call x-y graph plotting
250 END
1000 REM SS1PL2 =================================================
1010 REM *********************>> XY-PLOT <<**********************
1020 REM ========================================================
1030 REM This subroutine produces an X-Y line graph of
1040 REM two interdependent parameters (e.g., musical waveform
1050 REM cycle over a time period). It performs its own
1060 REM scaling, which means that any set of data, positive
1070 REM negative, of any range, may be graphed without
1080 REM concern for compression or expansion.
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM X(): array holding the x-axis elements
1130 REM Y(): array holding the y-axis elements
1140 REM TOTAL : number of elements in arrays X(),Y()
1150 REM C$ : plotting character
1160 REM Exiting -
1170 REM none (subroutine is procedural)
1180 REM Local -
1190 REM LOWVAL: lowest value in array Y()
1200 REM HIGHVAL: highest value in array Y()
1210 REM SCDISP: scale displacement between LOWVAL,HIGHVAL
1220 REM LEFTDISP: leftmargin displacement for X position
1230 REM K9: loop index, pointer to arrays X(),Y()
1240 REM ========================================================
1250 LOWVAL = Y(1)
1260 HIGHVAL = Y(1)
1270 FOR K9 = 2 TO TOTAL
1280 IF Y(K9) < LOWVAL THEN LOWVAL = Y(K9)
1290 IF Y(K9) < HIGHVAL THEN HIGHVAL = Y(K9)
1300 NEXT K9
1310 SCDISP = HIGHVAL - LOWVAL
1320 IF SCDISP = 0 THEN SCDISP = 1
1330 FOR K9 = 1 TO TOTAL
1340 LEFTDISP = INT(1+(Y(K9)-LOWVAL) / SCDISP * 20+.5)
1350 PRINT X(K9);TAB(15 + LEFTDISP);C$
1360 NEXT K9
1370 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Histo)
130 REM =========================================================
140 DIM X(20)
150 RANGE = 20 '<< set random number range 1-20
160 TOTAL = 400 '<< return 400 values
170 RANDOMIZE
180 GOSUB 1000 '<< generate frequency table
190 GOSUB 2000 '<< call bargraph display
200 END
1000 REM ========================================================
1010 REM *******************>> FREQTABL <<***********************
1020 REM ========================================================
1030 REM This subroutine computes a table of occurrence
1040 REM frequency for each value generated during a run.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM Entering -
1080 REM TOTAL: number of samples to return
1090 REM RANGE: numeric range of samples
1100 REM Exiting -
1110 REM X(): array holding frequency table
1120 REM Local -
1130 REM VALUE: random integer, pointer to array X()
1140 REM K9: loop index
1150 REM ========================================================
1160 FOR K9 = 1 TO TOTAL
1170 VALUE = INT(RND * RANGE)+1 '<< gen random value
1180 X(VALUE)=X(VALUE)+1 '<< record occurrence of value
1190 NEXT K9
1200 RETURN
2000 REM ========================================================
2010 REM *******************>> BARGRAPH <<***********************
2020 REM ========================================================
2030 REM This procedural subroutine prints a simple
2040 REM bargraph. In this case the bargraph represents
2050 REM an occurance frequency table of random integers
2060 REM generated during program execution.
2070 REM ========================================================
2080 REM Variable Descriptions
2090 REM Entering -
2100 REM X(): occurence frequency table,
2110 REM address = random number,
2120 REM contents = frequency of occurance
2130 REM RANGE: range of integer values in table
2140 REM Exiting -
2150 REM none (subroutine is procedural)
2160 REM Local -
2170 REM K9: loop index, pointer to frequency table
2180 REM ========================================================
2190 FOR K9 = 1 TO RANGE
2200 PRINT K9;TAB(10);STRING$(X(K9),">")
2210 NEXT K9
2220 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Hypcosin)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 GOSUB 1000 '<< call hyperbolic cosine distribution
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM ******************>> HYPCOSIN <<************************
1020 REM ========================================================
1030 REM The Hyperbolic Cosine Probability Distribution
1040 REM function produces a symmetrical curve; however,
1050 REM although centered about zero, it has no mean value.
1060 REM ========================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM TOTAL: length of sequence
1100 REM Exiting -
1110 REM X(): array holding Hypercosine distribution
1120 REM Local -
1130 REM R9: uniform random number
1140 REM K9: loop index, pointer to array X()
1150 REM ========================================================
1160 FOR K9 = 1 TO TOTAL
1170 R9 = RND
1180 X(K9) = LOG(TAN(3.14159 * R9 /2))+4
1190 NEXT K9
1200 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (INSORT)
130 REM =========================================================
140 DIM X(50)
150 TOTAL = 50
160 RANDOMIZE
170 PRINT "ARRAY OF RANDOM-ORDER REAL NUMBERS (RANGE 0-1) --"
180 FOR J = 1 TO TOTAL
190 X(J) = RND
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "ARRAY SORTED IN ASCENDING ORDER --"
240 GOSUB 1000 '<< call insertion sort
250 FOR J = 1 TO TOTAL
260 PRINT X(J); '<< list to screen
270 NEXT J
280 END
1000 REM SS2TM2 =================================================
1010 REM ***********************>> INSORT <<*********************
1020 REM ========================================================
1030 REM This algorithm is surprisingly fast, yet simple
1040 REM to code and comprehend. It is also called the
1050 REM card players sort, because during sorting each
1060 REM unsorted element is inserted in its appropriate
1070 REM slot relative to already sorted values.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM X(): array of values to be sorted
1120 REM TOTAL: length of array X()
1130 REM Exiting -
1140 REM X(): array sorted in ascending order
1150 REM Local -
1160 REM K9: loop index, pointer to X()
1170 REM L9: loop index, pointer to X()
1180 REM FIRSTVAL: first value in unsorted list
1190 REM ========================================================
1200 FOR K9=1 TO TOTAL - 1
1210 FIRSTVAL = X(K9+1)
1220 FOR L9=K9 TO 1 STEP -1
1230 IF FIRSTVAL >= X(L9) THEN 1270
1240 X(L9+1) = X(L9)
1250 NEXT L9
1260 L9=0
1270 X(L9+1) = FIRSTVAL
1280 NEXT K9
1290 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM GAMINTS(12),P$(96)
140 RANDOMIZE
150 TOTAL = 5
160 INTOTAL = 6 '<< number of intervals in set
170 GOSUB 2000 '<< call pitch table
180 FOR J = 1 TO INTOTAL
190 GAMINTS(J) = INT(RND * 3)+1 '<< select interval set
200 NEXT J
210 FOR J = 1 TO TOTAL
220 PRINT "CHORD";J
230 ROOT = INT(RND * 12)+1
240 OCTAVE = INT(RND * 3)+1
250 CHORDMEMS = INT(RND * 14)+6
260 GOSUB 1000 '<< call interval gamut generator
270 PRINT
280 NEXT J
290 END
1000 REM ========================================================
1010 REM *******************>> INTGAM <<*************************
1020 REM ========================================================
1030 REM This subroutine generates non octave-repeating
1040 REM chords/gamuts from a set of intervals.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM Entering -
1080 REM P$(): pitch name table
1090 REM GAMINTS(): array of interval sizes
1100 REM ROOT: lowest chord/gamut member
1110 REM OCTAVE: octave register for chord initiation
1120 REM CHORDMEMS: number of tones contained in gamut
1130 REM INTOTAL: number of intervals in GAMINTS()
1140 REM Exiting -
1150 REM none (subroutine is procedural)
1160 REM Local -
1170 REM COUNT: tabulates chordtone generation
1180 REM CHORDTONE: next chord/gamut member
1190 REM K9: loop index
1200 REM L9: loop index, pointer to array GAMINTS()
1210 REM ========================================================
1220 COUNT = 0
1230 CHORDTONE = ROOT + ((OCTAVE - 1) * 12)
1240 FOR K9 = 1 TO 100
1250 FOR L9 = 1 TO INTOTAL
1260 PRINT P$(CHORDTONE);" ";
1270 COUNT = COUNT + 1
1280 IF COUNT = CHORDMEMS THEN RETURN
1290 CHORDTONE = CHORDTONE + GAMINTS(L9)
1300 NEXT L9
1310 NEXT K9
1320 RETURN
2000 REM ========================================================
2010 REM *******************>> PITCHTAB <<***********************
2020 REM ========================================================
2030 REM This subroutine initializes a pitch data table
2040 REM corresponding to integer values 1-n.
2050 REM ========================================================
2070 NOTE$ = " CC# DD# E FF# GG# AA# B"
2080 OCTAVE$ = "1234567"
2090 FOR K9 = 1 TO 7
2100 FOR L9 = 1 TO 12
2110 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
2120 NEXT L9
2130 NEXT K9
2140 RETURN
100 REM ==========================================================
110 REM DRIVER PROGRAM
120 REM (INTLINK)
130 REM ==========================================================
140 DIM PCUM(12),ICUM(12),PCLASS(12)
150 RANDOMIZE(1)
160 TOTAL = 10
170 GOSUB 1000 '<< call interval-linked PC series generator
180 END
1000 REM =========================================================
1010 REM **********************>> INTLINK <<**********************
1020 REM =========================================================
1030 REM This subroutine generates a random-order series,
1040 REM locates the series position at which interval-size
1050 REM redundancy occurs, then links subsequent set
1060 REM permutations by moving remaining values from flag-
1070 REM point in the current series to the beginning of the
1080 REM next series to form its nucleus. Appropriate values
1090 REM are then permutated to complete the (now) current
1100 REM series. Thus, value-group repetitions of various
1110 REM lengths are produced - within an overall serial
1120 REM context - as a method of generating new related
1130 REM sequences for use as pointers to pitch, rhythm,
1140 REM volume, articulation, or other parameter elements.
1150 REM ========================================================
1160 REM Variable Descriptions
1170 REM Entering -
1180 REM TOTAL: number of series to generate & link
1190 REM Exiting -
1200 REM (to ZEROMAT)
1210 REM PCUM: array of pitchclass flags
1220 REM ICUM: array of intervalclass flags
1230 REM (to MATPRINT)
1240 REM PCLASS(): array holding current series
1250 REM REDPT: interval redundancy point marker
1260 REM Local -
1270 REM INTSIZE: interval between consecutive pitchclasses
1280 REM SHIFT: number of places to shift remaining setmems
1290 REM R9: random integer
1300 REM K9: loop index
1310 REM L9: loop index, pointer to PCLASS()
1320 REM ========================================================
1330 REDPT = 1
1340 FOR K9 = 1 TO TOTAL '<< flag carried-over set members
1350 FOR L9 = 1 TO 12
1360 IF PCLASS(L9) > 0 THEN PCUM(PCLASS(L9)) = 1
1370 NEXT L9
1380 FOR L9 = 1 TO 12 '<< gen required new setmembers
1390 IF PCLASS(L9) > 0 THEN 1440
1400 R9 = INT(RND * 12) + 1
1410 IF PCUM(R9) = 1 THEN 1400
1420 PCUM(R9) = 1
1430 PCLASS(L9) = R9
1440 NEXT L9
1450 FOR L9 = 1 TO 11 '<< find intervals btwn setmembers
1460 INTSIZE = PCLASS(L9+1) - PCLASS(L9)
1470 IF INTSIZE < 0 THEN INTSIZE = 12 - ABS(INTSIZE)
1480 IF ICUM(INTSIZE) = 1 THEN 1510'<<mark redundancy
1490 ICUM(INTSIZE) = 1
1500 NEXT L9
1510 REDPT = L9 + 1
1520 PRINT "INTERVAL REDUNDANCY OCCURS";
1530 PRINT " AT POSITION -->";REDPT
1540 GOSUB 2000
1550 GOSUB 3000
1560 SHIFT = 1
1570 FOR L9 = REDPT TO 12 '<< shift set balance forward
1580 PCLASS(SHIFT) = PCLASS(L9)
1590 SHIFT = SHIFT + 1
1600 NEXT L9
1610 FOR L9 = SHIFT TO 12'<< zero remaining array places
1620 PCLASS(L9) = 0
1630 NEXT L9
1640 NEXT K9
1650 RETURN
2000 REM ========================================================
2010 REM *********************>> MATPRINT <<*********************
2020 REM (adapted to program specs)
2030 REM ========================================================
2040 PRINT "PC SET: ";
2050 FOR M9 = 1 TO 12
2060 PRINT PCLASS(M9);
2070 IF M9 = REDPT - 1 THEN PRINT "||";
2080 NEXT M9
2090 PRINT
2100 RETURN
3000 REM ========================================================
3010 REM *********************>> ZEROMAT <<**********************
3020 REM (adapted to program specs)
3030 REM ========================================================
3040 FOR N9 = 1 TO 12
3050 PCUM(N9) = 0 : ICUM(N9) = 0
3060 NEXT N9
3070 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Linear)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 GOSUB 1000 '<< call linear distribution
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM **********************>> LINEAR <<**********************
1020 REM (D)=====================================================
1030 REM The Linear Distribution Function generates
1040 REM continuous,random-order real numbers > 0 & < 1.
1050 REM Results closer to 0 are most likely to occur.
1060 REM The reverse condition may be obtained by altering
1070 REM the algorithm to select the larger rather than
1080 REM the smaller random value in line 1230.
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM TOTAL: length of sequence
1130 REM Exiting -
1140 REM X(): array holding LINEAR real number sequence
1150 REM Local -
1160 REM R8: random number 1
1170 REM R9: random number 2
1180 REM K9: loop index, pointer to array X()
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 R8 = RND
1220 R9 = RND
1230 IF R9 < R8 THEN R8=R9
1240 X(K9) = R8
1250 NEXT K9
1260 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (LINEFIT)
130 REM =========================================================
140 DIM X(100),Y(100)
150 RANDOMIZE(-2438)
160 C$ = "o" '<< character for graph
170 TOTAL = 50
180 PRINT TOTAL;"RANDOM NUMBERS"
190 PRINT
200 FOR J = 1 TO TOTAL
210 X(J)=J '<< data point ordinate
220 Y(J)= INT(RND * 88) + 1 '<< data point coordinate
230 PRINT Y(J), '<< random-order data to screen
240 NEXT J
250 GOSUB 1000 '<< call linear least squares fit
260 PRINT
270 PRINT "STRAIGHT LINE THAT BEST FITS THE DATA:"
280 PRINT
290 PRINT "Y=";SLOPE;"X";
300 IF INTERCEPT < 0 THEN PRINT "-"; ELSE PRINT "+";
310 PRINT ABS(INTERCEPT)
320 FOR K9 = 1 TO TOTAL '<< scale line for graph plotting
330 Y(K9) = SLOPE * K9 + INTERCEPT
340 NEXT K9
350 GOSUB 2000 '<< call x-y graph plot
360 END
1000 REM ========================================================
1010 REM *********************>> LINEFIT <<**********************
1020 REM ========================================================
1030 REM This subroutine calculates the equation of the
1040 REM straight line that best fits a set of data.
1050 REM Its proper name is the Linear Least Squares Fit.
1060 REM When the data is a collection of musical parameter
1070 REM values, this algorithm provides a quick picture of
1080 REM (statistical) direction tendency over the sequence
1090 REM of values.
1100 REM ========================================================
1110 REM Variable Descriptions
1120 REM Entering-
1130 REM X(): array of ordinate increments
1140 REM Y(): array of random integers for coordinate
1150 REM TOTAL: number of data points
1160 REM Exiting -
1170 REM SLOPE: slope of linear least squares fit
1180 REM INTERCEPT: (coordinate) intercept of linear least
1190 REM squares fit line
1200 REM Local -
1210 REM XERR: sum of x errors
1220 REM XSQERR: sum of x-squared errors
1230 REM YERR: sum of y errors
1240 REM XYPRODERR: sum of x-y (cross-product) errors
1250 REM K9: loop index, pointer to X(),Y()
1260 REM ========================================================
1270 XERR = 0
1280 XSQERR = 0
1290 YERR = 0
1300 XYPRODERR = 0
1310 FOR K9 = 1 TO TOTAL
1320 XERR = XERR + X(K9)
1330 XSQERR = XSQERR + X(K9) ^ 2
1340 YERR = YERR + Y(K9)
1350 XYPRODERR = XYPRODERR + X(K9) * Y(K9)
1360 NEXT K9
1370 SLOPE=(TOTAL * XYPRODERR - XERR * YERR) / (TOTAL * XSQERR - XERR ^ 2)
1380 INTERCEPT = (XSQERR * YERR - XERR * XYPRODERR) / (TOTAL * XSQERR - XERR ^ 2)
1390 RETURN
2000 REM ========================================================
2010 REM *********************>> XY-PLOT <<**********************
2020 REM ========================================================
2030 LOWVAL = Y(1)
2040 HIGHVAL = Y(1)
2050 FOR K9 = 2 TO TOTAL
2060 IF Y(K9) < LOWVAL THEN LOWVAL = Y(K9)
2070 IF Y(K9) < HIGHVAL THEN HIGHVAL = Y(K9)
2080 NEXT K9
2090 SCDISP = HIGHVAL - LOWVAL
2100 IF SCDISP = 0 THEN SCDISP = 1
2110 FOR K9 = 1 TO TOTAL
2120 LEFTDISP = INT(1+(Y(K9)-LOWVAL) / SCDISP * 2+.5)
2130 PRINT X(K9);TAB(5+LEFTDISP);C$
2140 NEXT K9
2150 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Logistic)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 PAR1 = 1
180 PAR2 = 5
190 GOSUB 1000 '<< call logistic distribution function
200 FOR J = 1 TO TOTAL
210 PRINT X(J); '<< sequence to screen
220 NEXT J
230 END
1000 REM ========================================================
1010 REM *********************>> LOGISTIC <<*********************
1020 REM ========================================================
1030 REM The Logistic Probability Distribution function is
1040 REM controlled by the variables PAR1 and PAR2.
1050 REM Output takes the form of continuously variable
1060 REM random-order real numbers (negative to positive).
1070 REM The control parameters determine mean and
1080 REM dispersion of the distribution.
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM TOTAL: length of sequence
1130 REM PAR1: control value 1
1140 REM PAR2: control value 2
1150 REM Exiting -
1160 REM X(): array holding Logistic distribution
1170 REM Local -
1180 REM R9: uniform random number
1190 REM K9: loop index, pointer to array X()
1200 REM ========================================================
1210 FOR K9 = 1 TO TOTAL
1220 R9 = RND
1230 X(K9) =(-PAR1 * -LOG(1 / R9 - 1)) / PAR2
1240 NEXT K9
1250 RETURN
100 REM =========================================================
200 REM DRIVER PROGRAM
205 REM =========================================================
220 DIM NUM(20)
230 PERIOD = 2
240 FACTOR = 3
250 STARTNUM = 20
260 NOTES = 20
270 MANY = 10
280 MODE$ = "S"
290 FOR J = 1 TO NOTES
300 NUM(J) = J
310 NEXT J
320 GOSUB 1000 '<< call loop generator (subtractive mode)
330 MODE$ = "A"
340 STARTNUM = 1
350 PRINT:PRINT
360 GOSUB 1000 '<< call loop generator (additive mode)
370 END
1000 REM ========================================================
1010 REM *******************>> LOOPGEN1 <<***********************
1020 REM ========================================================
1030 REM This subroutine is pattern/process oriented.
1040 REM It generates a given number of copies (loops)
1050 REM of an input sequence while processing the
1060 REM sequence in terms of length. The two modes
1070 REM of loop alteration are additive and subtractive.
1080 REM In additive mode, the loop copies grow longer
1090 REM with successive iteration, beginning with a
1100 REM melodic nucleus. In Subtractive mode, loop
1110 REM copies begin with the complete sequence, and
1120 REM grow shorter by a constant factor with each
1130 REM iteration. The loop copies are printed out
1140 REM within the subroutine, rather than being passed
1150 REM back to the main program.
1160 REM ========================================================
1170 REM Variable Descriptions
1180 REM Entering -
1190 REM NUM(): array containing numeric sequence
1200 REM PERIOD: number of cycles between loop change
1210 REM FACTOR: number of values to add/subtr
1220 REM STARTNUM: sequence nucleus in additive mode
1230 REM NOTES: number of values in original sequence
1240 REM MANY: number of loop iterations
1250 REM MODE$: holds flag for additive/subtractive mode
1260 REM
1270 REM Exiting -
1280 REM none
1290 REM
1300 REM Local -
1310 REM ALTER: stores current sequence length
1320 REM SHORT: holds number of values to add/subtract
1330 REM ITER: counts cycles, controls loop growth/trunc.
1340 REM COPIES: loop index
1350 REM ========================================================
1360 SHORT = FACTOR
1370 ITER = PERIOD
1380 IF MODE$ = "A" THEN ALTER = STARTNUM ELSE ALTER = NOTES
1390 IF MODE$ = "S" THEN PRINT "SUBTRACTIVE MODE -" ELSE PRINT "ADDITIVE MODE -"
1400 FOR COPIES = 0 TO MANY-1
1410 IF COPIES < ITER THEN 1440
1420 IF MODE$ = "A" THEN ALTER = STARTNUM + SHORT ELSE ALTER = NOTES - SHORT
1430 IF ALTER > NOTES THEN ALTER = NOTES
1440 FOR DUP = 1 TO ALTER
1450 PRINT NUM(DUP);
1460 NEXT DUP
1470 PRINT "/**/";
1480 IF COPIES = MANY THEN 1530
1490 IF COPIES < ITER THEN 1520
1500 SHORT = SHORT + FACTOR
1510 ITER = ITER + PERIOD
1520 NEXT COPIES
1530 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM X(20),TEMP(20)
140 NUMVALS = 20
150 FACTOR = 6
160 MANY = 6
170 REVERSE$ = "Y"
180 PRINT "ORIGINAL SEQUENCE -"
190 FOR J = 1 TO NUMVALS
200 PRINT J;
210 X(J) = J '<< load array with number sequence
220 NEXT J
230 PRINT
240 PRINT MANY;"COPIES TO BE MADE. DURING EACH CYCLE"
250 PRINT FACTOR;"VALUES WILL BE SHIFTED, REVERSE ORDER -"
260 GOSUB 1000 '<< call loop generator
270 END
1000 REM ========================================================
1010 REM *******************>> LOOPGEN2 <<***********************
1020 REM ========================================================
1030 REM This is a pattern/process oriented subroutine which
1040 REM shifts a specific number of values from the end of
1050 REM a group while generating a given number of loop copies.
1060 REM The shifted values may be placed in reverse order.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM X(): holds original number sequence
1110 REM NUMVALS: total in sequence
1120 REM FACTOR: number of values to shift
1130 REM MANY: number of loops to return
1140 REM REVERSE$: flag to reverse shifted values
1150 REM Exiting -
1160 REM none (original X() array contents are destroyed)
1170 REM
1180 REM Local -
1190 REM TEMP(): stores values to be shifted
1200 REM X(): stores loops, rearranged each cycle
1210 REM COPIES: loop index
1212 REM HOLD: loop index, pointer to array TEMP()
1220 REM GROUP: loop index
1230 REM SHIFT: loop index, pointer to array X()
1240 REM REPLACE: loop index, pointer to array X()
1250 REM CURRLOOP: loop index, pointer to array X()
1260 REM ========================================================
1270 FOR COPIES = 1 TO MANY
1280 REM >>> remove array values to be shifted
1290 FOR HOLD = 0 TO FACTOR - 1
1300 TEMP(HOLD + 1) = X(NUMVALS - HOLD)
1310 NEXT HOLD
1320 REM >>> slide remaining values to end of array
1330 FOR GROUP = 1 TO FACTOR
1340 FOR SHIFT = NUMVALS TO 1 STEP - 1
1350 X(SHIFT) = X(SHIFT - 1)
1360 NEXT SHIFT
1370 NEXT GROUP
1380 REM >>> place values to be moved at head of array
1390 REM >>> if flagged, reverse them
1400 FOR REPLACE = 1 TO FACTOR
1410 IF REVERSE$ = "Y" THEN X(REPLACE) = TEMP(REPLACE) ELSE X(REPLACE) = TEMP(FACTOR + 1 - REPLACE)
1420 NEXT REPLACE
1430 PRINT "/*";
1440 FOR CURRLOOP = 1 TO NUMVALS
1450 PRINT X(CURRLOOP);
1460 NEXT CURRLOOP
1470 PRINT "*/"
1480 NEXT COPIES
1490 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Markov)
130 REM =========================================================
140 DIM CYCLE(5000), SEED(88), FREQ(88)
150 ORDER = 2 '<<nmbr of preceding terms to sum for next term
160 MODULUS = 12 '<< set modulus of residue cycle
170 APPLY$ = "INCLUSIVE" '<< apply to all seeds
180 FOR J = 1 TO 2 '<< generate 2 separate cycles
190 PRINT APPLY$;" ADDITION; SEEDS ARE :";
200 FOR J1 = 1 TO ORDER
210 READ SEED(J1)
220 PRINT SEED(J1); '<< send seeds to screen
230 NEXT J1
240 REM ++++++++++++++++++++
250 DATA 0,1,1,4,5
260 REM ++++++++++++++++++++
270 PRINT
280 GOSUB 1000 '<< call Markovian summation subroutine
290 PRINT
300 PRINT TOTAL; " - MEMBER CYCLE:"
310 PRINT
320 FOR J1 = 1 TO TOTAL
330 PRINT CYCLE(J1), '<< display completed cycle
340 NEXT J1
350 PRINT : PRINT
360 PRINT "FREQUENCY TABLE:"
370 PRINT
380 FOR J1 = 1 TO MODULUS
390 PRINT (J1-1); ":"; FREQ(J1),
400 NEXT J1
410 ORDER = 3 '<< number of preceding terms to sum
420 APPLY$ = "EXCLUSIVE" '<< add outside seed pairs only
430 PRINT
440 PRINT
450 NEXT J
460 END
1000 REM ========================================================
1010 REM MARKOV
1020 REM ========================================================
1030 REM Markovian Integer Summation Residual Cycle Generator
1040 REM ========================================================
1050 REM Variable Descriptions
1060 REM Entering -
1070 REM ORDER: number of immediately preceding terms
1080 REM whose sum determines next term
1090 REM MODULUS: Integer-range modulus; cycle-creating
1100 REM factor to be imposed on each sum
1110 REM SEED(): array of seeds (initial "Order" number
1120 REM of integers to be summed)
1130 REM APPLY$: string to signal inclusive or exclusive
1140 REM addition of series seeds
1150 REM Exiting -
1160 REM CYCLE(): array holding generated integer cycle
1170 REM FREQ(): array of integer occurrence frequencies
1180 REM Local -
1190 REM NXTERM: next term to be computed
1200 REM TOTAL: total number of terms generated
1210 REM K9: loop index
1220 REM L9: loop index
1230 REM ========================================================
1240 FOR K9 = 1 TO ORDER
1250 CYCLE(K9) = SEED(K9) '<< start cycle with seeds
1260 NEXT K9
1270 TOTAL = ORDER
1280 FOR K9 = 1 TO 5000 '<< compute next new term
1290 NXTERM = SEED(ORDER)
1300 FOR L9 = 1 TO (ORDER-1)
1310 NXTERM = NXTERM + SEED(L9)
1320 NEXT L9
1330 IF APPLY$ = "EXCLUSIVE"
THEN NXTERM = SEED(ORDER) + SEED(1)
1340 NXTERM = NXTERM - INT(NXTERM/MODULUS) * MODULUS
1350 CYCLE(K9+ORDER) = NXTERM
1360 FOR L9 = 1 TO (ORDER-1)
1370 SEED(L9) = SEED(L9+1) '<< update seeds
1380 NEXT L9
1390 SEED(ORDER) = NXTERM
1400 TOTAL = TOTAL + 1
1410 FOR L9 = 1 TO ORDER
1420 IF SEED(L9) <> CYCLE(L9) THEN 1470 '<< finished?
1430 NEXT L9
1440 L9 = ORDER
1450 K9 = 5000
1460 TOTAL = TOTAL - ORDER
1470 NEXT K9
1475 GOSUB 2000 ' << call zeromat
1480 FOR K9 = 1 TO MODULUS '<< compute occurrence frequencies
1490 FOR L9 = 1 TO TOTAL
1500 IF CYCLE(L9) + 1 = K9 THEN FREQ(K9) = FREQ(K9) + 1
1510 NEXT L9
1520 NEXT K9
1530 RETURN
2000 REM================================================= CTB1.9
2010 REM *******************>> ZEROMAT <<***********************
2020 REM =======================================================
2030 FOR K9 = 1 TO MODULUS
2040 FREQ(K9) = 0
2050 NEXT K9
2060 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM W(10,10)
140 COUNT = 0
150 TOTAL = 40
160 XLOC = 5 : YLOC = 5 '<< matrix start coordinates
170 ROWS = 10 : COLS = 10
180 PRINT "THE MATRIX FOR THIS RANDOM WALK -"
190 FOR J1 = 1 TO ROWS
200 FOR J2 = 1 TO COLS
210 W(J1,J2)=((J1-1) * COLS) + J2
220 COUNT = COUNT + 1
230 IF (COUNT/COLS) = J1 THEN PRINT W(J1,J2)ELSE PRINT W(J1,J2);
240 IF COUNT < 9 THEN PRINT " ";
250 NEXT J2
260 NEXT J1
270 PRINT "START COORDINATES ARE: ROW ";XLOC;"COLUMN ";YLOC
280 RANDOMIZE
290 GOSUB 1000 '<< call matrix walk
300 END
1000 REM ========================================================
1010 REM *********************>> MATWALK <<**********************
1020 REM ========================================================
1030 REM This subroutine simulates a random walk within the
1040 REM boundaries of a two-dimensional matrix. The walker
1050 REM is free to step up, down, sideways, or diagonally.
1060 REM By shaping the matrix in various proportions, the
1070 REM user can influence the numeric interval sequence.
1080 REM Applied to pitch content, the effect is one of
1090 REM generating melodies with interval class succession
1100 REM which vary with the matrix shape & size.
1110 REM ========================================================
1120 REM Variable Descriptions
1130 REM Entering -
1140 REM W(n,n): random walk matrix
1150 REM TOTAL: number of random steps to be taken
1160 REM XLOC: stores current location on horizontal
1170 REM YLOC: stores current location on vertical
1180 REM ROWS: length of matrix
1190 REM COLS: width of matrix
1200 REM Exiting -
1210 REM none (subroutine is procedural)
1220 REM Local -
1230 REM XSTEP: random number -1, 0, or + 1
1240 REM YSTEP: random number -1. 0, or + 1
1250 REM K9: loop index
1260 REM ========================================================
1270 FOR K9 = 1 TO TOTAL
1280 PRINT W(XLOC,YLOC);" ";
1290 XSTEP = INT(RND * 3) - 1
1300 YSTEP = INT(RND * 3) - 1
1310 XLOC = XLOC + XSTEP
1320 YLOC = YLOC + YSTEP
1330 IF XLOC <= 0 THEN XLOC = 2 ELSE IF XLOC > ROWS THEN XLOC = ROWS - 1
1340 IF YLOC <= 0 THEN YLOC = 2 ELSE IF YLOC > COLS THEN YLOC = COLS - 1
1350 NEXT K9
1360 RETURN
100 REM =========================================================
110 REM PROGRAM DRIVER
120 REM (Meline)
130 REM =========================================================
140 DIM NOTE$(100),P$(84)
150 RANDOMIZE
160 TOTAL = 10 '<< length of sequence
170 SMALL = 1
180 LARGE = 3
190 UP = 80
200 REST = 0
210 START = 48
220 GOSUB 3010 '<< call pitch table
230 FOR J = 1 TO 4
240 NOTE$(1) = P$(START)
250 NOTE = START
260 PRINT "PASS";J
270 PRINT "TOTAL =";TOTAL;";SMALL=";SMALL;";LARGE =";LARGE;";UP =";UP;";REST=";REST;";START =";START
280 PRINT NOTE$(1);" ";
290 FOR J1 = 2 TO TOTAL
300 GOSUB 1000 '<<call rest probability
310 IF FLAG = 0 THEN GOSUB 2000 '<< call interval generator
320 PRINT NOTE$(J1);" "; '<< send array to screen
330 NEXT J1
340 PRINT
350 TOTAL = TOTAL + 10
360 SMALL = SMALL + 1
370 LARGE = LARGE + 2
380 INTVALRANGE = LARGE-SMALL+1
390 UP = UP - 20
400 REST = REST + 10
410 NEXT J
420 END
1000 REM =========================================================
1010 REM ***********************>> REST <<************************
1020 REM =========================================================
1030 REM This subroutine is similar to ADDORN, in that
1040 REM it checks a rest percentage threshold value
1050 REM before deciding whether to insert a rest note
1060 REM =========================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM REST: threshold test value (% of rest)
1100 REM NOTE$(): array to receive rest string (if selected)
1110 REM P$(0): pitchtable array address holding rest string
1120 REM J1: pointer to NOTE$() array
1130 REM Exiting -
1140 REM FLAG: signal to DRIVER not to call pitch generator
1150 REM NOTE$():
1160 REM Local - none
1170 REM =========================================================
1180 FLAG = 0
1190 IF RND * 100 <= REST THEN NOTE$(J1) = P$(0) : FLAG = 1
1200 RETURN
2000 REM =========================================================
2010 REM *********************>> MELINT <<************************
2020 REM =========================================================
2030 REM This subroutine resembles RDINTCHD in concept.
2040 REM However, it generates an interval-contained
2050 REM melodic sequence which is bi-directional
2060 REM as opposed to RDINTCHD's harmonic, unidirectional
2070 REM orientation.
2080 REM =========================================================
2090 REM Variable Descriptions
2100 REM Entering -
2110 REM SMALL: smallest allowable interval-size
2120 REM INTVALRANGE: span of allowable interval-sizes
2130 REM NOTE: most recent note generated
2140 REM UP: probability of upward interval motion
2150 REM NOTE$(): array to be filled with notes/rests
2160 REM P$(): pitch table array
2170 REM J1: pointer to NOTE$() array
2180 REM Exiting -
2190 REM NOTE$():
2200 REM Local -
2210 REM U: range-controlled random integer
2220 REM =======================================================
2230 U = INT(RND * INTVALRANGE) + SMALL
2240 IF RND * 100 <= UP THEN NOTE = NOTE + U ELSE NOTE = NOTE - U
2250 IF NOTE > 84 THEN NOTE = NOTE - 12 ELSE IF NOTE < 1 THEN NOTE = NOTE + 12 '<< in bounds?
2260 NOTE$(J1) = P$(NOTE)
2270 RETURN
3000 REM =========================================================
3010 REM ********************>> PITCHTAB <<***********************
3020 REM =========================================================
3030 NOTE$ = " CC# DD# E FF# GG# AA# B"
3040 OCTAVE$ = "1234567"
3050 P$(0) = " R "
3060 FOR K9 = 1 TO 7
3070 FOR L9 = 1 TO 12
3080 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
3090 NEXT L9
3100 NEXT K9
3110 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Modops)
130 REM =========================================================
140 DIM P$(12)
150 DIM X(12),Y(12)
160 RANDOMIZE
170 TOTAL = 12
180 OP = 5 '<< value for m5 operation
190 GOSUB 1000 '<< call pitch table
200 GOSUB 2000 '<< call random shuffle
210 PRINT
220 PRINT "RANDOM-ORDER 12-TONE SET --"
230 FOR J = 0 TO TOTAL-1
240 PRINT P$(X(J));" "; '<< random 12-tone set to screen
250 NEXT J
260 PRINT : PRINT
270 FOR J = 1 TO 2
280 GOSUB 3000 '<< call m5/m7 permutation
290 PRINT "THE PERMUTATION RESULTING FROM ";"M";OP;" OPERATION"
300 FOR J1 = 0 TO TOTAL-1
310 PRINT P$(Y(J1));" "; '<< send perm to screen
320 NEXT J1
330 PRINT : PRINT
340 OP = 7 '<< value for m7 operation
350 NEXT J
360 END
1000 REM ========================================================
1010 REM *******************>> PITCHTAB <<***********************
1020 REM (modified to load pitch classes only)
1030 REM ========================================================
1040 FOR J = 0 TO TOTAL-1
1050 X(J) = J '<< load set elements
1060 READ P$(J) '<< load pitch class equivalents
1070 NEXT J
1080 REM+++++++++++++++++++++++++++++++++
1090 DATA C,C#,D,D#,E,F,F#,G,G#,A,A#,B
1100 REM+++++++++++++++++++++++++++++++++
1110 RETURN
2000 REM ========================================================
2010 REM ********************>> CONSHUFL <<**********************
2020 REM ========================================================
2030 FOR K9 = 0 TO TOTAL-1
2040 R9 = INT(RND * TOTAL)
2050 S9 = X(K9)
2060 X(K9) = X(R9)
2070 X(R9) = S9
2080 NEXT K9
2090 RETURN
3000 REM ========================================================
3010 REM *********************>> M5SETM7 <<**********************
3020 REM ========================================================
3030 REM This subroutine outputs a permutation of an input
3040 REM set (series) by the "M5" or "M7" operation.
3050 REM ========================================================
3060 REM Variable Descriptions
3070 REM Entering -
3080 REM X(): array holding random 12-tone set
3090 REM OP: value for m5 or m7 operation
3100 REM Exiting -
3110 REM Y(): array holding m5 or m7 permutation
3120 REM Local -
3130 REM K9: loop index, pointer to X(),Y()
3140 REM =======================================================
3150 FOR K9 = 0 TO 11
3160 Y(K9) = (X(K9) * OP) MOD 12
3170 NEXT
3180 RETURN
100 REM ========================================================
110 REM DRIVER PROGRAM
120 REM ========================================================
125 M = 12 '<< set modulus to 12
130 FOR J = 0 TO 83 '<< values to be converted mod M
140 M = 12 '<< set modulus to 12
150 GOSUB 1000 '<< call mod function
160 PRINT R; '<< send remainder to screen
170 IF R = 11 THEN PRINT '<< start newline
180 NEXT J
190 END
1000 REM ========================================================
1010 REM ********************>> MODULO <<************************
1020 REM ========================================================
1030 REM This subroutine is actually a function which
1040 REM receives an integer and returns the value of the
1050 REM integer modulo n. A more practical alternative
1060 REM is to code it as a user-defined funcion:
1070 REM DEF FNM(J,M) = J - INT(J / M) * M
1080 REM ========================================================
1090 REM
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM M: the modulus to be applied
1130 REM J: the integer to be returned mod M
1140 REM Exiting -
1150 REM R: the remainder mod I to be returned
1160 REM Local -
1170 REM none
1180 REM
1190 REM ========================================================
1200 R = J-INT(J/M)*M
1210 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM Motforms
130 REM =========================================================
140 DIM X(15),Y(15),P$(84)
150 RANDOMIZE(967)
160 GOSUB 1000 '<< call pitch table
170 TOTAL = 15
180 PRINT "ORIGINAL PITCH MOTIF --"
190 FOR J = 1 TO TOTAL
200 X(J) = INT(RND * 12) + 1
210 PRINT P$(X(J));" "; '<< random motif to screen
220 NEXT J
230 PRINT
240 GOSUB 3000 '<< call retrograde
250 PRINT "THE RETROGRADE MOTIF --"
260 GOSUB 2000 '<< call table print
270 PRINT
280 GOSUB 4000 '<< call motif inversion
290 PRINT "THE INVERTED MOTIF --"
300 GOSUB 2000 '<< call table print
310 PRINT
320 INTVAL = 1 '<< (set transposition interval
330 PRINT "ORIGINAL MOTIF TRANSPOSITIONS"
340 FOR J = 1 TO 11
350 PRINT "NUMBER ";J
360 GOSUB 5000 '<< call motif transposition
370 GOSUB 2000 '<< call table print
380 PRINT
390 INTVAL = INTVAL + 1
400 NEXT J
410 END
1000 REM =========================================================
1010 REM ********************>> PITCHTAB <<***********************
1020 REM =========================================================
1030 NOTE$ = " CC# DD# E FF# GG# AA# B"
1040 OCTAVE$ = "1234567"
1050 FOR K9 = 1 TO 7
1060 FOR L9 = 1 TO 12
1070 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
1080 NEXT L9
1090 NEXT K9
1100 RETURN
2000 REM ========================================================
2010 REM ********************>> TABLPRNT <<**********************
2020 REM ========================================================
2030 FOR K9 = 1 TO TOTAL
2040 PRINT P$(Y(K9));" ";
2050 NEXT K9
2060 RETURN
3000 REM ========================================================
3010 REM *********************>> MOTRETRO <<*********************
3020 REM ========================================================
3030 REM This subroutine accepts an input pitch sequence
3040 REM and outputs its retrograde form.
3050 REM ========================================================
3060 REM Variable Descriptions
3070 REM Entering -
3080 REM X(): prime motif array
3090 REM TOTAL: motif length
3100 REM Exiting -
3110 REM Y(): retrograde motif array
3120 REM Local -
3130 REM L: pointer to Y()
3140 REM K9; loop index, pointer to X()
3150 REM ========================================================
3160 FOR K9 = 1 TO TOTAL
3170 L = TOTAL-K9+1
3180 Y(L)=X(K9)
3190 NEXT K9
3200 RETURN
4000 REM ========================================================
4010 REM ********************>> MOTINVRT <<**********************
4020 REM ========================================================
4030 REM This subroutine accepts an input pitch sequence
4040 REM and outputs its mirror image form.
4050 REM ========================================================
4060 REM Variable Descriptions
4070 REM Entering -
4080 REM X(): prime motif array
4090 REM TOTAL: motif length
4100 REM Exiting -
4110 REM Y(): inverted motif array
4120 REM Local -
4130 REM K9: loop index, pointer to X(),Y()
4140 REM ========================================================
4150 Y(1)=X(1)
4160 FOR K9 = 2 TO TOTAL
4170 Y(K9) = Y(K9-1)-(X(K9)-X(K9-1))
4180 NEXT K9
4190 RETURN
5000 REM ========================================================
5010 REM ********************>> MOTRNPZ <<***********************
5020 REM ========================================================
5030 REM This subroutine transposes an input motif by
5040 REM a specified number of 1/2 steps. Transposition
5050 REM direction is determined by the sign of the
5060 REM transposition interval.
5070 REM ========================================================
5080 REM Variable Descriptions
5090 REM Entering -
5100 REM X(): array holding random motif
5110 REM TOTAL: motif length
5120 REM INTVAL: interval of transposition in 1/2-steps
5130 REM Exiting -
5140 REM Y(): array holding transposed motif
5150 REM Local -
5160 REM K9: loop index, pointer to Y()
5170 REM ========================================================
5180 FOR K9 = 1 TO TOTAL
5190 Y(K9) = X(K9) + INTVAL
5200 NEXT K9
5210 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Normhist)
130 REM =========================================================
140 DIM X(20)
150 RANGE = 20 '<< set random number range 1-20
160 TOTAL = 1000 '<< return 1000 values
170 RANDOMIZE
180 CLS
190 PRINT "INTEGER VALUE";TAB(20);"NORM. VALUE";TAB(40);"BAR MAP"
200 GOSUB 1000 '<< generate frequency table
210 GOSUB 2000 '<< call data normalization
220 GOSUB 3000 '<< call bargraph display
230 END
1000 REM ========================================================
1010 REM *******************>> FREQTABL <<***********************
1020 REM ========================================================
1030 FOR K9 = 1 TO TOTAL
1040 VALUE = INT(RND * RANGE)+1 '<< gen random value
1050 X(VALUE)=X(VALUE)+1 '<< record occurrence of value
1060 NEXT K9
1070 RETURN
2000 REM SS1ST6 =================================================
2010 REM ********************>> DATANORM <<**********************
2020 REM ========================================================
2030 REM This subroutine compresses wide-range data to
2040 REM fit within the range of 0 to 1. It is especially
2050 REM helpful when printing histograms of huge amounts
2060 REM of data which would otherwise cause the bars to
2070 REM wrap-around the screen.
2080 REM
2090 REM To adequately test probability distribution
2100 REM functions for musical uses, it often is necessary
2110 REM to generate thousands of values to flesh out a
2120 REM curve. When this is the goal, it is important
2130 REM to observe the shape of the distribution, not
2140 REM specific integer frequencies.
2150 REM =======================================================
2160 REM Variable Descriptions
2170 REM Entering -
2180 REM X(): frequency table to be normalized
2190 REM RANGE: range of integers in frequency table
2200 REM Exiting -
2210 REM X(): normalized frequency table
2220 REM Local -
2230 REM SUM: total of values frequency table
2240 REM K9: loop index,pointer to array X()
2250 REM ========================================================
2260 SUM = 0
2270 FOR K9 = 1 TO RANGE
2280 SUM = SUM + X(K9)
2290 NEXT K9
2300 FOR K9=1 TO RANGE
2310 X(K9) = X(K9)/ SUM
2320 NEXT K9
2330 PRINT
2340 RETURN
3000 REM ========================================================
3010 REM *******************>> BARGRAPH <<***********************
3020 REM (adapted to program specs)
3030 REM ========================================================
3040 FOR K9=1 TO RANGE
3050 MAP = INT(100*X(K9)+.5)
3060 PRINT K9;"=";TAB(20);X(K9);TAB(40);STRING$(MAP,">")
3070 NEXT K9
3080 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM GAMINTS(12),P$(96)
140 GAMUTS = 3 '<< number of unique gamuts
150 RANDOMIZE
160 SEGTOTAL = 3 '<< # of scale segments to return per gamut
170 INTOTAL = 6 '<< number of intervals in scale
180 GOSUB 2000 '<< call pitch table
190 FOR J1 = 1 TO GAMUTS
200 PRINT "SCALE GAMUT";J1;"INTERVAL SET ---";
210 HIGHOCTAVE = 7
220 EXCEED = 0
230 REM >>> select an octave-containable (scale) interval set
240 FOR J2 = 1 TO INTOTAL
250 GAMINTS(J2) = INT(RND * 3) + 1
260 EXCEED = EXCEED + GAMINTS(J2)
270 IF EXCEED > 11 THEN 220 '<< within octave?
280 NEXT J2
290 FOR J = 1 TO INTOTAL
300 PRINT GAMINTS(J);
310 NEXT J
320 PRINT
330 GOSUB 1000 '<< call scale generator
340 NEXT J1
350 END
1000 REM ========================================================
1010 REM *******************>> OCTSCALE <<***********************
1020 REM ========================================================
1030 REM This subroutine generates octave-repeating
1040 REM scales from a set of intervals.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM Entering -
1080 REM P$(): pitch name table
1090 REM GAMINTS(): array of interval sizes
1100 REM TONIC: lowest scale/gamut member
1110 REM HIGHOCTAVE: upper register octave limit
1120 REM INTOTAL: number of intervals in GAMINTS()
1130 REM SEGTOTAL: numeric length of scale segment
1140 REM Exiting -
1150 REM none (subroutine is procedural)
1160 REM Local -
1170 REM COUNT: tabulates chordtone generation
1180 REM SCALETONE: next chord/gamut member
1190 REM STARTOCTAVE: scale segment beginning register
1200 REM SCALEMEMS: number of tones in scale segment
1210 REM K9: loop index
1220 REM L9: loop index, pointer to array GAMINTS()
1230 REM M9: loop index, pointer to array P$()
1240 REM ========================================================
1250 FOR K9 = 1 TO SEGTOTAL
1260 TONIC= INT(RND * 12)+1
1270 STARTOCTAVE = INT(RND * 3)+1
1280 SCALEMEMS = INT(RND * 17)+4
1290 PRINT "scale segment";K9;"=";SCALEMEMS;"notes"
1300 COUNT = 0
1310 FOR L9 = STARTOCTAVE TO HIGHOCTAVE
1320 SCALETONE = TONIC
1330 FOR M9 = 1 TO INTOTAL+1
1340 PRINT P$(SCALETONE + ((L9-1) * 12));" ";
1350 COUNT = COUNT + 1
1360 IF COUNT = SCALEMEMS THEN 1410
1370 IF M9 > INTOTAL THEN 1400
1380 SCALETONE = SCALETONE + GAMINTS(M9)
1390 NEXT M9
1400 NEXT L9
1410 PRINT
1420 NEXT K9
1430 PRINT
1440 RETURN
2000 REM ========================================================
2010 REM *******************>> PITCHTAB <<***********************
2020 REM ========================================================
2030 REM This subroutine initializes a pitch data table
2040 REM corresponding to integer values 1-n.
2050 REM ========================================================
2060 NOTE$ = " CC# DD# E FF# GG# AA# B"
2070 OCTAVE$ = "1234567"
2080 FOR K9 = 1 TO 7
2090 FOR L9 = 1 TO 12
2100 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
2110 NEXT L9
2120 NEXT K9
2130 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Ornament)
130 REM =========================================================
140 DIM P$(84),TEMP(200),NOTE$(500)
150 DIM DEC(6),ORN(4),EMBTABLE(4)
160 ORN(1) = 1002 : ORN(2) = 2003
170 ORN(3) = 2004 : ORN(4) = 4006
180 DEC(1) = -1 : DEC(2) = 0 : DEC(3) = -1
190 DEC(4) = 0 : DEC(5) = 1 : DEC(6) = 0
200 DECO = 100 '<< % of sequence notes to decorate
210 RANDOMIZE(-11001)
220 GOSUB 3000 '<< call pitch table
230 MELENGTH = 20
240 PRINT "UNEMBELLISHED PITCH SEQUENCE =";MELENGTH;"NOTES --"
250 FOR J = 1 TO MELENGTH
260 TEMP(J) = INT(RND * 81) + 2
270 PRINT P$(TEMP(J));" "; '<< random sequence to screen
280 NEXT J
290 PRINT : PRINT
300 GOSUB 1000 '<< call ornament selection
310 PRINT "EMBELLISHED PITCH SEQUENCE =";T3;"NOTES ---"
320 FOR J = 0 TO T3
330 PRINT NOTE$(J);" "; '<< embellished seq. to screen
340 NEXT J
350 END
1000 REM ========================================================
1010 REM *******************>> ORNSELEC <<***********************
1020 REM ********* (variation of PROBTABL subroutine) **********
1030 REM ========================================================
1040 REM This subroutine loads a probability table
1050 REM with weights for each of 4 ornament patterns,
1060 REM then calls ADDORN subroutine to interpolate
1070 REM the selected embellishments.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM P$(): pitch table array
1120 REM TEMP(): stores sequence prior to decoration
1130 REM MELENGTH: number of notes in original sequence
1140 REM DECO: percentage of sequence notes to decorate
1150 REM Exiting -
1160 REM NOTE$(): stores final, embellished sequence
1170 REM T3: final number of notes in sequence
1180 REM Local -
1190 REM EMBTABLE(): stores ornament pattern probabilities
1200 REM WSUM: sum of ornament probability weights
1210 REM K9: loop index, pointer to array TEMP()
1220 REM ========================================================
1230 T3 = 0
1240 IF DECO = 0 THEN 1360
1250 PRINT "ORNAMENTS BEING ADDED (PROB. WEIGHTS 4,3,2,1) ---"
1260 PRINT "1) _ - 2) - _ 3) - _ - 4) _ - _"
1270 WSUM = 0
1280 FOR K9 = 1 TO 4
1290 READ EMBTABLE(K9)
1300 EMBTABLE(K9) = EMBTABLE(K9) + WSUM
1310 WSUM = EMBTABLE(K9)
1320 NEXT K9
1330 REM +++++++++++++++++++
1340 DATA 4,3,2,1
1350 REM +++++++++++++++++++
1360 FOR K9 = 1 TO MELENGTH
1370 IF RND * 100 > DECO THEN NOTE$(T3) = P$(TEMP(K9)) ELSE GOSUB 2000
1380 T3 = T3 + 1
1390 NEXT K9
1400 PRINT
1410 RETURN
2000 REM ========================================================
2010 REM *********************>> ADDORN <<***********************
2020 REM ========================================================
2030 REM This subroutine adds selected embellishment
2040 REM patterns to a pre-existant melodic sequence.
2050 REM In the process, the sequence is transferred
2060 REM to a pitch character string array.
2070 REM ========================================================
2080 REM Variable Descriptions
2090 REM Entering -
2100 REM P$(): pitch table array
2110 REM TEMP(): stores sequence prior to decoration
2120 REM EMBTABLE():
2130 REM ORN(): array of ornament patterns
2140 REM DEC(): array of values for pattern reference
2150 REM NOTE$(): stores final, embellished sequence
2160 REM WSUM: sum of ornament probability weights
2170 REM K9: pointer to array TEMP()
2180 REM Exiting -
2190 REM NOTE$(): (above)
2200 REM T3: pointer to array NOTE$()
2210 REM Local -
2220 REM I8: loop index, pointer to array DEC()
2230 REM I9: loop index, pointer to array DEC()
2240 REM M9: loop index, pointer to array ORN()
2250 REM N9: loop index, pointer to array DEC()
2260 REM ========================================================
2270 FOR M9 = 1 TO 4
2280 IF RND * WSUM > EMBTABLE(M9) THEN 2350
2290 I8 = INT(ORN(M9) / 1000) : I9 = CINT((ORN(M9) / 1000 - INT(ORN(M9) / 1000)) * 1000)
2300 FOR N9 = I8 TO I9
2310 NOTE$(T3) = P$(TEMP(K9) + DEC(N9))
2320 T3 = T3 + 1
2330 NEXT N9
2340 RETURN 1390
2350 NEXT M9
2360 RETURN 1390
3000 REM =========================================================
3010 REM ********************>> PITCHTAB <<***********************
3020 REM =========================================================
3030 REM This subroutine initializes a pitch data table
3040 REM corresponding to integer values 1-n.
3050 REM =========================================================
3060 NOTE$ = " CC# DD# E FF# GG# AA# B"
3070 OCTAVE$ = "1234567"
3080 FOR K9 = 1 TO 7
3090 FOR L9 = 1 TO 12
3100 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
3110 NEXT L9
3120 NEXT K9
3130 RETURN
100 REM ========================================================
110 REM DRIVER PROGRAM
120 REM (Partspan)
130 REM ========================================================
140 DIM P$(84),NOTE(48),PART(4),ADJUST(4)
150 CHORDLENGTH = 48 '<< pitchbank
160 VOICES = 4 '<< nmbr of parts
170 MELENGTH = 30 '<< notes in each derived part
180 RANDOMIZE
190 FOR J = 1 TO CHORDLENGTH
200 NOTE(J) = J '<< load pitchbank pointers
210 NEXT J
220 GOSUB 2000 '<< call pitch table
230 PRINT "PITCHBANK UPON WHICH MELODIES WILL BE BASED --"
240 FOR J = 1 TO CHORDLENGTH
250 PRINT P$(J);" "; '<< send pitchbank to screen
260 NEXT J
270 PRINT : PRINT
280 GOSUB 1000 '<< call part range computation
290 FOR J1 = 1 TO 2
300 IF J1 = 2 THEN PRINT "PASS 2, INTERLOCKING -" : D$ = "I" ELSE PRINT "PASS 1, STRATIFIED -" : D$ = "S"
310 FOR J2 = 1 TO VOICES
320 PRINT "VOICE";J2;"MELODY"
330 PRINT "RANGE =";P$(ADJUST(J2));" TO ";
340 PRINT P$(ADJUST(J2) + PART(J2) - 1)
350 FOR J3 = 1 TO MELENGTH
360 R = INT(RND * PART(J2)) + ADJUST(J2)
370 PRINT P$(NOTE(R));" ";
380 NEXT J3
390 PRINT
400 NEXT J2
410 PRINT
420 NEXT J1
430 END
1000 REM =======================================================
1010 REM ********************>> PARTSPAN <<*********************
1020 REM =======================================================
1030 REM This subroutine computes stratified or interlocking
1040 REM instrumental part ranges in reference to a pitch
1050 REM bank which will be used to generate melodic lines.
1060 REM =======================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM VOICES: number of part ranges
1100 REM CHORDLENGTH: number of notes in source pitch bank
1110 REM D$: flag to indicate stratified or interlocking
1120 REM Exiting -
1130 REM ADJUST(): array of part low pitches
1140 REM PART(): array of part ranges
1150 REM Local -
1160 REM SPAN: subdivision of total pitch bank range
1170 REM EXTRA: any remainder from subdivision
1180 REM COMP: compensatory value added to part(s)
1190 REM K9: loop index, pointer to arrays PART(),ADJUST()
1200 REM =======================================================
1210 SPAN = INT(CHORDLENGTH / VOICES)
1220 EXTRA = CHORDLENGTH-(VOICES*SPAN)
1230 FOR K9 = 1 TO VOICES
1240 IF EXTRA <= 0 THEN COMP = 0 ELSE COMP = 1
1250 PART(K9) = SPAN + COMP
1260 EXTRA = EXTRA - 1
1270 ADJUST(1) = 1
1280 IF K9 < VOICES THEN ADJUST(K9+1) = ADJUST(K9) + PART(K9)
1290 NEXT K9
1300 IF D$ = "S" THEN 1350
1310 REM >>> interlock part pitch ranges
1320 FOR K9 = 1 TO VOICES-1
1330 PART(K9) = PART(K9) + INT(PART(K9) * .5)
1340 NEXT K9
1350 RETURN
2000 REM ========================================================
2010 REM ********************>> PITCHTAB <<**********************
2020 REM ========================================================
2030 REM This subroutine initializes a pitch data table
2040 REM corresponding to integer values 1-n.
2050 REM ========================================================
2060 NOTE$ = " CC# DD# E FF# GG# AA# B"
2070 OCTAVE$ = "1234567"
2080 FOR K9 = 1 TO 7
2090 FOR L9 = 1 TO 12
2100 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
2110 NEXT L9
2120 NEXT K9
2130 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Permutot)
130 REM =========================================================
140 ELEMENTS = 1
150 MANY = 1
160 FOR J = 1 TO 10
170 GOSUB 1000 '<< call combinations
180 PRINT "PERMUTATIONS OF";ELEMENTS;"THINGS TAKEN";MANY;"AT A TIME IS";PERMUTS
190 ELEMENTS= ELEMENTS+ 3
200 MANY = MANY + 2
210 NEXT J
220 END
1000 REM SS2ST6 =================================================
1010 REM ********************>> PERMUTS <<***********************
1020 REM ========================================================
1030 REM This subroutine computes the number of possible
1040 REM permutations of n elements taken n at a time.
1050 REM It relies on Stirling's approximation to calculate
1060 REM the requisite factorials.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM ELEMENTS: nunber of items
1110 REM MANY: taken at a time
1120 REM Exiting -
1130 REM PERMUTS : permutation of ELEMENTS, taken MANY at
1140 REM a time
1150 REM Local -
1160 REM NUM:
1170 REM ELEMFACT: log of ELEMENTS factorial
1180 REM MANYFACT: log of MANY factorial
1190 REM ========================================================
1200 NUM = ELEMENTS
1210 GOSUB 2000 '<< call Stirling's approximation
1220 ELEMFACT = APPR
1230 NUM = ELEMENTS - MANY
1240 GOSUB 2000 '<< call Stirling's approximation
1250 MANYFACT = APPR
1260 PERMUTS = INT(EXP(ELEMFACT-MANYFACT)+.5)
1270 RETURN
2000 REM ========================================================
2010 REM ********************>> STIRLING <<**********************
2020 REM ========================================================
2030 APPR = 1
2040 IF NUM <= 0 THEN APPR = 0 : RETURN
2050 FOR K9 = 1 TO 10
2060 APPR = APPR * K9
2070 IF NUM = K9 THEN APPR = LOG(APPR) : RETURN
2080 NEXT K9
2090 APPR = LOG(6.283186)/2+LOG(NUM)*(NUM+.5)-NUM+1/(12*NUM)
2100 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM P$(84) '<< prepare array to hold 7 octaves
140 GOSUB 1000 '<< initialize pitch table
150 FOR J = 1 TO 84
160 PRINT "NUM";J;"="; '<< send a number to screen
170 PRINT P$(J), '<< send corresponding pitch to screen
180 NEXT J
190 END
1000 REM =========================================================
1010 REM ********************>> PITCHTAB <<***********************
1020 REM =========================================================
1030 REM This subroutine initializes a pitch data table
1040 REM corresponding to integer values 1-n.
1050 REM =========================================================
1060 REM Variable Descriptions
1070 REM
1080 REM Entering -
1090 REM none
1100 REM
1110 REM Exiting -
1120 REM P$(): hold pitch element table
1130 REM
1140 REM Local -
1150 REM NOTE$: char string holding pitch class names
1160 REM OCTAVE$: char string holding octave registers
1170 REM K9: loop index, pointer to NOTE$ substring
1180 REM L9: loop index, pointer to OCTAVE$ substring
1190 REM
1200 REM =========================================================
1210 NOTE$ = " CC# DD# E FF# GG# AA# B"
1220 OCTAVE$ = "1234567"
1230 FOR K9 = 1 TO 7
1240 FOR L9 = 1 TO 12
1250 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
1260 NEXT L9
1270 NEXT K9
1280 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Poisson)
130 REM =========================================================
140 DIM X(100)
150 RANDOMIZE
160 TOTAL = 100
165 SPREAD = 5
170 GOSUB 1000 '<< call Poisson distribution function
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM ********************>> POISSON <<***********************
1020 REM ========================================================
1030 REM The Poisson Probability Distribution returns
1040 REM non-negatve, random-order, integers. The control
1050 REM variable, SPREAD, determines the distribution
1060 REM of values.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM TOTAL: length of sequence
1110 REM SPREAD: scaling parameter
1120 REM Exiting -
1130 REM X(): array holding poisson distribution
1140 REM Local -
1150 REM NUM:
1160 REM R9: uniform random number
1170 REM T9: while loop limit
1180 REM K9: loop index, pointer to array X()
1190 REM ========================================================
1200 FOR K9 = 1 TO TOTAL
1210 NUM = 0
1220 R9 = RND
1230 T9 = EXP(-SPREAD)
1240 WHILE R9 > T9
1250 NUM = NUM + 1
1260 R9 = R9 * RND
1270 WEND
1280 X(K9) = NUM
1290 NEXT K9
1300 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Polyrhy)
130 REM =========================================================
140 DIM DUR(100), FRACTION$(100)
150 RANDOMIZE
160 TOTAL = 10
170 M1= 3
180 LEVEL = 1
190 TIMESCALE = 10
200 FOR J = 1 TO 4
210 PRINT "PASS ";J
220 PRINT "LENGTH OF RHYTHM SEQUENCE = ";TOTAL
230 PRINT "MEDIAN =";M1
240 PRINT "TIMESCALE = ";TIMESCALE;"(scale = 1-10)"
250 PRINT "LEVEL = ";LEVEL;
260 PRINT "(from a choice of 1-2-4-8)"
270 GOSUB 1000
280 FOR J1 = 1 TO TOTAL
290 PRINT FRACTION$(J1);
300 NEXT J1
310 PRINT:PRINT
320 LEVEL = LEVEL + LEVEL
330 TOTAL = TOTAL + 10
340 M1 = M1 + 1
350 NEXT J
360 END
1000 REM ========================================================
1010 REM ********************>> POLYRHY <<***********************
1020 REM ========================================================
1030 REM This subroutine computes random-order rhythm
1040 REM duration sequences on 4 selectable levels of
1050 REM complexity. It produces polyrhythmic/metric
1060 REM output layers which occupy identical time frames;
1070 REM That is, as long as the timescale remains
1080 REM constant, all independent output layers will
1090 REM end synchronously, regardless of metrical
1100 REM orientation (3/4,4/4,5/4,7/4,9/4,etc.).
1110 REM =======================================================
1120 REM Variable Descriptions
1130 REM Entering -
1140 REM TOTAL: length of rhythm sequence
1150 REM TIMESCALE: arbitrary time reference
1160 REM M1: basic metrical unit
1170 REM LEVEL: degree of complexity (1-2-4-8)
1180 REM Exiting - (to DRIVER)
1190 REM FRACTION$(): array storing duration fractions
1200 REM Exiting - (to DURRED subroutine)
1210 REM DUR(): array storing fraction numerators
1220 REM NEWMED: reduced fraction denominator
1230 REM K9:loop index, pointer to DUR()
1240 REM Local -
1250 REM ODD: holds flag for odd number of values
1260 REM SUM: total of micropulses in raw sequence
1270 REM BASE: number of micropulses to distribute
1280 REM MEDIAN: metrical base value (3,4,5,7,9,etc)
1290 REM FACTOR: determinant of rnd generator range
1300 REM RANGE: span of rnd generator
1310 REM WEDGE: low bias of rnd generator
1320 REM RCOMP: rnd generator overrun or underrun
1330 REM U,R0,F0: random values for duration numerators
1340 REM K9: loop index, pointer to DUR(), FRACTION$()
1350 REM L9: loop index, pointer to DUR()
1360 REM ========================================================
1370 ODD = 0
1380 SUM = 0
1390 MEDIAN = M1
1400 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1410 REM Lines 1440-1530 reconcile sequence length with
1420 REM metrical base value and timescale.
1430 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1440 BASE = MEDIAN * TIMESCALE
1450 IF TOTAL = 1 THEN DUR(1) = TIMESCALE : GOTO 1840 ELSE IF TIMESCALE - TOTAL > 0 THEN 1490
1460 FOR K9 = 1 TO 30
1470 IF TOTAL > BASE THEN MEDIAN = MEDIAN * 2 : BASE = BASE * 2 ELSE 1580
1480 NEXT K9
1490 IF BASE/2 <> INT(BASE/2)THEN BASE = BASE - 1 : ODD = M1
1500 FOR K9 = 1 TO 100
1510 IF BASE/2 <> INT(BASE/2)OR MEDIAN/2 <> INT(MEDIAN/2) THEN 1580
1520 IF TOTAL <= BASE / 2 THEN MEDIAN = MEDIAN / 2 : BASE = BASE / 2 ELSE 1580
1530 NEXT K9
1540 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1550 REM Lines 1580-1790 compute micropulse (subdivision)
1560 REM level and generate random-order durations.
1570 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1580 BASE = BASE * LEVEL
1590 MEDIAN = MEDIAN * LEVEL
1600 IF LEVEL = 4 THEN FACTOR = 3 ELSE IF LEVEL = 8 THEN FACTOR = 4 ELSE FACTOR = LEVEL
1610 WEDGE = FACTOR
1620 RANGE = (FACTOR + LEVEL) + INT(BASE/TOTAL)
1630 FOR K9 = 1 TO TOTAL
1640 U = INT(RND * RANGE) + WEDGE
1650 DUR(K9) = U
1660 SUM = SUM + U
1670 NEXT K9
1680 RCOMP = BASE - SUM
1690 FOR K9 = 1 TO 10000
1700 FOR L9 = 1 TO TOTAL
1710 IF RCOMP < 0 THEN 1730
1720 IF RCOMP = 0 THEN 1760 ELSE DUR(L9) = DUR(L9) + 1 : RCOMP = RCOMP - 1 : GOTO 1740
1730 IF DUR(L9) < 2 THEN 1740 ELSE DUR(L9) = DUR(L9) - 1 : RCOMP = RCOMP + 1
1740 NEXT L9
1750 NEXT K9
1760 IF ODD < 1 THEN 1840
1770 R0 = INT(RND * TOTAL) + 1
1780 F0 = INT(RND * TOTAL) + 1
1790 IF TOTAL > 1 AND F0 = R0 THEN 1780 ELSE DUR(R0) = DUR(R0) + DUR(F0) : DUR(F0) = -1
1800 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1810 REM Lines 1140-1880 reduce duration fraction and
1820 REM load the sequence into a character string array
1830 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1840 FOR K9 = 1 TO TOTAL
1850 NEWMED = MEDIAN
1860 IF DUR(K9)/2 = INT(DUR(K9)/2)AND NEWMED/2 = INT(NEWMED/2) THEN GOSUB 2000 '<< call fraction reduction
1870 IF DUR(K9) < 0 THEN FRACTION$(K9) = STR$(1)+"/"+MID$(STR$(ODD),2) ELSE FRACTION$(K9) = STR$(DUR(K9)) + "/" + MID$(STR$(NEWMED),2)
1880 NEXT K9
1890 RETURN
2000 REM ========================================================
2010 REM *****************>> DURRED <<***************************
2020 REM (modified form)
2030 REM ========================================================
2040 DUR(K9) = DUR(K9)/2
2050 NEWMED = NEWMED/2
2060 IF DUR(K9)/2 = INT(DUR(K9)/2) AND NEWMED/2 = INT(NEWMED/2)THEN 2040 ELSE RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Primops)
130 REM =========================================================
140 DIM X(100), Y(100)
150 LOW = 500
160 HIGH = 800
170 PRINT "PRIME NUMBERS WITHIN RANGE ";LOW;"TO";HIGH;" --"
180 GOSUB 1000 '<< call prime interval generator
190 FOR J = 1 TO PCNT
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "NUMERIC INTERVALS BETWEEN PRIMES --"
240 FOR J = 1 TO PCNT-1
250 PRINT Y(J);
260 NEXT J
270 END
1000 REM =========================================================
1010 REM ********************>> PRIMINTV <<***********************
1020 REM =========================================================
1030 REM This subroutine invokes the prime number indicator
1040 REM subroutine to locate primes, then creates two
1050 REM array sequences: 1) a list of the primes, and
1060 REM 2) a list of numeric intervals separating primes.
1070 REM The list can be mapped to various musical parameters,
1080 REM and can be modified in scale by addition or
1090 REM subtraction of a numerical constant.
1100 REM =========================================================
1110 REM Variable Descriptions
1120 REM Entering -
1130 REM LOW: smallest integer within test range
1140 REM HIGH: largest integer within test range
1150 REM PRIM: (from SR 2000) prime flag
1160 REM Exiting -
1170 REM NUM: (to SR 2000) current integer to be tested
1180 REM X(): list of prime numbers
1190 REM Y(): list of numeric intervals between primes
1200 REM Local -
1210 REM PCNT: prime number counter, pointer to X(),Y()
1220 REM =========================================================
1230 PCNT = 0
1240 FOR NUM = LOW TO HIGH
1250 GOSUB 2000 '<< call prime number indicator
1260 IF PRIM <> 1 THEN 1300
1270 PCNT = PCNT + 1
1280 X(PCNT) = NUM
1290 IF PCNT >= 2 THEN Y(PCNT-1) = X(PCNT)-X(PCNT-1)
1300 NEXT NUM
1310 RETURN
2000 REM =======================================================
2010 REM *******************>> PRIMENUM <<**********************
2020 REM =======================================================
2030 REM This subroutine locates and returns prime numbers
2040 REM from a stream of consecutive numbers within a
2050 REM specified range. (Prime numbers are integers
2060 REM which have only themselves or the number 1
2070 REM as a factor.)
2080 REM =======================================================
2090 REM Variable Descriptions
2100 REM Entering -
2110 REM NUM: number to be tested for prime
2120 REM Exiting -
2130 REM PRIM: flag indicating a prime number
2140 REM Local -
2150 REM DIVISOR: loop index, divisor for prime test
2160 REM =======================================================
2170 PRIM = 1
2180 IF NUM = 1 THEN PRIM = 0 : RETURN ELSE IF NUM = 2 OR NUM = 3 THEN RETURN
2190 IF NUM = INT(NUM/2) * 2 THEN PRIM = 0 : RETURN
2200 FOR DIVISOR = 3 TO INT(SQR(NUM)) STEP 2
2210 IF NUM = INT(NUM/DIVISOR) * DIVISOR THEN PRIM = 0 : RETURN
2220 NEXT DIVISOR
2230 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Pstnperm)
130 REM =========================================================
140 DIM SET(12),POSIT(12),CUM(12)
150 RANDOMIZE
160 TOTAL = 12
170 LOW = 1
180 HIGH = 12
190 RANGE = HIGH-LOW+1
200 GOSUB 1000 '<< call series generator
210 PRINT "PRIME ORDER SERIES --"
220 FOR J = 1 TO TOTAL
230 PRINT SET(J);" "; '<< send series to screen
240 NEXT J
250 GOSUB 2000 '<< call position permutator
260 PRINT
270 PRINT "SET PERMUTATION RESULTING FROM ";"SWAP OF PC NMBR AND POSITION
280 FOR J = 1 TO TOTAL
290 PRINT POSIT(J);" "; '<< send permutation to screen
300 NEXT J
310 END
1000 REM =======================================================
1010 REM *********************>> SETFLAG <<*********************
1020 REM =======================================================
1030 FOR K9 = 1 TO TOTAL
1040 R9 = INT(RND * RANGE) + LOW
1050 IF CUM(R9) = 1 THEN 1040
1060 CUM(R9) = 1
1070 SET(K9) = R9
1080 NEXT K9
1090 RETURN
2000 REM ========================================================
2010 REM *********************>> PSTNPERM <<*********************
2020 REM ========================================================
2030 REM This subroutine generates a permutation of a
2040 REM prime order series by swapping pitch class numbers
2050 REM with position-in-set numbers. (If the series is
2060 REM the chromatic scale, then, of course, no alteration
2070 REM of the set will take place - the retrograde will
2080 REM be returned.)
2090 REM ========================================================
2100 REM Variable Descriptions
2110 REM Entering -
2120 REM SET(): array containing series, pointer to POSIT()
2130 REM TOTAL: length of series
2140 REM Exiting -
2150 REM POSIT(): array containing set permutation
2160 REM Local -
2170 REM K9: loop index, pointer to SET()
2180 REM ========================================================
2190 FOR K9 = 1 TO TOTAL
2200 POSIT(SET(K9)) = K9
2210 NEXT K9
2220 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Quicksrt)
130 REM =========================================================
140 DIM X(60),STACK(40)
150 TOTAL = 60
160 RANDOMIZE
170 PRINT "ARRAY OF RANDOM-ORDER INTEGERS --"
180 FOR J= 1 TO TOTAL
190 X(J) = INT(RND*60)+1
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "ARRAY SORTED IN ASCENDING ORDER --"
240 GOSUB 1000 '<< call Quicksort algorithm
250 FOR J = 1 TO TOTAL
260 PRINT X(J);
270 NEXT J
280 END
1000 REM SS2TM3 =================================================
1010 REM *********************>> QUICKSRT <<*********************
1020 REM ========================================================
1030 REM This subroutine is one of the fastest sorting
1040 REM algorithms; however, its drawbacks are that it
1050 REM is lengthy, complex, and difficult to decipher.
1060 REM BASIC language does not offer a stack, and this
1070 REM algorithm requires one. Therefore, a stack
1080 REM has been coded within the subroutine. In
1090 REM languages such as C or Pascal the stack code can
1100 REM be eliminated.
1110 REM ========================================================
1120 REM Variable Descriptions
1130 REM Entering -
1140 REM X(): array of values to be sorted
1150 REM STACK(): stack to hold array X() pointers
1160 REM TOTAL: length of array X()
1170 REM Exiting -
1180 REM X(): array sorted in ascending order
1190 REM Local -
1200 REM FIN : indicator. When zero the sort is done
1210 REM PTR: stack pointer. PTR+1 points to the top of the segment, PTR+2 to bottom of segment
1220 REM TOPVAL: value at top of segment
1230 REM BOTTOMVAL: value at bottom of segment
1240 REM SEGTOP: pointer to top of segment
1250 REM SEGBOTTOM: pointer to bottom of segment
1260 REM COMPVAL: value being compared against current X()
1270 REM ========================================================
1280 FIN = 1
1290 PTR = 0
1300 STACK(PTR+1)=1
1310 STACK(PTR+2)=TOTAL
1320 WHILE FIN <> 0
1330 FIN=FIN-1
1340 PTR=FIN+FIN
1350 TOPVAL=STACK(PTR+1)
1360 BOTTOMVAL=STACK(PTR+2)
1370 COMPVAL=X(TOPVAL)
1380 SEGTOP=TOPVAL
1390 SEGBOTTOM=BOTTOMVAL+1
1400 WHILE SEGBOTTOM-1 <> SEGTOP
1410 SEGBOTTOM=SEGBOTTOM-1
1420 IF COMPVAL <=X(SEGBOTTOM)THEN 1450 ELSE X(SEGTOP) = X(SEGBOTTOM)
1430 SEGTOP=SEGTOP+1
1440 IF SEGBOTTOM = SEGTOP
THEN 1460
ELSE IF COMPVAL >= X(SEGTOP)
THEN 1430
ELSE X(SEGBOTTOM) = X(SEGTOP)
1450 WEND
1460 X(SEGTOP)=COMPVAL
1470 IF BOTTOMVAL-SEGTOP < 2 THEN 1520
1480 PTR=FIN+FIN
1490 STACK(PTR+1)=SEGTOP+1
1500 STACK(PTR+2)=BOTTOMVAL
1510 FIN=FIN+1
1520 IF SEGBOTTOM - TOPVAL < 2 THEN 1570
1530 PTR=FIN+FIN
1540 STACK(PTR+1)=TOPVAL
1550 STACK(PTR+2)=SEGBOTTOM-1
1560 FIN=FIN+1
1570 WEND
1580 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 RANDOMIZE
140 LASTLOC = 7
150 PRINT "START POSITION = ";LASTLOC
160 FOR J = 1 TO 40
170 GOSUB 1000 '<< call random walk
180 PRINT CURRLOC;
190 LASTLOC = CURRLOC
200 NEXT J
210 END
1000 REM ========================================================
1010 REM ********************>> RANDWALK <<**********************
1020 REM ========================================================
1030 REM This subroutine simulates a simple, bi-directional
1040 REM random walk which is restricted at both ends.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM
1080 REM Entering -
1090 REM LASTLOC: previous location of walker
1100 REM Exiting -
1110 REM CURRLOC: present location of walker
1120 REM Local -
1130 REM D: step direction storage
1140 REM U: random number determining step direction
1150 REM S: next step value after computation
1160 REM
1170 REM ========================================================
1180 D=1
1190 U=RND
1200 IF U < .5 THEN D = -1
1210 S = LASTLOC + D
1220 IF S > 15 THEN S = 14 '<< upper boundary test & reset
1230 IF S < 1 THEN S = 2 '<< lower boundary test & reset
1240 CURRLOC = S
1250 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM P$(96)
140 RANDOMIZE
150 TOTAL = 5 '<< number of discrete chords
160 GOSUB 2000 '<< call pitch table
170 FOR J = 1 TO TOTAL
180 PRINT "CHORD";J
190 ROOT = INT(RND * 12)+1 '<< chord start pitch (C-B)
200 OCTAVE = INT(RND * 3)+1 '<< chord start octave (1-3)
210 CHORDMEMS = INT(RND * 7)+3 '<< number of chordtones
220 SMALL = INT(RND * 5)+1 '<< smallest rnd interval
230 LARGE = INT(RND * 8)+5 '<< largest rnd interval
240 INTVALRANGE = LARGE - SMALL + 1
250 GOSUB 1000 '<< call random-interval chord generator
260 PRINT
270 NEXT J
280 END
1000 REM ========================================================
1010 REM *********************>> RDINTCHD <<*********************
1020 REM ========================================================
1030 REM This subroutine generates constrained
1040 REM random-interval chords.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM Entering -
1080 REM ROOT: lowest chordmember
1090 REM OCTAVE: octave register for chord initiation
1100 REM CHORDMEMS: number of tones contained in chord
1110 REM SMALL: smallest interval size selected
1120 REM INTVALRANGE: overall range for interval choice
1130 REM Exiting -
1140 REM none (subroutine is procedural)
1150 REM Local -
1160 REM INTVAL: selected interval size for next chordmem
1170 REM CHORDTONE: next chordmember
1180 REM K9: loop index
1190 REM ========================================================
1200 CHORDTONE = ROOT
1210 FOR K9 = 1 TO CHORDMEMS
1220 PRINT P$(CHORDTONE + ((OCTAVE-1) * 12));" ";
1230 INTVAL = INT(RND * (INTVALRANGE))+SMALL
1240 CHORDTONE = CHORDTONE + INTVAL
1250 NEXT K9
1260 PRINT
1270 RETURN
2000 REM =========================================================
2010 REM ********************>> PITCHTAB <<***********************
2020 REM =========================================================
2030 REM This subroutine initializes a pitch data table
2040 REM corresponding to integer values 1-n.
2050 REM =========================================================
2060 NOTE$ = " CC# DD# E FF# GG# AA# B"
2070 OCTAVE$ = "1234567"
2080 FOR K9 = 1 TO 7
2090 FOR L9 = 1 TO 12
2100 P$(L9+(K9-1)*12) = MID$(NOTE$,(L9*2-1),2)+MID$(OCTAVE$,K9,1)
2110 NEXT L9
2120 NEXT K9
2130 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Rhyprops)
130 REM =========================================================
140 CLS
150 PRINT "THIS PROGRAM CONVERTS RHYTHMIC INFORMATION"
160 PRINT " - EXPRESSED AS NUMERIC PROPORTIONS - "
170 PRINT "INTO TIME DURATIONS."
180 PRINT
190 PRINT "THE PROPORTION(S) WILL BE REALIZED ";"AS A FRACTION"
200 PRINT "OR SEQUENCE OF FRACTIONS OF A WHOLE NOTE."
210 PRINT "FOR EXAMPLE, 4/1 MEANS A DURATION EQUAL ";"TO 4 WHOLE NOTES;"
220 PRINT "1/4 MEANS A DURATION EQUAL TO ONE QUARTER NOTE."
230 PRINT
240 PRINT "- PRESS ANY KEY TO CONTINUE -"
250 A$=INKEY$
260 IF A$ = "" THEN 250
270 PRINT
280 PRINT "----------- A NOTE ABOUT PROPORTIONS -----------"
290 PRINT
300 PRINT "WHEN VALUE 1 > VALUE 2 (E.G., 9:8),"
310 PRINT "VALUE 2 SHOULD CONFORM TO ONE OF THE FOLLOWING"
320 PRINT "NUMBERS - 1,2,4,8,16 ."
330 PRINT
340 PRINT
350 PRINT "WHEN VALUE 2 > VALUE 1 (E.G.,4:9), VALUE 1"
360 PRINT "SHOULD CONFORM TO ONE OF THE ABOVE NUMBERS."
370 PRINT
380 PRINT
390 PRINT "ON THE OTHER HAND, ANY PROPORTION CAN BE INPUT."
400 PRINT "THE COMPUTATION WILL BE MADE,"
410 PRINT "BUT THE RESULT MAY BE TOO COMPLEX TO USE."
420 PRINT
430 PRINT "FOR EXAMPLE, IF THE PROPORTION 10,9,4 ";"(MEANING 10 NOTES"
440 PRINT "IN THE TIME OCCUPIED BY NINE ";"QUARTER NOTES) IS INPUT,"
450 PRINT "ORIGINAL FORM OUTPUT WILL BE ";"TEN IDENTICAL FRACTIONS -"
460 PRINT " 524288/2330169
470 PRINT
480 PRINT " - PRESS ANY KEY TO CONTINUE - "
490 A$ = INKEY$
500 IF A$ = "" THEN 490
510 CLS
520 TOTAL = 3
530 GOSUB 1010 '<< call multiple value storage
540 E = 0: I = 1: F = TOTAL: G = 1
550 PRINT "ORIGINAL FORM --"
560 GOSUB 2000 '<< call value extraction
570 PRINT
580 PRINT"RETROGRADE FORM -- "
590 E = 0: I = TOTAL: F = 1: G = -1
600 GOSUB 2000 '<< call value extraction
610 PRINT
620 PRINT "INVERTED FORM -- "
630 E = 1: I = 1: F = TOTAL: G = 1
640 GOSUB 2000 '<< call value extraction
650 PRINT
660 PRINT "RETROGRADE INVERSION FORM -- "
670 E= 1: I = TOTAL: F = 1: G = -1
680 GOSUB 2000 '<< call value extraction
690 PRINT
700 END
1000 REM ========================================================
1010 REM **********************>> SEQSTORE <<********************
1020 REM (adapted to program specs)
1030 REM ========================================================
1040 PRINT "+++++++ VALUE 1, VALUE 2, METRICAL BASE ++++++ "
1050 FOR K9 = 1 TO TOTAL
1060 R1# = K9 * K9
1070 R2# = K9 + 3
1080 B# = 8
1090 PRINT "SELECTED PROPORTION";K9;"-->";R1#;":";R2#;", ";"BASE";B#
1100 R1#= R1# * 1000000!
1110 R2#=R2# * 1000
1120 C#(K9) = R1#+ R2#+ B#
1130 NEXT K9
1140 RETURN
2000 REM =======================================================
2010 REM *******************>> SEQXTRCT <<**********************
2020 REM (adapted to program specs)
2030 REM =======================================================
2040 FOR K9 = I TO F STEP G
2050 D# = C#(K9)
2060 D# = D#/1000000!
2070 R1 = INT(D#)
2080 R2 = INT((D# - INT(D#)) * 1000)
2090 D# = D# * 1000
2100 B = INT((D# - INT(D#)) * 1000+.5)
2110 GOSUB 3000 '<< call proportion/rhythm conversion
2120 NEXT K9
2130 RETURN
3000 REM =======================================================
3010 REM ******************>> RHYPROPS <<***********************
3020 REM =======================================================
3030 REM This subroutine converts numeric proportions
3040 REM into rhythm duration values.
3050 REM =======================================================
3060 REM Variable Descriptions
3070 REM Entering -
3080 REM R1: proportion value #1
3090 REM R2: proportion value #2
3100 REM B: rhythm median value
3110 REM E: flag to invert proportion
3120 REM Exiting -
3130 REM none (subroutine is procedural)
3140 REM Local -
3150 REM CUM: converted duration numerator
3160 REM DUR: converted duration denominator
3170 REM L9: loop index
3180 REM =======================================================
3190 IF E = 1 THEN SWAP R1,R2
3200 IF R1 < R2 THEN 3280
3210 CUM = 1
3220 DUR = R1 * B / R2
3230 IF DUR <> INT(DUR)THEN CUM = CUM * 2 : DUR = DUR * 2 : GOTO 3230
3240 FOR L9 = 1 TO R1
3250 PRINT CUM;"/";DUR;
3260 NEXT L9
3270 RETURN
3280 DUR = R2/R1
3290 IF INT(DUR) <> DUR THEN DUR = DUR * 2 : B = B * 2 : GOTO 3290
3300 FOR L9 = 1 TO R1
3310 PRINT DUR;"/";B;
3320 NEXT L9
3330 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Rnd-Rnd)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
161 LOW = 1
162 HIGH = 12
163 RANGE = HIGH - LOW + 1
170 GOSUB 1000 '<< call recursive random distribution
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM *********************>> RND-RND <<**********************
1020 REM ========================================================
1021 REM The RND-RND probability distribution generates
1022 REM a range of integers whose occurrence frequency
1023 REM falls off with magnitude. It's distribution
1024 REM curve is similar to the exponential curve.
1029 REM ========================================================
1030 REM Variable Descriptions
1040 REM Entering -
1050 REM TOTAL:
1060 REM RANGE:
1070 REM LOW:
1080 REM Exiting -
1090 REM X():
1100 REM Local -
1110 REM K9: loop index, pointer to array X()
1111 REM ========================================================
1120 FOR K9 = 1 TO TOTAL
1130 X(K9) = INT(RND * RND * (RANGE)) + LOW
1140 NEXT K9
1150 RETURN
100 REM ========================================================
110 REM DRIVER PROGRAM
120 REM (Rotation)
130 REM ========================================================
140 REM This set of subroutines performs rotation and
150 REM transposition operations on a 12-element set
160 REM of values. This program deals with number sets
170 REM to point out applications to parameters other
180 REM than pitch; however, the values may be printed
190 REM as pitch classes simply by adding a pitch
200 REM conversion subroutine.
210 REM ========================================================
220 DIM CUM(12),SET(12),MAT1(12,12),MAT2(12,12),MAT3(12,12)
230 RANDOMIZE
240 SET = 12
250 PRINT "A RANDOM-ORDER SET -->"
260 GOSUB 1000 '<< call set generator
270 FOR J = 0 TO SET-1
280 PRINT SET(J);" ";
290 NEXT J
300 PRINT
310 PRINT
320 ROTEGROUP = 4
330 PRINT "UNPARTITIONED ARRAY, ELEMENT/GROUP ROTATION -->"
340 PRINT "(";ROTEGROUP;"SET MEMBERS PER CYCLE ROTATED )"
350 GOSUB 5000 '<< call Euclid's Algorithm
360 PRINT "TOTAL NUMBER OF UNIQUE CYCLES =";CYCLES
370 GOSUB 2000 '<< call unpartitioned set group rotation
380 FOR J1 = 0 TO CYCLES-1
390 FOR J2 = 0 TO SET-1
400 PRINT MAT1(J1,J2);
410 NEXT J2
420 PRINT
430 PRINT
440 NEXT J1
450 PRINT "'0' START POINT TRANSPOSITION -->"
460 GOSUB 3000 '<< call set transposition
470 FOR J1 = 0 TO CYCLES-1
480 FOR J2 = 0 TO SET-1
490 PRINT MAT2(J1,J2);
500 NEXT J2
510 PRINT
520 PRINT
530 NEXT J1
540 NUMSEGS = 4
550 SEGMEMS = SET/NUMSEGS
560 PRINT "PARTITIONED ARRAY, ROTATION WITHIN SEGMENT -->"
570 PRINT "(DIVIDED INTO";NUMSEGS;"EQUAL SEGMENTS)"
580 GOSUB 4000 '<< call set segment member rotation
590 FOR J1 = 0 TO SEGMEMS - 1
600 PRINT "|";
610 FOR J2 = 0 TO SET - 1
620 PRINT MAT3(J1,J2);
630 IF (J2+1) MOD SEGMEMS = 0 THEN PRINT "|";
640 NEXT J2
650 PRINT
660 PRINT
670 NEXT J1
680 END
1000 REM ========================================================
1010 REM **********************>> SETFLAG <<*********************
1020 REM ========================================================
1030 FOR K9 = 0 TO SET - 1
1040 R9 = INT(RND * SET)
1050 IF CUM(R9) = 1 THEN 1040
1060 CUM(R9) = 1
1070 SET(K9) = R9
1080 NEXT K9
1090 RETURN
2000 REM ========================================================
2010 REM *********************>> SETROTAT <<*********************
2020 REM ========================================================
2030 REM This subroutine rotates set members by moving a
2040 REM specified group of notes from the beginning to the
2050 REM end of the series.
2060 REM ========================================================
2070 REM Variable Descriptions
2080 REM Entering -
2090 REM SET: length of series
2100 REM ROTEGROUP: # of contiguous set members to rotate
2110 REM Exiting -
2120 REM MAT1: matrix of rotated sets
2130 REM Local -
2140 REM R9: rotation factor marker
2150 REM S9: counter, pointer to MAT1(n,n)
2160 REM T9: pointer to SET()
2170 REM K9: loop index
2180 REM L9: loop index, pointer to MAT(n,n)
2190 REM ========================================================
2200 ROTEGROUP = ROTEGROUP - 1
2210 R9 = 0
2220 S9 = 0
2230 FOR K9 = ROTEGROUP TO SET-1 + ROTEGROUP
2240 FOR L9 = 1 TO SET
2250 T9 = (K9+L9+R9) MOD SET
2260 MAT1(S9,L9-1) = SET(T9)
2270 NEXT L9
2280 R9 = R9 + ROTEGROUP
2290 S9 = S9 + 1
2295 IF S9 = CYCLES THEN RETURN
2300 NEXT K9
2310 RETURN
3000 REM ========================================================
3010 REM *******************>> ZEROTRNP <<***********************
3020 REM ========================================================
3030 REM This subroutine transposes a collection of sets
3040 REM sets to '0' start point.
3050 REM ========================================================
3060 REM Variable Descriptions
3070 REM Entering -
3080 REM MAT1(n,n): matrix of rotated sets
3090 REM SET: length of series
3100 REM Exiting -
3110 REM MAT2(n,n): matrix of transposed sets
3120 REM Local -
3130 REM INTVAL: interval of transposition
3140 REM S9: set member after transposition
3150 REM K9: loop index, pointer to MAT1(n,n) & MAT2(n,n)
3160 REM L9: loop index, pointer to MAT1(n,n) & MAT2(n,n)
3170 REM ========================================================
3180 FOR K9 = 0 TO CYCLES-1
3190 INTVAL = MAT1(K9,0)
3200 FOR L9 = 0 TO SET-1
3210 S9 = MAT1(K9,L9)-INTVAL
3220 IF S9 < 0 THEN S9 = S9 + 12
3230 MAT2(K9,L9) = S9
3240 NEXT L9
3250 NEXT K9
3260 RETURN
4000 REM ========================================================
4010 REM **********************>> SEGROTAT <<********************
4020 REM ========================================================
4030 REM This subroutine rotates partitioned-set segment
4040 REM members.
4050 REM ========================================================
4060 REM Variable Descriptions
4070 REM Entering -
4080 REM SET(): prime set
4090 REM SET: length of series
4100 REM NUMSEGS: symmetrical set partitioning
4110 REM Exiting -
4120 REM MAT3(n,n): matrix of sets after internal rotation
4130 REM Local -
4140 REM SEGMEMS: number of members in each segment
4150 REM S9: counter, pointer to MAT(n,n)
4160 REM T9: counter, pointer to MAT(n,n)
4170 REM K9: loop index
4180 REM L9: loop index, pointer to SET()
4190 REM M9: loop index, pointer to SET()
4200 REM ========================================================
4210 S9 = 0
4220 SEGMEMS = SET/NUMSEGS
4230 FOR K9 = 1 TO SEGMEMS
4240 T9 = 0
4250 FOR L9 = 0 TO SET-1 STEP SEGMEMS
4260 FOR M9 = S9 + 1 TO SEGMEMS + S9
4270 MAT3(S9,T9) = SET(M9 MOD SEGMEMS + L9)
4280 T9 = T9 + 1
4290 NEXT M9
4300 NEXT L9
4310 S9 = S9 + 1
4320 NEXT K9
4330 RETURN
5000 REM ========================================================
5010 REM ********************>> EUCREDUC <<**********************
5020 REM (modified to meet program specs)
5030 REM ========================================================
5040 A9 = SET
5050 B9 = ROTEGROUP
5060 IF A9 > B9 THEN SWAP A9,B9
5070 WHILE A9 > 0
5080 C9 = INT(B9/A9)
5090 D9 = B9-A9*C9
5100 B9 = A9
5110 A9 = D9
5120 WEND
5130 CYCLES = SET/B9
5140 RETURN100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Rowforms)
130 REM =========================================================
140 REM This set of subroutines produces commonly found
150 REM 12-tone row forms - original, retrograde, inversion,
160 REM and transpositions. Because the processes are well
170 REM known and simple, variable descriptions have been
180 REM dispensed with.
190 REM =========================================================
200 DIM P$(12)
210 DIM X(12),Y(12)
220 INTVAL = 4
230 RANDOMIZE
240 GOSUB 1000 '<< load element tables
250 GOSUB 2000 '<< call random shuffle
260 PRINT
270 PRINT "RANDOM-ORDER 12-TONE ROW --"
280 FOR J = 0 TO 11
290 PRINT P$(X(J));" "; '<< random 12-tone row to screen
300 NEXT J
310 PRINT : PRINT
320 FOR J = 1 TO 3
330 ON J GOSUB 3000,4000,5000 '<< call retro,invrt,trnpz
340 FOR J1 = 0 TO 11
350 PRINT P$(Y(J1));" "; '<< row forms to screen
360 NEXT J1
370 PRINT : PRINT
380 NEXT J
390 END
1000 REM ========================================================
1010 REM *********************<< PITCHTAB <<*********************
1020 REM (modified to program specs)
1030 REM ========================================================
1040 FOR J = 0 TO 11
1050 X(J) = J '<< load row elements
1060 READ P$(J) '<< load pitch class equivalents
1070 NEXT J
1080 REM+++++++++++++++++++++++++++++++++
1090 DATA C,C#,D,D#,E,F,F#,G,G#,A,A#,B
1100 REM+++++++++++++++++++++++++++++++++
1110 RETURN
2000 REM ========================================================
2010 REM ********************>> CONSHUFL <<**********************
2020 REM ========================================================
2030 FOR K9 = 0 TO 11
2040 R9 = INT(RND * 12)
2050 S9 = X(K9)
2060 X(K9) = X(R9)
2070 X(R9) = S9
2080 NEXT K9
2090 RETURN
3000 REM ========================================================
3010 REM **********************>> ROWRETRO <<********************
3020 REM =======================================================
3030 REM This subroutine outputs retrograde form.
3040 REM =======================================================
3050 PRINT "RETROGRADE ORDER --"
3060 FOR K9 = 0 TO 11
3070 L = (11 - K9) MOD 12
3080 Y(L) = X(K9)
3090 NEXT K9
3100 RETURN
4000 REM ========================================================
4010 REM ********************>> ROWINVRT <<**********************
4020 REM ========================================================
4030 REM This subroutine outputs inverted form.
4040 REM ========================================================
4050 PRINT "INVERTED ORDER --"
4060 FOR K9 = 0 TO 11
4070 Y(K9) = (12 - X(K9)) MOD 12
4080 NEXT K9
4090 RETURN
5000 REM =======================================================
5010 REM ********************>> ROWTRNPZ <<*********************
5020 REM =======================================================
5030 REM This subroutine outputs row form transpositions.
5040 REM =======================================================
5050 PRINT "TRANSPOSED (UP MAJOR 3RD) ORIGINAL FORM --"
5060 FOR K9 = 0 TO 11
5070 Y(K9) = (X(K9) + INTVAL) MOD 12
5080 NEXT K9
5090 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Rowsquar)
130 REM =========================================================
140 DIM P$(12),CUM(12),X(12),Y(12)
150 RANDOMIZE
160 GOSUB 1000 '<< call pitch table
170 GOSUB 2000 '<< call set generator
180 GOSUB 3000 '<< call composite row form printout
190 END
1000 REM ========================================================
1010 REM *********************>> PITCHTAB <<*********************
1020 REM (modified to load pitch classes only)
1030 REM ========================================================
1040 FOR J = 0 TO 11
1050 READ P$(J) '<< load pitch table
1060 NEXT J
1070 REM++++++++++++++++++++++++++++++++++++++++
1080 DATA "C ","C# ","D ","D# ","E ","F "
1090 DATA "F# ","G ","G# ","A ","A# ","B "
1100 REM++++++++++++++++++++++++++++++++++++++++
1110 RETURN
2000 REM ========================================================
2010 REM *********************>> SETFLAG <<**********************
2020 REM (modified to program specs)
2030 REM ========================================================
2040 FOR K9 = 0 TO 11
2050 F = INT(RND*12)
2060 IF CUM(F) = 1 THEN 2050
2070 CUM(F) = 1
2080 IF K9 = 0 THEN TRANS = F
2090 IF F-TRANS < 0 THEN X(K9) = F-TRANS+ 12 ELSE X(K9) = F-TRANS
2100 Y(K9) = (12-X(K9)) MOD 12
2110 NEXT K9
2120 RETURN
3000 REM ========================================================
3010 REM *********************>> ROWSQUAR <<*********************
3020 REM ========================================================
3030 REM This subroutine prints a square matrix containing
3040 REM composite 12-tone row forms: Original (Prime),
3050 REM Retrograde, Inversion, and Retrograde-Inversion.
3060 REM ========================================================
3070 REM Variable Descriptions
3080 REM Entering -
3090 REM X(): original order set array
3100 REM Y(): inverted order set array
3110 REM P$(): pitch table array
3120 REM Exiting -
3130 REM none (subroutine is procedural)
3140 REM Local -
3150 REM INTVAL: transposition interval
3160 REM K9: loop index, pointer to Y()
3170 REM L9: loop index, pointer to X()
3180 REM =======================================================
3190 CLS
3200 PRINT " MATRIX OF TRANSPOSITIONS YIELDING O,RO,I,RI "
3210 PRINT "++++++++++++++++++++++++++++++++++++++++++++++++++"
3220 PRINT "+ ORIGINAL ----> +"
3230 PRINT "+ | INVERSION +"
3240 PRINT "+ V +"
3250 FOR K9= 0 TO 11
3260 PRINT "+";TAB(8);
3270 INTVAL = Y(K9)
3280 FOR L9= 0 TO 11
3290 PRINT P$((X(L9) + INTVAL) MOD 12);
3300 NEXT L9
3310 PRINT TAB(50);"+"
3320 NEXT K9
3330 PRINT "+ ^ +"
3340 PRINT "+ | RETROGRADE INVERSION +"
3350 PRINT "+ <--- RETROGRADE +"
3360 PRINT "++++++++++++++++++++++++++++++++++++++++++++++++++"
3370 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Samplset)
130 REM =========================================================
140 DIM SET(100),A(100),B(100)
150 PERMUT = 5
160 TOTAL = 12
170 PRINT "A SEQUENTIAL SET -"
180 FOR J = 1 TO TOTAL
190 SET(J) = J : PRINT SET(J);
200 NEXT J
210 PRINT
220 FACTOR = 2
230 FOR CYCLE = 1 TO PERMUT
240 PRINT "PERMUTATION ";CYCLE
250 TARGET = 1
260 PRINT "SET START POSITION = ";TARGET;"; ""SET TARGET FACTOR= ";FACTOR
270 GOSUB 1000 '<< call sampling
280 FACTOR = FACTOR + 2
290 NEXT CYCLE
300 END
1000 REM =========================================================
1010 REM *******************>> SAMPLSET <<************************
1020 REM =========================================================
1030 REM This subroutine produces numeric series permutations
1040 REM by cyclical set sampling at a selected interval.
1050 REM (start at set member n and remove every nth element,
1060 REM looping back through the series until reordered.)
1070 REM The algorithm is derived from the classic 'Josephus'
1080 REM Problem', which is expressed below in pseudo-code:
1090 REM
1100 REM Arrange a group of men in a circle;
1110 REM move around the circle;
1120 REM shoot and remove every nth man;
1130 REM repeat until none remains.
1140 REM
1150 REM ========================================================
1160 REM Variable Descriptions
1170 REM Entering -
1180 REM SET(): initial value series
1190 REM TOTAL: series length
1200 REM TARGET: current set sample
1210 REM FACTOR: sampling interval
1220 REM Exiting -
1230 REM none: (subroutine is procedural)
1240 REM Local -
1250 REM SETL: current set length (shrinks every iteration)
1270 REM A(): bounce array 1
1280 REM B(): bounce array 2
1290 REM ACNT: pointer to A()
1300 REM BCNT: pointer to B()
1310 REM K9: loop index, pointer to A(),B()
1320 REM ========================================================
1330 SETL = TOTAL
1340 FOR K9 = 1 TO SETL
1350 A(K9)=SET(K9)
1360 NEXT K9
1370 BCNT = 0
1380 FOR K9 = 1 TO SETL
1390 IF K9 = TARGET THEN PRINT A(K9); : TARGET = TARGET + FACTOR ELSE BCNT = BCNT + 1 : B(BCNT) = A(K9)
1400 NEXT K9
1410 IF BCNT < 1 THEN 1530
1420 TARGET = TARGET - SETL
1430 ACNT = 0
1440 IF TARGET MOD BCNT <> 0 THEN TARGET = TARGET MOD BCNT ELSE TARGET = BCNT
1450 FOR K9 = 1 TO BCNT
1460 IF K9 = TARGET THEN PRINT B(K9); : TARGET = TARGET + FACTOR ELSE ACNT = ACNT + 1 : A(ACNT) = B(K9)
1470 NEXT K9
1480 IF ACNT < 1 THEN 1530
1490 SETL = ACNT
1500 TARGET = TARGET - BCNT
1510 IF TARGET MOD SETL <> 0 THEN TARGET = TARGET MOD SETL ELSE TARGET = SETL
1520 GOTO 1370
1530 PRINT
1540 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Scorform)
130 REM =========================================================
140 PRINT "FIFTY RANDOM VALUES FROM 1-50 ARE BEING PUT IN"
150 PRINT "PITCH, RHYTHM, ARTICULATION, AND VOLUME FILES"
160 PRINT "NAMED 'P1.DAT','R1.DAT','A1.DAT','V1.DAT' -----"
170 FOR J1 = 1 TO 4
180 IF J1 = 1
THEN OPEN "O",#1,"P1.DAT"
ELSE
IF J1 = 2
THEN OPEN "O",#2,"R1.DAT"
ELSE
IF J1 = 3
THEN OPEN "O",#3,"A1.DAT"
ELSE OPEN "O",#4,"V1.DAT"
190 FOR J2 = 1 TO 50
200 NUM = INT(RND * 50)+1
210 PRINT #J1,NUM; '<< put 50 values in each file
220 IF J2 MOD 15 = 0 THEN PRINT #J1, '<< 10 per line
230 NEXT J2
240 CLOSE #J1
250 NEXT J1
260 PRINT
270 PRINT "NOW THE 4 SEPARATE PARAMETER FILES ARE BEING"
280 PRINT "PLACED IN FINAL SCORE FILE NAMED 'SCORE.DAT' ---"
290 PRINT
300 GOSUB 1000 '<< call score formatting
310 END
1000 REM ========================================================
1010 REM *******************>> SCORFORM <<***********************
1020 REM ========================================================
1030 REM Formatted-Score-Filing Subroutine
1040 REM ========================================================
1050 X$ = "+"
1060 Z$ = "SCORE.DAT"
1070 OPEN "I",#1,"P1.DAT"
1080 OPEN "I",#2,"R1.DAT"
1090 OPEN "I",#3,"A1.DAT"
1100 OPEN "I",#4,"V1.DAT"
1110 OPEN "O",#5,Z$
1120 PRINT #5,"NOTELIST:"
1130 WHILE NOT EOF(1)
1140 LINE INPUT #1,A$
1150 PRINT #5,"P ";A$
1160 LINE INPUT #2,B$
1170 PRINT #5,"R ";B$
1180 LINE INPUT #3,C$
1190 PRINT #5,"A ";C$
1200 LINE INPUT #4,D$
1210 PRINT #5,"V ";D$
1220 PRINT #5,"/*";STRING$(55,X$);"*/"
1230 WEND
1240 CLOSE #1,#2,#3,#4,#5
1250 PRINT "HERE IS FINAL SCORE --"
1260 OPEN "I",#5,Z$
1270 WHILE NOT EOF(5)
1280 LINE INPUT #5,A$
1290 PRINT A$
1300 WEND
1310 CLOSE #5
1320 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Seqfile)
130 REM =========================================================
140 DIM X(200)
150 SEQTOTAL = 5
160 OPEN "O",#1,"SEQ.DAT" '<< prepare file for writing
170 PRINT "FILE LOOKS LIKE THIS ---"
180 GOSUB 1000 '<< call sequence filing routine
190 CLOSE #1
200 OPEN "I",#1,"SEQ.DAT" '<< prepare file for reading
210 PRINT "EXTRACTED SEQUENCES LOOK LIKE THIS --"
220 GOSUB 2000 '<< call sequence extraction routine
230 CLOSE #1
240 END
1000 REM ========================================================
1010 REM ********************>> SEQSTORE <<**********************
1020 REM ========================================================
1030 REM Discrete Sequence Store and File Subroutine
1040 REM ========================================================
1050 REM Variable Descriptions
1060 REM Entering -
1070 REM SEQTOTAL: number of sequences to store
1080 REM Exiting -
1090 REM X(): array containing sequence and keys
1100 REM Local -
1110 REM SEQLEN: random-length number sequence
1120 REM FILEVAL: integer for array storage & filing
1130 REM K9: loop index
1140 REM L9: loop index, pointer to array X()
1150 REM T8: counter, pointer to array X()
1160 REM ========================================================
1170 FOR K9 = 1 TO SEQTOTAL
1180 SEQLEN = INT(RND * 20)+5
1190 FOR L9 = 1 TO SEQLEN
1200 FILEVAL = L9 * K9
1210 IF L9 = 1 THEN X(L9+T8) = FILEVAL * 1000 + SEQLEN ELSE X(L9+T8) = FILEVAL
1220 PRINT X(L9+T8);:PRINT #1,X(L9+T8);
1230 NEXT L9
1240 T8 = T8 + SEQLEN
1250 NEXT K9
1260 PRINT
1270 RETURN
2000 REM ========================================================
2010 REM ********************>> SEQXTRCT <<**********************
2020 REM ========================================================
2030 REM Discrete Sequence Retrieval Subroutine
2040 REM ========================================================
2050 REM Variable Descriptions
2060 REM Entering -
2070 REM X(): array containing sequence & keys
2080 REM Exiting -
2090 REM none (subroutine is procedural)
2100 REM Local -
2110 REM S8: sequence counter
2120 REM K9: loop index, pointer to array X()
2130 REM ========================================================
2140 S8 = 0
2150 FOR K9= 1 TO 10000
2160 IF EOF(1) THEN 2190 ELSE INPUT #1,X(K9)
2170 IF X(K9) < 1000 THEN PRINT X(K9); ELSE PRINT : S8 = S8 + 1 :PRINT "SEQUENCE";S8 : PRINT INT(X(K9)/1000);
2180 NEXT K9
2190 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 DIM SET(12),CUM(12)
140 RANDOMIZE
150 TOTAL = 12
160 LOW = 1
170 HIGH = 12
180 RANGE = HIGH-LOW+1
190 GOSUB 1000
200 FOR J = 1 TO TOTAL
210 PRINT SET(J);" "; '<< send series to screen
220 NEXT J
230 END
1000 REM =======================================================
1010 REM *********************>> SETFLAG <<*********************
1020 REM =======================================================
1030 REM This subroutine generates random-order series by
1040 REM the array flag method. That is, when a random
1050 REM integer is generated, the subroutine checks the
1060 REM content of the CUM() address pointed to by the
1070 REM random number to determine whether a flag (1)
1080 REM is present. If the address is empty, it receives
1090 REM the flag, and the random number is placed in SET()
1100 REM as a series member. If the address has the flag,
1110 REM the number is discarded and another generated.
1120 REM =======================================================
1130 REM Variable Descriptions
1140 REM Entering -
1150 REM TOTAL: length of set
1160 REM LOW: lowest value
1170 REM RANGE: set value range
1180 REM Exiting -
1190 REM SET(): final set of values
1200 REM Local -
1210 REM CUM(): array holding occurrence flags
1220 REM R9: random value to be tested for occurrence
1230 REM K9: loop index, pointer to array SET()
1240 REM =======================================================
1250 FOR K9 = 1 TO TOTAL
1260 R9 = INT(RND * RANGE) + LOW
1270 IF CUM(R9) = 1 THEN 1260
1280 CUM(R9) = 1
1290 SET(K9) = R9
1300 NEXT K9
1310 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Shellsrt)
130 REM =========================================================
140 DIM X(50)
150 TOTAL = 50
160 RANDOMIZE
170 PRINT "ARRAY OF RANDOM-ORDER REAL NUMBERS (RANGE 0-1) --"
180 FOR J = 1 TO TOTAL
190 X(J) = RND
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "ARRAY SORTED IN ASCENDING ORDER --"
240 GOSUB 1000 '<< call Shell sort algorithm
250 FOR J = 1 TO TOTAL
260 PRINT X(J); '<< list to screen
270 NEXT J
280 END
1000 REM SS1TM2 =================================================
1010 REM *********************>> SHELLSRT <<*********************
1020 REM ========================================================
1030 REM This in-place binary sorting subroutine is fast,
1040 REM compact, and easy to understand. The algorithm
1050 REM works by successively splitting the list into
1060 REM smaller halves, rearranging contents along the way.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM X(): array of values to be sorted
1110 REM TOTAL: length of list
1120 REM Exiting -
1130 REM X(): array sorted in ascending order
1140 REM Local -
1150 REM SUBDIV: list subdivision size
1160 REM REMAINDER: original list size less SUBDIV
1170 REM FLAG: 0 or 1 condition indicates switch or no
1180 REM switch has occurred
1190 REM TEMP: temporary storage
1200 REM K9: loop index, first sublist pointer
1210 REM COMPTR: second sublist pointer for comparison
1220 REM and switch
1230 REM ========================================================
1240 SUBDIV = TOTAL
1241 SUBDIV = INT(SUBDIV / 2)
1250 WHILE SUBDIV > 0
1270 REMAINDER = TOTAL - SUBDIV
1280 FLAG = 0
1290 FOR K9=1 TO REMAINDER
1300 COMPTR = K9+SUBDIV
1310 IF X(K9) <= X(COMPTR)THEN 1360
1320 TEMP = X(K9)
1330 X(K9) = X(COMPTR)
1340 X(COMPTR) = TEMP
1350 FLAG = 1
1360 NEXT K9
1370 IF FLAG > 0 THEN 1280
1371 SUBDIV = INT(SUBDIV / 2)
1372 WEND
1373 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (S-MSORT)
130 REM =========================================================
140 DIM X(50)
150 TOTAL = 50
160 RANDOMIZE
170 PRINT "ARRAY OF RANDOM-ORDER REAL NUMBERS (RANGE 0-1) --"
180 FOR J = 1 TO TOTAL
190 X(J) = RND
200 PRINT X(J);
210 NEXT J
220 PRINT
230 PRINT "ARRAY SORTED IN ASCENDING ORDER --"
240 GOSUB 1010 '<< call Shell-Metzner sort
250 FOR J = 1 TO TOTAL
260 PRINT X(J); '<< list to screen
270 NEXT J
280 END
1000 REM SS1TM3 =================================================
1010 REM ********************>> S-MSORT << **********************
1020 REM ========================================================
1030 REM The shell-Metzner sorting algorithm is a variation
1040 REM on the Shell sort. It rearranges an array of values
1050 REM into ascending order. It is a binary sort, very
1060 REM fast, and does the sorting in place. It does not
1070 REM require a stack, as does the Quicksort algorithm.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM X(): array of values to be sorted
1120 REM TOTAL: length of array X()
1130 REM Exiting -
1140 REM X(): array sorted in ascending order
1150 REM Local -
1160 REM SUBDIV: list subdivision size
1170 REM REMAINDER: original list size minus SUBDIV
1180 REM PTR1: loop index, first sublist pointer
1190 REM COMPTR: second sublist pointer for comparison
1200 REM and switch
1210 REM K9: loop index
1220 REM TEMP: temporary storage
1230 REM ========================================================
1240 SUBDIV = TOTAL
1250 SUBDIV = INT(SUBDIV / 2)
1260 WHILE SUBDIV > 0
1270 REMAINDER =TOTAL - SUBDIV
1280 FOR K9 = 1 TO REMAINDER
1290 PTR1 = K9
1300 COMPTR = PTR1 + SUBDIV
1310 IF X(PTR1) <= X(COMPTR) THEN 1350
1320 TEMP = X(PTR1)
1321 X(PTR1) = X(COMPTR)
1330 X(COMPTR) = TEMP
1331 PTR1 = PTR1 - SUBDIV
1340 IF PTR1 >= 1 THEN 1300
1350 NEXT K9
1360 SUBDIV = INT(SUBDIV / 2)
1370 WEND
1380 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (SNDTEXT)
130 REM =========================================================
140 DIM X(51),Y(100)
150 TOTAL = 50
160 RANGE = 26 '<< letters of alphabet
170 BLANKS = 10 '<< additional codes to be filtered as blanks
180 X(0) = TOTAL
190 RANDOMIZE
200 PRINT "RANDOM INTEGERS TO INTERPRET AS ASCII CODES --"
210 FOR J = 1 TO TOTAL
220 X(J) = INT(RND * (RANGE+BLANKS)) + 97
230 PRINT X(J);
240 NEXT J
250 PRINT
260 PRINT "THE NUMBER-TO-CHARACTER CONVERTED TEXT --"
270 GOSUB 1000 '<< call numeric-to-character conversion
280 PRINT TEXT$ '<< text-converted sequence to screen
290 PRINT "THE TEXT CONVERTED BACK TO INTEGERS ";
300 PRINT "WITH NON ALPHABET-RANGE VALUES AS BLANKS --"
310 GOSUB 2000
320 FOR J = 1 TO TOTAL
330 PRINT Y(J);
340 NEXT J
350 END
1000 REM SS1WP3 ==================================================
1010 REM *********************>> SNDTEXT1 <<**********************
1020 REM =========================================================
1030 REM This subroutine converts integers to their
1040 REM corresponding character representation using
1050 REM the CHR$ function. It also adds blanks randomly
1060 REM to simulate the appearance of normal text. It may
1070 REM be adapted to a number of applications which
1080 REM correlate text and musical parameters in some
1090 REM fashion. For example, a sequence of pitch values,
1100 REM transposed to the approprate ASCII code range, can
1110 REM be converted to alphabetic characters whose codes
1120 REM represent the mapping of pitch onto text. The result,
1130 REM however, will probably not conform to any known
1140 REM language because of the absence of syntactical rules.
1150 REM ========================================================
1160 REM Variable Descriptions
1170 REM Entering -
1180 REM X(): sequence of integer values, to be interpreted
1190 REM as ASCII codes
1200 REM TOTAL: length of array X()
1210 REM Exiting -
1220 REM TEXT$: string of alphabet characters representing
1230 REM mapping of numbers to text
1240 REM Local -
1250 REM K9: loop index, pointer to array X()
1260 REM ========================================================
1270 TEXT$ = ""
1280 FOR K9 = 1 TO X(0)
1290 IF X(K9) > 122 THEN TEXT$ = TEXT$ + " " ELSE TEXT$ = TEXT$ + CHR$(X(K9))
1300 NEXT K9
1310 RETURN
2000 REM SS1WP2=================================================
2010 REM *********************>> SNDTEXT2 <<********************
2020 REM =======================================================
2030 REM This subroutine is the converse of SNDTEXT1 - a
2040 REM character-to-number conversion algorithm. Text
2050 REM strings may be input and translated to integers,
2060 REM which in turn may be assigned to pitch, rhythm,
2070 REM volume, or any musical parameter.
2080 REM =======================================================
2090 REM Variable Descriptions
2100 REM Entering -
2110 REM TEXT$: character string
2120 REM Exiting -
2130 REM Y(): array holding integer-converted sequence
2140 REM Local -
2150 REM K9: loop index, pointer to array Y()
2160 REM =======================================================
2170 Y(0) = LEN(TEXT$)
2180 FOR K9 = 1 TO Y(0)
2190 Y(K9) = ASC(MID$(TEXT$,K9,1))
2200 NEXT K9
2210 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Stats)
130 REM =========================================================
140 DIM X(200),Y(15)'<< sequence array, frequency table array
150 RANGE = 15 '<< set random number range 1-15
160 TOTAL = 200 '<< return 200 values
170 RANDOMIZE
180 GOSUB 1000 '<< generate sequence array & frequency table
190 GOSUB 2000 '<< call bargraph display
200 GOSUB 3000 '<< call statistical mode (maxval)
210 GOSUB 4000 '<< call least frequent (minval)
220 GOSUB 5000 '<< call arithmetic mean
230 GOSUB 6000 '<< call statistical variance
240 GOSUB 7000 '<< call standard deviation
250 END
1000 REM ========================================================
1010 REM *******************>> FREQTABL <<***********************
1020 REM ========================================================
1030 FOR K9 = 1 TO TOTAL
1040 VALUE = INT(RND * RANGE)+1 '<< gen random value
1050 X(K9) = VALUE '<< load sequence array
1060 Y(VALUE)=Y(VALUE)+1 '<< record occurrence of value
1070 NEXT K9
1080 RETURN
2000 REM ========================================================
2010 REM *******************>> BARGRAPH <<***********************
2020 REM ========================================================
2030 FOR K9 = 1 TO RANGE
2040 PRINT K9;TAB(10);STRING$(Y(K9),">")
2050 NEXT K9
2060 RETURN
3000 REM ========================================================
3010 REM *********************>> MAXVAL <<***********************
3020 REM ========================================================
3030 REM This subroutine finds the statistical mode of
3040 REM a collection of values. It scans the integer
3050 REM frequency table, then records the address and
3060 REM number of occurrence of the most frequent value(s).
3070 REM ========================================================
3080 REM Variable Descriptions
3090 REM Entering -
3100 REM Y(): occurrence frequency table
3110 REM RANGE: range of integer values in table
3120 REM Exiting -
3130 REM none (subroutine is procedural)
3140 REM Local -
3150 REM MAX: statistical mode
3160 REM K9: loop index, pointer to frequency table
3170 REM ========================================================
3180 MAX = Y(1)
3190 FOR K9 = 2 TO RANGE
3200 IF MAX < Y(K9) THEN MAX = Y(K9)
3210 NEXT K9
3220 FOR K9 = 1 TO RANGE
3230 IF Y(K9) = MAX THEN PRINT "THE INTEGER";K9;"= MODE;";" FREQ =";MAX
3240 NEXT K9
3250 RETURN
4000 REM ========================================================
4010 REM ********************>> MINVAL <<************************
4020 REM ========================================================
4030 REM This subroutine scans the occurrence frequency
4040 REM table, then records the address and number of
4050 REM occurrences of the least frequent value.
4060 REM ========================================================
4070 REM Variable Descriptions
4080 REM Entering -
4090 REM Y(): occurrence frequency table
4100 REM RANGE: range of integer values in table
4110 REM Exiting -
4120 REM none (subroutine is procedural)
4130 REM Local -
4140 REM MIN: least frequent integer
4150 REM K9: loop index, pointer to array Y()
4160 REM ========================================================
4170 MIN = Y(1)
4180 FOR K9 = 2 TO RANGE
4190 IF MIN > Y(K9) THEN MIN = Y(K9)
4200 NEXT K9
4210 FOR K9 = 1 TO RANGE
4220 IF Y(K9) = MIN THEN PRINT "THE INTEGER";K9;" = LEAST FREQUENT;";" FREQ =";MIN
4230 NEXT K9
4240 RETURN
5000 REM ========================================================
5010 REM **********************>> MEAN <<************************
5020 REM ========================================================
5030 REM This subroutine finds the arithmetic mean of
5040 REM a sample collection.
5050 REM ========================================================
5060 REM Variable Descriptions
5070 REM Entering -
5080 REM TOTAL: length of sequence
5090 REM Exiting -
5100 REM none (subroutine is procedural)
5110 REM Local -
5120 REM SUM: sum of sequence values
5130 REM MEAN: arithmetic mean of values
5140 REM K9: loop index, pointer to sequence array X()
5150 REM ========================================================
5160 SUM = 0
5170 FOR K9 = 1 TO TOTAL
5180 SUM = SUM + X(K9)
5190 NEXT K9
5200 MEAN = SUM / TOTAL
5210 PRINT "MEAN =";MEAN;" ";
5220 RETURN
6000 REM ========================================================
6010 REM *******************>> VARIANCE <<***********************
6020 REM ========================================================
6030 REM This subroutine computes statistical variance of
6040 REM a collection of samples.
6050 REM ========================================================
6060 REM Variable Descriptions
6070 REM Entering -
6080 REM TOTAL: length of sequence
6090 REM MEAN: arithmetic mean of sequence values
6100 REM Exiting -
6110 REM none (subroutine is procedural)
6120 REM Local -
6130 REM VARIANCE: statistical variance
6140 REM TEMP: temporary storage of computation
6150 REM K9: loop index, pointer to sequence array X()
6160 REM ========================================================
6170 VARIANCE = 0
6180 FOR K9 = 1 TO TOTAL
6190 TEMP = (X(K9) - MEAN) ^ 2
6200 VARIANCE = VARIANCE + TEMP
6210 NEXT K9
6220 VARIANCE = VARIANCE / (TOTAL - 1)
6230 PRINT "VARIANCE = ";VARIANCE
6240 RETURN
7000 REM ========================================================
7010 REM ********************>> STDEV <<*************************
7020 REM ========================================================
7030 REM This subroutine computes standard deviation and
7040 REM standard error of the mean.
7050 REM ========================================================
7060 REM Variable Descriptions
7070 REM Entering -
7080 REM VARIANCE: statistical variance
7090 REM Exiting -
7100 REM none (subroutine is procedural)
7110 REM Local -
7120 REM DEV: standard deviation
7130 REM STDERR: standard error of the mean
7140 REM ========================================================
7150 DEV = SQR(VARIANCE)
7160 STDERR = DEV / SQR(TOTAL)
7170 PRINT "STANDARD DEVIATION = ";DEV
7180 PRINT "STANDARD ERROR OF THE MEAN = ";STDERR
7190 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Stirling)
130 REM =========================================================
140 FOR J = 9 TO 12
150 NUM = J
160 PRINT "INTEGER FOR WHICH FACTORIAL ";"WILL BE COMPUTED IS";NUM
170 GOSUB 1000 '<< call stirling's approximation
180 PRINT "LOG OF FACTORIAL IS APPROXIMATELY";APPR
190 IF NUM < 34 THEN PRINT "FACTORIAL IS APPROXIMATELY";INT(EXP(APPR)+.5)
200 PRINT
210 NEXT J
220 END
1000 REM ========================================================
1010 REM ********************>> STIRLING <<**********************
1020 REM ========================================================
1030 REM Stirling's approximation is useful in applications
1040 REM which require calculation of porbabilities, combin-
1050 REM ations, and permutations. The subroutine returns
1060 REM the exact log of N factorial for values <= 10, and
1070 REM returns the approximation of the log of n factorial
1080 REM for values larger than 10.
1090 REM Stirling's approximation is useful in applications
1100 REM ========================================================
1110 REM Variable Descriptions
1120 REM Entering -
1130 REM NUM: integer for which factorial is to be computed
1140 REM Exiting -
1150 REM APPR: Stirling's approximation of log of NUM
1160 REM Local -
1170 REM K9: loop index for factorial up to 10
1180 REM ========================================================
1190 APPR = 1
1200 IF NUM <= 0 THEN APPR = 0 : RETURN
1210 FOR K9 = 1 TO 10
1220 APPR = APPR * K9
1230 IF NUM = K9 THEN APPR = LOG(APPR) : RETURN
1240 NEXT K9
1250 APPR = LOG(6.283186)/2+LOG(NUM)*(NUM+.5)-NUM+1/(12*NUM)
1260 RETURN
100 REM ========================================================
110 REM DRIVER PROGRAM
111 REM ========================================================
120 REM This subroutine is a set of subroutines which
130 REM produce systematic(as opposed to random-order)
140 REM permutations of a series of values.
150 REM If program structure appears strange to you,
160 REM it is because the algorithm was directly adapted
170 REM from the original, written in Pascal language.
180 REM ========================================================
190 DIM A(12), S(500),T(500)
220 PRINT "ENTER NUMBER OF SET MEMBERS TO BE PERMUTATED:"
230 INPUT N
240 PRINT "HOW MANY PERMUTATIONS TO BE RETURNED?"
250 INPUT T
260 K = N
270 FOR I = 1 TO N
280 A(I) = I
290 NEXT I
300 GOSUB 1030 '<< call permute
310 END
1000 REM =======================================================
1010 REM ******************>> SYSTPERM <<***********************
1020 REM =======================================================
1030 IF K = 1 THEN 4010 '<< call print
1040 GOSUB 2010 '<< call stack push
1050 K = K - 1
1060 GOSUB 1030 '<< call permute
1070 I = 1
1080 IF I = K THEN 1200
1090 X = A(I)
1100 A(I) = A(K)
1110 A(K) = X
1120 GOSUB 2010 '<< call stack push
1130 K = K - 1
1140 GOSUB 1030 '<< call permute
1150 X = A(I)
1160 A(I) = A(K)
1170 A(K) = X
1180 I = I + 1
1190 GOTO 1080
1200 GOSUB 3010 '<< call stack pop
1210 RETURN
1220 REM:
2000 REM =======================================================
2010 REM ***********************>> PUSH <<**********************
2020 REM =======================================================
2030 P = P + 1
2040 S(P) = K
2050 T(P) = I
2060 RETURN
3000 REM ========================================================
3010 REM ***********************>> POP <<***********************
3020 REM ========================================================
3030 K = S(P)
3040 I = T(P)
3050 P = P - 1
3060 RETURN
4000 REM ========================================================
4010 REM ********************>> PRINT <<**************************
4020 REM ========================================================
4030 FOR J = 1 TO N
4040 PRINT A(J);
4050 NEXT J
4060 PRINT
4070 Z = Z + 1
4080 IF Z = T THEN END ELSE 1200
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Timpoint)
130 REM =========================================================
140 DIM SET(12),CUM(12)
150 DIM P$(12),FRACTION$(12)
160 RANDOMIZE
170 MEDIAN = 16
180 GOSUB 1000 '<< call pitch class table
190 FOR J = 1 TO 4
200 GOSUB 2000 '<< call set generator
210 PRINT "RANDOM-ORDER 12-TONE ROW #";J;"MOD";MDLS;"--"
220 FOR J1 = 0 TO 11
230 PRINT P$(SET(J1));" "; '<< series to screen
240 NEXT J1
250 PRINT
260 PRINT "THE NUMERIC EQUIVALENT --"
270 FOR J1 = 0 TO 11
280 PRINT SET(J1);
290 NEXT J1
300 PRINT
310 PRINT "DURATIONS REPRESENTING THE DISTANCE";" BETWEEN TIME POINTS --"
320 PRINT "(USING A 16TH-NOTE PULSE BASE ";"AND A MEASURE OF ";MDLS;"-16THS)"
330 GOSUB 3000 '<< call timepoint generator
340 FOR J1 = 0 TO 11
350 PRINT FRACTION$(J1); '<< timepoints to screen
360 NEXT J1
370 PRINT "TOTAL OF DURATIONS =";TALLY;
380 PRINT
390 PRINT
400 NEXT J
410 END
1000 REM ========================================================
1010 REM ********************>> PITCHTAB <<**********************
1020 REM (modified to load pitch classes only)
1030 REM ========================================================
1040 FOR J = 0 TO 11
1050 READ P$(J) '<< load pitch classes
1060 NEXT J
1070 REM+++++++++++++++++++++++++++++++++
1080 DATA C,C#,D,D#,E,F,F#,G,G#,A,A#,B
1090 REM+++++++++++++++++++++++++++++++++
1100 RETURN
2000 REM ========================================================
2010 REM ********************>> SETFLAG <<***********************
2020 REM (modified to generate modulus-converted
2030 REM series and reset flag array)
2040 REM ========================================================
2050 MDLS = 12/J '<< change modulus for each new series
2060 FOR K9 = 0 TO 11
2070 R9 = INT(RND * 12)
2080 IF CUM(R9) = 1 THEN 2070
2090 CUM(R9) = 1
2100 SET(K9) = R9 MOD MDLS
2110 NEXT K9
2120 FOR K9 = 0 TO 12
2130 CUM(K9) = 0 '<< zero flags prior to next call
2140 NEXT K9
2150 RETURN
3000 REM ========================================================
3010 REM *********************>> TIMPOINT <<*********************
3020 REM ========================================================
3030 REM This subroutine produces rhythm duration values
3040 REM using the serial 'timepoint system'. That is,
3050 REM a sequence of time durations,mod n,is derived
3060 REM from the distance between consecutive set
3070 REM members. The modulus determines the number of
3080 REM metrical pulses contained within one measure.
3090 REM ========================================================
3100 REM Variable Descriptions
3110 REM Entering -
3120 REM SET(): array of series values
3130 REM MDLS: modulus for computation
3140 REM MEDIAN: basic pulse unit
3150 REM Exiting -
3160 REM FRACTION$(): character array of time durations
3170 REM TALLY: total of time durations
3180 REM Local -
3190 REM DUR: fraction numerator
3200 REM K9: loop index, pointer to SET()
3210 REM =======================================================
3220 TALLY = 0
3230 FOR K9 = 0 TO 10
3240 IF SET(K9+1) <= SET(K9) THEN DUR = MDLS - SET(K9) + SET(K9+1)ELSE DUR = SET(K9+1) - SET(K9)
3250 TALLY = TALLY + DUR
3260 FRACTION$(K9) = STR$(DUR) + "/" + STR$(MEDIAN)
3270 NEXT K9
3280 DUR = MDLS - SET(K9)
3290 TALLY = TALLY + DUR
3300 FRACTION$(11) = STR$(DUR) + "/" + STR$(MEDIAN)
3310 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM =========================================================
130 REM To change the probabilities in this program, edit
140 REM the DATA statements which are read into the table.
150 REM =========================================================
160 DIM P(4,4),P$(4)
170 REM >> load pitch character set
180 P$(1)="C"
190 P$(2)="F"
200 P$(3)="G"
210 P$(4)="B"
220 TOTAL = 25
230 LASTPITCH = 3
240 PRINT
250 PRINT "CURRENT PROBABILITY TABLE --"
260 FOR J1 = 1 TO 4
270 FOR J2 = 1 TO 4
280 READ P(J1,J2) '<< load probability table
290 PRINT P(J1,J2), '<< send to screen
300 NEXT J2
310 PRINT
320 NEXT J1
330 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
340 DATA .0,.5,.1,.0
350 DATA .1,.2,.5,.1
360 DATA .6,.3,.1,.5
370 DATA .3,.0,.3,.4
380 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
390 RANDOMIZE
400 PRINT P$(LASTPITCH);" ";
410 FOR J = 1 TO TOTAL-1
420 GOSUB 1000 '<< call transition probability
430 PRINT P$(NEXTPITCH);" "; '<< send choice to screen
440 LASTPITCH = NEXTPITCH
450 NEXT J
460 END
1000 REM ========================================================
1010 REM *********************>> TRANTABL <<*********************
1020 REM ========================================================
1030 REM This subroutine incorporates a first-order
1040 REM transitional probability table to determine
1050 REM melodic pitch class sequence.
1060 REM
1070 REM A 2-dimensional matrix holds occurence frequency
1080 REM probabilities which make the current note choice
1090 REM conditional on the previous choice.
1100 REM The appropriate probabilities are entered in the
1110 REM matrix P(), either as program DATA statements,
1120 REM or via user INPUT statements.
1130 REM
1140 REM For output data to be accurate, it is important
1150 REM that the sum of each column be 1.0. Moreover,
1160 REM the data table should be well thought out to
1170 REM prevent situations with no exit. For instance,
1180 REM if, in the following table, the probability that C
1190 REM follows F is changed to 0.0, the probability that
1200 REM F follows F is changed to 1.0, and the probability
1210 REM that G follows F is changed to 0.0, nothing but the
1220 REM pitch F will be generated once F is selected.
1230 REM
1240 REM ================== example of concept ==================
1250 REM
1260 REM L A S T P I T C H
1270 REM C F G B
1280 REM |--------|--------|--------|---------|
1290 REM C | 0.0 | 0.5 | 0.1 | 0.0 |
1300 REM NEXT |--------|--------|--------|---------|
1310 REM F | 0.1 | 0.2 | 0.5 | 0.1 |
1320 REM PITCH |--------|--------|--------|---------|
1330 REM G | 0.6 | 0.3 | 0.1 | 0.5 |
1340 REM |--------|--------|--------|---------|
1350 REM B | 0.3 | 0.0 | 0.3 | 0.4 |
1360 REM |--------|--------|--------|---------|
1370 REM
1380 REM Read the columns for last pitch, rows for next pitch.
1390 REM For instance, if the last pitch returned was B
1400 REM (col 4), then the probability of the next pitch being
1410 REM B (row 4) is 0.1. This principle can be extended to
1420 REM three, four, or more dimensions, but quickly becomes
1430 REM difficult to comprehend.
1440 REM ========================================================
1450 REM Variable Descriptions
1460 REM Entering -
1470 REM LASTPITCH: holds last note choice
1480 REM Exiting -
1490 REM NEXTPITCH: holds the current note choice
1500 REM Local -
1510 REM U: uniform random number
1520 REM T9: threshold test value
1530 REM K9: loop index, pointer to data table
1540 REM =======================================================
1550 U = RND
1560 T9 = 0
1570 FOR K9 = 1 TO 4
1580 T9 = P(K9,LASTPITCH) + T9
1590 IF U <= T9 THEN 1610
1600 NEXT K9
1610 NEXTPITCH = K9
1620 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Triangle)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 GOSUB 1000 '<< call triangular distribution function
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM ********************>> TRIANGLE <<**********************
1020 REM ========================================================
1030 REM The Triangular Distribution Function generates
1040 REM continuous, random-order real numbers > 0 & < 1.
1050 REM Middle-valued results are most likely to occur.
1060 REM ========================================================
1070 REM Variable Descriptions
1080 REM Entering -
1090 REM TOTAL: length of sequence
1100 REM Exiting -
1110 REM X(): array holding triangular distribution
1120 REM Local -
1130 REM R8: random number 1
1140 REM
1150 REM R9: random number 2
1160 REM ========================================================
1170 FOR K9 = 1 TO TOTAL
1180 R8 = RND
1190 R9 = RND
1200 X(K9) = .5 * (R8+R9)
1210 NEXT K9
1220 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (TSEARCH1)
130 REM =========================================================
140 DIM X(200)
150 TOTAL = 200
160 LOW = 1
170 HIGH = 60
180 RANGE = HIGH - LOW + 1
190 RANDOMIZE
200 PRINT "ARRAY OF RANDOM-ORDER NUMBERS (RANGE 1-";RANGE;")"
210 FOR J = 1 TO TOTAL
220 X(J) = INT(RND * RANGE)+1
230 PRINT X(J);
240 NEXT J
250 PRINT
260 PRINT
270 TABLKEY = LOW
280 PRINT "LOWEST VALUE -";LOW
290 GOSUB 1000 '<< call linear unsorted table search
300 TABLKEY = HIGH
310 PRINT "HIGHEST VALUE -";HIGH
320 GOSUB 1000 '<< call linear unsorted table search
330 END
1000 REM SS2TL1 =================================================
1010 REM *********************>> TSEARCH1 <<*********************
1020 REM ========================================================
1030 REM This linear unsorted table search subroutine
1040 REM scans a value sequence (list) for occurrences of
1050 REM keyed values. In this implementation, the search
1060 REM is for array positions where the low and high
1070 REM boundaries of the random generator range are stored.
1080 REM If the values are not found to be present at all,
1090 REM a message to that effect is printed. Although not
1100 REM strictly a part of the searching algorithm, an
1110 REM value occurrence counter (ITEMCOUNT) has been
1120 REM included .
1130 REM
1140 REM If TSEARCH is to be applied to pitch, then the
1150 REM indicated key positions would be used to reference
1160 REM the appropriate addresses in the pitch character
1170 REM string array (table).
1180 REM ========================================================
1190 REM Variable Descriptions
1200 REM Entering -
1210 REM X(): array of bounded random integers
1220 REM TOTAL: length of sequence
1230 REM TABLKEY: search argument (key to search for)
1240 REM Exiting -
1250 REM none (subroutine is procedural)
1260 REM Local -
1270 REM ITEMCOUNT: occurrence frequency tabulator
1280 REM K9: loop index, pointer to X(),
1290 REM key position indicator
1300 REM =======================================================
1310 ITEMCOUNT = 0
1320 FOR K9 = 1 TO TOTAL
1330 IF TABLKEY = X(K9)THEN PRINT "FOUND AT POSITION ";K9 ELSE 1350
1340 ITEMCOUNT = ITEMCOUNT + 1
1350 NEXT K9
1360 PRINT "KEY ITEM OCCURRED";ITEMCOUNT;"TIME(S)"
1370 PRINT
1380 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (TSEARCH2)
130 REM =========================================================
140 DIM X(50)
150 TOTAL = 50
160 PRINT "A SORTED ARRAY OF INTEGERS (RANGE 1-100) --"
170 FOR J = 1 TO TOTAL
180 X(J) = J * 2
190 PRINT X(J);
200 NEXT J
210 PRINT
220 PRINT
230 ARG = 58
240 PRINT "THE INTEGER";ARG; "WILL BE THE ITEM TO SEARCH FOR"
250 GOSUB 1000
260 IF KPOS = 0 THEN PRINT "NOT FOUND" ELSE PRINT "KEY ";ARG;"= POS"KPOS;
270 END
1000 REM SS1TL2 ================================================
1010 REM *******************>> TSEARCH2 <<**********************
1020 REM =======================================================
1030 REM This binary search subroutine requires a sorted
1040 REM table with unique entry keys. It is the fastest
1050 REM algorithm in common use, and have a variety of
1060 REM compositional application - from simple boundary
1070 REM searches to test condition retrieval.
1080 REM =======================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM X() array of sorted items (keys)
1120 REM TOTAL: length of array X()
1130 REM ARG: search argument (item to look for)
1140 REM Exiting -
1150 REM KPOS: location (address) of item if found,
1160 REM 0 if not found
1170 REM Local -
1180 REM LL: lower limit for current search portion
1190 REM UL: upper limit for current search portion
1200 REM KVAL: computed value of key
1210 REM MP: computed halfway point
1220 REM ========================================================
1230 LL=0
1240 UL=TOTAL+1
1250 KPOS=0
1260 IF ARG < X(1) OR ARG > X(TOTAL)THEN RETURN
1270 IF UL >=LL
THEN MP=INT((UL+LL)/2) : KV=X(MP) :
IF KV <> ARG
THEN IF KV >= ARG
THEN UL=MP-1 : GOTO 1270
ELSE LL=MP+1 : GOTO 1270
ELSE KPOS=MP
ELSE KPOS=UL
1280 IF ARG <> X(KPOS)
THEN KPOS = 0
1290 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (TSEARCH3)
130 REM =========================================================
140 DIM X(52)
150 TOTAL = 50
160 PRINT "A SORTED ARRAY OF INTEGERS (RANGE 1-100) --"
170 FOR J = 1 TO TOTAL
180 X(J) = J * 2
190 PRINT X(J);
200 NEXT J
210 PRINT
220 PRINT
230 ARG = 96
240 PRINT "THE INTEGER";ARG; "WILL BE THE ITEM TO SEARCH FOR"
250 GOSUB 1000 '<< call interpolation search
260 IF KPOS = 0 THEN PRINT "NOT FOUND" ELSE PRINT "KEY ";ARG;"= POS";KPOS;
270 END
1000 REM SS2TL2 =================================================
1010 REM *********************>> TSEARCH3 <<*********************
1020 REM ========================================================
1030 REM This Interpolation Search subroutine requires a
1040 REM sorted list of unique keys (elements). It is
1050 REM faster than the Binary Search in some cases,
1060 REM particularly when the distribution of items is
1070 REM highly skewed. It uses the key's value as an
1080 REM indicator of where to begin the search. which is
1090 REM similar to the method most people use to index
1100 REM an element in a sorted list. Musical applications
1110 REM range from analysis of random-order data to
1120 REM retrieval of stored condition in rule-based
1130 REM compositional procedures.
1140 REM ========================================================
1150 REM Variable Descriptions
1160 REM Entering -
1170 REM X(): array of sorted items (keys)
1180 REM TOTAL: length of array X()
1190 REM Exiting -
1200 REM KPOS: location (address) of item if found,
1210 REM 0 if not found
1220 REM Local -
1230 REM LL: lower search boundary
1240 REM UL: upper search boundary
1250 REM LOKEY: key at lower boundary
1260 REM UPKEY: key at upper boundary
1270 REM INTPOS: interpolated position in array for
1280 REM next comparison
1290 REM INTKEY: key at interpolated position
1300 REM ========================================================
1310 LL = 0
1320 UL = TOTAL + 1
1330 X(LL) = X(1) - 1
1340 X(UL) = X(TOTAL) + 1
1350 LOKEY = X(1)
1360 UPKEY = X(TOTAL)
1370 KPOS = 0
1380 IF ARG < LOKEY OR ARG > UPKEY THEN RETURN
1390 IF UL < LL THEN RETURN
1400 INTPOS = LL + INT((UL - LL) * (ARG - LOKEY) / (UPKEY - LOKEY))
1410 INTKEY = X(INTPOS)
1420 IF INTKEY <> ARG
THEN IF INTKEY >= ARG
THEN UL = INTPOS - 1: UPKEY = INTKEY: GOTO 1390
ELSE LL = INTPOS + 1: LOKEY = INTKEY: GOTO 1390
ELSE KPOS = INTPOS
1430 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (TSEARCH4)
130 REM =========================================================
140 DIM X(52)
150 TOTAL = 50
160 PRINT "A SORTED ARRAY OF INTEGERS (RANGE 1-100) --"
170 FOR J = 1 TO TOTAL
180 X(J) = J * 2
190 PRINT X(J);
200 NEXT J
210 PRINT
220 PRINT
230 ARG = 42
240 SWIDTH = 5
250 PRINT "THE INTEGER";ARG;"WILL BE THE ITEM TO SEARCH FOR"
260 GOSUB 1000 '<< call interpolation search
270 FOR J =LLL TO LUL
280 PRINT X(J) '<< send returned segment to screen
290 NEXT J
300 END
1000 REM SS1TL3 =================================================
1010 REM *********************>> TSEARCH4 <<*********************
1020 REM ========================================================
1030 REM This Proximity Search subroutine requires a
1040 REM sorted list of unique keys (elements). It is
1050 REM more powerful than the Binary Search in that
1060 REM it returns a subset of the array on either side
1070 REM of the key (even if the requested item is missing
1080 REM from the list. This method may be preferable for
1090 REM compositional applications which require searching
1100 REM of rule-groups for prioritized solutions to compos-
1110 REM itional problems, an approach gaining popularity
1120 REM as an alternative to the Monte Carlo method of
1130 REM random number parameter generation.
1140 REM ========================================================
1150 REM Variable Descriptions
1160 REM Entering -
1170 REM X(): array of sorted items (keys)
1180 REM TOTAL: length of array X()
1190 REM ARG: search argument (item to look for)
1200 REM SWIDTH: width of search below & above item
1210 REM Exiting -
1220 REM LUL: upper limit of list of items returned
1230 REM LLL: lower limit of list of items returned
1240 REM Local -
1250 REM K9: loop index, pointer to array X()
1260 REM ========================================================
1270 FOR K9=1 TO TOTAL
1280 IF ARG <= X(K9) THEN 1310
1290 NEXT K9
1300 K9=TOTAL+1
1310 IF ARG=X(K9) THEN LUL=K9+SWIDTH ELSE LUL=K9+SWIDTH-1
1320 LLL=K9-SWIDTH
1330 IF LUL > TOTAL THEN LUL=TOTAL
1340 IF LLL < 1 THEN LLL=1
1350 RETURN
100 REM =========================================================
110 REM ==================== DRIVER PROGRAM =====================
120 REM =========================================================
130 DIM TONE(84)
140 NUMTONES = 84
150 OCTDIV = 19 '<< specify a 19-tone per octave scale
160 FREQ1 = 61.735
170 GOSUB 1000 '<< call tuning compiler
180 FOR J= 1 TO NUMTONES
190 PRINT TONE(J), '<< send scale frequencies to screen
200 NEXT J
210 END
1000 REM ========================================================
1010 REM ********************>> TUNINGS <<***********************
1020 REM ========================================================
1030 REM This subroutine compiles a data table containing
1040 REM equal-tempered, octave-repeating tunings.
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM
1080 REM Entering -
1090 REM FREQ1: frequency in Herz (cps) of scale tonic
1100 REM NUMTONES: number of pitches to compute
1110 REM OCTDIV: number of equalsize steps within octave
1120 REM Exiting -
1130 REM TONE(): array of computed scale frequencies
1140 REM Local -
1150 REM COEFF: coefficient for specified octave division
1160 REM K9: loop index, pointer to array TONE()
1170 REM
1180 REM ========================================================
1190 COEFF = 2^(1/OCTDIV)
1200 TONE(1) = INT(FREQ1+.5)
1210 FOR K9= 2 TO NUMTONES
1220 TONE(K9) = INT(TONE(K9-1)*COEFF+.5)
1230 NEXT K9
1240 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
115 REM (Valratio)
120 REM =========================================================
130 DIM P(12),X(100)
140 RANDOMIZE(-29312)
150 TOTAL = 100
160 RANGE = 12
170 WINDO = 4
180 GOSUB 1000 '<< call value ratio control
185 PRINT "SIZE OF VALUE WINDOW IS ";WINDO
190 FOR J = 1 TO 100
200 PRINT X(J),
210 NEXT J
220 END
1000 REM ========================================================
1010 REM ******************>> REPRATIO <<***********************
1020 REM ========================================================
1030 REM This algorithm prevents repetition of values which
1040 REM fall within a specified 'window' of predetermined
1050 REM size. For instance, if 100 values are to be
1060 REM returned, a window of 9 is specified, and a
1070 REM random number value range of 1-10 is entered,
1080 REM then the sequence which is generated will be a
1090 REM non-repeating series (set). However, if a smaller
1100 REM window is entered, then only the values falling
1110 REM within the sliding 'window' will be prevented
1120 REM from containing repetitions.
1130 REM ========================================================
1140 REM Variable Descriptions
1150 REM
1160 REM Entering -
1170 REM TOTAL: number of values to be returned
1180 REM RANGE: 1-n inclusive limits for random numbers
1190 REM WINDO: size of window for repetition prevention
1200 REM Exiting -
1210 REM X(): array holding sequence of values
1220 REM Local -
1230 REM U: random number, pointer to array P()
1240 REM P(): array which records value occurence
1250 REM K9: loop index, pointer to array X()
1260 REM
1270 REM ========================================================
1280 FOR K9 = 1 TO TOTAL
1290 U = INT(RND * RANGE)+1
1300 IF P(U) = 1 THEN 1290
1310 P(U) = 1
1320 X(K9) = U
1330 IF K9 <= WINDO THEN 1350
1340 P(X(K9-WINDO)) = 0
1350 NEXT K9
1360 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
115 REM (Valuprobs)
120 REM =========================================================
130 DIM WTABLE(5), X(40)
140 RANDOMIZE
150 PROBS = 5
160 TOTAL = 40
170 GOSUB 1000 '<< call probability table subr.
180 GOSUB 2000 '<< call table look-up & test
190 FOR J = 1 TO TOTAL
200 PRINT X(J), '<< send choices to screen
210 NEXT J
220 END
1000 REM ========================================================
1010 REM *******************>> PROBTABL <<**********************
1020 REM ========================================================
1030 REM This subroutine reads relative weights into a
1040 REM cumulative probability table (array).
1050 REM ========================================================
1060 REM Variable Descriptions
1070 REM Entering -
1080 REM PROBS: number of relative probability weights
1090 REM Exiting -
1100 REM WTABLE(): data table containing relative weights
1110 REM Local -
1120 REM WSUM: holds current sum of probability weights
1130 REM K9: loop index, pointer to array WTABLE()
1140 REM ========================================================
1150 WSUM = 0
1160 FOR K9 = 1 TO PROBS
1170 READ WTABLE(K9)
1180 WTABLE(K9)=WTABLE(K9)+WSUM
1190 WSUM=WTABLE(K9)
1200 NEXT K9
1210 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1220 DATA 1,2,3,4,5
1230 REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1240 RETURN
2000 REM ========================================================
2010 REM *******************>> PROBCALC <<***********************
2020 REM ========================================================
2030 REM This subroutine generates the numbers 1-n over a
2040 REM run of n values in relative proportion to the
2050 REM probability weights contained in WTABLE().
2060 REM The numbers may be used directly, or they may
2070 REM serve as pointers to pitch class characters,
2080 REM rhythmic duration, volume, or articulation
2090 REM arrays.
2100 REM ========================================================
2110 REM Variable Descriptions
2120 REM Entering -
2130 REM TOTAL: number of values to be returned
2140 REM WTABLE(): array containing relative weights
2150 REM PROBS: number of relative probability weights
2160 REM WSUM: holds current sum of probability weights
2170 REM Exiting -
2180 REM X(): array containing selected values
2190 REM Local -
2200 REM WSUM: stores current sum of probability weights
2210 REM R: random number, scaled to sum of weights
2220 REM L9: loop index, pointer to WTABLE()
2230 REM K9: loop index, pointer to array X()
2240 REM ========================================================
2250 FOR K9 = 1 TO TOTAL
2260 R = RND * WSUM
2270 FOR L9 = 1 TO PROBS
2280 IF R <= WTABLE(L9) THEN 2300
2290 NEXT L9
2300 X(K9) = L9
2310 NEXT K9
2320 RETURN
100 REM =========================================================
110 REM VECTORS
120 REM =========================================================
130 REM The subroutine VECTSTOR creates 'event vectors'
140 REM by storing pitch, rhythm and volume data for a
150 REM single musical event in one double precision number.
170 REM The subroutine PARXTRCT extracts the event attributes
180 REM from the composite value.
200 REM =========================================================
210 REM =========================================================
220 REM Variable Descriptions
230 REM
240 REM P: holds value of event vector pitch parameter
250 REM R: holds value of event vector rhythm parameter
260 REM V: holds value of event vector volume parameter
270 REM COMP#(): double precision vector (values P,R,V)
280 REM K9: loop index, pointer to array COMP#()
290 REM
300 REM =========================================================
310 REM =================== DRIVER PROGRAM ======================
320 REM =========================================================
330 DIM COMP#(10)
340 GOSUB 1000 '<< call event vector storage
350 PRINT
360 GOSUB 2000 '<< call event vector extract
370 END
1000 REM ========================================================
1010 REM ******************>> VECTSTOR <<************************
1020 REM ========================================================
1030 PRINT "STORE EVENT PARAMETERS IN DBL PRECIS. NUMBER --
1040 FOR K9= 1 TO 10
1050 P = K9 '<< assign pitch value
1060 R = K9 * 5 '<< assign rhythm duration value
1070 V = K9 * 10 '<< assign volume level value
1080 PRINT "PITCH = ";P,"RHYTHM = ";R, "VOLUME =";V,
1090 COMP#(K9) = (P * 1000000!) + (R * 1000) + V
1100 PRINT "COMPOSITE NUMBER IS ";COMP#(K9)
1110 NEXT K9
1120 RETURN
2000 REM ========================================================
2010 REM *******************>> PARXTRCT <<***********************
2020 REM ========================================================
2030 PRINT "EXTRACT EVENT PARAMETERS FROM COMPOSITE NUMBER--"
2040 FOR K9 = 1 TO 10
2050 COMP#(K9) = COMP#(K9)/1000000!
2060 P = INT(COMP#(K9))
2070 PRINT "P=";P ,
2080 R = INT((COMP#(K9) - INT(COMP#(K9))) * 1000)
2090 PRINT "R=";R ,
2100 COMP#(K9) = COMP#(K9) * 1000
2110 V = INT((COMP#(K9) - INT(COMP#(K9))) * 1000+.5)
2120 PRINT "V=";V
2130 NEXT K9
2140 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Voss)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
170 LAST = 24
180 GOSUB 1000 '<< call one-over-f distribution function
190 FOR J = 1 TO TOTAL
200 PRINT X(J); '<< sequence to screen
210 NEXT J
220 END
1000 REM ========================================================
1010 REM ********************>> VOSS <<**************************
1020 REM ========================================================
1030 REM This subroutine generates 1/f fractional noise
1040 REM patterns for use in any musical parameter. Each
1050 REM subsequent value is conditional on the last value
1060 REM generated, and all generated values correlate
1070 REM logarithmically with the past, resulting in a
1080 REM process which has longe-range memory.
1090 REM ========================================================
1100 REM Variable Descriptions
1110 REM Entering -
1120 REM TOTAL: length of sequence
1130 REM LAST: last value generated
1140 REM Exiting -
1150 REM X(): array holding one-over-f distribution
1160 REM Local -
1170 REM FRACT: current one-over-f value
1180 REM HALFVALS: 1/2 the number of possible values
1190 REM PROB: 1 / number of possible values
1200 REM R9: uniform random number
1210 REM S9: stores in-progress computation
1220 REM K9: loop index, pointer to array X()
1230 REM ========================================================
1240 REM
1250 REM
1260 FOR K9 = 1 TO TOTAL
1270 FRACT = 0
1280 HALFVALS = 16 ' = 1/2 number of poss values
1290 PROB = .03125 ' = 1/num poss values
1300 WHILE HALFVALS > = 1
1310 S9 = INT(LAST/HALFVALS)
1320 IF S9 = 1 THEN LAST = LAST-HALFVALS
1330 R9 = RND
1340 IF R9 < PROB THEN S9 = 1-S9
1350 FRACT= FRACT + S9 * HALFVALS
1360 HALFVALS = HALFVALS/2
1370 PROB = PROB * 2
1380 WEND
1390 X(K9) = FRACT
1400 LAST = FRACT
1410 NEXT K9
1420 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Weibull)
130 REM =========================================================
140 DIM X(50)
150 RANDOMIZE
160 TOTAL = 50
161 SPREAD = 20
162 DENSHAPE = 1
170 GOSUB 1000 '<< call Weibull distribution function
180 FOR J = 1 TO TOTAL
190 PRINT X(J); '<< sequence to screen
200 NEXT J
210 END
990 REM =========================================================
1000 REM **********************>> WEIBULL <<*********************
1010 REM ========================================================
1020 REM The Weibull Probability Distribution function
1030 REM generates random-order real numbers greater than
1040 REM zero. Its curve can assume a variety of shapes in
1050 REM accordance with the value of its input parameter,
1060 REM DENSHAPE. The SPREAD parameter controls only the
1070 REM horizontal scale.
1080 REM ========================================================
1090 REM Variable Descriptions
1100 REM Entering -
1110 REM TOTAL: length of sequence
1120 REM SPREAD: horizontal scaling parameter
1130 REM DENSHAPE : curve shaping parameter
1140 REM Exiting -
1150 REM X(): array holding Weibull distribution
1160 REM Local -
1170 REM R9: uniform random number
1180 REM K9: loop index, pointer to array X()
1189 REM ========================================================
1190 FOR K9 = 1 TO TOTAL
1200 R9 = RND
1210 R9=1/(1-R9)
1220 X(K9) = SPREAD * LOG(R9)^(1/DENSHAPE)
1230 NEXT K9
1240 RETURN
100 REM =========================================================
110 REM DRIVER PROGRAM
120 REM (Wordplay)
130 REM =========================================================
140 DIM WORD$(200),TEXT$(13)
150 DIM TXTLN(12),TXTWD(200),X(20),WTABL(20)
160 FOR J = 1 TO 20
170 X(J) = J
180 NEXT J
190 READ TOTAL
200 PRINT "THE ORIGINAL TEXT --"
210 FOR J = 1 TO TOTAL
220 READ TEXT$(J)
230 PRINT TEXT$(J)
240 NEXT J
250 PRINT
260 RANDOMIZE
270 PRINT "A RANDOM ORDERING OF THE TEXT LINES --"
280 GOSUB 1000
290 TEXT$(TOTAL) = TEXT$(TOTAL) + " #"
300 PRINT "WORDS IN TEXT" : PRINT
310 CHARSET$ =" abcdefghijklmnopqrstuvwxyz0123456789"
320 CHARSET$ = CHARSET$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
330 ENDFLAG = 0 : PHRPTR = 1 : POSIT = 1 : COUNT = 0
340 WHILE ENDFLAG <> 1
350 GOSUB 2000 '<< call next word
360 CLNWORD$ = NXTWORD$
370 GOSUB 3000 '<< call string clean-up & compress
380 WRDCNT = WRDCNT + 1
390 NXTWORD$ = CLNWORD$
400 PRINT NXTWORD$,
410 WORD$(WRDCNT) = NXTWORD$
420 SIZE = LEN(NXTWORD$)
430 WTABL(SIZE) = WTABL(SIZE) + 1
440 WEND
450 PRINT
460 P$=" ## ### ## ###"
470 PRINT "length frequency length frequency"
480 FOR J = 1 TO 20 STEP 2
490 PRINT USING P$;J,WTABL(J),J+1,WTABL(J+1)
500 NEXT J
510 GOSUB 4000 '<< call weighted average
520 PRINT
530 PRINT "AVERAGE WORD LENGTH = ";AVERAGE
540 PRINT "A RANDOM ORDERING OF THE TEXT WORDS --"
550 GOSUB 5000 '<< call random word-walk
560 PRINT
570 END
580 REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
590 DATA 12
600 DATA "At morn -at noon -at twilight dim-"
610 DATA "Maria! thou hast heard my hymn!"
620 DATA "In joy and woe -in good and ill-"
630 DATA "Mother of God, be with me still!"
640 DATA "When the hours flew brightly by,"
650 DATA "And not a cloud obscured the sky,"
660 DATA "My soul, lest it should truant be,"
670 DATA "Thy grace did guide to thine and thee;"
680 DATA "Now, when storms of Fate o'rcast"
690 DATA "Darkly my Present and my Past,"
700 DATA "Let my Future radiant shine"
710 DATA "With sweet hopes of thee and thine!"
720 REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1000 REM ========================================================
1010 REM ********************>> RANDLINE <<**********************
1020 REM ========================================================
1030 REM This subroutine is an adaptation of the sampling-
1040 REM without-replacement algorithm. It simply uses the
1050 REM ARRAYFLAG method of serializing the lines, then
1060 REM returns one copy of each line in random-order.
1070 REM ========================================================
1080 REM Variable Descriptions
1090 REM Entering -
1100 REM TEXT$(): array holding lines of text
1110 REM TOTAL: number of lines in TEXT$()
1120 REM Exiting -
1130 REM none (subroutine is procedural)
1140 REM Local -
1150 REM LINSTEP: random number
1160 REM TXTLN(): array to store occurrence flags
1170 REM K9: loop index
1180 REM ========================================================
1190 FOR K9 = 1 TO TOTAL
1200 LINSTEP = INT(RND * TOTAL)+1
1210 IF TXTLN(LINSTEP)= 1 THEN 1200
1220 PRINT TEXT$(LINSTEP)
1230 TXTLN(LINSTEP) = 1
1240 NEXT K9
1250 RETURN
2000 REM ========================================================
2010 REM ********************>> NEXTWORD <<**********************
2020 REM ========================================================
2030 REM This subroutine extracts the next word in line
2040 REM from the list of phrases supplied by the DRIVER
2050 REM PROGRAM, which also passes several flags to
2060 REM signal the processing status. End-of-word is
2070 REM indicated by (" "), end-of-phrase by ("_#").
2080 REM ========================================================
2090 REM Variable Descriptions
2100 REM Entering -
2110 REM TEXT$(): list of phrases to be broken into words
2120 REM PHRPTR: phrase pointer
2130 REM POSIT: position in phrase being analyzed
2140 REM Exiting -
2150 REM ENDFLAG: signal for end of processing (if = 1)
2160 REM NXTWORD$: next word (extracted)
2170 REM Local -
2180 REM SCANCHAR$: character being scanned
2190 REM K9: phrase loop index
2200 REM L9: word loop index
2210 REM ========================================================
2220 NXTWORD$ = ""
2230 FOR K9 = POSIT TO LEN(TEXT$(PHRPTR))
2240 SCANCHAR$ = MID$(TEXT$(PHRPTR),K9,1)
2250 IF SCANCHAR$ = "#" THEN ENDFLAG = 1 : RETURN
2260 IF SCANCHAR$ <> " " THEN 2300
2270 NEXT K9
2280 PHRPTR = PHRPTR + 1 : POSIT = 1
2290 IF NXTWORD$ = "" THEN 2230 ELSE ENDFLAG = 0 : RETURN
2300 NXTWORD$ = NXTWORD$ + SCANCHAR$
2310 IF K9 = LEN(TEXT$(PHRPTR)) THEN PHRPTR = PHRPTR + 1 : POSIT = 1 :ENDFLAG = 0 : RETURN
2320 FOR L9 = K9 + 1 TO LEN(TEXT$(PHRPTR))
2330 SCANCHAR$ = MID$(TEXT$(PHRPTR),L9,1)
2340 IF SCANCHAR$ = " " THEN POSIT = L9 : GOTO 2380
2350 NXTWORD$ = NXTWORD$ + SCANCHAR$
2360 NEXT L9
2370 PHRPTR = PHRPTR + 1 : POSIT = 1
2380 ENDFLAG = 0
2390 RETURN
3000 REM ========================================================
3010 REM **********************>> STRCLEAN <<********************
3020 REM ========================================================
3030 REM This subroutine strips all special characters from
3040 REM a string, then compresses it.
3050 REM ========================================================
3060 REM Variable Descriptions
3070 REM Entering -
3080 REM CLNWORD$: string to be cleaned
3090 REM CHARSET$: string of legal characters to be kept
3100 REM Exiting -
3110 REM CLNWORD$: cleaned string
3120 REM Local -
3130 REM TBUFF$: temporary string buffer
3140 REM K9: loop index, pointer to CLNWORD$ characters
3150 REM ========================================================
3160 TBUFF$ = ""
3170 FOR K9 = 1 TO LEN(CLNWORD$)
3180 IF INSTR(CHARSET$,MID$(CLNWORD$,K9,1)) <> 0 THEN TBUFF$ = TBUFF$+MID$(CLNWORD$,K9,1)
3190 NEXT K9
3200 CLNWORD$ = TBUFF$
3210 RETURN
4000 REM ========================================================
4010 REM **********************>> AVERAGE <<*********************
4020 REM ========================================================
4030 REM This subroutine computes the weighted average length
4040 REM of all words contained in the text.
4050 REM ========================================================
4060 REM Variable Descriptions
4070 REM Entering -
4080 REM X(): array of values to be averaged
4090 REM WTABL(): array of weights corresponding to each X()
4100 REM TOTAL: number of values in X() and WTABL()
4110 REM Exiting -
4120 REM AVERAGE: weighted average length of words
4130 REM Local -
4140 REM PRODSUM: sum of products of value and weight
4150 REM WEIGHTSUM: sum of weights
4160 REM K9: loop index, pointer to WTABLE()
4170 REM ========================================================
4180 PRODSUM = 0 : WEIGHTSUM = 0
4190 FOR K9 = 1 TO TOTAL
4200 PRODSUM = PRODSUM + WTABL(K9) * X(K9)
4210 WEIGHTSUM = WEIGHTSUM + WTABL(K9)
4220 NEXT K9
4230 AVERAGE = PRODSUM / WEIGHTSUM
4240 RETURN
5000 REM ========================================================
5010 REM *********************>> RANDWORD <<*********************
5020 REM ========================================================
5030 REM This subroutine is identical in function to
5040 REM RANDLINE, except that it randomizes word order.
5050 REM ========================================================
5060 REM Variable Descriptions
5070 REM Entering -
5080 REM WORD$(): array holding words of text
5090 REM WRDCNT: number of words in array WORD$()
5100 REM Exiting -
5110 REM none (subroutine is procedural)
5120 REM Local -
5130 REM TXTWD(): array to store occurrence flags
5140 REM WRDSTEP: random number
5150 REM K9: loop index
5160 REM ========================================================
5170 FOR K9 = 1 TO WRDCNT
5180 WRDSTEP = INT(RND * WRDCNT)+1
5190 IF TXTWD(WRDSTEP) = 1 THEN 5180
5200 PRINT WORD$(WRDSTEP);" ";
5210 TXTWD(WRDSTEP) = 1
5220 IF K9 MOD 10 = 0 THEN PRINT
5230 NEXT K9
5240 RETURN
Back
