バイオリズムのアルゴリズム

-VISUALBASICの簡単な使用法-

北海道札幌西陵高等学校　　瀬戸　知比呂

0.　数学Ａ、数学Ｂ、数学Ｃ程度のBASICのプログラムをVisualBasic6.0に直すとどうなるか、考えてみた。

1.　PRINT文

Private Sub Form_Load()
  　Visible = True		'フォームを見えるようにする
  　Print 5 * 12
  　Print Abs(-3)
  　Print Sqr(9)
  　Print Int(2.56)
End Sub

2.　INPUT文 

Private Sub Form_Load()
  　Visible = True
  　Dim A As Integer	'変数の定義
  　Dim B%, X%		'変数の定義
  　A = InputBox("数字を入れよ")
  　B = InputBox("数字を入れよ")
  　X = A
    If B > X Then X = B
  　Print X
End Sub

3.　繰り返し処理

Private Sub Form_Load()
    Visible = True
    Dim N%, R%, I%
    N = InputBox("自然数を入れよ")
    For I = 1 To N
         R = N - Int(N / I) * I
         If R <> 0 Then GoTo 繰り返し
         Print I
    繰り返し:		'ラベル名に漢字も使える
    Next I
End Sub

4.　エラトステネスのふるい

Option Explicit		'変数を前もって定義して使う
Private Sub Form_Load()
    Visible = True: AutoRedraw = True:Caption = "素数"	'再描画させる
    Dim P(400) As Integer, M As Integer
    Dim N%, 最大数%		'変数に漢字も使える
    P(1) = 1    最大数 = InputBox("自然数を入力せよ")
    For M = 2 To 最大数
        If P(M) = 1 Then GoTo 素数:
        If M * 2 > 最大数 Then GoTo 素数:
            For N = M * 2 To 最大数 Step M
                P(N) = 1
            Next N
        素数:
    Next M
    For N = 1 To 最大数
        If P(N) = 1 Then ForeColor = QBColor(0): Print Format(N, "##"),
        If P(N) <> 1 Then ForeColor = QBColor(12): Print Format(N, "##"),
        If N Mod 10 = 0 Then Print
    Next N
End Sub

5　いろいろな曲線

Private Sub Form_Load()
    Visible = True:Dim X#, Y#
    Scale (-10, 10)-(10, -10)
    Line (-10, 0)-(10, 0): Line (0, 10)-(0, -10)
    For X = -10 To 10 Step 0.01
        Y = -2 * X + 1
        PSet (X, Y)
    Next X
End Sub

6.　バイオリズム

＜N88BASICによるプログラム例＞

10 SCREEN 3:WIDTH 80,25:CONSOLE 0,24,1,1:CLS 3
20 LOCATE 20,19:INPUT "  ";SYY$,SM1,SD1
30 SY1=VAL(SYY$)
40 LOCATE 20,20:INPUT "  ";SYY$,SM2
50 SY2=VAL(SYY$)
60 COLOR 1:LOCATE 0,7:PRINT "BODY---"
70 COLOR 2:LOCATE 0,7:PRINT "MIND---"
80 COLOR 4:LOCATE 0,11:PRINT "INTE---"
90 COLOR 7:LOCATE 12,2:PRINT " 1 ";
100 FOR I=2 TO 7
110     LOCATE (I-1)*10+10,2:PRINT  USING"##";(I-1)*5
120 NEXT I
130 WINDOW (-6,-50)-(186,50):VIEW(91,24)-(603,296)
140 LINE(-3,-50)-(183,-50),2,B
150 LINE(-3,0)-(183,0),2
160 FOR I=2 TO 30
170     IF (I MOD 5)=0 THEN 200
180        LINE(-3+I*6,-2)-(-3+I*6,2),2
190        GOTO 210
200     LINE(-3+I*6,-50)-(-3+I*6,50),2
210 NEXT I
220 SD2=1:GOSUB *NISSU
230 SN=(SD MOD 23):KN=(SD MOD 28):SI=(SD MOD 33)
240 FOR IX=-1 TO 30 STEP .1
250     PSET(6*IX+3,-40*SIN((IX+SN)/23*6.28)),1
260     PSET(6*IX+3,-40*SIN((IX+KN)/28*6.28)),2
270     PSET(6*IX+3,-40*SIN((IX+SN)/33*6.28)),5
280 NEXT IX
290 LOCATE 20,21:INPUT"  (Y OR N)";Y$
300 IF Y$="Y" THEN 10
310 IF Y$<>"N" THEN BEEP:GOTO 290
320 CONSOLE 0,24,1,1:VIEW(0,0)-(639,399)
330 END
340 *NISSU
350   IF W1=1 THEN 370
360   DEF FNN(Y,M,D)=INT(365.25*Y)+INT(Y/400)-INT(Y/100)+INT(30.59*(M-2))+D+678912!
370   W1=1:WY1=SY1:WM1=SM1:WY2=SY2:WM2=SM2
380   IF  SM1=1 OR SM1=2 THEN WM1=SM1+I2:WY1=SY1-1
390   IF  SM2=1 OR SM2=2 THEN WM2=SM2+I2:WY2=SY2-1
400   SD=FNN(WY2,WM2,SD2)-FNN(WY1,WM1,SD1)
410 RETURN

