$EXTRN CARD, OPEN, PUT, PROUT;
$ENTRY Go {
= <OPEN 'w' 1 'GN.BAs'>
<Rab <Spar <Ubpr <Vvod <PROUT 'F(t)= ... the end - &'>
<CARD > >>>>;
}
* ввод до символа '&'
Vvod {
e.1 '&' e.2 = e.1;
e.1 = e.1 <Vvod <CARD >>;
}
* убирание всех пробелов
Ubpr {
e.1 ' ' e.2 = e.1 <Ubpr e.2>;
e.1 = e.1;
}
* организация вывода результирующей программы
Rab {
e.1 = <PUT 1 '10 t = 0.0'>
<PUT 1 '20 FOR I=1 TO 100'>
<PUT 1 '30 t = t + 0.01'>
<PUT 1 '40 F = ' <Rassk e.1>>
<PUT 1 '50 FDt = ' <Rassk <Easy <Dif ('t') e.1 >>>>
<PUT 1 '60 PRINT "t="; t, "F="; F, "FD="; FDt'>
<PUT 1 '70 NEXT I'>
<PUT 1 '80 END'>;
}
* Расспаривание скобок для вывода
Rassk {
e.1 (e.2) e.3 = e.1 '(' <Rassk e.2 ')' e.3>;
e.1 = e.1;
}
* спаривание скобок
Spar { e.1 = <Spar1 ('*') e.1 >; }
Spar1 {
(e.1) '(' e.3 = <Spar1 ((e.1)) e.3 >;
((e.1) e.2) ')' e.3 = <Spar1 (e.1 (e.2)) e.3 >;
('*'e.1) ')' e.3 = 'error' e.1 ')' e.3;
(e.1) s.A e.3 = <Spar1 (e.1 s.A) e.3 >;
('*'e.1) = e.1;
((e.1) e.2) = 'error' e.1 '(' e.2;
}
* функция дифференцирования выражения e.z по переменной e.t
* обращение: <Dif (e.t) e.z>
Dif {
(e.t) 'ln' (e.1) = (<Dif (e.t) e.1>) '/' (e.1);
(e.t) 'sin' (e.1) = 'cos' (e.1) '*' (<Dif (e.t) e.1>);
(e.t) 'cos' (e.1) = '-sin' (e.1) '*' (<Dif (e.t) e.1>);
(e.t) 'tg' (e.1) = (<Dif (e.t) e.1>) '/cos^2 ' (e.1);
(e.t) 'ctg' (e.1) = '-' (<Dif (e.t) e.1>) '/sin^2 ' (e.1);
(e.t) 'exp' (e.1) = (<Dif (e.t) e.1>) '*exp' (e.1);
(e.t) e.1 '+' e.2 = <Dif (e.t) e.1> '+' <Dif (e.t) e.2>;
(e.t) e.1 '-' e.2 = <Dif (e.t) e.1> '-' <Dif (e.t) e.2>;
(e.t) e.1 '*' e.2 = (<Dif (e.t) e.1>) '*' e.2
'+' e.1 '*' <Dif (e.t) e.2>;
(e.t) e.1 '/' e.2 = (<Dif (e.t) e.1>) '*' e.2
'-' e.1 '*' <Dif (e.t) e.2>
'/' e.2 '^2';
(e.t) e.1 ':' e.2 = (<Dif (e.t) e.1>) '*' e.2 '-'
e.1 '*' <Dif (e.t) e.2>
':' e.2 '^2';
(e.t) e.1 '^' e.2 = e.2 '*(' e.1 '^(' e.2 '- 1))*'
<Dif (e.t) e.1> '+'
'(' e.1 '^' e.2 ')*Ln' (e.1) '*'
(<Dif (e.t) e.2>);
(e.t) e.t = '1';
(e.t) e.1 = '0';
}
* один из вариантов возможного упрощения полученной функции
Easy {
e.1 '+0' = <Easy e.1 >;
e.1 '-0' = <Easy e.1>;
'0+' e.1 = <Easy e.1>;
'0-' e.1 = <Easy '-' e.1>;
e.1 '+0+' e.2 = <Easy e.1 '+' e.2>;
e.1 '-0+' e.2 = <Easy e.1 '+' e.2>;
e.1 '+0-' e.2 = <Easy e.1 '-' e.2>;
e.1 '-0-' e.2 = <Easy e.1 '-' e.2>;
e.1 '*1+' e.2 = <Easy e.1 '+' e.2>;
e.1 '+1*' e.2 = <Easy e.1 '+' e.2>;
e.1 '*1-' e.2 = <Easy e.1 '-' e.2>;
e.1 '-1*' e.2 = <Easy e.1 '-' e.2>;
e.1 '*1' = <Easy e.1>;
'1*' e.1 = <Easy e.1>;
'-1*' e.1 = <Easy '-'e.1>;
e.1 '-1*' = <Easy '-'e.1>;
e.1 = e.1;
}