Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Вычисление значений функции

Автор: BDS 4.06.2003 19:07

Надо сделать программу, чтобы она вычисляла таблицу значений функции, заданной в виде разложения в ряд. При этом: границы интервала вычислений a и b, величина шага изменения аргумента h, точность вычисления функции E задаются с экрана.

Сама прога у меня есть (если кому надо, могу кинуть). Но проблема в том, что ее надо с Ассемблерными вставками сделать! Если кто может помочь, пишите!

Автор: GLuk 4.06.2003 19:19

Может постишь сюда...?
И вообще для таких вещей есть раздел Ассемблер!

Автор: BDS 4.06.2003 19:43

Вот прога:

Код
Program KKR2;
uses crt;
CONST
 path = 'D:BPMYKKR';
LABEL 1;
TYPE
 FileName = string [13];
VAR
 E,x,y,a,ak,b,h:real;
 NameFile:FileName;
 flag:boolean;
 k:integer;
 n:longint;
 p:string;
 f:text;

BEGIN
 REPEAT
 ClrScr;
   REPEAT
     write('Введите границы интервала вычислений a и b (a<b): ');readln(a,B);
   UNTIL a<=b;
   write('Введите величину шага изменения аргумента h: ');readln(h);
   REPEAT
     write('Введите точность вычисления функции E (E>0): ');readln(E);
   UNTIL E>0;
 ClrScr;
   writeln(' a=',a:5:2,' b=',b:5:2,' h= ',h:2:2,' E=',E:2:4);
   write('Все верно? (y/n) ');
   readln(p);
 UNTIL ((p='y') or (p='Y')); {повторять ввод данных пока нет подтверждения о его правильности}
  ClrScr;
  REPEAT
     writeln('Вывод в файл результатов подсчета.');
     write('Введите имя файла: ');
     readln(NameFile);
   assign(f,path+NameFile);
   {$I-} {отключение автоматической проверки ошибок ввода/вывода}
     reset(f);
   {$I+} {включение автоматической проверки ошибок ввода/вывода}
     IF IOResult <> 0 THEN  {проверка существования файла}
       BEGIN
         ClrScr;
         writeln('Указанного файла нет в текущей директории!');writeln;
         flag:=FALSE;
       END
     ELSE flag:=TRUE;
  UNTIL flag=TRUE;
   close(f);
   rewrite(f);
     writeln(f,'Данный файл создан программой Буробина Дмитрия,');
     writeln(f,'которая вычислила таблицу значений функции, заданной в виде разложения в ряд.');
     writeln(f);
     writeln(f,'Границы интервала вычислений a и b равны ',a:5:2,' ',b:5:2);
     writeln(f,'Величина шага изменения аргумента h равна ',h:2:2);
     writeln(f,'Точность вычисления функции E равна ',E:2:4);
     writeln(f);
     writeln(f,'     #      X          F(x)          # чл.р.');
 x:=a;
 n:=1;
 REPEAT
 BEGIN
   k:=2;
   write(f,n:6,x:10:2);
   ak:=(x-1)/(x+1);
   y:=ak;
   IF abs(ak)<E THEN goto 1;
   REPEAT
   BEGIN
     ak:=ak*(((2*k-3)/(2*k-1))*((sqr(x-1))/(sqr(x+1)))); {множитель для нахождения a(k)}
     y:=y+ak;
     Inc(k);
   END UNTIL (abs(ak)<E);
1:  writeln(f,2*y:15:8,k-1:10);
   x:=x+h;
   Inc(n);
 END UNTIL x>b;
 close(f);
 ClrScr;
  writeln('Данные добавлены в фаил "',path+NameFile,'"');
  write('Просмотреть его вы можете нажав в NC клавишу <F3>, ');
  writeln('или блокнотом Windows.');
  writeln;write('Для выхода нажмите <Ввод>');
 readkey;
END.

Автор: Shadow 5.06.2003 0:15

:D
-=-=
а вставки какие всеиполностью даже формулы
-=-=
или только избавиться от модуля Crt ???

Автор: BDS 5.06.2003 12:32

Любые! Где угодно, чтобы только были!!!!! :o

Автор: Shadow 5.06.2003 13:49

ню я уже начал
-=-=
напишу все что могу
-=-=-=
надеюсь ето не очень срочно

Автор: BDS 5.06.2003 19:33

Вообще к понедельнику надо сдать! :-X

Автор: GLuk 5.06.2003 19:54

Ну и я заодно попробую... по ходу надо и FPU подключать??

Автор: BDS 5.06.2003 20:05

Наверное??  ???

Автор: BDS 5.06.2003 20:10

Ну вообще мне надо хоть что-нибудь на пас+асм, желательно с матрицами, или чем-то, где их использование облегчает решение (асм. вставок)!
Если есть что-нибудь готовое, буду очень благодарен!!!!!!!

Автор: Shadow 5.06.2003 23:19

Ню вот примерно
-=-=

Код
program KKR1;
{uses crt;} var
E,a,b,s,h,R,x,d,c,integ,integlast:real;
s1:String;
i:integer;
p:Char;
n:longint;

function func(x:real):real;             {}
begin                               {}
if x<=-2*R then func:=d             {}
else                               {}
if x<=0 then func:=sqrt(x*(-x-2*R))       {}
else                               {}
if x>2*R then func:=c                   {}
else                               {}
func:=-sqrt(x*(-x+2*R))             {}
end;                               {}
Procedure ClScr;Assembler;
asm
     mov ax,3
     int 10h
