Ввод функции на Delphi

← →
Edu (2004-02-16 07:01) [0]

Мне нужно во время выполнения программы ввести математическую функцию,
чтобы программа определила ее как функцию и продалжала с ней работу.
(Например, вводишь Abs(x), а программа предположим
выведет значение в определенной точке). Мне важен этап распознавания
функции (Например, f(x)=Abs(x)), при введенной в поле строке (Например,
"Abs(x)"), или иной путь введения функции во время выполнения программы.
Заранее благодарен за помощь.

← →
Maxud (2004-02-16 08:14) [1]

Можно использовать типа такой конструкции:Type
TProc = function (X: Integer): Integer;
TProcName = string[10];
TCustromProc = record
cpName: TProcName;
cpProc: TProc;
end;
TAvailableProc: array of TCustomProc;
var
Procs: TAvailableProc;
...
function IsProc(const ProcName: TProcName): TProc;
var i: Integer;
begin
Result := nil;
for i := 0 to High(Procs) do
if ProcName = Procs[i] then
begin
Result := Procs[i];
Break;
end;
end;
...
var
P: TProc;
V: Integer;
begin
P := IsProc(Edit1.Text);
if Assigned(P)then
V := P(StrToInt(Edit2.Text));
...
end;

← →
Edu (2004-02-22 06:13) [2]

Если я правильно понял, то код выглядит так,но как заполнять массив Procs? (Ведь программа только читает массив, но не заполняет его). Здесь массив Procs представляет собой библиотеку функций? Если нужно вводить все функции и их названия, то вся введенная в ходе выполнения программы строка будет сравниваться с оригиналом, но нельзя ввести все функции. Как быть с составными функциями типа abs(cos(x)) и sqr(x)+sin(x), и др.?
-------------------------------------------------------------------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TProc = function (X: Integer): Integer; //Целочисленная Функция
TProcName = string[10]; //Вводимая строка
TCustromProc = record //запись, состоящая из
cpName: TProcName; //введенной строки и
cpProc: TProc; //состветствующей функции.
end;
TAvailableProc = array of TCustromProc; { Массив записей, состоящих из
String[10] - введенной строки и состветствующей функции.}
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Procs: TAvailableProc;

implementation

{$R *.dfm}

function IsProc(const ProcName: TProcName): TProc; //Создает функцию по введенной строке
var i: Integer;
begin
Result := nil; //Начальное значение функции - отсутствует
for i := 0 to High(Procs) do //Рассматривает все элементы массива Procs.
with Procs[i] do
if ProcName = cpName then {Если введенная строка совпадает со строкой i-ого
элемента массива Procs, то}
begin
Result := cpProc; //Искомой функции присваивается функция, соответствующая
//i-ому элементы массива Procs
Break;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
P: TProc; //Вводимая функция
V: Integer; // Значение функции в точке
begin
P := IsProc(Edit1.Text); // Создание функции
if Assigned(P)then // Если функция не отсутствует, то
V := P(StrToInt(Edit2.Text)); // V присваивается значение функции в точке, введенной в Edit2
Form1.Label1.Caption:=IntToStr(V); // Вывод значения функции в точке
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Close;
end;
begin

end.

← →
Юрий Зотов (2004-02-22 06:49) [3]

Вам нужен интерпретатор выражений с поддержкой встроенных функций. Проще всего найти в сети готовый, их немало. Если же сильно хочется написать его самому, то во-первых надо быть готовым к тому, что это не так-то уж и просто, а во-вторых, заглянуть для начала сюда:
http://stikriz.narod.ru/art/Interp.htm#_Toc32830868
http://www.ergeal.ru/archive/cs/index.htm

← →
olookin (2004-02-22 07:53) [4]

Юрий Зотов © (22.02.04 06:49) [3]
>>чтоо это не так-то уж и просто

Это не так уж сложно

← →
Avsam (2004-02-22 13:30) [5]

На Torry поищи Parser.
Там точно есть, причем некоторые с исходным кодом.

← →
Kerghan (2004-02-28 13:36) [6]

Насколько я понял, суть задачи сводится к написанию калькулятора. Приведу исходный код модуля, в котором реализован этот самый калькулятор. Использование модуля весьма простое. Реализуется следующим образом:
-------------------------------------------------
......
uses ....,calc,.....;
......

procedure TForm1.Button1Click(Sender: TObject);
begin
calc.ss:=Edit1.Text;
calc.Analise;
if calc.error = ""
then Edit2.Text:=FloatToStr(calc.Res)
else Edit2.Text:=calc.Error;
end;
--------------------------------------------------
Собсна, модуль:
--------------------------------------------------
unit calc;

interface

procedure Analise;

var ss:string;
Res:Extended;
Error:string;

implementation

uses windows,SysUtils;

procedure A; forward;
procedure B; forward;
procedure C; forward;
procedure D; forward;

var pstr,pstk:integer;
cc:char;
stack:array[1..1000] of Extended;

procedure Getch;
begin
while ss[pstr] = " " do
inc(pstr);
cc:=ss[pstr];
inc(pstr);
end;

procedure Push(x:Extended);
begin
stack[pstk]:=x;
inc(pstk);
end;

function Pop:Extended;
begin
dec(pstk);
if pstk > 0
then Result:=stack[pstk]
else Error:="Unable to read from empty stack!";
stack[pstk]:=0;
end;

