AMOS THE CREATOR
Retro bilgisayar
Bu ayki yazımızda son birkaç aydır devam ettiğimiz şekil tanıma programını noktalıyoruz. Programa son olarak menü komutlarını ilave ettim. Bu komutu daha önce hiç kullanmamıştık. Program listesinde de göreceğiniz gibi, kullanımı oldukça basit bir komut. MENU komutunu kullanarak, menüler hazırlanıyor. Daha sonra 'MENU ON' komutuyla bunlar kullanılabilir hale getiriliyor. Menülerin okunması ise, 'CHOICE' komutu ile yapılıyor. Daha ileriki programlarımızda, menüleri daha detaylı olarak göreceğiz. Şimdi sizlere, programın son halini veriyorum. Program üzerinde daha fazla değişiklik yapmayacağım. Artık gerisi size kalmış...
Rem ************************************** *
Rem Burak OZDEMIR 20 October 1991
Rem Name:Hopfield network
Rem Version:2
Rem ************************************** *
Rem
Set Buffer 30
INITSCRN
RemCLMNS=8
RWS=8
N_NODES=CLMNS*RWS
N_SMPLRS=3
UNKNOWN=N_SMPLRS
RESULT=N_SMPLRS+1
MXT=20
Rem
Dim SMPLR(N_SMPLRS+2,N_NODES)
Dim W_MATRIX(N_NODES,N_NODES)
Rem
RemGlobal SMPLR(),W_MATRIX()
Global CLMNS,RWS,N_NODES,N_SMPLRS,UNKNOWN,
RESULT, MXT, TST1, TST2/TST3
RemScreen Close 0
Screen Open 0,640,200,4,Hires
Cls(0)
Rem
MEN
Rem
Rem
DoCls(0)
TST1=Choice
Rem herhangi bir menunu seçildiği zaman -1 olurTST2=Choice(l) '
Rem seçilen menunun numarası
TST3=Choice(2)
Rem o menu'ye ait eleman numarası
If TST1=-1 Then FMEN
Loop
Rem
Rem
Procedure AD_NOISEPrint "Hata yüzdesini ver "
Input P
For I=0 To N_NODES-lT=Rnd(100)
If(T<P)SMPLR(UNKNOWN,I)=-SMPLR(UNKNOWN,I)
Print "Altered bit ",I
End If
Next I
Wait Key
End Proc
Rem
Rem
Procedure INP_UNKNOWNCls
Print "Bilinmeyen sekli gir "
INP_SAMPLE[UNKNOWN]
SHW_SMPLR[UNKNOWN]
End Proc
Rem
Rem
Procedure SV_SMPLRSCls
Print "Örnek numarasini ver
Input N
N=N-1
Print "Isim ?
Input NAMES
Open Out 1,NAMES
For I=0 To N_NODES-lPrint #1,SMPLR(N,I)
Next I
Close 1
End Proc
Rem
Rem
Procedure LD_SMPLRSClsPrint "Ornek numarasi "
Input N
N=N-1
Print "Isim ?
Input NAMES
Open In 1,NAMES
For I=0 To N_NODES-lInput #1,SMPLR(N,I)
Next IClose 1
End Proc
Rem
Rem
Procedure LD_UNKNOWN.Cls
Print "Isim ?
Input NAME$
Open In 1,NAME$
For I=0 To N_NODES-lInput #l,SMPLR(UNKNOWN,I)
Next I
Close 1
End Proc
Rem
Rem
Procedure SV_UNKNOWNCls
Print "Isim ?
Input NAME$
Open Out 1,NAME$
For I=0 To N_NODES-lPrint #1,SMPLR(N,I)
Next I
Close 1
End Proc
Rem
Rem
Procedure GT_SMPLRSCls
Print" Ornek numarasi Max ",N_SMPLRS
Input S
If((S>0) and(S<=N_SMPLRS))INP_SAMPLE[S-1]
ElseILLEGAL
End If
End Proc
Rem
Rem
Procedure INP_SAMPLE[S]Cls
Locate 0,22
Print "Ornek verilerini gir "
Reserve Zone 64
Ink 0
For 1=0 To 7For F=0 To 7
Set Zone I+8*F+1 ,I*20,F*20 To(I+1 )*20,(F+1 )*20
Box I*20,F*20To(I+l)*20,(F+l)*20
Next F
Next I
DoFlash Off
Curs Off
T=Zone(X Screen(X Mouse),Y Screen(Y Mouse))
R=Int((T-l)/8)
C=T-8*R-1
If(Mouse Key>0 and T<>0) Then SETPIX[S,R,C]
If(Mouse Key>0 and T=0) Then Exit
Loop
End Proc
Rem
Rem
Procedure SETPIX[S,R,C]
If Mouse Key=l
Ink 2
iiDc
SMPLR(S,R*CLMNS+C)= 1
End If
If Mouse Key=2Ink 1SMPLR(S,R*CLMNS+C)=0
End If
X=X Screen(X Mouse)
Y=Y Screen(Y Mouse)
Paint X,Y,0
End Proc
Rem
Rem
Procedure PRT_SMPLRSCls
Print" Ornek numarasini ver Max ",N_SMPLRS
Input S
If((S>0) and(S<=N_SMPLRS))SHW_SMPLR[S-1]
ElseILLEGAL
End If
End Proc
Rem
Rem
Procedure SHW_SMPLR[S]Cls
Locate 0,22
Print "Ornek ",S+1
InkO
For I=0 To 7For F=0 To 7
Set Zone I+8*F+l,I*20,F*20To(I+l)*20,(F+l)*20
Box I*20,F*20To(I+l)*20,(F+l)*20
Next F
Next I
RemFor R=0 To 7For C=0 To 7PRTPIX[S,R,C]
Next C
NextR
Wait Key
End Proc
Rem
Rem
Procedure PRTPIX[S,R,C]
If SMPLR(S,R*CLMNS+C)=1 Then Ink 2
IfSMPLR(S,R*CLMNS+C)=0 Then Ink 1
X=C*20+10
Y=R*20+10
Paint X,Y,0
End Proc
Rem
Rem
Procedure SHWJJNKNOWNSHW_SMPLR[UNKNOWN]
End Proc
Rem
Rem
Procedure SET_WEIGHTSCls
COUNT=0
Print "Katsayilar hesaplaniyor"
For I=0 To N_NODES-l
For J=0 To N_NODES-l
W_MATRIX(I,J)=0
If(IoJ)
For S=0 To N_SMPLRS-l
W_MATR1X(U)=W_MATRIX(U>KSMPLR(S,I)*SMPLR(SJ))
Next S
End If
Inc COUNT
Next J
Next I
Print "Katsayi adedi ",COUNT
Wait Key
End Proc
Rem
Rem
Procedure PRT_WEIGHTSCls
Print "Katsayi matrisi"
For I=0 To N_NODES-l
Print
ForJ=0 To N_NODES-l
Print W_MATRIX(I,J)
Next J
Next I
Wait Key
End Proc
Rem
Rem
Procedure ITERATECls
ITERATIONS=0
Print" Hesaplaniyor"
Repeat
PrintSHW_SMPLR[UNKNOWN]
For N=0 To N_NODES-l
SIGMA[N]
TEMP=Param
NLFUNC[TEMP]
SMPLR(RESULT,N)=Param
Next N
Inc ITERATIONS
COMPARE
TEMP=Param
If(TEMP<>N_NODES)
SWP_RESULT
End If
Until(ITERATIONS>MXT)or(TEMP=N_NODES)
Print "Islem tamam! Iterasyon sayisi ",ITERATIONS
Wait Key
End Proc
Rem
Rem
Procedure SIGMA[N]SUM=0
For I=0 To N_NODES-l
SUM=SUM-KW_MATRIX(N,I)*SMPLR(UNKNOWN,I))
Next I
End Proc[SUM]
Rem
Rem
Procedure NLFUNQIN]If IN>=0Q=l
ElseQ=-i
End If
End Proc[Q]Rem
RemProcedure SWP_RESULTFor I=0 To N_NODES-l
SMPLR(UNKNOWN,I)=SMPLR(RESULT,I)
Next I
End Proc
Rem
Rem
Procedure COMPARETEST=0
For I=0 To N_NODES-l
If(SMPLR(UNKNOWN,I)=SMPLR(RESULT,I))
Inc TEST
End If
Next I
End Proc[TEST]
Rem
Rem
Procedure ILLEGALCls
Print "Hatali giriş, tekrar deneyin"
End Proc
Rem
Rem
Procedure INITSCRNScreen Close 0
Screen Open 0.640,200,4,Hires
Cls
Flash Off
End Proc
Rem
Rem
Procedure MENMenu$(l)="Quit "
Menu$(l.l)="Cik"
Menu$(2)="Sampler "
Menu$(2.1)="Gir"
Menu$(2.2)="Kayitla "
Menu$(2,3)="Yukle"
Menu$(2,4)="Goster"
Menu$(3)="Katsayilar "
Menu$(3,l)="Hesapla"
Menu$(3.2)="Yaz"
Menu$(4)="Bilinmeyen "
MenuS(4,l)="Gir"
MenuS(4,2)="Kayitla"
MenuS(4,3)="Yukle "
Menu$(4,4)="Goster"
Menu$(5 )="Gurultu
MenuS(5,l)="Ekle"
Menu$(6)="Bul "
Menu$(6,l)="Basla"
RemMenu On
End Proc
Procedure FMEN
If TST2=1 and TST3=l Then End
If TST2=2 and TST3=1 Then GT_SMPLRS
If TST2=2 and TST3=2 Then SV_SMPLRS
If TST2=2 and TST3=3 Then LD_SMPLRS
If TST2=2 and TST3=4 Then PRT_SMPLRS
If TST2=3 and TST3=l Then SET.WEIGHTS
If TST2=3 and TST3=2 Then PRT_WEIGHTS
If TST2=4 and TST3=1 Then INPJJNKNOWN
If TST2=4 and TST3=2 Then SV_UNKNOWN
If TST2=4 and TST3=3 Then LD_UNKNOWN
If TST2=4 and TST3=4 Then SHW_UNKNOWN
If TST2=5 and TST3=1 Then AD_NOISE
If TST2=6 and TST3=1 Then ITERATE
End Proc