end;
Procedure OutText(sss:String);
Begin
s1:=sss;   {в/Є/ Џ бЄ «м ¬ «Ґ­мЄ® ­Ґ­ 室Ёв ­Ґ Ј®«®Ў «м­лҐ ЇаҐ¬Ґ­­лҐ }
asm
     mov dx,offset s1+1       {+1 Є®а४вЁа®ўЄ }
     {ᬥ饭ЁҐ Є ЇҐаҐ¬Ґ­­®© ў Є®в®а®© Ўг¤Ґв еа ­Ёвбп ўлў®¤Ё¬ бва®Є }
     mov ah,9      {д­Єж ўлў®¤ }
     int 21h       {DOS interrypt}
end;
end;

Procedure InitData;{вгв ­ бва Ёў Ґ¬ ॣЁбв DS ­  бҐЈ¬Ґ­в ¤ ­­ле}
{вॡгҐвбп ®¤Ё­ а § ў б ¬®¬ ­ з «Ґ}
Var
Data:Word;
BEGIN
Data:=DSeg;
asm
     mov ax,data{ ¤аҐб ᥣ¬Ґ­в  ¤ ­­ле ў ॣЁбва Їа®ж }
     mov ds,ax  { ¤аҐб ў ॣЁбв DS в/Є/ ®­ ®вўҐз Ґв §  бҐЈ¬Ґ­в ¤ ­­ле }
     xor ax,ax  {®Ў­г« ­  ўбпЄЁ© б«гз ©}
end;
END;

Procedure MCurXY(x,y:Byte);Assembler;{¤«п ЇҐаҐ¬ҐйҐ­Ёп Єгаб®а }
asm
     mov ah,02       {;function moving the cursor}
     mov bh,0      {;screen number}
     mov dh,y      {;x-posit}
     mov dl,x      {;y-posit}
     int 10h            {;BIOS INTerrypt}

end;

Procedure WaitKey;Assembler;
asm
     mov ah,0
     int 16h
end;
{=============}
{=============}
{=============}
begin                              {}

{ўаҐ§г«мв ⥠Їа®Ја ¬¬Ёа®ў ­Ёп ў®§­ЁЄ ў®Їа®б Ї®зҐ¬г ASM ­Ґ ­Ґ ­ 室Ёв}
{­Ґ Ј«®Ў «м­лҐ ЇҐаҐ¬Ґ­­лҐ}
InitData;                  {}
ClScr;                          {}
MCurXY(5,5);
OutText('Ї®­пв­® § 祬 Їа®жҐ¤ MCyrXY$');  {Џа®Ў  :) }
{ЇаЁ¬Ґз ­ЁҐ §­ Є -=$=- ®Ўп§ ⥫Ґ­ в/Є/ Ґв® Є®­Ґж бва®ЄЁ}
WaitKey;                        {}
ClScr;                          {}
repeat
     repeat
OutText('‚ўҐ¤ЁвҐ A and B (a<b):$');readln(a,B); {}
     until a<b;                         {}
repeat                               {}
OutText('‚ўҐ¤ЁвҐ R (R>0):$');readln®; {}
until r>0;                         {}

repeat                               {}
OutText('‚ўҐ¤ЁвҐ d (d<0):$');readln(d);      {}
until d<0;                         {}

repeat                               {}
OutText('‚ўҐ¤ЁвҐ c (c>0):$');readln©;      {}
until c>0;                         {}

repeat                               {}
OutText('‚ўҐ¤ЁвҐ E (E>0):$');readln(E); {}
until E>0;                         {}
ClScr;

writeln(' a=',a:5:2,' b=',b:5:2,' d=',d:5:2,' c=',c:5:2,' R=',r:5:2, ' E=',E:2:4); {}
OutText('‚ᥠЇа ўЁ«м­® (y/n):$');      {}
readln(p);                         {}

until ((p='y') or (p='Y')); {повторять ввод данных пока нет подтверждения о его правильности} {}
ClScr;                         {}
OutText('Please wait$');             {}
                             {}
repeat                               {}
begin                               {}
ClScr;                               {}
n:=1;                      {г вҐЎп ®­ 0 Ўл«}
writeln('n=',n);                   {}
h:=(b-a)/n;
s:=0;                               {}
for i:=1 to n do                   {}
begin                               {}
x:=a+i*h;                         {}
s:=s+func(x);                         {}
end;                               {}
Integlast:=Integ;                   {}
n:=n*2;                         {}
Integ:=h*s;
end until (abs(Integ-Integlast)<E);       {}
ClScr;                         {}
writeln('Значение интеграла на интервале [',a:0:2,',',b:0:2,'] для функции,'); {}
writeln('заданной графически равно: ',Integ:0:4);                         {}
WaitKey;                         {}
end.                               {}
                             {}
                             {}

Автор: Shadow 5.06.2003 23:36

Цитата
Ну и я заодно попробую... по ходу надо и FPU подключать??

расшифруй FPU

Автор: Shadow 5.06.2003 23:52

и вот еще есть чтучка как XMM - расширение архитектуры микропроцессора Pentium
-=-=-=-=--=
которая добавляет 8    128-биттных регистров с плавающей точкой
-=-=
как бы ее применить

Автор: GLuk 6.06.2003 19:39

FPU -> сопроцессор.

Автор: Shadow 6.06.2003 22:02

я так и понял