Original Sender : "Andry Raharja" <[EMAIL PROTECTED]>
---------------------------------
Hai semua lagii....
Saya mo nanya nih tentang kesalahan dari program ini ini program tentang
probabiliti keadaan cuaca
dalam 1 taon program ini salahnya waktu pengulangannya . Bagi yang tau bisa
tolong kasih koreksi nya ?
okayyy tolong yaaa
====================== BEGIN PASCAL
Program Curah_Hujan;
Uses Crt, Dos;
Type rek = record
Tahun : integer;
Bulan : String[9];
DTE : Byte;
Keadaan : String[6];
Intensitas : real;
end;
f = file of rek;
Var Pil : integer;
FHujan : f;
RHujan : rek;
Procedure Tulis (x,y : byte; kalimat : string);
Begin
Gotoxy(x,y);write(kalimat);
end;
Procedure Garis(g : char; l : byte);
var i : byte;
Begin
for i := 1 to l do
write(g);
end;
Procedure Kotak(x1,y1,x2,y2 : byte);
var i : byte;
begin
gotoxy(x1,y1);
write('�'); garis(chr(205),x2-x1-1); write('�');
for i := y1+1 to y2-1 do
begin
gotoxy(x1,i); write('�');
gotoxy(x2,i); write('�');
end;
gotoxy(x1,y2);
write('�'); garis(chr(205),x2-x1-1); write('�');
end;
{ *----- Menu -----* }
Procedure Menu;
Begin
ClrScr;
Kotak(20,04,52,22);
GotoXY(24,06);Write(' MENU UTAMA');
GotoXY(24,08);Garis('�',26);
GotoXY(24,10);Write('1. ISI DATA CURAH HUJAN');
GotoXY(24,12);Write('2. CETAK DATA CURAH HUJAN');
GotoXY(24,14);Write('3. MARKOV DAN MONTE CARLO');
GotoXY(24,16);Write('4. SELESAI');
GotoXY(24,18);Garis('�',26);
GotoXY(24,20);Write('Masukkan Pilihan Anda :');
repeat
gotoxy(48,20); write(' ');
gotoxy(48,20); readln(pil);
until (pil > 0) and (pil < 5);
end;
{ *----- Isi Data -----*}
Procedure IsiData;
var ins : real;
th1, th2, hari, i : integer;
jawab : char;
Begin
clrscr;
kotak(19,3,60,23);
tulis(34,4,'Catatan !');
tulis(21,6,'Data Yang Digunakan Dalam Program Ini');
tulis(21,7,'Harus Kontinu');
gotoxy(21,9); garis(chr(205),38);
tulis(35,10,'Isi Data :');
tulis(21,12,'Terjadinya Keadaan Hujan Diatas');
repeat
tulis(21,21,' ');
tulis(21,13,'Intensitas : ');
tulis(21,15,'Bulan : ');
tulis(21,17,'Data Dari Tahun : ');
tulis(21,19,'Sampai Tahun : ');
gotoxy(44,13); readln(ins);
gotoxy(44,15); readln(rhujan.bulan);
gotoxy(44,17); readln(th1);
gotoxy(44,19); readln(th2);
gotoxy(21,21); write('Data Sudah Betul [Y/N] = ');
readln(jawab);
until upcase(jawab) = 'Y';
clrscr;
rewrite(fhujan);
for rhujan.tahun := th1 to th2 do
begin
kotak(19,1,60,23);
tulis(29,2,'Isi Data Curah Hujan');
tulis(21,3,'Bulan : '+ rhujan.bulan);
tulis(40,3,'Tahun : '); write(rhujan.tahun);
tulis(21,4,'Banyak Hari Per Bulan : ');
gotoxy(45,4); readln(hari);
gotoxy(21,5); garis(chr(205),38);
tulis(21,6,'Tgl Intensitas');
tulis(42,6,'Tgl Intensitas');
for i := 1 to hari do
if i < 17 then
begin
gotoxy(21,i+6); write(i);
end else
begin
gotoxy(42,i-10); write(i);
end;
for rhujan.dte := 1 to hari do
begin
if rhujan.dte < 17 then
gotoxy(28,rhujan.dte+6)
else
gotoxy(49,rhujan.dte-10);
readln(rhujan.intensitas);
if rhujan.intensitas >= ins then
rhujan.keadaan := 'Hujan'
else
rhujan.keadaan := 'Kering';
write(fhujan, rhujan);
end;
for i := 1 to hari do
if i < 17 then
begin
gotoxy(21,i+6); garis(' ',13);
end else
begin
gotoxy(42,i-10); garis(' ',13);
end;
end;
close(fhujan);
end;
{ *----- Cetak Data -----* }
Procedure CetakData;
var jawab : char;
i,keluar: byte;
MBulan : String;
MTahun : Integer;
Begin
Reset(FHujan);
Read(FHujan, RHujan);
Keluar :=0;
While Not Eof(FHujan) do
Begin
Clrscr;
Kotak(11,1,68,23);
Tulis(26,2,'DATA CURAH HUJAN TAHUN'); Write(RHujan.Tahun);
Tulis(14,3,'BULAN :'+ RHujan.Bulan);
GotoXY(12,5); Garis(chr(205),56);
Tulis(12,6,'TGL INTENSITAS KEADAAN');
Tulis(42,6,'TGL INTENSITAS KEADAAN');
MTahun := RHujan.Tahun;
While (MTahun = RHujan.Tahun) AND (Keluar = 0) do
Begin
If RHujan.DTE < 17 then
Begin
i := RHujan.DTE + 6;
GotoXY(13, i); Write(RHujan.DTE);
GotoXY(20, i); Write(RHujan.Intensitas:5:2);
GotoXY(30, i); Write(RHujan.Keadaan);
End else
Begin
i := RHujan.DTE - 10;
GotoXY(42, i); Write(RHujan.DTE);
GotoXY(49, i); Write(RHujan.Intensitas:5:2);
GotoXY(59, i); Write(RHujan.Keadaan);
End;
If Eof(FHujan) then
Keluar :=1
else
Read(FHujan, Rhujan);
End;
If Not Eof(FHujan) then
Begin
Tulis(25,24,'TEKAN ENTER UNTUK MELANJUTKAN');
Readln;
End;
End;
Tulis(25,24,'TEKAN ENTER UNTUK KEMBALI KE MENU');
Readln;
Close(FHujan);
End;
{*------MONTE CARLO------*}
Procedure Carlo(MTahun : Integer; Bulan:String; poo,poi,pio,pii:real);
Var Pola, Hari, Chanel, Ulang : Byte;
j, Simulasi, S, DD,
DR, RD, RR, Rum, DDD,
RRR, TU2, TU3 : Integer;
Stat : Array [1..2] of String[6];
R, PDD, PDR, PRD, PRR,
UN,
TU, SDD, SDR, ZD1,
ZD2, ZR1, ZR2, Z : Real;
P : Array [1..2,1..2] of Real;
Keadaan, MKeadaan : String;
Count : Array [1..2] of integer;
Jw : Char;
TU1 : LongInt;
Begin
ClrScr;
P[1,1]:=POO;
P[1,2]:=POI;
P[2,1]:=PIO;
P[2,2]:=PII;
MKeadaan:='';
Kotak(3,1,77,23);
Kotak(5,2,46,22);
Tulis(51,3,'M O N T E C A R L O');
GotoXY(51,4); Garis(chr(223),21);
GotoXY(51,5); Write(MTahun);
Write(' '+ 'Bulan');
Tulis(50,7,'MATRIKS TRANSISI MARKOV');
For j := 9 to 11 do
Begin
Tulis(49,j,Chr(179));
Tulis(73,j,Chr(179));
End;
GotoXY(52,09); Write(POO:4:2);
GotoXY(65,09); Write(POI:4:2);
GotoXY(52,11); Write(PIO:4:2);
GotoXY(65,11); Write(PII:4:2);
Pola :=1;
Tulis(30,3,'POLA KE : '); Write(Pola);
Repeat
Tulis(7,3,'BANYAK HARI: ');
GotoXY(20,3); Readln(Hari);
Until (Hari >= 1) and (Hari <=31);
GotoXY(6,4); Garis(Chr(205),38);
Tulis(10,5,'TGL');
Tulis(16,5,'KEADAAN');
Tulis(28,5,'TGL');
Tulis(35,5,'KEADAAN');
Stat[1] := 'KERING'; Stat[2] := 'Hujan';
Ulang := 1;
Repeat
GotoXY(40,3); Write(Pola);
Count[1] := 0; Count[2]:=0;
S:=1; Chanel := 0; Rum := 0;
DD:=0; DR:=0; RD:=0; RR:=0;
For Simulasi:=1 to Hari do
Begin
R := Random;
For j:= 1 to 2 do
Begin
R:=R-P[S,j];
If R < 0 Then
Begin
S:=j;
Keadaan:=Stat[S];
If Simulasi >= 17 Then
Begin
GotoXY(28,Simulasi-11); Write(Simulasi);
GotoXY(35,Simulasi-11); Write(Keadaan + ' ');
End else
Begin
GotoXY(10,Simulasi+5); Write(Simulasi);
GotoXY(16,Simulasi+5); Write(Keadaan + ' ');
End;
If Chanel <> 0 Then
Begin
If (MKeadaan = 'Kering') and (Stat[S] = 'Kering')
Then
DD := DD + 1;
If (MKeadaan = 'Kering') and (Stat[S] = 'Hujan')
Then
Begin
DR := DR + 1;
rum := rum + 1;
end;
if (MKeadaan = 'Hujan') and (stat[s] = 'Kering')
then
begin
RD := RD + 1;
rum := rum +1;
end;
if (Mkeadaan = 'Hujan') and (stat[s] = 'Hujan')
then
RR := RR +1;
end;
Mkeadaan := stat[s];
chanel := 1;
j := 2;
end;
end;
inc(count[s]);
end;
DDD := DD + DR;
RRR := RR + RD;
if DDD <> 0 then
Begin
PDD := DD/DDD;
PDR := DR/DDD;
end else
Begin
PDD := 0;
PDR := 0;
end;
if RRR <> 0 Then
Begin
PRD := RD/RRR;
PRR := RR/RRR;
end else
Begin
PRD := 0;
PRR := 0;
end;
tulis(50,14,'Matriks Transisi M-Carlo');
for j := 16 to 18 do
begin
tulis(49,j,chr(179));
tulis(73,j,chr(179));
end;
gotoxy(52,16); write(PDD:4:2);
gotoxy(65,16); write(PDR:4:2);
gotoxy(52,18); write(PRD:4:2);
gotoxy(65,18); write(PRR:4:2);
UN := ((2*count[1]*count[2])/(count[1]+count[2]))+1;
TU1 := (2*count[1]*count[2]);
TU1 := TU1*(TU1-count[1]-count[2]);
if TU1 = 0 then
begin
Z := 0;
end else
begin
TU2 := count[1] + count[2];
TU3 := count[1] + count[2] -1;
TU := sqrt(TU1/(TU2*TU2*TU3));
if TU = 0 then
Z := 0
else
Z := (rum - UN) /TU;
end;
SDD := sqrt(((1-POO)*POO)/Hari);
SDR := sqrt(((1-PII)*PII)/hari);
ZD1 := PDD + (1.96 * SDD);
ZD2 := PDD - (1.96 * SDD);
ZR1 := PRR + (1.96 * SDR);
ZR2 := PRR - (1.96 * SDR);
if (POO <= ZD1) and (POO >= ZD2) then
if (PII <= ZR1) and (PII >= ZR2) then
if Z <= 2.33 then
begin
ulang := 0;
end else
ulang := 1;
if ulang = 0 then
begin
tulis(48,21,'Alternatif Lain Dari Pola');
repeat
tulis(48,22,'Cuaca [Y/T] : ');
gotoxy(62,22); readln(Jw);
until (Upcase(Jw) = 'Y') or (upcase(jw) = 'T');
if upcase(jw) = 'T' then
begin
ulang := 0;
end else
begin
ulang := 1;
pola := pola + 1;
end;
end;
until ulang = 0;
end;
{ Markov }
Procedure Markov;
var POO, POI, PIO, PII : real;
OO, OI, IO, II, BGO, BHO : integer;
MTahun, I : integer;
Mkeadaan, Bulan : string;
jawab : char;
begin
clrscr;
kotak(3,1,77,23);
tulis(30,3,'Analisa Markov');
tulis(5,5,'Poo = Probabilitas Dari Keadaan Kering Ke Kering');
tulis(5,6,'Po1 = Probabilitas Dari Keadaan Kering Ke Hujan');
tulis(5,7,'P1o = Probabilitas Dari Keadaan Hujan Ke Kering');
tulis(5,8,'P11 = Probabilitas Dari Keadaan Hujan Ke Hujan');
OO := 0; OI := 0; IO := 0; II := 0;
reset(fhujan);
read(fhujan,rhujan);
while not eof (fhujan) do
begin
Mtahun := rhujan.tahun;
while (Mtahun = rhujan.tahun) and (not eof (fhujan)) do
begin
Mkeadaan := rhujan.Keadaan;
read(fhujan, rhujan);
if mtahun = rhujan.tahun then
begin
if (Mkeadaan = 'Kering') and (rhujan.keadaan = 'Kering') then
OO := OO + 1;
if (Mkeadaan = 'Kering') and (rhujan.keadaan = 'Hujan') then
OI := OI + 1;
if (Mkeadaan = 'Hujan') and (rhujan.keadaan = 'Kering') then
IO := IO + 1;
if (Mkeadaan = 'Hujan') and (rhujan.keadaan = 'Hujan') then
II := II + 1;
end;
end;
end;
close(fhujan);
bulan := rhujan.bulan;
BGO := OO + OI;
BHO := IO + II;
if BGO = 0 then
begin
POO := 0;
POI := 0;
end else
begin
POO := OO / BGO;
POI := OI / BGO;
end;
if BHO = 0 then
begin
PIO := 0;
PII := 0;
end else
begin
PIO := IO / BHO;
PII := II / BHO;
end;
for i := 11 to 13 do
begin
tulis(14,i,chr(179));
tulis(27,i,chr(179));
tulis(33,i,chr(179));
tulis(58,i,chr(179));
end;
tulis(8,12,'MPT =');
tulis(16,11,'POO');
tulis(23,11,'PO1');
tulis(16,13,'P1O');
tulis(23,13,'P11');
gotoxy(35,11); write(POO:7:5);
gotoxy(50,11); write(POI:7:5);
gotoxy(35,13); write(PIO:7:5);
gotoxy(50,13); write(PII:7:5);
Mtahun := rhujan.tahun + 1;
tulis(23,15,'Matriks Transisi Pada Tahun ');
write(Mtahun);
gotoxy(5,20);
garis(chr(205),71);
repeat
tulis(5,22,'Ke Menu [M] atau M.Carlo [L] = ');
gotoxy(36,22); readln(jawab);
until (Upcase(jawab) = 'M') or (Upcase(jawab) = 'L');
if upcase(jawab) = 'L' then
Carlo(Mtahun,Bulan,POO,POi,PIO,PIi);
end;
{ Program Utama }
Begin
Assign(fhujan,'Data.Dat');
repeat
Menu;
Case Pil of
1 : isidata;
2 : cetakdata;
3 : markov;
end
until pil = 4;
clrscr;
write('Terima Kasih !');
readln;
end.
----------------------------------------------------------------
Compu-Mania MailingList is provided by PT Centrin Utama
Maintained by : [EMAIL PROTECTED]
To Post a msg : Send mail to [EMAIL PROTECTED]
To Unsubscribe : Mail to [EMAIL PROTECTED]
BODY : unsubscribe Compu-Mania
For more information, send mail to [EMAIL PROTECTED]
with "HELP" in the BODY of your mail (without quote).
----------------------------------------------------------------