procedure Z;
var p,q:Extended;
begin
if cc = "+"
then
begin
Getch;
B;
p:=pop;
q:=pop;
push(p+q);
Z;
end
else
if cc = "-" then
begin
Getch;
B;
q:=pop;
p:=pop;
push(p-q);
Z;
end;
end;

procedure Y;
var p,q:Extended;
begin
if cc = "*"
then
begin
Getch;
C;
p:=pop;
q:=pop;
push(p*q);
Y;
end
else
if cc = "/" then
begin
Getch;
C;
q:=pop;
p:=pop;
if q = 0 then
begin
Error:="Division by zero!!!";
exit;
end;
push(p/q);
Y;
end;
end;

← →
Kerghan (2004-02-28 13:37) [7]

procedure X;
var p,q:Extended;
begin
if cc = "^"
then
begin
Getch;
D;
q:=pop;
p:=pop;
push(Exp(q*ln(p)));
X;
end
end;

procedure D;
var s:string;
q:Extended;
begin
case UpCase(cc) of
"S":begin
s:="";
s:=Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
if s = "SIN("
then
begin
Getch;
A;
q:=pop;
push(sin(q));
if cc = ")"
then
begin
Getch;
exit
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end
else
begin
Getch;
s:=s+Upcase(cc);
if s = "SQRT(" then
begin
Getch;
A;
q:=pop;
if q < 0
then
begin
Error:="Square root from negative value!!!";
exit;
end
else
begin
push(sqrt(q));
end;
if cc = ")"
then
begin
Getch;
exit;
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end;
end;
end;
"C":begin
s:="";
s:=Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
if s = "COS(" then
begin
Getch;
A;
q:=pop;
push(cos(q));
if cc = ")"
then
begin
Getch;
exit
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end;
end;
"T":begin
s:="";
s:=Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
if s = "TG(" then
begin
Getch;
A;
q:=pop;
push(sin(q)/cos(q));
if cc = ")"
then
begin
Getch;
exit
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end;
end;
"L":begin
s:="";
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
Getch;
s:=s+Upcase(cc);
if s = "LN(" then
begin
Getch;
A;
q:=pop;
if q > 0 then push(ln(q))
else
begin
Error:="Logarythm of negative number!!!";
exit;
end;
if cc = ")"
then
begin
Getch;
exit;
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end;

end;
"E":begin
Getch;
if UpCase(cc) ="X"
then
begin
Getch;
if UpCase(cc) = "P"
then
begin
Getch;
if cc = "(" then
begin
Getch;
A;
push(Exp(pop));
if cc = ")"
then
begin
Getch;
exit;
end
else
begin
Error:=""")"" expected!!!";
end;
end;
end;
end
else push(Exp(1));
end;
"A":begin
s:=UpCase(cc);
Getch;
s:=s+UpCase(cc);
Getch;
s:=s+UpCase(cc);
Getch;
s:=s+UpCase(cc);
if s = "ABS(" then
begin
Getch;
D;
push(Abs(pop));
end;
end;
"P":begin
Getch;
if UpCase(cc) = "I"
then
begin
push(pi);
Getch;
end;
end;
"(":begin
Getch;
A;
if cc = ")"
then
begin
Getch;
exit;
end
else
begin
Error:=""")"" expected!!!";
exit;
end;
end;
"-":begin
Getch;
D;
push(-pop);
end;
"+":begin
Getch;
D;
end;
"0".."9":begin
s:="";
s:=s+cc;
while cc in ["0".."9",",","."] do
begin
Getch;
if cc in ["0".."9",",","."] then
s:=s+cc;
end;
try
Push(StrToFloat(s));
except
Error:="Invalid Extended value";
end;
end;
end
end;

procedure C;
begin
D;X;
end;

procedure B;
begin
C;Y;
end;

procedure A;
begin
B;Z;
end;

procedure Analise;
begin
if ss = "" then
begin
Error:="Empty input!!!";
exit;
end;
pstr:=1;pstk:=1;
Error:="";
Getch;
A;
if pstr >= length(ss)+1
then
begin
if Error = "" then
Res:=stack[1];
end
else Error:="Bad syntax";
end;

end.
--------------------------------------------------
Функций пока не много, но основные присутствуют. Выполняются, разумеется в порядке приоритетов. Присутствуют(перечисленно случайным образом) :
+,-,*,/,^,sin,cos,tg,ln,exp,abs,sqrt, ... .
При желании можна добавить ещё парочку.

Сам калькулятор реализован методом граматик Хомского
(так кажись...). Если возникнут вопросы с реализацией, с радостью отвечу. Но по-моему, и так всё понятно ;).

И всё же, я надеюсь, что смог кому-то помочь.

← →
Kerghan (2004-02-28 13:39) [8]

Модуль в один пост не влез, пришлось разделить на два...

Так что, как видите синтаксический анализатор - не так уж
сложно :) ;).

← →
GAlex (2004-02-28 14:19) [9]

TO:olookin ©
Ты правда так думаешь?
Согласен что +,-,*,/,sin, cos... несложно.
Но видимо ты забываешь, что математика этим не ограничивается,
а останавливаться в на уровне пятого класса - действительно несложно... :-)))))))

Ввод функции на Delphi Найти похожие ветки