1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        ORGCHE:   DRILL ON ORGANIC COMPOUND NOMENCLATURE
4  REM
5  REM        36646 REV  A    10/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
10  DIM A[2,20],B[2,20],C[20,20],D[20,11],A$[10],N$[11]
20  DIM B$[2],C$[20]
30  PRINT '13'10'10;TAB(15);"DRILL ON ORGANIC NOMENCLATURE"'13'10'10
40  PRINT "THE CODES ARE:"'13'10
50  PRINT "     1)  ALKANES"
60  PRINT "     2)  ALKENES"
70  PRINT "     3)  ALKYNES"
80  PRINT "     4)  HALOGEN SUBSTITUTIONS"
90  PRINT "     5)  ALCOHOLS"
100  PRINT "     6)  ETHERS"
110  PRINT "     7)  ORGANIC ACIDS"
120  PRINT "     8)  AMINES"
130  PRINT "     9)  KETONES"
140  PRINT "    10)  ALDEHYDES"
150  PRINT "     0)  ANY COMBINATION OF THE ABOVE"
160  PRINT '13'10"WHAT CODE : ";
170  INPUT C
180  IF C <> INT(C) OR ABS(C-5)>5 THEN 170
190  PRINT '13'10"HOW MANY : ";
200  INPUT Z
210  PRINT '13'10"^,- BOTH REPRESENT SINGLE BONDS, #,= BOTH REPRESENT DOUBLE"
220  PRINT "BONDS, AND * IS USED TO REPRESENT A TRIPLE BOND."'13'10'10'10
230  LET N$="12345678910"
240  MAT D=ZER[2*Z,11]
250  FOR Z1=1 TO Z MIN 10
260  LET D2=0
270  LET C1=C
280  IF C1>0 THEN 300
290  LET C1=INT(10*RND(1)+1)
300  LET C2=RND(1)
310  LET N=INT(7*RND(1)+4)
320  MAT A=ZER[2,N]
330  GOTO C1 OF 840,340,460,530,610,690,840,690,740,840
340  LET C2=D2=INT(C2*3+1)
350  LET C3=INT((N-1)*RND(1)+1)
360  IF A[1,C3]=-.9 OR A[2,C3]=-.9 THEN 350
370  IF A[1,C3] THEN 400
380  LET A[1,C3]=-.9
390  GOTO 410
400  LET A[2,C3]=-.9
410  IF A[1,C3+1] THEN 440
420  LET A[1,C3+1]=-1.1
430  GOTO 450
440  LET A[2,C3+1]=-1.1
450  GOTO 820
460  LET C2=D2=INT(C2*3+1)
470  LET C2=C2-(C2-INT(N/2))*(C2>INT(N/2))
480  LET C3=INT((N-1)*RND(1)+1)
490  IF A[1,C3] THEN 480
500  LET A[1,C3]=A[2,C3]=-.8
510  LET A[1,C3+1]=A[2,C3+1]=-1.2
520  GOTO 820
530  LET C2=INT(5*C2+1)
540  LET C3=INT(N*RND(1)+1)
550  IF A[1,C3] AND A[2,C3] THEN 540
560  IF A[1,C3] THEN 590
570  LET A[1,C3]=-2-INT(4*RND(1))
580  GOTO 600
590  LET A[2,C3]=-2-INT(4*RND(1))
600  GOTO 820
610  LET C2=D2=INT(3*C2+1)
620  LET C3=INT(N*RND(1)+1)
630  IF A[2,C3] THEN 620
640  IF A[1,C3] THEN 670
650  LET A[1,C3]=-6
660  GOTO 680
670  LET A[2,C3]=-6
680  GOTO 820
690  LET C2=INT(10*RND(1))
700  LET C3=INT(10*RND(1)+(C2=0)*3)
705  IF ABS(C2-3)>2 OR ABS(C3-3)>2 THEN 690
710  IF C3=C2 THEN 690
720  LET N=1
730  GOTO 920
740  LET C2=D2=INT(4*C2+1)
750  LET C3=INT((N-2)*RND(1)+2)
760  IF A[1,C3]<0 THEN 750
770  IF A[1,C3] AND A[2,C3] THEN 750
780  IF A[1,C3] THEN 810
790  LET A[1,C3]=-7
800  GOTO 820
810  LET A[2,C3]=-7
820  LET C2=C2-1
830  GOTO (C2>0)*C1 OF 10,350,480,540,620,10,10,10,750,10
840  FOR C3=2 TO N-1
850  FOR C4=1 TO 2
860  IF A[C4,C3] OR RND(1)>.3 THEN 900
870  IF A[1,C3]=-7 THEN 900
880  LET C5=(C3-1) MIN (N-C3)
890  LET A[C4,C3]=INT(C5*RND(1)+1)
900  NEXT C4
910  NEXT C3
920  MAT B=ZER[2,N]
930  IF C1 <> 6 AND C1 <> 8 THEN 970
940  LET B[1,1]=A[1,1]=C2 MIN C3
950  LET B[2,1]=A[2,1]=C2 MAX C3
960  GOTO 1270
970  IF C1=7 OR C1=10 THEN 1100
980  LET T1=T2=0
990  FOR C2=1 TO N
1000  LET T1=T1+(A[1,C2]<0)*C2+(A[2,C2]<0)*C2
1010  LET T2=T2+(N+1-C2)*((A[1,C2]<0)+(A[2,C2]<0))
1020  NEXT C2
1030  GOTO 2+SGN(T1-T2) OF 1180,1040,1100
1040  LET T1=T2=0
1050  FOR C2=1 TO N
1060  LET T1=T1+C2*(A[1,C2]*(A[1,C2]>0)+A[2,C2]*(A[2,C2]>0))
1070  LET T2=T2+(N+1-C2)*(A[1,C2]*(A[1,C2]>0)+A[2,C2]*(A[2,C2]>0))
1080  NEXT C2
1090  GOTO 2+SGN(T1-T2) OF 1180,1180,1100
1100  FOR C2=1 TO N
1110  FOR C3=1 TO 2
1120  LET B[C3,C2]=A[C3,N+1-C2]
1130  IF ABS(B[C3,C2]+1)>.5 THEN 1150
1140  LET B[C3,C2]=-2-B[C3,C2]
1150  NEXT C3
1160  NEXT C2
1170  GOTO 1190
1180  MAT B=A
1190  FOR Z2=1 TO Z1-1
1200  IF D[2*Z2-1,1] <> C1 OR D[2*Z2,1] <> N THEN 1260
1210  FOR Z3=1 TO N
1220  IF D[2*Z2-1,Z3+1]=B[1,Z3] AND D[2*Z2,Z3+1]=B[2,Z3] THEN 1240
1230  IF D[2*Z2-1,Z3+1] <> B[2,Z3] OR D[2*Z2,Z3+1] <> B[1,Z3] THEN 1260
1240  NEXT Z3
1250  GOTO 270
1260  NEXT Z2
1270  LET D[2*Z1-1,1]=C1+10*D2
1280  LET D[2*Z1,1]=N
1290  FOR Z2=1 TO N
1300  LET D[2*Z1-1,Z2+1]=B[1,Z2]
1310  LET D[2*Z1,Z2+1]=B[2,Z2]
1320  NEXT Z2
1330  REMARK:  AT THIS POINT THE CHEMICAL COMPOUND HAS BEEN GENERATED.
1340  REM
1350  PRINT "(";Z1;" )"
1360  PRINT 
1370  IF C1=6 OR C1=8 THEN 2060
1380  LET T1=T2=0
1390  FOR T3=1 TO N
1400  LET T1=T1 MAX A[1,T3]
1410  LET T2=T2 MAX A[2,T3]
1420  NEXT T3
1430  LET B$="C^"
1440  GOTO 1860
1450  LET T6=T1*(T9=0)+2*T9
1460  LET T7=T2*T9+2*(1-T9)
1470  LET T8=(-1)^(T9+1)
1480  FOR T3=T6 TO T7 STEP T8
1490  FOR T4=1+T9 TO 2-T9 STEP (-1)^T9
1500  FOR T5=1 TO N
1510  IF T3 <= A[1+T9,T5] THEN 1540
1520  PRINT "    ";
1530  GOTO 1550
1540  PRINT " ";B$[T4,T4];"  ";
1550  NEXT T5
1560  PRINT 
1570  NEXT T4
1580  NEXT T3
1590  RETURN 
1600  FOR T3=1+T9 TO 2-T9 STEP (-1)^T9
1610  FOR T4=1 TO N
1620  IF ABS(A[1+T9,T4]+.75) <= .75 AND (T4 <> N OR C1 <> 7) THEN 1690
1630  IF T9=1 AND T4=N AND C1=7 THEN 1690
1640  IF T3=2 THEN 1780
1650  IF A[1+T9,T4]>0 THEN 1710
1660  IF A[1+T9,T4] <> 0 THEN 1730
1670  PRINT " OH";
1680  GOTO 1820
1690  PRINT "    ";
1700  GOTO 1820
1710  PRINT " C  ";
1720  GOTO 1820
1730  DIM E$[12]
1740  LET E$="BRCLF I OHO "
1750  LET E1=-1-A[1+T9,T4]
1760  PRINT " ";E$[2*E1-1,2*E1];" ";
1770  GOTO 1820
1780  IF A[1+T9,T4]=-7 THEN 1810
1790  PRINT " ^  ";
1800  GOTO 1820
1810  PRINT " #  ";
1820  NEXT T4
1830  PRINT 
1840  NEXT T3
1850  RETURN 
1860  LET T9=0
1870  GOSUB 1450
1880  GOSUB 1600
1890  FOR T3=1 TO N-1
1900  IF A[1+T9,T3]=-.9 OR A[2-T9,T3]=-.9 THEN 1960
1910  IF A[1-T9,T3]=-.8 THEN 1940
1920  PRINT " C -";
1930  GOTO 1970
1940  PRINT " C *";
1950  GOTO 1970
1960  PRINT " C =";
1970  NEXT T3
1980  IF C1=7 OR C1=10 THEN 2010
1990  PRINT " C"
2000  GOTO 2020
2010  PRINT " C = O"
2020  LET T9=1
2030  GOSUB 1600
2040  GOSUB 1450
2050  GOTO 2180
2060  LET C3=INT(RND(1)+.5)
2070  FOR A=1 TO B[1+C3,1]
2080  PRINT "C - ";
2090  NEXT A
2100  IF C1=8 THEN 2130
2110  PRINT "O";
2120  GOTO 2140
2130  PRINT "N";
2140  FOR A=1 TO B[2-C3,1]
2150  PRINT " - C";
2160  NEXT A
2170  PRINT 
2180  PRINT '13'10'10'10
2190  NEXT Z1
2200  PRINT '13'10"*************************FOLD UNDER*******************************"'13'10
2210  FOR Z1=1 TO Z
2220  PRINT "(";Z1;" )  ";
2230  LET Z2=2*Z1-1
2240  LET P2=0
2250  FOR T1=1 TO 4
2260  LET D=-1-T1
2270  GOSUB 2930
2280  LET T4=T2
2290  RESTORE 3150
2300  GOSUB 2860
2310  IF T2=0 THEN 2360
2320  LET T4=T1
2330  RESTORE 3120
2340  GOSUB 2860
2350  GOSUB 2820
2360  NEXT T1
2370  FOR T1=1 TO 10
2380  LET D=T1
2390  IF D[Z2,1] <> 6 AND D[Z2,1] <> 8 THEN 2420
2400  IF D=D[Z2,2] OR D=D[Z2+1,2] THEN 2470
2410  GOTO 2530
2420  GOSUB 2930
2430  IF T2=0 THEN 2530
2440  LET T4=T2
2450  RESTORE 3150
2460  GOSUB 2860
2470  LET T4=T1
2480  RESTORE 3130
2490  GOSUB 2860
2500  PRINT "YL";
2510  LET P2=P2+2
2520  GOSUB 2820
2530  NEXT T1
2540  RESTORE 3110
2550  MAT  READ F[4]
2560  FOR T1=1 TO 4
2570  LET D=F[T1]
2580  GOSUB 2930
2590  NEXT T1
2600  RESTORE 3130
2610  IF D[Z2,1]=6 OR D[Z2,1]=8 THEN 2640
2620  LET T4=D[Z2+1,1]
2630  GOSUB 2860
2640  LET T4=T2=INT(D[Z2,1]/10)
2650  IF T2=0 THEN 2750
2660  IF D[Z2,1]-10*T2=2 OR D[Z2,1]-10*T2=3 THEN 2710
2670  PRINT "AN";
2680  IF T2=1 THEN 2700
2690  PRINT "E";
2700  GOTO 2730
2710  IF T2=1 THEN 2730
2720  PRINT "A";
2730  RESTORE 3150
2740  GOSUB 2860
2750  LET T4=D[Z2,1]-10*(INT(D[Z2,1]/10)-(D[Z2,1]=10))
2760  RESTORE 3180
2770  GOSUB 2860
2780  PRINT LIN(1)
2790  NEXT Z1
2800  PRINT '13'10"******************************************************************"
2810  END 
2820  IF P2<45 THEN 2850
2830  PRINT "-"
2840  LET P2=0
2850  RETURN 
2860  LET C$=""
2870  FOR T3=1 TO T4
2880  READ C$
2890  NEXT T3
2900  PRINT C$;
2910  LET P2=P2+LEN(C$)
2920  RETURN 
2930  LET T2=0
2940  FOR T3=1 TO D[Z2+1,1]
2950  FOR T4=Z2 TO Z2+1
2960  IF ABS(D-D[T4,T3+1])>.05 THEN 3060
2970  IF T2*P2 THEN 3010
2980  IF P2=0 THEN 3020
2990  PRINT "-";
3000  GOTO 3020
3010  PRINT ",";
3020  LET P2=P2+1+(P2>0)+(T3=10)
3030  PRINT N$[T3,T3+(T3=10)];
3040  LET T2=T2+1
3050  IF D=-.8 THEN 3070
3060  NEXT T4
3070  NEXT T3
3080  IF T2=0 THEN 3100
3090  PRINT "-";
3100  RETURN 
3110  DATA -7,-6,-.9,-.8
3120  DATA "BROMO","CHLORO","FLUORO","IODO"
3130  DATA "METH","ETH","PROP","BUT","PENT","HEX","HEPT","OCT","NON"
3140  DATA "DEC"
3150  DATA "","DI","TRI","TETRA","PENTA","HEXA","HEPTA","OCTA","NONA"
3160  DATA "DECA","UNDECA","DODECA","TRIDECA","TETRADECA","PENTADECA"
3170  DATA "HEXADECA"
3180  DATA "ANE","ENE","YNE","ANE","OL"," ETHER","ANOIC ACID"," AMINE"
3190  DATA "ONE","AL"
3200  END 
