En Küçük Kareler Yöntemi
Problem :
(x1,y1) , (x2,y2) , (x3,y3) , ... , (xn,yn)
serpme noktalarına en yakın olan eğrinin belirlenmesi uygulamada önemli bir problemdir. Serpme noktalarının dağılımına göre, uygulamacı, öncelikle eğrinin ne olabileceğine karar vermelidir. Çoğunlukla karşılaşılan haller şunlardır:
1. y =
ax doğrusu,
2.
2.
2.
2.
y = a +
bx doğrusu,
3.
3.
3.
3.
y = a +
bx + cx2 parabolü.
İlk durum, ikincinin özel bir durumudur. Burada, ikinci durum için matris denklemlerinden yararlanan bir çözüm yapacağız. Aynı problemin, doğrusal denklem sistemlerine dayanan bir çözümü için bkz. : Doğrusal Denklemler Sistemleriyle En Küçük Kareler Yöntemi
En
Küçük Kareler Yöntemi,
y = a + bx doğrusu
üzerindeki (xi , y)
noktaları ile verilen (xi , yi) serpme noktaları
arasındaki uzaklıkların kareleri toplamını minumum yapan a ve b katsayılarını bulma işleminden
ibarettir. Bu katsayılar bulununca, y =
a + bx doğrusu (regresyon doğrusu) bulunmuş olur.
Bu
uzaklıkların kareleri toplamı
T yi minumum yapan a ve b sayılarını bulmak
için, T nin a ve b ye
göre kısmi türevlerini sıfır yapan değerleri bulmalıyız. Bunun için
denklem sisteminin çözülmesi gerekir. Bu denklemleri düzenlersek,
yazabiliriz. Bu matrisleri soldan sağa doğru M, A, N ile gösterirsek
matris eşitliği elde edilir. Serpme diyağramındaki noktaların koordinatlarından yararlanarak,
ve 
matrisleri tanımlanırsa,
ve 
olduğu görülür. Buradan,
çıkar. Bu matris eşitliğinden A matrisini çözersek,
buluruz. Sağ taraftaki matrisleri yerlerine yazarak A matrisini bulabiliriz. Bu da aradığımız a ve b katsayılarının bulunması demektir.
Aşağıdaki Pascal programı, bu matris denklemini çözmektedir.
Pascal Programı ile En Küçük
Kareler Yöntemi
Matris Çözümü
(* En Küçük
Kareler Yöntemi *)
(* Matris
Denklemiyle Çözüm *)
program
ekareler;
uses wincrt;
const
max = 20;
type
boyut = 1..max;
dizi =
array[boyut] of real;
matris =
array[boyut,boyut] of real;
var
m : boyut;
apsis , ordinat : dizi;
A, V, W, X , Y,
TX, tersW : matris;
Procedure
DiziGir(var s,t :
dizi ; k : integer);
var
i : integer;
Begin
for i:=1 to k do
begin
WriteLn('x(' ,i, ')' , ' , y(',i,') sayılarını giriniz :');
readln(s[i],t[i]);
end;
End;
procedure
DiziYaz(T : dizi; k : boyut);
var
i : boyut;
Begin
for i := 1 to k do
write(T[i]:5:2);
writeln
End;
Procedure
XMatrisYap(var U : matris ; k : integer);
var
i : integer;
Begin
for i := 1 to k do
begin
U[i,1] := 1;
U[i,2] := apsis[i];
end;
End;
Procedure
Transpose(W : matris ; var TW:matris; p,q : boyut);
var
i,j : boyut;
Begin
for i := 1 to p do
for j := 1 to q do
TW[i,j] := W[j,i];
End;
Procedure YMatrisYap(d
: dizi; var R : matris; k : integer);
var
i : boyut;
Begin
for i := 1 to k do
R[i,1] := ordinat[i];
End;
procedure
Matris_Carp(U : matris; V : matris; var W : matris; p,q,r :
boyut);
{U matrisi p x
q tipinden, V matrisi q x r tipinden olmak üzere,
W çarpım
matrisi p x r tipinden olur.}
var
i,j,k : boyut;
toplam : real;
begin
for i := 1 to p do
for j := 1 to r do
begin
toplam := 0;
for k := 1 to q do
toplam := toplam + U[i,k]*V[k,j];
W[i,j] := toplam
end
end;
Function
Determinant(U : matris): real;
var
i,j : integer;
D : real;
Begin
D := U[1,1] * U[2,2] - U[1,2] * U[2,1];
Determinant := D;
End;
Procedure
TersMatris(U : matris; var tersU : matris);
Begin
tersU[1,1] :=
U[2,2]/Determinant(U);
tersU[1,2] := -U[1,2]/Determinant(U);
tersU[2,1] := -U[2,1]/Determinant(U);
tersU[2,2] :=
U[1,1]/Determinant(U);
End;
Procedure
MatrisYaz(M : matris; p,q : boyut);
var
i,j : boyut;
Begin
for i := 1 to p do
begin
for j:= 1 to q do
Write(M[i,j]:8:2);
WriteLn;
end;
End;
BEGIN
clrscr;
write('Kaç tane (xi ,yi)
noktası var ? ');
repeat
readln(m);
if not (m in [1..max]) then
WriteLn('1..',max, ' arasında bir sayı girmelisiniz! ');
until m in [1..max];
DiziGir(apsis,ordinat,m);
DiziYaz(apsis,m);
DiziYaz(ordinat,m);
writeLn;
XMatrisYap(X,m);
YMatrisYap(ordinat,Y,m);
Transpose(X,TX,2,m);
Matris_Carp(TX,X,W,2,m,2);
TersMatris(W, tersW);
Matris_Carp(TX,Y,V,2,m,1);
Matris_Carp(tersW,V,A,2,2,1);
WriteLn('Doğru denklemi : y = ',A[2,1]:10:5,'x + ',
A[1,1]:10:5);
END.