IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V < 1 2 >  
 Ответить  Открыть новую тему 
> Интерпретатор, нужно сделать прогу на паскале
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +



{
Ђ­ «Ё§ в®а/Є «мЄг«пв®а бва®ЄЁ :-)
 ‹ аоиЄЁ­ ћаЁ©. 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






К сожалению, у меня эта программа вылетает с переполнением стека...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


Может быть тогда посоветуете какую из предложенных прог мне лучше взять?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Цитата(volvo @ 3.05.05 17:26)
К сожалению, у меня эта программа вылетает с переполнением стека...
:no: Просто эта программа очень активно использует стек, рекурсии и т.д., так что размера стека по умолчанию ей не хватает. Первой строкой программы ставим директиву распределения памяти:
{$M 32767, 0, 0}
и все работает...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


Если эта программа работает,то можно к ней комментарии?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Общие комментарии добавлены. Для более детального объяснения алгоритма работы программы - обращайтесь к автору...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






chessman, кстати эту программу можно немного упростить для понимания, если использовать процедурные типы. Ну, например, вот так:
вместо того, чтобы явно перечислять все функции (и их параметры), как сделано здесь
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);

Теперь в случае добавления новых функций не нужно будет менять сам CALC, достаточно добавить имя и указатель на функцию в массив CF и увеличить SIZE_FUNC... smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18





Группа: Пользователи
Сообщений: 5
Пол: Мужской

Репутация: -  0  +


Обьясните пожалуйста программу
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






To: Antonio
Что именно в программе не понятно? Я уже добавлял основные комментарии ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20





Группа: Пользователи
Сообщений: 5
Пол: Мужской

Репутация: -  0  +


После компиляции ничего не происходит!!!
Зачем пример внутри кода???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #21


Гость






To: Antonio
Хотелось бы напомнить, после компиляции ничего и не должно происходить... Запускать не пробовал? А пост №14 внимательно читал?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #22





Группа: Пользователи
Сообщений: 5
Пол: Мужской

Репутация: -  0  +


Обьясните, как вводить новые выражения и получить ответ выражения
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #23


Гость






blink.gif вообще-то так обычно делается...
...
readln(s);
writeln(s, '=', calc(s));
...
 К началу страницы 
+ Ответить 

2 страниц V < 1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 16.10.2021 6:34
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name