Rabu, 16 Juli 2008

Bisection

berikut adalah contoh bisection untuk sampai nilai 0.9500000.
terlebih dulu kita sudah menyiapkan suatu sheet kosong, DIMANA Var1 untuk xi, Var2 untuk Xi+1 , Var 3 untuk Q(xi) dan var4 untuk Q(xi+1).
semua Var tersebut harus di set dengan display format number dengan decimal digit 7, untuk tingkat ketelitian 7 digit belakang koma.
kemudian di save.
posisinya harus sama dengan yang ada "h:\kuliah\latihan6.sta" --> bisa di rubah

----
Option Base 1
Option Explicit
'#Uses "*STB.SVX"
'#Uses "*GRAPHICS.SVX"
Dim spr As Spreadsheet
Dim xi As Double
Dim xii As Double
Dim Bariske As Integer
Dim NilaiAwalbawah, NilaiAwalAtas As Double
Sub Main
Dim DisNormal1, DisNormal2 As Double
Dim ArrayXi() As Double
Dim ArrayXii() As Double
NilaiAwalbawah =0.50000
NilaiAwalAtas =2.00000
Set spr= Spreadsheets.Open("h:\kuliah\latihan6.sta")

Bariske = 1
ReDim Preserve ArrayXi(Bariske)
ReDim Preserve ArrayXii(Bariske)
spr.Header ="Latihan ke 6 Bisection "

spr.Visible = True
spr.Cells(1,1) = NilaiAwalbawah
spr.Cells(1,2) = NilaiAwalAtas

spr.Cells(1,3) = HitungNormDist(NilaiAwalbawah)
spr.Cells(1,4) = HitungNormDist(NilaiAwalAtas)

ArrayXi(Bariske) = Round(Abs(0.95-spr.Cells(1,3)),6)
ArrayXii(Bariske)= Round(Abs(0.95-spr.Cells(1,4)),6)
xi = NilaiAwalbawah
xii = NilaiAwalAtas
Bariske=Bariske + 1
ReDim Preserve ArrayXi(Bariske)
ReDim Preserve ArrayXii(Bariske)

Do
'jika xi > xi+1 maka xi+1 Nilainya = nilai sebelumya sebaliknya xi=nilai sebelumnya
If ArrayXi(Bariske-1) < ArrayXii(Bariske-1) Then
spr.Cells(Bariske,1)=spr.Cells(Bariske-1,1)
xii=Format(Nilainya(xi,xii,Bariske,2),"#.00000")
Else
xi=Format(Nilainya(xi,xii,Bariske,1),"#.00000")
spr.Cells(Bariske,2)=spr.Cells(Bariske-1,2)
End If

DisNormal1 = HitungNormDist(xi)
spr.Cells(Bariske,3) = DisNormal1

DisNormal2 = HitungNormDist(xii)
spr.Cells(Bariske,4) = DisNormal2

ArrayXi(Bariske) = Round(Abs(0.95-spr.Cells(Bariske,3)),6)
ArrayXii(Bariske)= Round(Abs(0.95-spr.Cells(Bariske,4)),6)

Bariske = Bariske + 1
ReDim Preserve ArrayXi(Bariske)
ReDim Preserve ArrayXii(Bariske)
If Bariske >= 11 Then spr.AddCases (Bariske - 1,1)

Loop Until (DisNormal1 = 0.9500000 Or DisNormal2 = 0.9500000)

End Sub
Function Nilainya(Bawah As Double, Atas As Double, Baris As Integer, kolom As Integer ) As Double
Dim TmpNilai As Double

Nilainya= ((Bawah + Atas)/2)
spr.Cells(Baris,kolom) = (Bawah + Atas)/2
End Function
Function HitungNormDist(Localxi As Double) As Double
HitungNormDist =Round(INormal(Localxi,0,1),5)
End Function

Tidak ada komentar: