/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 381
от 27.05.2007, 01:05

Вопрос № 87.955

Помогите написать программу,которая строит график ф-ции y=-2,7*x*x*x+0,23*x*x-1,4 при помощи линий.Максимальное и минимальное значение аргумента вводится самостоятельно.Шаг вычислений - одна двадцатая диапазона.

Отправлен: 21.05.2007, 20:09 Вопрос задал: Безпалов Владимир Александрович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, Безпалов Владимир Александрович! См. пример в приложении. Из данного примера можно любую функцию сделать, нужно только вставить ее в функцию funcY(X). Удачи! Приложение: program q87955; uses Graph, Crt; function funcY(const X: Real): Real; begin funcY:= -2.7*x*x*x + 0.23*x*x - 1.4; end; var mode, Driver, i: Integer; y: Real; x1, x2, delta, x: Real; y1, y2: Real; strTemp: String; Res: array[1..20] of Real; begin ClrScr; Write(' Start with x = '); ReadLn(x1); Write(' Finish with x = '); ReadLn(x2); Driver:= 9; mode:= 1; InitGraph(driver, mode, ''); if (GraphResult <> grOk) then begin WriteLn('Graph driver ', driver, ' graph mode ', mode, ' not supported'); Halt(1); end; setcolor(10); setviewport(0,0,550,300,true); rectangle(1,0,550,300); setcolor(7); line(0,150,550,150); line(275,0,275,300); setcolor(12); Str(x1:1:2, strTemp); outtextxy(25,153,strTemp); Str(x2:1:2, strTemp); outtextxy(500,153,strTemp); setcolor(14); outtextxy(540,143,'x'); outtextxy(278,1,'y'); delta:= (x2 - x1)/20; x:= x1; for i:= 1 to 20 do begin Res[i]:= funcY(x); x:= x + delta; end; y1:= Res[1]; y2:= Res[1]; for i:= 2 to 20 do if (Res[i] > y1) then y1:= Res[i] else if (Res[i] < y2) then y2:= Res[i]; setcolor(12); Str(y1:1:2, strTemp); outtextxy(278,10,strTemp); Str(y2:1:2, strTemp); outtextxy(278,290,strTemp); for i:= 1 to 20 do begin setcolor(9); y:= 290 - (Res[i] - y2)*280/(y1 - y2); if (i = 1) then begin setcolor(0); lineto(25, trunc(y)); end else lineto(i*25, trunc(y)); end; ReadLn; CloseGraph; end.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 21.05.2007, 21:52