＜Vsual Basic ソ−ス例＞

Option Explicit
Dim SY1 As Single, SM1 As Single, SD1 As Single
Dim SY2 As Single, SM2 As Single, SD2 As Single
Private Sub Form_Load()
    Visible = True: AutoRedraw = True
    Dim YES As String, SD As Long,I As Integer,Dim IX As Single
    Dim SN As Integer, KN As Integer, SI As Integer
    Do 
        Cls: Scale (-6, 50)-(186, -50): CurrentX = 0: CurrentY = 50
        SY1 = InputBox("生まれた西暦年"): SM1 = InputBox("生まれた月")
        SD1 = InputBox("生まれた日"):SY2 = InputBox("見たい西暦年")
        SM2 = InputBox("見たい月")
        Form1.ForeColor = QBColor(9): Print "BODY"
        Form1.ForeColor = QBColor(12): Print "MIND"
        Form1.ForeColor = QBColor(10): Print "INTE"
        Form1.ForeColor = QBColor(0)
        Line (-3, 0)-(183, 0)
        For I = 1 To 30
            If (I Mod 5) = 0 Then
                Line (-3 + I * 6, -50)-(-3 + I * 6, 50)
            Else
                Line (-3 + I * 6, -2)-(-3 + I * 6, 2)
            End If
        Next I
        SD2 = 1
        NISSU SD
        SN = (SD Mod 23): KN = (SD Mod 28): SI = (SD Mod 33)
        Debug.Print SD, SN, KN, SI
        For IX = -1 To 30 Step 0.1
            PSet (6 * IX + 3, 40 * Sin((IX + SN) / 23 * 6.28)), QBColor(9)
            PSet (6 * IX + 3, 40 * Sin((IX + KN) / 28 * 6.28)), QBColor(12)
            PSet (6 * IX + 3, 40 * Sin((IX + SI) / 33 * 6.28)), QBColor(10)
            Debug.Print IX,
        Next IX
        YES = InputBox("もう一度 (Y/N)")
        If LCase(YES) <> "y" Then Exit Do
    Loop
End Sub

Sub NISSU(SD As Long)
    Dim WY1 As Long, WM1 As Long, WY2 As Long, WM2 As Long
    WY1 = SY1: WM1 = SM1: WY2 = SY2: WM2 = SM2
    If SM1 = 1 Or SM1 = 2 Then WM1 = SM1 + 12: WY1 = SY1 - 1
    If SM2 = 1 Or SM2 = 2 Then WM2 = SM2 + 12: WY2 = SY2 - 1
    SD = TWODATES(WY2, WM2, SD2) - TWODATES(WY1, WM1, SD1)
End Sub
Function TWODATES(Y As Long, M As Long, D As Single) As Long
    TWODATES = Int(365.25 * Y) + Int(Y / 400) - Int(Y / 100) + Int(30.59 * (M - 2))
 + D
End Function


＜参考図書＞