mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 09:21:15 +00:00
136 lines
4.1 KiB
QBasic
136 lines
4.1 KiB
QBasic
|
||
|
||
100 REM GENE1 - A SIMPLE GENETICS PROGRAM
|
||
110 REM COPYRIGHT 1971, STATE UNIVERSITY OF NEW YORK
|
||
120 REM A$,B$ - FEMALE PARENT'S GENES
|
||
130 REM Z$,Y$ - MALE PARENT'S GENES
|
||
140 REM G$,H$ - CHILD'S INHERITED GENES ; P$ - CHILD'S PHENOTYPE
|
||
150 REM D$,R$ - DOMINANT AND RECESSIVE GENES, RESPECTIVELY
|
||
160 REM T$ - DETAILED REPORT FLAG
|
||
170 REM S1:TOTAL NUMBER OF CHILDREN WITH PURE DOMINANT GENES
|
||
180 REM S2:TOTAL NUMBER OF CHILDREN WITH PURE RECESSIVE GENES
|
||
190 REM S3:TOTAL NUMBER OF CHILDREN WITH DOMINANT PHENOTYPE
|
||
200 REM (I.E. PURE DOMINANTS PLUS HYBRIDS)
|
||
210 REM DEVELOPED AND PROGRAMMED BY L. BRAUN, MAY 1971
|
||
220 REM LATEST REVISION: 8-27-72
|
||
230 REM CONVERT FOLLOWING TWO LINES TO DIMENSIONS IF NECESSARY
|
||
240 REM DIM A$(10),B$(10),D$(10),R$(10),Y$(10),Z$(10)
|
||
250 REM DIM G$(10),H$(10),P$(10),T$(10)
|
||
260 REM CHANGE NEXT LINE TO INCREASE UPPER LIMIT ON REPORTING
|
||
270 LET R=200
|
||
280 REM INPUT DOMINANT AND RECESSIVE TRAITS
|
||
290 PRINT "WHAT ARE THE TWO TRAITS TO BE STUDIED?"
|
||
300 PRINT "DOMINANT TRAIT";
|
||
310 INPUT D$
|
||
320 PRINT "RECESSIVE TRAIT";
|
||
330 INPUT R$
|
||
340 IF D$=R$ THEN 290
|
||
350 PRINT
|
||
360 PRINT "******"
|
||
370 PRINT
|
||
380 REM INPUT THE GENOTYPES OF BOTH PARENTS
|
||
390 PRINT "GENOTYPE OF FEMALE PARENT";
|
||
400 INPUT A$,B$
|
||
410 IF A$=D$ THEN 450
|
||
420 IF A$=R$ THEN 450
|
||
430 PRINT "FEMALE GENOTYPE INCLUDES INCORRECT TRAIT. RE-ENTER."
|
||
440 GOTO 390
|
||
450 IF B$=D$ THEN 470
|
||
460 IF B$ <> R$ THEN 430
|
||
470 PRINT
|
||
480 PRINT "GENOTYPE OF MALE PARENT";
|
||
490 INPUT Z$,Y$
|
||
500 IF Z$=D$ THEN 540
|
||
510 IF Z$=R$ THEN 540
|
||
520 PRINT "MALE GENOTYPE INCLUDES INCORRECT TRAIT. RE-ENTER."
|
||
530 GOTO 480
|
||
540 IF Y$=D$ THEN 580
|
||
550 IF Y$ <> R$ THEN 520
|
||
560 REM IF BOTH PARENTS ARE PURE GENOTYPES, DO NOT RUN THE RANDOM
|
||
570 REM EXPERIMENTS, BUT INDICATE RESULTS AS A SPECIAL CASE.
|
||
580 PRINT
|
||
590 IF A$ <> B$ THEN 700
|
||
600 IF Y$ <> Z$ THEN 700
|
||
610 PRINT "BECAUSE THE PARENTS ARE PURE GENOTYPES, ALL OFFSPRING ARE "
|
||
620 IF A$=Y$ THEN 650
|
||
630 PRINT D$;"-";R$;", THAT IS, HYBRID."
|
||
640 GOTO 1340
|
||
650 IF A$=R$ THEN 680
|
||
660 PRINT D$;"-";D$;", THAT IS, PURE DOMINANT."
|
||
670 GOTO 1340
|
||
680 PRINT R$;"-";R$;", THAT IS, PURE RECESSIVE."
|
||
690 GOTO 1340
|
||
700 PRINT
|
||
710 PRINT "HOW MANY OFFSPRING DO YOU WANT TO STUDY";
|
||
720 INPUT N
|
||
730 PRINT
|
||
740 REM LET Q=RND(-1)
|
||
750 RANDOMIZE
|
||
760 REM CHANGE HERE FOR DIFFERENT NUMBER OF REPORTED CASES
|
||
770 IF N<R+1 THEN 820
|
||
780 LET T$="NO"
|
||
790 PRINT "RATIOS ONLY WILL BE TYPED, BECAUSE OF "
|
||
800 PRINT "THE LARGE NUMBER OF OFFSPRING."
|
||
810 GOTO 920
|
||
820 PRINT "DETAILED REPORT (YES OR NO)";
|
||
830 INPUT T$
|
||
840 IF T$="NO" THEN 920
|
||
850 IF T$ <> "YES" THEN 820
|
||
860 PRINT
|
||
870 PRINT
|
||
880 PRINT
|
||
890 PRINT "OFFSPRING NO.","------GENOTYPE------","PHENOTYPE"
|
||
900 PRINT " ","GENE 1","GENE 2"
|
||
910 PRINT "================================================="
|
||
920 LET S1=0
|
||
930 LET S2=0
|
||
940 LET S3=0
|
||
950 FOR I=1 TO N
|
||
960 REM SELECT RANDOMLY WHICH GENE CHILD WILL INHERIT
|
||
970 LET R1=RND(X)
|
||
980 IF R1>.5 THEN 1010
|
||
990 LET G$=A$
|
||
1000 GOTO 1030
|
||
1010 LET G$=B$
|
||
1020 REM SELECT RANDOMLY WHICH GENE CHILD WILL INHERIT
|
||
1030 LET R2=RND(X)
|
||
1040 IF R2>.5 THEN 1070
|
||
1050 LET H$=Z$
|
||
1060 GOTO 1080
|
||
1070 LET H$=Y$
|
||
1080 IF G$=D$ THEN 1140
|
||
1090 IF H$=D$ THEN 1170
|
||
1100 REM IF BOTH INHERITED GENES ARE RECESSIVE, ADD 1 TO NO. RECESSIVES
|
||
1110 LET P$=R$
|
||
1120 LET S2=S2+1
|
||
1130 GOTO 1200
|
||
1140 IF H$ <> D$ THEN 1170
|
||
1150 REM IF BOTH INHERITED GENES DOMINANT,ADD 1 TO NO. PURE DOMINANTS
|
||
1160 LET S1=S1+1
|
||
1170 LET P$=D$
|
||
1180 REM IF EITHER INHERITED GENE DOMINANT,ADD 1 TO DOMINANT PHENOTYPES
|
||
1190 LET S3=S3+1
|
||
1200 IF T$="NO" THEN 1220
|
||
1210 PRINT I,G$,H$,P$
|
||
1220 NEXT I
|
||
1230 PRINT
|
||
1240 PRINT "************"
|
||
1250 PRINT
|
||
1260 IF S1>0 THEN 1290
|
||
1270 PRINT "GENOTYPE RATIO 0 :";(N-S1-S2)/S2;": 1"
|
||
1280 GOTO 1300
|
||
1290 PRINT "GENOTYPE RATIO 1 :";(N-S1-S2)/S1;":";S2/S1
|
||
1300 IF N>S3 THEN 1330
|
||
1310 PRINT "PHENOTYPE RATIO 1 : 0"
|
||
1320 GOTO 1340
|
||
1330 PRINT "PHENOTYPE RATIO ";S3/(N-S3);": 1"
|
||
1340 PRINT
|
||
1350 PRINT "############"
|
||
1360 PRINT
|
||
1370 PRINT "WANT ANOTHER RUN (YES OR NO)";
|
||
1380 INPUT T$
|
||
1390 IF T$="YES" THEN 350
|
||
1400 IF T$ <> "NO" THEN 1370
|
||
1410 END
|
||
|
||
READY
|
||
*U* 4 |