10 REM ****** REAKTIONSLIKHETER ******
11 REM *                             *
12 REM * MICHAEL WIDENIUS 24-10-1981 *
13 REM *                             *
14 REM *******************************
15 REM OMR]DE :   KEMI
16 REM 
17 COMMON Meny$=16%,Qwerty$=16%,Highcolour%,Rambuffer%,Qwerty1%,Qwerty2%,Qwerty3%
18 M%=13% : M1%=19% : M2%=15% : REM MAX
19 DIM A$=210%,In$=160%,B$=29%,C$=20%,D$=2%
20 DIM A$(M1%)=M2%,B$(M1%)=2%,S$=M2%
21 DIM A(M1%,M%),B(M%,M%),X$(M%)=25%
22 DEF FNA%(X$)=(ASCII(X$) AND 223%)=78% 
23 REM 
24 ON ERROR GOTO 319
25 ; CHR$(12%) TAB(10%) DBLE RED "REAKTIONSLIKHETER"
26 ; : ; : ; 
27 ; "Kemilektionen kan b|rja:"
28 ; 
29 INPUT "Vill du ha instruktioner (J) ?"A$
30 IF FNA%(A$) THEN 59
31 ; CUR(3%,0%) "Nu {r jag beredd p} att balanserar"
32 ; "alla de reaktionslikheter som du kan"
33 ; "st|ta p} under dina kemiska studier."
34 ; "( I varje fall n{stan alla. )     "
35 ; 
36 ; "Du skall mata in reaktonslikheten"
37 ; "precis som den st}r och g}r. Ex:"
38 ; 
39 ; TAB(10%) YEL "N2O5+H20->HNO3"
40 ; 
41 ; "- [mnena f}r dock ej inneh}lla tv} eller";
42 ; "flera parenteser innanf|r varandra."
43 ; YEL "Ca3(PO4)2" WHT "{r dock helt lovligt."
44 ; 
45 ; "- Som intelligent person f|rst}r du nog"
46 ; "att alla reaktionslikheter inte kan"
47 ; "balanseras.  Undvik d{rf|r att belasta"
48 ; "min dyrbara tid med s}dana vidrigheter."
49 ; 
50 ; "Tryck p}" RED "RETURN" WHT "n{r du l{st f{rdigt !";
51 INPUT ""A$
52 ; CHR$(12%) "Kom ih}g att jag s|ker efter l|sningen"
53 ; "till en" MAG "(1)" WHT "reaktionslikhet !  Om rea-"
54 ; "tionslikheten best}r av flera samman-"
55 ; "fogade likheter kan jag inte balansera"
56 ; "den !"
57 ; 
58 ; "L}tom oss nu s{tta ig}ng med problemen !"
59 ; 
60 ; CYA "Skriv nu ner reaktionslikheten !" : ; 
61 REM 
62 REM *** INMATNINGEN ***
63 REM 
64 INPUT LINE In$
65 In$=LEFT$(In$,LEN(In$)-2%) : A$=In$
66 IF LEN(In$)<4% ; CHR$(13%) "     " CHR$(13%); : GOTO 64
67 IF In$="SLUT" THEN 95
68 ; : GOSUB 105 : IF F% THEN 155
69 REM 
70 REM *** ARBETET B\RJAR ***
71 REM 
72 ; CHR$(12%) GRN "JAG TAR EN KORT TANKEPAUS......"
73 GOSUB 129 : IF F% THEN 157
74 GOSUB 185 : IF F% THEN 157
75 GOSUB 262
76 GOSUB 217 : D=INT(ABS(S)+.5)
77 IF D=0% THEN F%=3% ELSE IF D>99999 THEN F%=4%
78 IF F% THEN 157
79 GOSUB 235
80 GOSUB 268 : IF F% THEN 157
81 GOSUB 279 : GOSUB 292
82 IF F% THEN 157
83 REM * F[RDIG *
84 ; CHR$(12%) GRN "Den balanserade reaktionslikheten {r:"
85 FOR S%=1% TO 700% : Skr%=INP(5%) : NEXT S% 
86 ; : ; 
87 GOSUB 308
88 ; : ; 
89 ; CYA "Skriv nu ner n{sta reaktionslikhet:"
90 ; 
91 GOTO 64
92 REM 
93 REM *** SLUT ***
94 REM 
95 ; : ; 
96 ; "Tack f|r idag och v{lkommen om du n}gon"
97 ; "annan g}ng har problem med n}gon enkel"
98 ; "reaktionslikhet" RED "!"
99 ON ERROR GOTO 101
100 CHAIN Meny$
101 END 
102 REM 
103 REM *** SEPARERAR [MNENA ***
104 REM 
105 A%=-1% : R%=-1% : F%=0% : S%=1% : A$=A$+"+"
106 S%=INSTR(S%,A$," ") : IF S%=0% THEN 109
107 A$=LEFT$(A$,S%-1%)+RIGHT$(A$,S%+1%)
108 GOTO 106
109 IF A$="" THEN 124
110 R%=R%+1% : IF R%>M1% F%=1% : RETURN 
111 S%=INSTR(1%,A$,"+")
112 F1%=0% : IF A%<>-1% THEN 116
113 REM * REAKTIONSPRODUKTERNA ? *
114 S1%=INSTR(1%,LEFT$(A$,S%-1%),"->")
115 IF S1%<>0% S%=S1% : F1%=1% : A%=R%
116 IF S%>M2%+1% OR S%=1% F%=1% : RETURN 
117 B$=LEFT$(A$,S%-1%)
118 A$=RIGHT$(A$,S%+1%+F1%)
119 RESTORE 123 : FOR I1%=1% TO 7%
120   READ C$ : IF C$=B$ THEN B$=B$+"2"
121 NEXT I1% 
122 A$(R%)=B$ : GOTO 109
123 DATA F,Cl,Br,I,N,H,O
124 IF A%=-1% OR R%=A% THEN F%=1%
125 RETURN 
126 REM 
127 REM *** SEPARERAR GRUND[MNENA ***
128 REM 
129 R1%=-1% : F1%=1%
130 FOR I%=0% TO R% : A$=A$(I%)
131   IF I%>A% THEN F1%=-1%
132   F2%=1% : F3%=0%
133   GOSUB 205 : IF F% RETURN 
134   ON INSTR(1%,"()",B$)+1% GOTO 142,135,140
135   IF F3%<>0% OR B%<>1% F%=1% : RETURN 
136   F3%=INSTR(1%,A$,")") : IF F3%<3% THEN F%=1% : RETURN 
137   IF F3%<3% OR B%<>1% F%=1% : RETURN 
138   S$=A$ : A$=RIGHT$(A$,F3%) : GOSUB 205
139   IF F% RETURN ELSE F2%=B% : A$=S$ : GOTO 133
140   IF F3%=0% THEN F%=1% : RETURN 
141   F3%=0% : F2%=1% : GOTO 150
142   C$=LEFT$(B$,1%) : IF C$<"A" OR C$>"Z" THEN F%=1% : RETURN 
143   FOR I1%=0% TO R1%
144     IF B$(I1%)=B$ THEN 149
145   NEXT I1% : R1%=I1% : IF R1%>M1% THEN F%=2% : RETURN 
146   B$(I1%)=B$ : FOR I2%=0% TO R%
147     A(R1%,I2%)=0%
148   NEXT I2% 
149   A(I1%,I%)=B%*F1%*F2%+A(I1%,I%)
150   IF LEFT$(A$,1%)<>" " THEN 133
151 NEXT I% : RETURN 
152 REM 
153 REM *** ERROR ***
154 REM 
155 ; : ; CHR$(7%) RED "Det d{r f|rstod jag inte."
156 GOTO 59
157 ; CHR$(12%) 'Den givna "reaktionslikheten":'
158 ; 
159 ; In$
160 ; 
161 ON F% GOTO 166,162,170,173,173
162 ; CHR$(7%) RED "Jag kan tyv{rr inte r{kna med s} m}nga"
163 ; RED "olika {mnen !"
164 ; 
165 GOTO 88
166 ; CHR$(7%) "Jag f|rst}r tyv{rr inte vad du menar"
167 ; "med detta :" : ; : ; 
168 ; TAB(18%-LEN(A$(I%))/2%) RED NWBG YEL A$(I%) "  " BLBG
169 GOTO 88
170 ; CHR$(7%) "Jag kan tyv{rr inte l|sa reaktions-"
171 ; "likheten emedan den inte {r" MAG "entydig!"
172 GOTO 88
173 ; CHR$(7%) RED "Din reaktionslikhet har ingen l|sning !"
174 ; 
175 ; " Du har kanske gjort n}got fel n{r du"
176 ; "gav den }t mig ?"
177 GOTO 88
178 ; CHR$(7%) "Tyv{rr {r detta problem f| sv}rt f|r"
179 ; "mig.  Min " RED "ber{kningsnogrannhet" WHT "r{cker"
180 ; "inte till. - Jag beklagar !"
181 GOTO 88
182 REM 
183 REM *** IDENTISKA EKVATIONER ? ***
184 REM 
185 IF R1%=R%-1% OR R%=1% RETURN 
186 R%=R%-1% : R2%=1%
187 IF R1%<R% F%=3% : RETURN 
188 FOR I%=0% TO R2% : FOR I1%=0% TO R%+1%
189     B(I%,I1%)=A(I%,I1%)
190 NEXT I1% : NEXT I% : F1%=1%
191 FOR I%=I% TO R% : FOR I1%=0% TO R%+1%
192     IF I%=A% THEN F1%=-1%
193   B(I%,I1%)=F1% : NEXT I1% 
194 B(I%,I%)=2%*F1% : NEXT I% 
195 GOSUB 220 : IF S=0% THEN 198
196 IF R2%>=R% R%=R%+1% : RETURN 
197 R2%=R2%+1% : GOTO 188
198 FOR I%=0% TO R%+1%
199 A(R2%,I%)=A(R1%,I%) : NEXT I% 
200 R1%=R1%-1% : IF R1%<>R% THEN 188
201 R%=R%+1% : RETURN 
202 REM 
203 REM *** AVSKILJER ETT [MNE ***
204 REM 
205 B$="" : D$=""
206 B$=B$+LEFT$(A$,1%)
207 IF LEN(B$)=3% THEN F%=1% : RETURN 
208 A$=RIGHT$(A$+" ",2%) : C$=LEFT$(A$,1%)
209 IF D$="" IF C$>="a" THEN 206
210 IF C$<"0" OR C$>"9" THEN 212
211 IF LEN(D$)<2% D$=D$+C$ : GOTO 208 ELSE F%=1% : RETURN 
212 IF D$="" THEN B%=1% ELSE B%=VAL(D$)
213 RETURN 
214 REM 
215 REM *** DETERMINANTEN A(-,-) ***
216 REM 
217 FOR I%=0% TO R% : FOR I1%=0% TO R%
218     B(I%,I1%)=A(I%,I1%)
219 NEXT I1% : NEXT I% 
220 S=1% : FOR I%=R% TO 1% STEP -1%
221   S1=B(I%,I%) : IF S1<>0% THEN 227
222   FOR I1%=0% TO I%-1%
223   S1=B(I1%,I%) : IF S1=0% NEXT I1% : S=0% : RETURN 
224   FOR I2%=0% TO I%
225     B(I%,I2%)=B(I%,I2%)+B(I1%,I2%)
226   NEXT I2% 
227   S=S*S1 : FOR I1%=0% TO I%-1%
228     S2=B(I1%,I%)/S1 : FOR I2%=0% TO I%-1%
229       B(I1%,I2%)=B(I1%,I2%)-S2*B(I%,I2%)
230 NEXT I2% : NEXT I1% : NEXT I% 
231 S=S*B(I%,I%) : RETURN 
232 REM 
233 REM *** INVERTERAR A(-,-) ***
234 REM 
235 FOR I%=0% TO R% : FOR I1%=0% TO R%
236   B(I%,I1%)=0% : NEXT I1% 
237 B(I%,I%)=1% : NEXT I% 
238 FOR I%=0% TO R%
239   FOR I1%=I% TO R%
240     IF A(I1%,I%)<>0% THEN 243
241   NEXT I1% 
242   F%=3% : RETURN 
243   FOR I2%=0% TO R%
244     S=A(I%,I2%) : A(I%,I2%)=A(I1%,I2%)
245     A(I1%,I2%)=S : S=B(I%,I2%)
246     B(I%,I2%)=B(I1%,I2%)
247   B(I1%,I2%)=S : NEXT I2% 
248   S=A(I%,I%) : FOR I1%=0% TO R%
249     A(I%,I1%)=A(I%,I1%)/S
250     B(I%,I1%)=B(I%,I1%)/S
251   NEXT I1% 
252   FOR I1%=0% TO R%
253     IF I1%=I% THEN 258
254     S=A(I1%,I%) : FOR I2%=0% TO R%
255       A(I1%,I2%)=A(I1%,I2%)-S*A(I%,I2%)
256       B(I1%,I2%)=B(I1%,I2%)-S*B(I%,I2%)
257     NEXT I2% 
258 NEXT I1% : NEXT I% : RETURN 
259 REM 
260 REM *** KONSTANTEN BORTAGES ***
261 REM 
262 FOR I%=0% TO R1%
263 A(I%,R%)=-A(I%,R%) : NEXT I% 
264 R%=R%-1% : RETURN 
265 REM 
266 REM *** L\SER R\TTERNA ***
267 REM 
268 FOR I%=0% TO R% : B$="0"
269   FOR I1%=0% TO R%
270     B$=ADD$(B$,MUL$(NUM$(B(I%,I1%)),NUM$(A(I1%,R%+1%)),5%),5%)
271   NEXT I1% 
272 X$(I%)=B$ : NEXT I% 
273 FOR I%=0% TO R%
274   IF COMP%("0.00000",X$(I%))<>-1% F%=4%
275 NEXT I% : RETURN 
276 REM 
277 REM *** R\TTERNA TILL HELTAL ***
278 REM 
279 FOR I%=0% TO R%
280   X$(I%)=MUL$(X$(I%),NUM$(D),0%)
281 NEXT I% : X$(I%)=NUM$(D) : R%=R%+1%
282 A$=X$(0%)
283 FOR I%=1% TO R% : B$=X$(I%)
284 GOSUB 300 : NEXT I% 
285 IF A$="1" RETURN 
286 FOR I%=0% TO R%
287 X$(I%)=DIV$(X$(I%),A$,0%) : NEXT I% 
288 RETURN 
289 REM 
290 REM *** SISTA KONTROLLEN ***
291 REM 
292 IF R1%=R%-1% RETURN 
293 FOR I%=R% TO R1% : A$="0" : FOR I1%=0% TO R%-1%
294   A$=ADD$(A$,MUL$(NUM$(A(I%,I1%)),X$(I1%),5%),5) : NEXT I1% 
295   IF SUB$(A$,MUL$(X$(I1%),NUM$(A(I%,I1%)),0%),0%)<>"0" F%=5% : RETURN 
296 NEXT I% : RETURN 
297 REM 
298 REM *** S.G.D ***
299 REM 
300 C$=DIV$(B$,A$,7%)
301 IF INSTR(1%,C$,"0000000") RETURN 
302 B$=A$ : A$=MUL$(RIGHT$(C$,LEN(C$)-7%),A$,0%)
303 IF A$<>"1" THEN 300
304 RETURN 
305 REM 
306 REM *** REAKTIONSLIKHETEN ***
307 REM 
308 A$="" : B$=""
309 FOR I%=0% TO R% : B$=""
310   IF X$(I%)<>"1" B$=X$(I%)+" "
311   B$=B$+A$(I%)
312   IF I%=A% THEN B$=B$+RED+"->"+CYA ELSE IF I%<>R% THEN B$=B$+" + "
313   IF LEN(A$+B$)>38% THEN ; CYA A$ : A$=""
314 A$=A$+B$ : NEXT I% : ; CYA A$
315 RETURN 
316 REM 
317 REM *** ERRORHANTERINGEN ***
318 REM 
319 IF ERRCODE<>53% THEN 324
320 Skr%=SYS(6%) : GET A$
321 IF ASCII(A$)=231% THEN RESUME 99
322 ; CHR$(13%,7%);
323 RESUME 
324 ON ERROR GOTO