Ĺadny brzuch
Witam potrzebuje pomocy w napisaniu kilku programów czy jest ktoś w stanie mi pomóc ? O to lista
1 prog. metoda siecznych, Newtona,program powinien miec mozliwosc wyznaczaania ekstremum i pochodna obliczyc
2.liczenie roznic skonczonych. Ogolnie metody interpolacjii
3. calkowanie metoda trapezow Simpsona i monte carlo
4. rozwiazywanie ukladow liniowych eliminacjii Gaussa i jordana
5. aproksymacja funkcji liniowej z mozliwoscia aproksymacji potegowej
Narazie miałem semestr podstaw informatyki a teraz takie coś mam napisać [e beksa] niewiem jak HELP
Tyle wystrobałem pierwszego prog ale działa tylko jedna metoda
***************************************************************** unit all; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, TeEngine, Series, TeeProcs, Chart; type TForm1 = class(TForm) Chart1: TChart; Series1: TLineSeries; GroupBox1: TGroupBox; Panel1: TPanel; Edit1: TEdit; Panel2: TPanel; Edit2: TEdit; GroupBox2: TGroupBox; Panel3: TPanel; Edit3: TEdit; Panel4: TPanel; Edit4: TEdit; GroupBox3: TGroupBox; Panel5: TPanel; Edit5: TEdit; Panel6: TPanel; Edit6: TEdit; Button1: TButton; Button2: TButton; GroupBox4: TGroupBox; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; procedure Button1Click(Sender: TObject); procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button2Click(Sender: TObject); private { Private declarations } public lewa,prawa:real; // pola klasy TForm1 a,b,x:real; function f(x:real):real; procedure RysujFunkcje;// metoda klasy TForm1 function Bisekcja:Boolean; function Sieczna:Boolean;{ Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.Bisekcja:Boolean;//znajdz pierwiastek Var eps,fa,fb,fx:real; begin eps:=StrToFloat(edit6.Text); Result:=True; fa:=f(a); fb:=f(B); if fa*fb>0 then begin result:=false;exit end; repeat if abs(fa)<eps then begin x:=a;exit end; if abs(fb)<eps then begin x:=b;exit end; x:=(a+B)/2; fx:=f(x); if fa*fx<0 then begin b:=x;fb:=f(B);end else begin a:=x;fa:=f(a); end; until abs(b-a)<eps; end; function TForm1.Sieczna:Boolean;//znajdz pierwiastek var eps,fa,fb,fx:real; begin eps:=StrToFloat(edit6.Text); Result:=True; fa:=f(a); fb:=f(B); if fa*fb>0 then begin result:=false;exit end; repeat if abs(fa)<eps then begin x:=a;exit end; if abs(fb)<eps then begin x:=b;exit end; x:=a-fa/(fb-fa)*(b-a); fx:=f(x); if fa*fx<0 then begin b:=x;fb:=f(B);end else begin a:=x; fa:=f(a); end; until abs(b-a)<eps; end; function TForm1.f(x:real):real; //Dana Funkcja begin result:=sin(x); //wynik funkcji end; procedure TForm1.RysujFunkcje; //procedura rysowania funkcji const N=1024; //liczba punktów na wykresie var dx,x:real;//przyrost miedzy puktami, odleglosc i:integer; begin dx:=(prawa-lewa)/(N-1); // skok funkcji x:=lewa-dx; series1.clear; for i:=1 to N do begin x:=x+dx; series1.AddXY(x,f(x),'',clblue); // dodanie 1 pkt do serii end; end; procedure TForm1.Button1Click(Sender: TObject); begin lewa:=StrToFloat(edit1.text); prawa:=StrToFloat(edit2.text); RysujFunkcje; end; procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbleft then begin a:=Chart1.BottomAxis.CalcPosPoint(x); Edit3.Text:=FloatToStr(a); end else begin b:=Chart1.BottomAxis.CalcPosPoint(x); Edit4.Text:=FloatToStr(B); end; end; procedure TForm1.Button2Click(Sender: TObject); begin if CheckBox1.Checked then begin Bisekcja(); edit5.text:=FloatToStr(x); end else if checkbox2.checked then begin Sieczna(); edit5.text:=FloatToStr(x) end else ShowMessage('Brak pierwiastka'); end; end. *****************************************************************
Jest ktoś w stanie mi pomóc ??
// Używaj [ code ] (ew. [ codebox] )
Użytkownik _Herkules_ edytował ten post 20 maj 2005, 16:20
poszukaj na googlach, kiedys znalazlem jakiegos pdfa w ktorym bylo wiele metod numerycznych dokladnie omowionych. a eliminacja gaussa jest w cormenie.
Inny problem czemu ni na koniec 2 razy wypisuje wynik z metody simpsona HELP bo ślepy juz chyba jestem i niewidze czemu tak jest :P Oto kod
***************************************************** program Project1; {$APPTYPE CONSOLE} uses SysUtils; function f(x : real) : real; begin f := sqr(x)+x; end; procedure trapez; var a,b,c,xi,yi,h,l:real; i,n:integer; begin writeln('Metody obliczania calek'); writeln('Metoda trapezow'); write('podaj poczatek przedzialu a='); readln(a); write('podaj koniec przedzialu b='); readln(B); write('podaj ilosc przedzialow n='); readln(n); h:=(b-a)/n; l:=(f(a)+f(B))/2 ; for i:=1 to (n-1) do begin xi:=a+i*h; yi:=f(xi); l:=l+Yi; end; C:=h*l; writeln('calka metoda trapezow wynosi calka=',c:8:5); end; procedure simpson ; var n,i,q: integer; a,b,sum1,sum2,h,eps: real; x,y: array[0..100] of real; cal: array[1..2] of real; begin writeln; writeln('METODA SIMPSONA'); write('podaj poczatek przedzialu a='); readln(a); write('podaj koniec przedzialu b='); readln(B); write('podaj ilosc przedzialow n='); readln(n); repeat for q:= 1 to 2 do begin n:= q*n; h:= (b-a)/n; for i:= 0 to n do begin x[i]:= a+i*h; y[i]:= f(x[i]) end; sum1:= 0; sum2:= 0; for i:= 1 to n-1 do if odd(i) then sum1:= sum1+y[i] else sum2:= sum2+y[i]; cal[q]:= h/3*(y[0]+y[n]+4*sum1+2*sum2); write ('calka metoda Simpsona wynosi calka=',cal[q]:15:10); //readln; end; writeln; until abs(cal[1]-cal[2]) < eps; //readln; end; begin trapez; simpson; writeln('Program czeka na nacisniecia klawiasza Enter'); readln; end. **************************************************
HELP
// Używaj [ code ] (ew. [ codebox] )
Użytkownik cavemanxp edytował ten post 20 maj 2005, 16:27
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
1 prog. metoda siecznych, Newtona,program powinien miec mozliwosc wyznaczaania ekstremum i pochodna obliczyc
2.liczenie roznic skonczonych. Ogolnie metody interpolacjii
3. calkowanie metoda trapezow Simpsona i monte carlo
4. rozwiazywanie ukladow liniowych eliminacjii Gaussa i jordana
5. aproksymacja funkcji liniowej z mozliwoscia aproksymacji potegowej
Narazie miałem semestr podstaw informatyki a teraz takie coś mam napisać [e beksa] niewiem jak HELP
Tyle wystrobałem pierwszego prog ale działa tylko jedna metoda
***************************************************************** unit all; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, TeEngine, Series, TeeProcs, Chart; type TForm1 = class(TForm) Chart1: TChart; Series1: TLineSeries; GroupBox1: TGroupBox; Panel1: TPanel; Edit1: TEdit; Panel2: TPanel; Edit2: TEdit; GroupBox2: TGroupBox; Panel3: TPanel; Edit3: TEdit; Panel4: TPanel; Edit4: TEdit; GroupBox3: TGroupBox; Panel5: TPanel; Edit5: TEdit; Panel6: TPanel; Edit6: TEdit; Button1: TButton; Button2: TButton; GroupBox4: TGroupBox; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; procedure Button1Click(Sender: TObject); procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button2Click(Sender: TObject); private { Private declarations } public lewa,prawa:real; // pola klasy TForm1 a,b,x:real; function f(x:real):real; procedure RysujFunkcje;// metoda klasy TForm1 function Bisekcja:Boolean; function Sieczna:Boolean;{ Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.Bisekcja:Boolean;//znajdz pierwiastek Var eps,fa,fb,fx:real; begin eps:=StrToFloat(edit6.Text); Result:=True; fa:=f(a); fb:=f(B); if fa*fb>0 then begin result:=false;exit end; repeat if abs(fa)<eps then begin x:=a;exit end; if abs(fb)<eps then begin x:=b;exit end; x:=(a+B)/2; fx:=f(x); if fa*fx<0 then begin b:=x;fb:=f(B);end else begin a:=x;fa:=f(a); end; until abs(b-a)<eps; end; function TForm1.Sieczna:Boolean;//znajdz pierwiastek var eps,fa,fb,fx:real; begin eps:=StrToFloat(edit6.Text); Result:=True; fa:=f(a); fb:=f(B); if fa*fb>0 then begin result:=false;exit end; repeat if abs(fa)<eps then begin x:=a;exit end; if abs(fb)<eps then begin x:=b;exit end; x:=a-fa/(fb-fa)*(b-a); fx:=f(x); if fa*fx<0 then begin b:=x;fb:=f(B);end else begin a:=x; fa:=f(a); end; until abs(b-a)<eps; end; function TForm1.f(x:real):real; //Dana Funkcja begin result:=sin(x); //wynik funkcji end; procedure TForm1.RysujFunkcje; //procedura rysowania funkcji const N=1024; //liczba punktów na wykresie var dx,x:real;//przyrost miedzy puktami, odleglosc i:integer; begin dx:=(prawa-lewa)/(N-1); // skok funkcji x:=lewa-dx; series1.clear; for i:=1 to N do begin x:=x+dx; series1.AddXY(x,f(x),'',clblue); // dodanie 1 pkt do serii end; end; procedure TForm1.Button1Click(Sender: TObject); begin lewa:=StrToFloat(edit1.text); prawa:=StrToFloat(edit2.text); RysujFunkcje; end; procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbleft then begin a:=Chart1.BottomAxis.CalcPosPoint(x); Edit3.Text:=FloatToStr(a); end else begin b:=Chart1.BottomAxis.CalcPosPoint(x); Edit4.Text:=FloatToStr(B); end; end; procedure TForm1.Button2Click(Sender: TObject); begin if CheckBox1.Checked then begin Bisekcja(); edit5.text:=FloatToStr(x); end else if checkbox2.checked then begin Sieczna(); edit5.text:=FloatToStr(x) end else ShowMessage('Brak pierwiastka'); end; end. *****************************************************************
Jest ktoś w stanie mi pomóc ??
// Używaj [ code ] (ew. [ codebox] )
Użytkownik _Herkules_ edytował ten post 20 maj 2005, 16:20
poszukaj na googlach, kiedys znalazlem jakiegos pdfa w ktorym bylo wiele metod numerycznych dokladnie omowionych. a eliminacja gaussa jest w cormenie.
Inny problem czemu ni na koniec 2 razy wypisuje wynik z metody simpsona HELP bo ślepy juz chyba jestem i niewidze czemu tak jest :P Oto kod
***************************************************** program Project1; {$APPTYPE CONSOLE} uses SysUtils; function f(x : real) : real; begin f := sqr(x)+x; end; procedure trapez; var a,b,c,xi,yi,h,l:real; i,n:integer; begin writeln('Metody obliczania calek'); writeln('Metoda trapezow'); write('podaj poczatek przedzialu a='); readln(a); write('podaj koniec przedzialu b='); readln(B); write('podaj ilosc przedzialow n='); readln(n); h:=(b-a)/n; l:=(f(a)+f(B))/2 ; for i:=1 to (n-1) do begin xi:=a+i*h; yi:=f(xi); l:=l+Yi; end; C:=h*l; writeln('calka metoda trapezow wynosi calka=',c:8:5); end; procedure simpson ; var n,i,q: integer; a,b,sum1,sum2,h,eps: real; x,y: array[0..100] of real; cal: array[1..2] of real; begin writeln; writeln('METODA SIMPSONA'); write('podaj poczatek przedzialu a='); readln(a); write('podaj koniec przedzialu b='); readln(B); write('podaj ilosc przedzialow n='); readln(n); repeat for q:= 1 to 2 do begin n:= q*n; h:= (b-a)/n; for i:= 0 to n do begin x[i]:= a+i*h; y[i]:= f(x[i]) end; sum1:= 0; sum2:= 0; for i:= 1 to n-1 do if odd(i) then sum1:= sum1+y[i] else sum2:= sum2+y[i]; cal[q]:= h/3*(y[0]+y[n]+4*sum1+2*sum2); write ('calka metoda Simpsona wynosi calka=',cal[q]:15:10); //readln; end; writeln; until abs(cal[1]-cal[2]) < eps; //readln; end; begin trapez; simpson; writeln('Program czeka na nacisniecia klawiasza Enter'); readln; end. **************************************************
HELP
// Używaj [ code ] (ew. [ codebox] )
Użytkownik cavemanxp edytował ten post 20 maj 2005, 16:27