Правила форума
Прочтите прежде чем задавать вопрос!
Вот собственно програмка,более-менее мне понятная.
{
Ђ «Ё§ в®а/Є «мЄг«пв®а бва®ЄЁ :-)
‹ аоиЄЁ ћаЁ©. 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.
Можно объяснить что делает каждая функция?Вообщем хотелось бы комментарии к проге.
Сообщение отредактировано: volvo -
вообще-то так обычно делается...