Форум: "Основная";
Текущий архив: 2002.04.29;
Скачать: [xml.tar.bz2];
Вниз
Опять ТП7. Найти похожие ветки
← →
Miwa (2002-04-16 13:00) [9]2 Anatoly Podgoretsky © (16.04.02 12:41):
Ну все, Вы напросились ;о) Привожу полный текст программы. Держитесь ;о)) Ошибка - почти в самом низу (OutputRes - кажись предпоследняя процедура.
uses crt;
const dn=11;{interfase...}
var look: char;{current char}
vrbl: real;{X}
i:byte;{char counter}
curr,funk,fdef,sdef:string;{functionals}
a,b,c:real;{borders}
eps:real;{bingo}
x,y,d,r:array[0..20]of real;
{---------------------------------------------------------------}
function Expression: real; Forward;
{---------------------------------------------------------------}
procedure GetChar;
begin
look:=curr[i];
if i>length(curr) then look:=" ";
inc(i);
end;
{--------------------------------------------------------------}
procedure Match (x: char);
begin
if look = x then GetChar
end;
{--------------------------------------------------------------}
function IsAlpha (c: char): boolean;
begin
IsAlpha:=upcase (c) in ["A".."W","Y","Z"]
end;
{--------------------------------------------------------------}
function IsVar(c:char):boolean;
begin
IsVar:=upcase(c) = "X"
end;
{--------------------------------------------------------------}
function IsDigit (c: char): boolean;
begin
IsDigit := c in ["0".."9","."];
end;
{--------------------------------------------------------------}
function IsAddop (c:char):boolean;
begin
IsAddop:=c in ["+","-"];
end;
{--------------------------------------------------------------}
function GetNum: real;
var Value: real;
begin
Value := 0;
while IsDigit (Look) do begin
Value := 10 * Value + Ord (Look) - Ord ("0");
GetChar;
end;
GetNum := Value;
end;
{---------------------------------------------------------------}
function Func:real;
var name:string[3];
begin
name:="";
while look <> "(" do
begin
name:=name+look;
getchar;
end;
Match("(");
{FUCKEN CASE!!!!!!!}
if name = "sin" then func:=sin(expression*pi/180);
if name = "cos" then func:=cos(expression*pi/180);
if name = "tan" then func:=sin(expression*pi/180)/cos(expression*pi/180);
if name = "cot" then func:=cos(expression*pi/180)/sin(expression*pi/180);
if name = "ln" then func:=ln(expression);
if name = "exp" then func:=exp(expression);
{to be continued...}
match(")");
end;
{---------------------------------------------------------------}
function Factor: real;
begin
if Look = "("then
begin
Match ("(");
Factor := Expression;
Match (")");
end
else if IsAlpha(Look) then factor:=func
else if IsVar(look) then begin factor:=vrbl;getchar end
else Factor := GetNum
end;
{---------------------------------------------------------------}
function Power:real;
var value:real;
begin
value:=factor;
if look="^" then
begin Match("^"); Value := exp(factor*ln(abs(value))); end;
power:=value;
end;
{---------------------------------------------------------------}
function Term: real;
var Value: real;
begin
Value := power;
while Look in ["*", "/"] do begin
case Look of
"*": begin Match("*"); Value := Value * power; end;
"/": begin Match("/"); Value := Value / power; end;
end;
end;
Term := Value;
end;
{---------------------------------------------------------------}
function Expression: real;
var Value: real;
begin
if IsAddop (Look) then Value := 0 else Value := term;
while IsAddop (Look) do
begin
case Look of
"+": begin Match ("+"); Value := Value + term end;
"-": begin Match ("-"); Value := Value - term end
end{case}
end;
Expression := Value;
end;
{--------------------------------------------------------------}
function interp(what:string;x:real):real;
begin
i:=2;
curr:=what;
vrbl:=x;
look:=curr[1];
interp:=Expression;
end;
{--------------------------------------------------------------}
{End of interpretator}
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.04.29;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.005 c