Отвечает: Const Здравствуйте, Безпалов Владимир Александрович! Модуль в приложении должен помочь Вам построить график функции. Думаю, что для Вас не составит проблем подкорректировать этот код под свои нужды. Приложение: Uses Graph; var x,dx : real; { аргумент и его приращение } xl,x2 : real; { диапазон изменения аргумента } y : real; { значение функции } mx,my : integer; { масштаб по X и Y - кол-во точек экрана,} { соответствующее единице по осям координат} x0,y0 : integer; { начало осей координат } px,py : integer; { координаты точек на экране } grDriver,grMode,ErrCode,i,x1,y1,z : integer; grPath,num : string; FF,a : real; {---------------------------------------------------------------------------} procedure Graf; begin grDriver := VGA; grMode := VGAHi; grPath := 'f: p7units'; InitGraph(grDriver,grMode,grPath); ErrCode := GraphResult; SetBkColor(1); if ErrCode <> grOK then begin writeln (' Ошибка инициализации графического режима,'); writeln (' Для завершения работы нажмите <Enter>'); readln; Halt (1); end; x0 := 320; y0 := 240; mx := 20; my := 20; Setcolor(13); { оси координат } setlinestyle(0,0,3); Line(0,y0,640,y0); { горизонтали } Line(x0,0,x0,480); { вертикали } setcolor (14); z := -16; line(i*20,0,i*20,480); for i := 0 to 32 do { разметка Ox и Oy} begin str(z:1,num); if z <> 0 then OuttextXY(305,560-i*20,num); OutTextXY(i*20,245,num); z := z+1; end; setcolor(2); {начало построения сетки} setlinestyle(0,0,1); x1 := 640;y1 := 480; for i := 1 to 24 do begin Line(0,y1,640,y1); y1 := y1-20; end; for i := 1 to 32 do begin Line(x1,0,x1,480); x1 := x1-20; end; xl := -15; { Построение графика по точкам (Pixel) } x2 := 15; dx := 0.001; x := xl; while (x<x2) do begin y := cos(2/x)-2*sin(1/x)+1/x; px := x0+Round(x*mx); py := y0-Round(y*my); PutPixel(px,py,White); x := x+dx; end; read; End; {------------------ Заданная функция F(x) ----------------------------------} function F(x : real) : real; begin f := cos(2/x)-2*sin(1/x)+1/x; {---------------------------------------------------------------------------} End; function F1(x : real) : real; begin { Производная функция F(x) } f1 := 2/sqr(x)*sin(2/x)+2/sqr(x)*cos(1/x)-1/sqr(x); End; {------------------ Рекурсивный метод дихотомии ----------------------------} function X_Dich_01(a,b,eps : real) : real; var x : real; begin if F(a)*F(b) > 0.0 then begin writeln('error02');readln; Halt; end else begin x := 0.5*(a+b); if abs(F(x))>eps then if F(a)*F(x)<0.0 then X_Dich_01 := X_Dich_01(a,x,eps) else X_Dich_01 := X_Dich_01(x,b,eps) else X_Dich_01 := x end End; {------------------ Метод хорд ---------------------------------------------} function X_Dich_02(a,b,eps : real) : real; var u,v,w ,x : real; begin u := f(a); v := f(b); repeat x := 0.5*(a+b); w := f(x); if (u*w<0.0) then begin b := x; v := w end else begin a := x; u := w end; until abs(w) < eps; X_Dich_02 := x End; {---------------------------------------------------------------------------} function Sign(x : real) : integer; begin Sign := 0; If x < 0.0 then Sign := -1; If x > 0.0 then Sign := 1; End; {------------------ Знаковый метод дихотомии -------------------------------} function X_Dich_03(a,b,eps : real) : real; var s : integer; w,x : real; begin s := Sign(f(a)); repeat x := 0.5*(a+b); w := f(x); if Sign(w)=s then a := x else b := x; until abs(w) < eps; X_Dich_03 := x End; {------------------ Метод Ньютона (косательных) ----------------------------} function X_Nyutona(x,eps : real) : real; var x1 : real; begin x1 := x-f(x)/f1(x); if abs(f(x)) > Eps then X_Nyutona := X_Nyutona(x1,eps) else X_Nyutona := x1 End; {---------------------------------------------------------------------------} var b,eps : real; begin Graf; writeln(' Vvedite znaceniya a,b,x,eps '); readln(a,b,x,eps); writeln(' Pekupsivnii metog gixotomii = ', X_Dich_01(a,b,eps):2:5); read; writeln(' Metod xopg = ', X_Dich_02(a,b,eps):2:5); read; writeln(' Znakovii metog gixotomii = ', X_Dich_03(a,b,eps):2:5); read; writeln(' Metog kocatelnix (Nyuton) = ', X_Nyutona(x,eps):2:5); readln; End.

Ответ отправил: Const (статус: 1-ый класс) Ответ отправлен: 21.05.2007, 21:59

Вопрос № 87.984

Уважаемые эксперты. Вот программа: (условие задачи - максимальное по модулю отриц. число заминить нулем) program lab_3_1; label 1; const n=20; var a:array [1..n] of real; max:integer; i:byte; BEGIN max:=1; Writeln ('VVEDITE MASSIV'); for i:=1 to n do Readln (a[i]); for i:=1 to n do if a[i]<0 then max:=i; for i:=1 to n do if (abs(a[max])<abs(a[i])) and (a[i]<0) then max:=i; Writeln ('max otrichatelnoe chislo= ',a[max]:3:2); a[max]:=0; for i:=1 to n do Write (' ',a[i]:3:1); Writeln; END. если в массив ввести все положительные числа, то алгоритм заменяет первое число в массиве на 0 (этого бы как раз и не нужно). Как сделать так чтоб при обнаружении в массиве только положительных чисел программа выдавала например "НЕТ ОТРИЦАТЕЛЬНЫХ ЧИСЕЛ. НЕСООТВЕТСВИЕ УСЛОВИЮ ЗАДАЧИ".

