Нужна прога на паскале-"Интерпретатор".
Может у кого -нибудь уже есть такая прога.
Или помогите советом.
{
Ђ «Ё§ в(r)а/Є «мЄг«пв(r)а бва(r)ЄЁ :-)
‹ аоиЄЁ ћаЁ(c). 2:5059/9.58
}
uses crt;
const fn=['a'..'z'];
fn2=['*','/','+','_'];
ch=['0'..'9','.','-'];
var s:string;
{ преобразует число в строковое представление
с точностью 10 знаков }
function stt(e:extended):string;
var s:string;
begin
str(e:0:10,s);
stt:=s;
end;
{ обратное преобразование - преобразует строку
в число типа extended }
function stt_(s:string):extended;
var q,w:extended;
i,j:integer;
begin
if pos ('.',s) = 0 then val (s,q,i) else
begin
if s[1]='-' then j:=-1 else j:=1;
val (copy(s,1,pos('.',s)-1),q,i);
val (copy(s,pos ('.',s)+1,byte(s[0])),w,i);
while w>1 do w:=w/10;
q:=j*(abs(q)+w);
end;
stt_:=q;
end;
{ в эту функцию передается простое выражение,
НЕ содержащее скобок }
function clc (s:string):string;
var i,j,k,l:integer;
e:extended;
{ эта функция заменяет в простом выражении строковое
представление одной операции (ее обозначение
передается в строке C) на результат этой операции }
procedure clc_(c:string);
begin
while pos(c,s)<>0 do begin
i:=pos(c,s);k:=i; dec (i);
while (s[i] in ch) and (i>=1) do dec (i);
j:=k; inc (j);
while (s[j] in ch) and (j<=byte(s[0])) do inc (j);
case c[1] of
'+': s:=copy(s,1,i)+stt(stt_(copy (s,i+1,k-i-1))+stt_(copy(s,k+1,j-k-1)))+copy(s,j,byte(s[0]));
'_': s:=copy(s,1,i)+stt(stt_(copy (s,i+1,k-i-1))-stt_(copy(s,k+1,j-k-1)))+copy(s,j,byte(s[0]));
'*': s:=copy(s,1,i)+stt(stt_(copy (s,i+1,k-i-1))*stt_(copy(s,k+1,j-k-1)))+copy(s,j,byte(s[0]));
'/': s:=copy(s,1,i)+stt(stt_(copy (s,i+1,k-i-1))/stt_(copy(s,k+1,j-k-1)))+copy(s,j,byte(s[0]));
end;
s:=clc(s);
end;
end;
{ сама же функция проверяет, есть ли вхождения
простых арифметических операций (* / + -), и заставляет
вложенную ф-ю clc_ вычислять результаты операций
согласно приоритету }
begin
if (pos('*',s)=0) and (pos('/',s)=0) and
(pos('+',s)=0) and (pos('_',s)=0) then clc:=s else begin
clc_('*'); clc_('/'); clc_('_'); clc_('+');
end;clc:=s;
end;
{ это - сердце программы. Эта ф-я ищет в строке с выражением
обращение к функциям (sin, cos, ...), и выполняет эти функции.
результат выполнения заносится в ту же строку вместо полного
написания ф-ии }
function calc(s:string):string;
var i,j,k,l:integer;
s_,ss:string;
begin
for i:=1 to byte (s[0]) do begin
if (s[i]='-') and (s[i-1] in ch) then s[i]:='_';
if (s[i]='-') and (s[i-1] ='+') then s[i]:='_';
end;
calc:=s;
l:=byte (s[0]); i:=l;
if pos ('(',s)<>0 then begin
while (s[i]<>'(') and (i>1) do dec (i);
j:=i;
while (s[i]<>')') and (i<l) do inc (i);
if not(s[j-1] in fn) then begin
s:=copy (s,1,j-1)+(calc(copy(s,j+1,(i-j-1))))+copy (s,i+1,l);
s:=calc(s)
end else begin
s_:=calc(copy(s,j+1,(i-j-1)));
k:=j-1;
while (s[k] in fn) and (k>1) do dec (k);
ss:=copy (s,k+1,j-k-1);
randomize;
{ здесь в строке ss хранится название ф-ии которую необходимо выполнить,
а в строке s_ - строковое представление аргумента.
таким образом, имя ф-ии с агрументом просто "вырезается" из строки и
заменяется результатом }
if ss='sin' then s:=copy (s,1,k)+stt(sin (stt_(s_)))+copy (s,i+1,l);
if ss='cos' then s:=copy (s,1,k)+stt(cos (stt_(s_)))+copy (s,i+1,l);
if ss='tg' then s:=copy (s,1,k)+stt(sin (stt_(s_))/cos (stt_(s_)))+copy (s,i+1,l);
if ss='atctg' then s:=copy (s,1,k)+stt(arctan (stt_(s_)))+copy (s,i+1,l);
if ss='ln' then s:=copy (s,1,k)+stt(ln (stt_(s_)))+copy (s,i+1,l);
if ss='abs' then s:=copy (s,1,k)+stt(abs (stt_(s_)))+copy (s,i+1,l);
if ss='rnd' then s:=copy (s,1,k)+stt(random (round(stt_(s_))))+copy (s,i+1,l);
if ss='exp' then s:=copy (s,1,k)+stt(exp (stt_(s_)))+copy (s,i+1,l);
s:=calc(s);
end; end;
calc:=clc(s);
end;
begin
clrscr;
s:='(34+((-45+56)*abs((54+6+sin(5)*10+46-38)*2)/46))/cos(111)';
writeln (s,'=',calc(s));
writeln(((34+((-45+56)*abs((54+6+sin(5)*10+46-38)*2)/46))/cos(111)):0:10);
end.
Вот собственно програмка,более-менее мне понятная.{$M 32767, 0, 0}
и все работает...
if ss='sin' then s:=copy (s,1,k)+stt(sin (stt_(s_)))+copy (s,i+1,l);
if ss='cos' then s:=copy (s,1,k)+stt(cos (stt_(s_)))+copy (s,i+1,l);
if ss='tg' then s:=copy (s,1,k)+stt(sin (stt_(s_))/cos (stt_(s_)))+copy (s,i+1,l);
if ss='atctg' then s:=copy (s,1,k)+stt(arctan (stt_(s_)))+copy (s,i+1,l);
if ss='ln' then s:=copy (s,1,k)+stt(ln (stt_(s_)))+copy (s,i+1,l);
if ss='abs' then s:=copy (s,1,k)+stt(abs (stt_(s_)))+copy (s,i+1,l);
if ss='rnd' then s:=copy (s,1,k)+stt(random (round(stt_(s_))))+copy (s,i+1,l);
if ss='exp' then s:=copy (s,1,k)+stt(exp (stt_(s_)))+copy (s,i+1,l);
type
f_type = function(e: extended): extended;
const
size_func = 8;
cf: array[1 .. size_func] of record
name: string;
func: f_type;
end = (
(name: 'sin'; func: f_sin),
(name: 'cos'; func: f_cos),
(name: 'tg'; func: f_tg),
(name:'atctg'; func:f_atan),
(name: 'ln'; func: f_ln),
(name: 'abs'; func: f_abs),
(name: 'rnd'; func: f_rnd),
(name: 'exp'; func: f_exp)
);
...
{ внутри CALC делать так: }
for ii := 1 to size_func do
if ss = cf[ii].name then
s := copy (s,1,k)+stt(cf[ii].func(stt_(s_)))+copy (s,i+1,l);
...
readln(s);
writeln(s, '=', calc(s));
...