Отправлен: 22.05.2007, 00:10 Вопрос задал: DancaN (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Gh0stik Здравствуйте, DancaN! Ищите изменения в выделенных строках. program lab_3_1; const n=20; var a:array [1..n] of real; max:integer; i:byte; BEGIN max:=0; Writeln ('VVEDITE MASSIV'); for i:=1 to n do Readln (a[i]); for i:=1 to n do if a[i]<0 then max:=i; if max < > 0 then begin for i:=1 to n do if (abs(a[max]) < abs(a[i])) and (a[i] < 0) then max:=i; Writeln ('max otrichatelnoe chislo= ',a[max]:3:2); a[max]:=0; for i:=1 to n do Write (' ',a[i]:3:1); Writeln; end else writeln('net otricatelnich!!!'); END. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 22.05.2007, 00:21 Оценка за ответ: 5 Комментарий оценки: Все четко и понятно!. Спасибо!

Отвечает: Загиров Рустам Здравствуйте, DancaN! Чтобы не бегать 2 раза по массиву, можно прямо при вводе массива проверять на отрицательность элемента. Можно также опускать функции Abs, заменив знак на противоположный. Приложение: program lab_3_1; const n=10; var a:array [1..n] of real; max,i:byte; BEGIN max:=0; Writeln ('VVEDITE MASSIV'); for i:=1 to n do begin Readln (a[i]); if a[i]<0 then max:=i; end; if max>0 then begin for i:=1 to n do if (a[i]<0) AND (a[i]<a[max]) then max:=i; Writeln ('max otrichatelnoe chislo= ',a[max]:3:2); a[max]:=0; for i:=1 to n do Write (' ',a[i]:3:1); end else writeln('Net otritsatelnih chisel'); Writeln; END. --------- Этот мир обречён на нас ©Сергей Маврин

Ответ отправил: Загиров Рустам (статус: Специалист) Ответ отправлен: 22.05.2007, 00:48

Отвечает: Denisss Здравствуйте, DancaN! См. исправленный пример в приложении. Убрал функцию получения модуля abs. Т.к. нам известно, что число отрицательное, то, чтобы найти наибольшее по модулю, нужно всего лишь сравнить два отрицательных числа. Если одно число меньше другого, значит по модулю оно будет больше. Пример: -5 < -2 --- значит -5 по модулю больше, чем -2 В конце добавил код проверки элемента a[max] на отрицательность. Если a[max] не отрицательно, значит это первый элемент массива. Значит в массиве нет отрицательных чисел. Удачи! Приложение: program lab_3_1; const n=20; var a: array [1..n] of real; max: integer; i: byte; BEGIN max:= 1; Writeln ('VVEDITE MASSIV'); for i:= 1 to n do begin write('a[', i, '] = '); Readln (a[i]); end; for i:= 1 to n do if ((a[i] < 0) and (a[max] > a[i])) then max:=i; if (a[max] < 0) then begin Writeln ('max otrichatelnoe chislo = ', a[max]:3:2); a[max]:= 0; end else WriteLn('V massive net otricatelnyh chisel!'); for i:= 1 to n do Write (' ',a[i]:3:1); Writeln('Press any key...'); ReadLn; END.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 22.05.2007, 00:55

Отвечает: Анна Игоревна Здравствуйте, DancaN! вот я думаю, что это будет выглядеть следующим образоом (немного переделала твою задачу, так мне кажется будет порациональнее ...) Приложение: program lab_3_1; const n=5; var a:array [1..n] of real; max:integer; i:byte; BEGIN max:=0; Writeln ('VVEDITE MASSIV'); for i:=1 to n do Readln (a[i]); for i:=1 to n do if (max=0) and (a[i]<0) then max:=i {если это первый отрицательный элемент, то он и будет максимальным} else {если не первый, то смотрим будет ли он по модулю больше нашего пероначального максимального} if (a[i]<0) and (abs(a[i]) > abs(a[max])) then max:=i; if max = 0 then {это условие будет выполняться только в том случае, если ни одного отрицательного элемента в массиве нет} begin writeln('NET OTRICATELNIH CHSEL'); EXIT; {досрочный выход из программы} end; Writeln ('max otrichatelnoe chislo= ',a[max]:3:2); a[max]:=0; for i:=1 to n do Write (' ',a[i]:3:1); Writeln; readln; END.

Ответ отправила: Анна Игоревна (статус: 1-ый класс) Ответ отправлен: 22.05.2007, 15:16

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.52 от 02.05.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru