!' ステガノグラフィー
OPTION CHARACTER BYTE
DECLARE EXTERNAL FUNCTION GETDATA
PUBLIC NUMERIC XSIZE,YSIZE,ADR
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
LET KEY$="Steganography" !'判別文字列
LET ADR=0
LET D$=""
FOR I=1 TO LEN(KEY$)
LET D$=D$&CHR$(GETDATA)
NEXT I
IF D$<>KEY$ THEN
PRINT "任意ファイルを画像に埋め込みます"
PRINT XSIZE*YSIZE-(LEN(KEY$)+5+255);"Byteまで"
FILE GETNAME F$,"埋め込みファイル|*.*"
IF F$="" THEN STOP
FILE SPLITNAME (F$) PATH$, NAME$, EXT$
LET NAME$=NAME$&EXT$
PRINT "埋め込みファイル:";NAME$
OPEN #1:NAME F$
ASK #1 : FILESIZE FSIZE
PRINT "ファイルサイズ:";FSIZE;"Byte"
IF XSIZE*YSIZE-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
PRINT "ファイルが大き過ぎます。"
CLOSE #1
STOP
END IF
LET ADR=0
FOR I=1 TO LEN(KEY$)
CALL PUTDATA(ORD(KEY$(I:I)))
NEXT I
LET NAMESIZE=LEN(NAME$)
CALL PUTDATA(NAMESIZE)
FOR I=1 TO NAMESIZE
CALL PUTDATA(ORD(NAME$(I:I)))
NEXT I
LET FSIZE$=MKL$(FSIZE)
FOR I=1 TO 4
CALL PUTDATA(ORD(FSIZE$(I:I)))
NEXT I
FOR I=1 TO FSIZE
CHARACTER INPUT #1 : A$
CALL PUTDATA(ORD(A$))
NEXT I
CLOSE #1
FILE GETSAVENAME F$,"保存BMP,PNGファイル|*.BMP;*.PNG"
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$&".png"
GSAVE F$
ELSE
LET ADR=LEN(KEY$)
PRINT "画像からファイルを抽出します"
LET NAMESIZE=GETDATA
LET FILENAME$=""
FOR I=1 TO NAMESIZE
LET FILENAME$=FILENAME$&CHR$(GETDATA)
NEXT I
PRINT "抽出ファイル名:";FILENAME$
LET S$=""
FOR I=1 TO 4
LET S$=S$&CHR$(GETDATA)
NEXT I
LET FSIZE=CVL(S$)
PRINT "ファイルサイズ:";FSIZE
FILE GETSAVENAME F$,"抽出ファイル|*.*"
IF F$="" THEN STOP
OPEN #1:NAME F$
ERASE #1
FOR I=1 TO FSIZE
PRINT #1:CHR$(GETDATA);
NEXT I
CLOSE #1
END IF
END
EXTERNAL SUB PUTDATA(N)
LET XX=MOD(ADR,XSIZE)
LET YY=INT(ADR/XSIZE)
LET ADR=ADR+1
CALL GETPOINT(XX,YY,R,G,B)
LET R=BITAND(R,BVAL("11111000",2))
LET R=BITOR(R,BITAND(N,BVAL("11100000",2))/32)
LET G=BITAND(G,BVAL("11111000",2))
LET G=BITOR(G,BITAND(N,BVAL("00011100",2))/4)
LET B=BITAND(B,BVAL("11111100",2))
LET B=BITOR(B,BITAND(N,BVAL("00000011",2)))
CALL PSET(XX,YY,R,G,B)
END SUB
EXTERNAL FUNCTION GETDATA
LET XX=MOD(ADR,XSIZE)
LET YY=INT(ADR/XSIZE)
LET ADR=ADR+1
CALL GETPOINT(XX,YY,R,G,B)
LET GETDATA=BITAND(R,7)*32+BITAND(G,7)*4+BITAND(B,3)
END FUNCTION
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
DECLARE FUNCTION GETDATA
OPTION CHARACTER BYTE
OPTION BASE 0
INPUT PROMPT "符号化(1) or 復元(2) ":SW
FILE GETNAME F$,"BMPファイル|*.bmp"
IF F$="" THEN STOP
DIM A$(54)
OPEN #1:NAME F$
FOR I=1 TO 54
CHARACTER INPUT #1:A$(I)
NEXT I
LET BFTYPE$=A$(1)&A$(2)
LET BFSIZE=CVL(A$(3)&A$(4)&A$(5)&A$(6))
LET RESERVED=CVI(A$(7)&A$(8))
LET RESERVED2=CVI(A$(9)&A$(10))
LET OFFSET=CVL(A$(11)&A$(12)&A$(13)&A$(14))
LET HEADERSIZE=CVL(A$(15)&A$(16)&A$(17)&A$(18))
LET XSIZE=CVL(A$(19)&A$(20)&A$(21)&A$(22))
LET YSIZE=CVL(A$(23)&A$(24)&A$(25)&A$(26))
LET PLANE=CVI(A$(27)&A$(28))
LET BITCOLOR=CVI(A$(29)&A$(30))
LET COMPRESS=CVL(A$(31)&A$(32)&A$(33)&A$(34))
IF BFTYPE$<>"BM" AND PLANE<>1 THEN
PRINT "BMPファイルではありません"
CLOSE #1
STOP
END IF
IF HEADERSIZE<>40 AND COMPRESS<>0 AND BITCOLOR<>24 THEN
PRINT "対応していません"
CLOSE #1
STOP
END IF
LET BW=INT((3*XSIZE+3)/4)*4
DIM R$(YSIZE),G$(YSIZE),B$(YSIZE),COL$(BW),V(10)
INPUT PROMPT "判別キー=":KEY$
PRINT "BMPファイル読み込み中..."
FOR Y=YSIZE-1 TO 0 STEP -1
LET S=INT((YSIZE-1-Y)/(YSIZE-1)*100)
IF MOD(S,10)=0 AND V(INT(S/10))=0 THEN
PRINT S;"%"
LET V(INT(S/10))=1
END IF
FOR I=0 TO BW-1
CHARACTER INPUT #1:COL$(I)
NEXT I
FOR X=0 TO XSIZE-1
LET R$(Y)=R$(Y)&COL$(3*X+2)
LET G$(Y)=G$(Y)&COL$(3*X+1)
LET B$(Y)=B$(Y)&COL$(3*X)
NEXT X
NEXT Y
CLOSE #1
LET ADR=0
SELECT CASE SW
CASE 2
LET D$=""
FOR I=1 TO LEN(KEY$)
LET D$=D$&CHR$(GETDATA)
NEXT I
IF KEY$<>D$ THEN
PRINT "判別キーが一致しません"
STOP
END IF
PRINT "画像からファイルを抽出します"
LET NAMESIZE=GETDATA
LET FILENAME$=""
FOR I=1 TO NAMESIZE
LET FILENAME$=FILENAME$&CHR$(GETDATA)
NEXT I
PRINT "抽出ファイル名:";FILENAME$
LET S$=""
FOR I=1 TO 4
LET S$=S$&CHR$(GETDATA)
NEXT I
LET FSIZE=CVL(S$)
PRINT "ファイルサイズ:";FSIZE
FILE GETSAVENAME F$,"抽出ファイル|*.*"
IF F$="" THEN STOP
OPEN #1:NAME F$
ERASE #1
FOR I=1 TO FSIZE
PRINT #1:CHR$(GETDATA);
NEXT I
CLOSE #1
CASE 1
PRINT "任意ファイルを画像ファイルに埋め込みます"
PRINT XSIZE*YSIZE-(LEN(KEY$)+5+255);"Byteまで"
FILE GETOPENNAME F$,"埋込ファイル|*.*"
IF F$="" THEN STOP
FILE SPLITNAME (F$) PATH$, NAME$, EXT$
LET NAME$=NAME$&EXT$
PRINT "埋め込みファイル:";NAME$
OPEN #1:NAME F$
ASK #1 : FILESIZE FSIZE
PRINT "ファイルサイズ:";FSIZE;"Byte"
IF XSIZE*YSIZE-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
PRINT "ファイルが大きすぎます"
CLOSE #1
STOP
END IF
PRINT "処理中..."
LET ADR=0
FOR I=1 TO LEN(KEY$)
CALL PUTDATA(ORD(KEY$(I:I)))
NEXT I
LET NAMESIZE=LEN(NAME$)
CALL PUTDATA(NAMESIZE)
FOR I=1 TO NAMESIZE
CALL PUTDATA(ORD(NAME$(I:I)))
NEXT I
LET FSIZE$=MKL$(FSIZE)
FOR I=1 TO 4
CALL PUTDATA(ORD(FSIZE$(I:I)))
NEXT I
FOR I=1 TO FSIZE
CHARACTER INPUT #1 : P$
CALL PUTDATA(ORD(P$))
NEXT I
CLOSE #1
PRINT"BMPファイルに保存します"
FILE GETSAVENAME F$,"保存BMPファイル|*.bmp"
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$&".bmp"
LET BFTYPE$="BM"
LET OFFSET=54
LET HEADERSIZE=40
LET PLANE=1
LET BITCOLOR=24
LET BW=INT((3*XSIZE+3)/4)*4
LET BFSIZE=BW*YSIZE+OFFSET
OPEN #1:NAME F$
PRINT #1:BFTYPE$;
PRINT #1:MKL$(BFSIZE);
PRINT #1:MKI$(0);
PRINT #1:MKI$(0);
PRINT #1:MKL$(OFFSET);
PRINT #1:MKL$(HEADERSIZE);
PRINT #1:MKL$(XSIZE);
PRINT #1:MKL$(YSIZE);
PRINT #1:MKI$(PLANE);
PRINT #1:MKI$(BITCOLOR);
PRINT #1:REPEAT$(CHR$(0),24);
FOR Y=YSIZE-1 TO 0 STEP -1
FOR X=0 TO XSIZE-1
LET C$=C$&B$(Y)(X+1:X+1)&G$(Y)(X+1:X+1)&R$(Y)(X+1:X+1)
NEXT X
LET C$=LEFT$(C$&REPEAT$(CHR$(0),4),BW)
PRINT #1:C$;
LET C$=""
NEXT Y
CLOSE #1
CASE ELSE
END SELECT
FUNCTION GETDATA
LET X=MOD(ADR,XSIZE)
LET Y=INT(ADR/XSIZE)
LET ADR=ADR+1
LET R=ORD(R$(Y)(X+1:X+1))
LET G=ORD(G$(Y)(X+1:X+1))
LET B=ORD(B$(Y)(X+1:X+1))
LET GETDATA=BITAND(R,7)*32+BITAND(G,7)*4+BITAND(B,3)
END FUNCTION
SUB PUTDATA(N)
LET X=MOD(ADR,XSIZE)
LET Y=INT(ADR/XSIZE)
LET ADR=ADR+1
LET R=ORD(R$(Y)(X+1:X+1))
LET G=ORD(G$(Y)(X+1:X+1))
LET B=ORD(B$(Y)(X+1:X+1))
LET R=BITAND(R,BVAL("11111000",2))
LET R=BITOR(R,BITAND(N,BVAL("11100000",2))/32)
LET G=BITAND(G,BVAL("11111000",2))
LET G=BITOR(G,BITAND(N,BVAL("00011100",2))/4)
LET B=BITAND(B,BVAL("11111100",2))
LET B=BITOR(B,BITAND(N,BVAL("00000011",2)))
LET R$(Y)(X+1:X+1)=CHR$(R)
LET G$(Y)(X+1:X+1)=CHR$(G)
LET B$(Y)(X+1:X+1)=CHR$(B)
END SUB
END
EXTERNAL FUNCTION CVI(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,2)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION
EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION
EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
DECLARE FUNCTION GETDATA
OPTION CHARACTER BYTE
DIM A$(30)
FILE GETOPENNAME F$,"WAVファイル|*.wav"
IF F$="" THEN STOP
OPEN #1:NAME F$
FOR I=1 TO 12
CHARACTER INPUT #1:A$(I)
NEXT I
IF A$(1)&A$(2)&A$(3)&A$(4)<>"RIFF" THEN
PRINT "WAVファイルではありません"
CLOSE #1
STOP
END IF
LET WAVEFILESIZE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
IF A$(9)&A$(10)&A$(11)&A$(12)<>"WAVE" THEN
PRINT "WAVファイルではありません"
CLOSE #1
STOP
END IF
DO
FOR I=1 TO 4
CHARACTER INPUT #1:A$(I)
NEXT I
SELECT CASE A$(1)&A$(2)&A$(3)&A$(4)
CASE "fmt "
FOR I=1 TO 4
CHARACTER INPUT #1:A$(I)
NEXT I
LET HEADERSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
FOR I=1 TO HEADERSIZE
CHARACTER INPUT #1:A$(I)
NEXT I
LET WAVETYPE=CVI(A$(1)&A$(2))
IF WAVETYPE<>1 THEN
PRINT "対応していません"
CLOSE #1
STOP
END IF
LET CHANNEL=CVI(A$(3)&A$(4))
IF CHANNEL<>2 THEN
PRINT "ステレオではありません"
CLOSE #1
STOP
END IF
LET SAMPLINGFREQ=CVL(A$(5)&A$(6)&A$(7)&A$(8))
LET DATARATE=CVL(A$(9)&A$(10)&A$(11)&A$(12))
LET SAMPLESIZE=CVI(A$(13)&A$(14))
LET SAMPLEBIT=CVI(A$(15)&A$(16))
IF SAMPLEBIT<>16 THEN
PRINT "16bit PCMではありません"
CLOSE #1
STOP
END IF
CASE "data"
FOR I=1 TO 4
CHARACTER INPUT #1:A$(I)
NEXT I
LET PCMSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
LET SECOND=PCMSIZE/DATARATE
EXIT DO
CASE "fact"
FOR I=1 TO 8
CHARACTER INPUT #1:A$(I)
NEXT I
!'LET SIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
!'LET PCMSIZE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
CASE ELSE
PRINT "対応していません"
CLOSE #1
STOP
END SELECT
LOOP
PRINT "サンプリング周波数";SAMPLINGFREQ;"Hz"
PRINT "演奏時間";SECOND;"秒"
LET NUM=PCMSIZE/SAMPLESIZE
LET HEADERSIZE=16
LET SAMPLESIZE=SAMPLEBIT/8*CHANNEL
LET DATARATE = SAMPLESIZE * SAMPLINGFREQ
LET PCMSIZE=NUM*SAMPLESIZE
LET WAVEFILESIZE=PCMSIZE+36
INPUT PROMPT "符号化(1) or 復元(2) ":SW
INPUT PROMPT "判別キー=":KEY$
SELECT CASE SW
CASE 2
LET D$=""
FOR I=1 TO LEN(KEY$)
LET D$=D$&CHR$(GETDATA)
NEXT I
IF KEY$<>D$ THEN
PRINT "判別キーが一致しません"
STOP
END IF
PRINT "WAVファイルからファイルを抽出します"
LET NAMESIZE=GETDATA
LET FILENAME$=""
FOR I=1 TO NAMESIZE
LET FILENAME$=FILENAME$&CHR$(GETDATA)
NEXT I
PRINT "抽出ファイル名:";FILENAME$
LET S$=""
FOR I=1 TO 4
LET S$=S$&CHR$(GETDATA)
NEXT I
LET FSIZE=CVL(S$)
PRINT "ファイルサイズ:";FSIZE
FILE GETSAVENAME F$,"抽出ファイル|*.*"
IF F$="" THEN STOP
OPEN #2:NAME F$
ERASE #2
FOR I=1 TO FSIZE
PRINT #2:CHR$(GETDATA);
NEXT I
CLOSE #2
CLOSE #1
CASE 1
PRINT "任意ファイルをWAVファイルに埋め込みます"
PRINT SAMPLINGFREQ*SECOND-(LEN(KEY$)+5+255);"Byteまで"
FILE GETNAME F$,"埋め込みファイル|*.*"
IF F$="" THEN STOP
FILE SPLITNAME (F$) PATH$, NAME$, EXT$
LET NAME$=NAME$&EXT$
PRINT "埋め込みファイル:";NAME$
OPEN #2:NAME F$
ASK #2 : FILESIZE FSIZE
PRINT "ファイルサイズ:";FSIZE;"Byte"
IF SAMPLINGFREQ*SECOND-(LEN(KEY$)+LEN(NAME$)+5)<FSIZE THEN
PRINT "ファイルが大き過ぎます。"
CLOSE #2
CLOSE #1
STOP
END IF
FILE GETSAVENAME F$,"保存WAVファイル|*.wav"
IF F$="" THEN STOP
IF POS(F$,".")=0 THEN LET F$=F$&".wav"
OPEN #3:NAME F$
PRINT #3:"RIFF";
PRINT #3:MKL$(WAVEFILESIZE);
PRINT #3:"WAVEfmt ";
PRINT #3:MKL$(HEADERSIZE);
PRINT #3:MKI$(WAVETYPE);
PRINT #3:MKI$(CHANNEL);
PRINT #3:MKL$(SAMPLINGFREQ);
PRINT #3:MKL$(DATARATE);
PRINT #3:MKI$(SAMPLESIZE);
PRINT #3:MKI$(SAMPLEBIT);
PRINT #3:"data";
PRINT #3:MKL$(PCMSIZE);
FOR I=1 TO LEN(KEY$)
CALL PUTDATA(ORD(KEY$(I:I)))
NEXT I
LET NAMESIZE=LEN(NAME$)
CALL PUTDATA(NAMESIZE)
FOR I=1 TO NAMESIZE
CALL PUTDATA(ORD(NAME$(I:I)))
NEXT I
LET FSIZE$=MKL$(FSIZE)
FOR I=1 TO 4
CALL PUTDATA(ORD(FSIZE$(I:I)))
NEXT I
FOR I=1 TO FSIZE
CHARACTER INPUT #2 : P$
CALL PUTDATA(ORD(P$))
NEXT I
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO : P$
PRINT #3:P$;
LOOP
CLOSE #1
CLOSE #2
CLOSE #3
CASE ELSE
END SELECT
FUNCTION GETDATA
CHARACTER INPUT #1:Z$
LET L$=Z$
CHARACTER INPUT #1:Z$
LET L$=L$&Z$
CHARACTER INPUT #1:Z$
LET R$=Z$
CHARACTER INPUT #1:Z$
LET R$=R$&Z$
LET L=CVI(L$)
LET R=CVI(R$)
LET GETDATA=BITAND(L,15)*16+BITAND(R,15)
END FUNCTION
SUB PUTDATA(N)
CHARACTER INPUT #1:Z$
LET L$=Z$
CHARACTER INPUT #1:Z$
LET L$=L$&Z$
CHARACTER INPUT #1:Z$
LET R$=Z$
CHARACTER INPUT #1:Z$
LET R$=R$&Z$
LET L=CVI(L$)
LET R=CVI(R$)
LET L=BITAND(R,BVAL("1111111111110000",2))
LET L=BITOR(L,BITAND(N,BVAL("11110000",2))/16)
LET R=BITAND(R,BVAL("1111111111110000",2))
LET R=BITOR(R,BITAND(N,BVAL("00001111",2)))
PRINT #3:MKI$(L);MKI$(R);
END SUB
END
EXTERNAL FUNCTION CVI(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION
EXTERNAL FUNCTION CVL(A$)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
EXTERNAL FUNCTION MKI$(X)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
LET A=INT(X)
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION
EXTERNAL FUNCTION MKL$(X)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
LET A=INT(X)
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
OPTION CHARACTER BYTE
INPUT PROMPT "ファイル合体(1) or ファイル取出(2) ":SW
SELECT CASE SW
CASE 1
FILE GETOPENNAME F$,"ダミーファイル|*.*"
IF F$="" THEN STOP
FILE GETOPENNAME G$,"隠蔽ファイル|*.*"
IF G$="" THEN STOP
FILE GETSAVENAME N$,"保存ファイル|*.*"
IF N$="" THEN STOP
OPEN #1:NAME F$
OPEN #2:NAME G$
OPEN #3:NAME N$
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO:A$
PRINT #3:A$;
LOOP
DO
CHARACTER INPUT #2,IF MISSING THEN EXIT DO:A$
PRINT #3:A$;
LOOP
CLOSE #1
CLOSE #2
CLOSE #3
CASE 2
FILE GETOPENNAME F$,"分離ファイル|*.*"
IF F$="" THEN STOP
FILE GETSAVENAME N$,"保存ファイル|*.*"
IF N$="" THEN STOP
INPUT PROMPT "空読みサイズ(Byte)=":SIZE
OPEN #1:NAME F$
OPEN #2:NAME N$
FOR I=1 TO SIZE
CHARACTER INPUT #1:A$
NEXT I
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO:A$
PRINT #2:A$;
LOOP
CLOSE #1
CLOSE #2
CASE ELSE
END SELECT
END
OPTION CHARACTER BYTE
FILE GETOPENNAME F$,"任意ファイル|*.*"
IF F$="" THEN STOP
INPUT PROMPT "暗号・復号キー":KEY$
FILE GETSAVENAME G$,"保存ファイル|*.*"
IF G$="" THEN STOP
IF POS(G$,".")=0 THEN LET G$=G$&".bin"
OPEN #1:NAME F$
OPEN #2:NAME G$
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO:A$
LET J=MOD(J,LEN(KEY$))+1
LET X$=CHR$(BITXOR(ORD(A$),ORD(KEY$(J:J))))
PRINT #2:X$;
LOOP
CLOSE #1
CLOSE #2
END
RANDOMIZE N ←パスワード文字と同時に引数も与える(0～4294967296)
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO:A$
J=INT(RND*LEN(KEY$))+1 ←ここを変更
LET X$=CHR$(BITXOR(ORD(A$),ORD(KEY$(J:J))))
PRINT #2:X$;
LOOP
更にパスワード文字を複数に拡張するなどの方法も考えられると思います。
LET A$="ABCDE" !'パスワード1
LET B$="VWXYZ" !'パスワード2
LET N$="BASIC" !'暗号化する文字
!'LET N$="UTHT\"
FOR I=1 TO LEN(N$)
LET N=ORD(N$(I:I))
LET A=ORD(A$(I:I))
LET B=ORD(B$(I:I))
PRINT CHR$(BITXOR(BITXOR(N,A),B));
NEXT I
END
OPTION CHARACTER BYTE
FILE GETOPENNAME F$,"任意ファイル|*.*"
IF F$="" THEN STOP
INPUT PROMPT "暗号・復号キー":KEY$
FILE GETSAVENAME G$,"保存ファイル|*.*"
IF G$="" THEN STOP
IF POS(G$,".")=0 THEN LET G$=G$&".bin"
OPEN #1:NAME F$
OPEN #2:NAME G$
RANDOMIZE 2469 !←パスワード文字と同時に引数も与える(0～4294967296)
DO
CHARACTER INPUT #1,IF MISSING THEN EXIT DO:A$
LET J=INT(RND*LEN(KEY$))+1
LET X$=CHR$(BITXOR(ORD(A$),ORD(KEY$(J:J))))
PRINT #2:X$;
LOOP
CLOSE #1
CLOSE #2
END
For-Next間のプログラムロジックの何処に誤りが有るのかを知りたいのですが、お分かりになる方居られましたらご教示お願い致します。
なお、For-Next間の下式
LET dsumrt= drt/Life(rt) !drtを寿命消耗時間[h]に換算
は誤っておりません。
LET Hangendo=8 !寿命半減則温度[deg]
LET Lifeyear=30 !95℃設計寿命[年]
LET b=LOG(2)/Hangendo
PRINT "巻線最高温度θmが95[℃]の設計寿命Y0[年]＝";Lifeyear
PRINT "期待寿命Yの計算は『";Hangendo;"℃半減則』を適用"
PRINT "技術報告の基本式 Y=Y0×EXP{-b(θm-95)}"
PRINT "上式の係数b＝";b
print
PRINT "[周囲温度変動条件]"
LET Ondoave=20
PRINT "年間平均温度θave[度]＝";Ondoave
LET Am=15
PRINT "年間変動温度振幅A[deg]＝";Am
LET Bm=5
PRINT "日間変動温度振幅B[deg]＝";Bm
print
LET wyear=2*PI/365/24
LET wday=2*PI/24
DEF Ondo(t)=Ondoave+Am*SIN(wyear*t)+Bm*SIN(wday*t)
DEF Life(t)=EXP(-b*(Ondo(t)+55+15-95)) !実使用時間を寿命消耗時間に換算する関数
LET Lifehour=Lifeyear*365*24 !設計寿命年数[年]を時間[h]に換算
LET sumrt=0
LET drt=1 !微分実時間[h]
FOR i=1 TO 50*365*24/drt
LET rt=i*drt !運転実時刻
LET dsumrt= drt/Life(rt) !drtを寿命消耗時間[h]に換算
LET sumrt=sumrt+dsumrt !累積
IF sumrt>Lifehour THEN !Lifetimeに達したらrtの進行を停止
LET rt=rt-drt
EXIT FOR
END IF
NEXT i
PRINT "[計算結果]"
PRINT "１）寿命到達まで使用可能な実年数[年]＝";rt/365/24
PRINT " 同上の時間数[h]＝";rt
!*** 等価周囲温度の計算 ****
LET ToukaOndo=LOG(Lifehour/rt)/b+95-55-15
PRINT "２）等価周囲温度[℃]＝";ToukaOndo
%BEGIN
!THIS IS A SELF-REPRODUCING PROGRAM
%ROUTINESPEC R
R
PRINT SYMBOL(39)
R
PRINT SYMBOL(39)
NEWLINE
%CAPTION %END~
%CAPTION %ENDOFPROGRAM~
%ROUTINE R
%PRINTTEXT '
%BEGIN
!THIS IS A SELF-REPRODUCING PROGRAM
%ROUTINESPEC R
R
PRINT SYMBOL(39)
R
PRINT SYMBOL(39)
NEWLINE
%CAPTION %END~
%CAPTION %ENDOFPROGRAM~
%ROUTINE R
%PRINTTEXT '
%END
%ENDOFPROGRAM
OPTION ARITHMETIC RATIONAL
LET k=0
LET x=3 !1≦z＜y＜x
DO
LET xx=x^2 !a+b
FOR y=2 TO x-1 !a+c
LET yy=y^2
LET t=xx-yy !b-c
IF INTSQR(t)^2=t THEN !平方数なら
FOR z=1 TO y-1 !b+c
LET zz=z^2
LET t=xx-zz !a-c
IF INTSQR(t)^2=t THEN
LET t=yy-zz !a-b
IF INTSQR(t)^2=t THEN
LET a=( xx+yy-zz)/2 !(x^2-z^2)+y^2＞0
LET b=( xx-yy+zz)/2 !(x^2-y^2)+z^2＞0
LET c=(-xx+yy+zz)/2 !※正負は不定である
IF c>0 AND a=INT(a) AND b=INT(b) AND c=INT(c) THEN !自然数なら
LET t=gcd(gcd(a,b),c)
IF INTSQR(t)^2=t THEN !最大公約数が平方因子を持つか
DIM S$((M+1)*(N+1)) !条件を満たす岸の状態
LET D=0
FOR X=0 TO M
FOR Y=0 TO N
IF X=0 OR X>=Y THEN !条件を満たす
LET D=D+1
LET S$(D)=REPEAT$("A",X)&REPEAT$("a",Y)
END IF
NEXT Y
NEXT X
PUBLIC NUMERIC C !解の数
LET C=0
DIM A(50) !手順（舟の乗せ方）
DIM B(0 TO 50) !こちらの岸の状態
LET B(0)=D
CALL try(1,A,B, M,N,K, D,S$)
IF C=0 THEN PRINT "解なし"
END
EXTERNAL SUB try(P,A(),B(), M,N,K, D,S$()) !バックトラック法で検索する
FOR i=1 TO D !舟に乗る
LET T=LEN(S$(i))
IF T>=1 AND T<=K THEN !k人乗りの舟 ※岸の部分集合
LET L$=S$(B(P-1)) !こちらの岸の状態
LET X=POS(L$,S$(i))
IF X>0 THEN
LET L$(X:X+T-1)="" !渡る
IF MOD(P,2)=1 AND L$="" THEN !すべて渡り終えたなら ※奇数回かつφなら
LET C=C+1
PRINT "No.";C
FOR J=1 TO P-1 !結果を表示する
PRINT STR$(J);": ";
IF MOD(J,2)=1 THEN
PRINT S$(B(J-1));"(";S$(A(J));")→"
ELSE
PRINT "←(";S$(A(J));")";S$(B(J-1))
END IF
NEXT J
PRINT STR$(P);": ";S$(i);"(";S$(i);")→"
PRINT
ELSE
CALL checkRule(L$,D,S$, id) !安全に渡れるなら
IF id>0 THEN
LET R$=S$(D) !向こう側の岸の状態 ※補集合 ~L、差 U-L
LET X=POS(R$,L$)
LET R$(X:X+LEN(L$)-1)=""
CALL checkRule(R$,D,S$, id) !安全に渡れるなら
IF id>0 THEN
FOR J=P-2 TO 0 STEP -2 !同じ状態に戻っていないか
IF id=B(J) THEN EXIT FOR
NEXT J
IF J<0 THEN
LET A(P)=i !記録する
LET B(P)=id
CALL try(P+1,A,B, M,N,K, D,S$) !次へ
!!!IF P<5 THEN CALL try(P+1,A,B, M,N,K, D,S$) !次へ
END IF
END IF
END IF
END IF
END IF
END IF
NEXT i
END SUB
EXTERNAL SUB checkRule(L$,D,S$(), id) !条件を満たすかどうか確認する
FOR id=1 TO D
IF L$=S$(id) THEN EXIT SUB !パターン番号を返す
NEXT id
LET id=-1 !NG
END SUB
OPTION ARITHMETIC RATIONAL
LET N=2015
FOR M=1 TO N
LET G=GCD(N-M+1,M)
IF MOD((N-M+1)/G,2)=0 THEN EXIT FOR
NEXT M
PRINT M
END
●C(n,m) mod p の計算
OPTION ARITHMETIC RATIONAL
LET N=2015
LET P=2
PRINT 1; !C(n,0)=1
DIM D(N) !約分された分子
FOR M=1 TO N !(n-m+1)/mをかける
LET D(M)=N-M+1
LET T=M !約分する
FOR J=1 TO M
LET G=GCD(D(J),T)
LET D(J)=D(J)/G
LET T=T/G
IF T=1 THEN EXIT FOR !分母が1になったなら
NEXT J
LET T=1
FOR J=1 TO M
LET T=MOD(T*D(J),P) !mod p
NEXT J
PRINT T;
NEXT M
PRINT
END
その２
LET N=2015
LET P=2
DIM C(0 TO N) !C(n,m)
FOR M=0 TO N !(1+x)^mの展開、パスカルの三角形のk段
LET C(M)=1
FOR J=M-1 TO 1 STEP -1
LET C(J)=MOD(C(J-1)+C(J),P) !mod p
NEXT J
NEXT M
MAT PRINT C;
END
DATA 1,2
DIM D(0 TO 1)
MAT READ D
LET P=0
FOR N=1 TO 20
PRINT STR$(N);":";
LET T=N !シミュレーション
DO WHILE T>0
PRINT D(P);
LET T=T-D(P)
LET P=P+1
IF P>1 THEN LET P=0
LOOP
PRINT
NEXT N
END
LET N=20
DIM R$(0 TO 2),Q$(0 TO 2)
DATA "","1","2" !?
DATA "12","12","21" !□
MAT READ R$
MAT READ Q$
LET X=MOD(N,3)
FOR K=1 TO INT(N/3)
PRINT Q$(X);
NEXT K
IF X>0 THEN PRINT R$(X) ELSE PRINT
END
SET TEXT FONT文で指定するフォント名を直接TTFファイルから読み出します。
TTFファイルから"name"タグを読み込み、シークして目標とする文字列(フォント名)を読み込みます。
但し、IDの種類がいくつもあり、またシステム(OS)がどのIDで認識しているのか不明であるため
プログラムでは、
LET PASS$="C:\WINDOWS\FONTS\" !'フォントフォルダ
LET FILTER$="*.TTF" !' TTFファイル
LET FONTDIR$=PASS$&FILTER$
LET N=FILES(FONTDIR$)
DIM FONTFILE$(N)
FILE LIST FONTDIR$,FONTFILE$
FOR I=1 TO N
!' PRINT "No.";I;"ファイル名:";FONTFILE$(I),"フォント名:";GETFONTNAME$(PASS$&FONTFILE$(I))
PRINT "DATA ";CHR$(34);GETFONTNAME$(PASS$&FONTFILE$(I));CHR$(34);" ! ";FONTFILE$(I)
NEXT I
END
EXTERNAL FUNCTION GETFONTNAME$(F$)
IF POS(UCASE$(F$),".TTF")=0 THEN
LET GETFONTNAME$=""
EXIT FUNCTION
END IF
OPTION CHARACTER BYTE
DIM A$(12)
WHEN EXCEPTION IN !'エラー処理
OPEN #1:NAME F$,ACCESS INPUT
FOR I=1 TO 12
CHARACTER INPUT #1:A$(I)
LET ADR=ADR+1
NEXT I
LET SFNTVER=CVI(A$(1)&A$(2))
LET NUMTABLES=CVL(A$(3)&A$(4)&A$(5)&A$(6))
LET SEARCHRANGE=CVI(A$(7)&A$(8))
LET ENTERYSELECTOR=CVI(A$(9)&A$(10))
LET RANGESHIFT=CVI(A$(11)&A$(12))
FOR I=1 TO NUMTABLES
LET TAG$=""
FOR J=1 TO 4
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LET TAG$=TAG$&S$
NEXT J
FOR J=1 TO 12
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
IF TAG$="name" THEN !' 'name'タグ
LET NAMEOFFSET=CVL(A$(5)&A$(6)&A$(7)&A$(8))
LET NAMELENGTH=CVL(A$(9)&A$(10)&A$(11)&A$(12))
EXIT FOR
END IF
NEXT I
DO
CHARACTER INPUT #1:S$ !'シーク
LET ADR=ADR+1
LOOP UNTIL ADR=NAMEOFFSET
FOR J=1 TO 6
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
LET FORMAT=CVI(A$(1)&A$(2))
LET COUNT=CVI(A$(3)&A$(4))
LET STRINGOFFSET=CVI(A$(5)&A$(6))
FOR I=1 TO COUNT
FOR J=1 TO 12
CHARACTER INPUT #1:A$(J)
LET ADR=ADR+1
NEXT J
LET PLATFORM_ID=CVI(A$(1)&A$(2))
LET SPECIFIC_ID=CVI(A$(3)&A$(4))
LET LANGUAGE_ID=CVI(A$(5)&A$(6))
LET NAME_ID=CVI(A$(7)&A$(8))
LET LENGTH=CVI(A$(9)&A$(10))
LET OFFSET=CVI(A$(11)&A$(12))
IF PLATFORM_ID=1 AND NAME_ID=1 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
ELSEIF PLATFORM_ID=1 AND NAME_ID=2 THEN
LET LENGTH2=LENGTH
LET OFFSET2=OFFSET
ELSEIF PLATFORM_ID=1 AND NAME_ID=4 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
LET LENGTH2=-1
LET OFFSET2=-1
EXIT FOR
END IF
IF LANGUAGE_ID=1033 AND SPECIFIC_ID=1 THEN
IF LENGTH1=0 AND PLATFORM_ID=3 AND NAME_ID=1 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
ELSEIF LENGTH2=0 AND PLATFORM_ID=3 AND NAME_ID=2 THEN
LET LENGTH2=LENGTH
LET OFFSET2=OFFSET
ELSEIF LENGTH2=0 AND PLATFORM_ID=3 AND NAME_ID=4 THEN
LET LENGTH1=LENGTH
LET OFFSET1=OFFSET
LET LENGTH2=-1
LET OFFSET2=-1
EXIT FOR
END IF
END IF
NEXT I
DO UNTIL ADR=NAMEOFFSET+STRINGOFFSET+OFFSET1
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LOOP
FOR J=1 TO LENGTH1 !'フォント名読み込み
CHARACTER INPUT #1:S$
LET ADR=ADR+1
IF S$<>CHR$(0) THEN LET F1$=F1$&S$
NEXT J
IF OFFSET2>0 THEN
DO UNTIL ADR=NAMEOFFSET+STRINGOFFSET+OFFSET2
CHARACTER INPUT #1:S$
LET ADR=ADR+1
LOOP
FOR J=1 TO LENGTH2 !'フォント名読み込み
CHARACTER INPUT #1:S$
LET ADR=ADR+1
IF S$<>CHR$(0) THEN LET F2$=F2$&S$
NEXT J
END IF
IF UCASE$(F2$)<>"REGULAR" AND F2$<>"" THEN !' "regular"は除外?
LET GETFONTNAME$=F1$&" "&F2$
ELSE
LET GETFONTNAME$=F1$
END IF
USE
LET GETFONTNAME$="(Error File)" !'リードエラー(読み出し失敗)
END WHEN
CLOSE #1
END FUNCTION
EXTERNAL FUNCTION CVI(A$) !'Big-Endian(2byte整数)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,2)
LET A=ORD(A$(2:2))+ORD(A$(1:1))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION
EXTERNAL FUNCTION CVL(A$) !'Big-Endian(4byte整数)
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(4:4))+ORD(A$(3:3))*256+ORD(A$(2:2))*256^2+ORD(A$(1:1))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION
読み出したDATA文は下記のプログラムとマージすると簡易フォントビューワになります。(0x00～0xFF)
前回表示と変化がない場合、読み出しに失敗している可能性があります。
(SET TEXT FONT文で存在しないフォント名を指定してもエラーにはならない)
OPTION CHARACTER BYTE
CALL GINIT(700,700)
LET SIZE=40
SET TEXT JUSTIFY "LEFT" , "TOP"
DO
SET TEXT COLOR 4
SET TEXT FONT "ＭＳ 明朝",SIZE*.7
FOR X=0 TO 15
PLOT TEXT ,AT 50+X*SIZE,0:RIGHT$("0"&BSTR$(X,16),2)
NEXT X
FOR Y=0 TO 15
PLOT TEXT ,AT 0,50+Y*SIZE:RIGHT$("0"&BSTR$(Y*16,16),2)
NEXT Y
FOR X=0 TO 16
CALL LINE(50+X*SIZE,50,50+X*SIZE,50+16*SIZE,6)
NEXT X
FOR Y=0 TO 16
CALL LINE(50,50+Y*SIZE,50+16*SIZE,50+Y*SIZE,6)
NEXT Y
READ IF MISSING THEN EXIT DO:FONTNAME$
PRINT FONTNAME$
SET TEXT FONT FONTNAME$,SIZE*.6
SET TEXT COLOR 7
FOR I=0 TO 15
FOR J=0 TO 15
PLOT TEXT ,AT 50+J*SIZE,50+I*SIZE :CHR$(I*16+J)
NEXT J
NEXT I
INPUT S$ !'一時停止
CLEAR
LOOP
!ここからDATA文を置く
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
SET TEXT JUSTIFY "LEFT","TOP"
CLEAR
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB
LET K=0 !k^3≦nを満たす最大の値
DO WHILE K^3<=N
LET K=K+1
LOOP
LET K=K-1
LET S=0
FOR B=K TO 0 STEP -1 !減少列
LET W=N-B^3
FOR A=B TO 0 STEP -1 !a^3≦b^3
LET T=A^3
IF T=W THEN !題意を満たす
LET S=S+1
IF S=1 THEN
LET AA=A !save it
LET BB=B
ELSEIF S=2 THEN
PRINT N; AA;BB
PRINT N; A;B
ELSE
PRINT N; A;B
END IF
EXIT FOR
ELSEIF T<W THEN !以降は可能性なし
EXIT FOR
END IF
NEXT A
IF B=A THEN EXIT FOR !以降は可能性なし
NEXT B
DATA 10, 5, 13, 11, 9, 3, 6, 1, 4, 7, 2, 8, 12
!DATA 8, 5, 12, 3, 11, 13, 6, 10, 1, 4, 7, 2, 9
DIM A(13)
MAT READ A
LET S=0 !既に並んでいるカードの枚数
LET P=1
DO
PRINT P
LET T=A(P) !p番目のカードの番号
IF T=P THEN
LET S=S+1
IF S=13 THEN EXIT DO !すべて昇順に並んだ
ELSE
LET A(P)=A(T) !既定位置へ移動させる
LET A(T)=T
MAT PRINT A; !進捗状況
END IF
DATA 43,46,49,52,55,58,61,64,67,70,73,76,79,82, 6914
LET S=0 !正答
FOR K=1 TO 14
READ A
LET S=S+A
NEXT K
READ W !誤答
PRINT (W-S)/99
END
別解 シミュレーション
DATA 43,46,49,52,55,58,61,64,67,70,73,76,79,82
DIM A(14)
MAT READ A
FOR K=1 TO 14-1 !忘れた位置
LET S=0 !和を求める
FOR J=1 TO 14
IF J=K THEN LET S=S+A(J)*100 ELSE LET S=S+A(J)
NEXT J
IF S=6914 THEN PRINT A(K) !題意を満たす
NEXT K
END
DATA 43,46,49,52,55,58,61,64,67,70,73,76,79,82, 3628
DIM A(14)
MAT READ A
READ W
LET S=0 !和を求める
FOR K=1 TO 14
LET S=S+A(K)
NEXT K
FOR K=1 TO 13
IF (A(K)-1)*(A(K+1)-1)=W-S+1 THEN PRINT A(K);A(K+1)
NEXT K
END
OPTION ARITHMETIC RATIONAL
DECLARE EXTERNAL FUNCTION HANOI.H
FOR N=1 TO 50
PRINT N; H(N,4)
NEXT N
END
MODULE HANOI !n枚の板、k本の棒のハノイの塔をH(n,k)と表す
OPTION ARITHMETIC RATIONAL
SHARE NUMERIC F(1000,10)
MAT F=ZER
PUBLIC FUNCTION H
EXTERNAL FUNCTION H(N,K)
OPTION ARITHMETIC RATIONAL
IF F(N,K)>0 THEN !算出している場合
LET H=F(N,K) !restore it
ELSE
IF K=3 THEN !3本の場合、(2^n-1)回
IF N=1 THEN
LET T=1
ELSE
LET T=2*H(N-1,3)+1 !漸化式
END IF
ELSE !4本以上
IF N=1 THEN
LET T=1
ELSE
LET T=2*H(1,K)+H(N-1,K-1) !最小のもの
FOR M=2 TO N-1
LET W=2*H(M,K)+H(N-M,K-1) !m本はk-hanoi、(n-m)本は(k-1)-hanoi
IF W<T THEN LET T=W
NEXT M
END IF
END IF
LET H=T
LET F(N,K)=T !save it
END IF
END FUNCTION
END MODULE
READ K
DIM A(N)
FOR i=1 TO N
READ T
LET A(i)=D(T)
NEXT i
MAT PRINT USING REPEAT$(" ###",K): A
FOR P=1 TO N/K
LET T=0 !p番目の人の合計
FOR i=1 TO K
LET T=T+A((P-1)*K+i)
NEXT i
PRINT T
NEXT P
PRINT
CALL try(1,N,A,K,S/3) !移動を試みる
END
EXTERNAL SUB try(P,N,A(),K,S) !1つ移動させる
LET T=0 !p番目の人の合計
FOR i=1 TO K
LET T=T+A((P-1)*K+i)
NEXT i
PRINT T !debug
IF P=N/K THEN !最後の人なら
MAT PRINT USING REPEAT$(" ###",K): A
ELSE
FOR i=1 TO K !p番目の人のi番目のみかんを入れ替える
LET X=(P-1)*K+i
FOR J=P*K+1 TO N !(p+1)番目以降の人のみかんが対象である
IF T-A(X)+A(J)=S THEN !可能なら
PRINT P; X;J !debug
LET W=A(X) !swap it
LET A(X)=A(J)
LET A(J)=W
CALL try(P+1,N,A,K,S) !次の人へ
LET W=A(X) !元に戻す
LET A(X)=A(J)
LET A(J)=W
END IF
NEXT J
NEXT i
END IF
END SUB
OPTION ARITHMETIC COMPLEX !複素平面
LET N=3
SET WINDOW -1,N+1,-1,N+1
DRAW grid
LET Oo=COMPLEX(0,0) !三角形OAB
LET OA=COMPLEX(1,0)
LET OB=COMPLEX(0,1/N)
FOR K=1 TO N !n^2個
FOR i=0 TO K-1
DRAW triangle(Oo,OA,OB) WITH SHIFT(i,1-K/N)
NEXT i
NEXT K
DRAW triangle(Oo,OA,OB) WITH ROTATE(RAD(90))*SHIFT(0,0) !(+1)個
END
EXTERNAL PICTURE triangle(Oo,OA,OB) !三角形OABを描く
OPTION ARITHMETIC COMPLEX !複素平面
PLOT LINES: Oo; OA; OB; Oo
END PICTURE
DIM B(0 TO 2^10-1) !添え字がビットパターンとなる
LET B(0)=0
FOR K=0 TO 10-1 !ひとつずつ取り出す
READ D
LET Y=2^(K+1)-1 !部分和を求める
FOR X=2^K-1 TO 0 STEP -1
LET B(Y)=B(X)+D
LET B(Y-1)=B(X)
LET Y=Y-2
NEXT X
!!!MAT PRINT B; !debug
NEXT K
FOR i=0 TO 2^10-1 !答え（すべて）
IF B(i)=1000 THEN PRINT RIGHT$("000000000"&BSTR$(i,2),10)
NEXT i
LET S=0
FOR i=1 TO 10 !ひとつずつ取り出す
READ D
FOR P=MIN(S,1000) TO 1 STEP -1 !部分和を求める
IF A(P)>0 THEN
LET T=P+D
IF T<=1000 THEN LET A(T)=A(T)+A(P)
END IF
NEXT P
LET A(D)=A(D)+1
LET S=S+D
NEXT i
PRINT A(1000);"通り" !答え（場合の数）
END
実行結果
10 通り
その３ 動的計画法（Dynamic Programming）による
DATA 50,80,130,190,230,250,280,310,390,440
DIM A(1000)
MAT A=ZER
LET S=0
FOR i=1 TO 10 !ひとつずつ取り出す
READ D
FOR P=MIN(S,1000) TO 1 STEP -1 !部分和を求める
IF A(P)>0 THEN !リンクを形成する（上書きされる）
LET T=P+D
IF T<=1000 THEN LET A(T)=D
END IF
NEXT P
LET A(D)=D
LET S=S+D
NEXT i
LET T=1000 !答え（解の1つ）
DO WHILE T>0
PRINT A(T);
LET T=T-A(T) !リンクをたどる
LOOP
PRINT
DIM F(N) !添え字p、値eで、p^eを表す
FOR i=1 TO N !1,2,3,4,5,…
LET F(i)=i
NEXT i
FOR i=1 TO N !因子i
LET T=F(i)
LET F(i)=0 !個数
IF T>1 THEN
LET S=1
FOR K=2*i TO N STEP i !割っていく
LET S=S+1
LET F(K)=F(K)/T
NEXT K
LET F(T)=F(T)+S !累積する
END IF
NEXT i
MAT PRINT F;
DECLARE EXTERNAL FUNCTION CALC.F
LET N=30
PRINT F(N);"通り"
END
MODULE CALC !F(n)=F(n-1)+F(n-2)、F(0)=1、F(1)=2
SHARE NUMERIC D(0 TO 50)
MAT D=ZER
PUBLIC FUNCTION F
EXTERNAL FUNCTION F(N)
IF D(N)>0 THEN !計算済みなら
LET T=D(N)
ELSE
IF N=0 THEN
LET T=1 !φの1通り
ELSEIF N=1 THEN
LET T=2 !0,1の2通り
ELSE
LET T=F(N-1)+F(N-2) !0**,10*
END IF
END IF
LET F=T
LET D(N)=T
END FUNCTION
END MODULE
LET N=30
LET S=1 !女が0人
FOR K=1 TO (N+1)/2 !女がk人
LET S=S+COMB(N-K+1,K) !男を(n-k)人並べて、その間に並べる
NEXT K
PRINT S;"通り"
END
・並びの列挙
LET N=30
PUBLIC NUMERIC C !場合の数
LET C=0
DIM A(0 TO N) !※0番目は番兵
MAT A=ZER
CALL try(1,N,A)
PRINT C;"通り"
END
EXTERNAL SUB try(P,N,A()) !シミュレーション
IF P>N THEN
LET C=C+1
!!PRINT "No.";C !並びを表示する
!!MAT PRINT A;
ELSE
LET A(P)=0 !男
CALL try(P+1,N,A)
IF A(P-1)=0 THEN !1つ前が男なら
LET A(P)=1 !女
CALL try(P+1,N,A)
END IF
END IF
END SUB
LET N=4
DIM A(N) !並び
CALL try(1, N,A)
END
EXTERNAL SUB try(K, N,A())
IF K>N THEN
MAT PRINT A; !答え
ELSE
DIM B(N)
LET B(1)=K !kを1番目に挿入する
FOR i=1 TO K-1 !k,a[1],a[2],…,a[k-1] ※a[1..k-1]
LET B(i+1)=A(i)
NEXT i
CALL try(K+1, N,B) !次へ
FOR P=2 TO K !kをp番目に挿入する
LET T=B(P-1) !swap it
LET B(P-1)=B(P)
LET B(P)=T
CALL try(K+1, N,B) !次へ
NEXT P
END IF
END SUB
LET N=4
DIM A(N) !並び 1234…n
FOR i=1 TO N
LET A(i)=i
NEXT i
MAT PRINT A;
FOR i=1 TO FACT(N)-1 !場合の数
LET T=i
LET K=2
DO WHILE MOD(T,K)=0
LET T=T/K
LET K=K+1
LOOP
PRINT i;K !debug
CALL Reverse(A,1,K) !先頭のk個
MAT PRINT A;
NEXT i
END
EXTERNAL SUB reverse(A(),L,R) !指定された範囲の並びを逆順にする
LET i=L !左端
LET J=R !右端
DO WHILE i<J !交換位置は半分まで ※全部すると元に戻る
LET t=A(i) !swap it
LET A(i)=A(J)
LET A(J)=t
LET i=i+1 !次へ
LET J=J-1
LOOP
END SUB
DATA 524 !最大収納量
DATA 33 !個数
DATA 442 !重さ
DATA 252,252,252,252,252,252,252
DATA 127,127,127,127,127
DATA 106,106,106,106
DATA 85
DATA 84
DATA 46
DATA 37,37
DATA 12,12,12
DATA 10,10,10,10,10,10
DATA 9,9
READ M,N
DIM D(N)
MAT READ D
LET S=0 !全重量
FOR i=1 TO N
LET S=S+D(i)
NEXT i
PRINT S; S/M
FOR i=1 TO N-1 !大きい順に並べ替える
FOR J=i+1 TO N
IF D(i)<D(J) THEN
LET T=D(i) !swap it
LET D(i)=D(J)
LET D(J)=T
END IF
NEXT J
NEXT i
MAT PRINT D; !debug
DIM X(N) !収納した箱の番号
DIM B(10) !箱の総重量
MAT B=ZER
LET P=0 !詰めた箱の個数
FOR i=1 TO N !順番に箱詰めする
FOR K=1 TO P
IF B(K)+D(i)<=M THEN !収納する
LET X(i)=K
!!!PRINT i;K !debug
LET B(K)=B(K)+D(i) !累積
EXIT FOR
END IF
NEXT K
IF K>P THEN !新しい箱を用意する
LET P=P+1
LET X(i)=P
!!!PRINT i;P !debug
LET B(P)=D(i)
END IF
NEXT i
!!!MAT PRINT B; !debug
!!!MAT PRINT X; !debug
FOR i=1 TO P !内訳を表示する
PRINT STR$(i);":"; !箱番号
FOR K=1 TO N
IF X(K)=i THEN PRINT D(K); !収納した重さ
NEXT K
PRINT "=";B(i)
NEXT i
DATA 524 !最大収納量
DATA 33 !個数
DATA 442 !重さ
DATA 252,252,252,252,252,252,252
DATA 127,127,127,127,127
DATA 106,106,106,106
DATA 85
DATA 84
DATA 46
DATA 37,37
DATA 12,12,12
DATA 10,10,10,10,10,10
DATA 9,9
READ M,N
DIM D(N)
MAT READ D
LET S=0 !全重量
FOR i=1 TO N
LET S=S+D(i)
NEXT i
PRINT S; S/M
!FOR i=1 TO N-1 !大きい順に並べ替える
! FOR J=i+1 TO N
! IF D(i)<D(J) THEN
! LET T=D(i) !swap it
! LET D(i)=D(J)
! LET D(J)=T
! END IF
! NEXT J
!NEXT i
!!!MAT PRINT D; !debug
DIM X(N) !収納した箱の番号
DIM B(10) !箱の総重量
MAT B=M*CON
LET P=0 !詰めた箱の個数
FOR i=1 TO N !順番に箱詰めする
LET Q=P+1
FOR K=1 TO P !空きが最小のもの
IF B(K)>=D(i) AND B(K)<B(Q) THEN LET Q=K
NEXT K
IF Q>P THEN LET P=Q !新しい箱を用意する
LET X(i)=Q
!!!PRINT i;Q !debug
LET B(Q)=B(Q)-D(i) !残り
NEXT i
!!!MAT PRINT B; !debug
!!!MAT PRINT X; !debug
FOR i=1 TO P !内訳を表示する
PRINT STR$(i);":"; !箱番号
FOR K=1 TO N
IF X(K)=i THEN PRINT D(K); !収納した重さ
NEXT K
PRINT "=";M-B(i)
NEXT i
LET N=13
DIM A(N) !並び
PUBLIC NUMERIC F(100) !各数字の残った回数
MAT F=ZER(N)
CALL try(1, N,A)
MAT PRINT F;
END
EXTERNAL SUB try(K, N,A()) !全順列を生成する（辞書順ではない）
IF K>N THEN
!!!MAT PRINT A; !答え
CALL game(A,N)
ELSE
DIM B(N)
LET B(K)=K !kをk番目に挿入する
FOR i=1 TO K-1 !a[1],a[2],…,a[k-1],k ※a[1..k-1]
LET B(i)=A(i)
NEXT i
CALL try(K+1, N,B) !次へ
FOR P=K-1 TO 1 STEP -1 !kをp番目に挿入する
LET T=B(P) !swap it
LET B(P)=B(P+1)
LET B(P+1)=T
CALL try(K+1, N,B) !次へ
NEXT P
END IF
END SUB
EXTERNAL SUB game(A(),N) !ゲームを行う
LET R=0 !右端
LET i=1
DO WHILE i<=N !i枚目
LET T=A(i)
IF T=1 THEN !1の場合
LET F(T)=F(T)+1 !カウントする
LET R=1
LET i=i+1 !a[i+1]を捨てる
ELSE
IF R>T THEN !捨てる
ELSE !並べる
LET F(T)=F(T)+1 !カウントする
LET R=T
END IF
END IF
LET i=i+1
LOOP
END SUB
LET N=4
FOR K=1 TO N
LET S=0
FOR M=1 TO K !数字kをm番目に配置した場合
LET S=S+PERM(K-1,M-1)*FACT(N-M)
NEXT M
PRINT K; S; FACT(N)/(N+1-K)
NEXT K
END
シミュレーションの場合、以下の部分を差し替えてください。
EXTERNAL SUB game(A(),N) !ゲームを行う
LET R=0 !右端
LET i=1
DO WHILE i<=N !i枚目
LET T=A(i)
IF R>T THEN !捨てる
ELSE !並べる
LET F(T)=F(T)+1 !カウントする
LET R=T
END IF
LET i=i+1
LOOP
END SUB
OPTION ARITHMETIC RATIONAL
LET P=3 !素数
DIM F(0 TO P-1) !数字0から(p-1)
FOR N=1 TO 50
PRINT STR$(N);": ";
MAT F=ZER
FOR X=1 TO P
LET T=1 !1+Σ[r=1,n-1]C(n,r)x^r
FOR R=1 TO N-1
LET T=T+MOD(COMB(N,R),P)*MOD(X^R, P)
NEXT R
LET T=MOD(T,P)
PRINT T; !debug
IF F(T)=1 THEN EXIT FOR !既出なら
LET F(T)=1
NEXT X
IF X>P-1 THEN PRINT "←題意を満たす";
PRINT
NEXT N
END
OPTION ARITHMETIC RATIONAL
LET P=3 !素数
FOR N=1 TO 15
PRINT "N=";N
FOR M=1 TO P-1 !x^(k(p-1)+m)に対する
LET C=0
FOR R=M TO N-1 STEP P-1 !係数をまとめる
LET C=C+COMB(N,R)
NEXT R
PRINT "x^";STR$(M); C; MOD(C,P)
NEXT M
PRINT
NEXT N
END
DIM A(10),S(6)
DATA 1,5,11,13,17,29
MAT READ S
FOR N=10 TO 2 STEP -1 !逆からたどる
LET A(N)=2015 !条件3
CALL try(N-1,N,A,6,S)
NEXT N
END
EXTERNAL SUB try(P,N,A(),M,S())
FOR K=1 TO M !条件2
LET T=(A(P+1)-1)/S(K)-1
IF T>0 AND T=INT(T) THEN !これより、a[n]は正の整数
IF P=1 THEN
FOR i=1 TO M !条件1
IF T=S(i) THEN EXIT FOR
NEXT i
IF i<=M THEN !結果を表示する
PRINT STR$(T);
FOR J=2 TO N
LET T=T+A(J)
PRINT "+";STR$(A(J));
NEXT J
PRINT "=";STR$(T)
END IF
ELSE
LET A(P)=T
CALL try(P-1,N,A,M,S) !次へ
END IF
END IF
NEXT K
END SUB
OPTION ARITHMETIC RATIONAL !有理数
!DATA 3,2 !x^3=2
!DATA 1,1,-1 !1+x-x^2
!DATA 4,2 !x^4=2
!DATA 1,1,0,-1 !1+x-x^3
DATA 5,4 !x^5=4
DATA 1,-1,0,1,0 !1+x^3-x
!DATA 5,2 !x^5=2
!DATA 1,2,-1,0,0 !1+2x-x^2
!DATA 3,2 !x^3=2
!DATA 1,2,3 !1+2x+3x^2
READ K,P !x^k=p
DIM M(K,K) !連立方程式 tM=n
FOR J=1 TO K !1行目 Σc[r]x^r
READ M(1,J)
NEXT J
FOR i=2 TO K !2行目以降
LET M(i,1)=M(i-1,K)*P !1列目 x^k=pを適用する
FOR J=2 TO K !2列目以降 右へずらす
LET M(i,J)=M(i-1,J-1)
NEXT J
NEXT i
MAT PRINT M; !debug
DIM T(K,K) !連立方程式を解く
MAT T=INV(M)
MAT PRINT T; !連立方程式の右辺が(1,0,…,0)なので、解P,Q,Rは1行目
END
1/(1+√2-√3)=(2+√2+√6)/4 は2変数多項式になるので手強い。
略解
x=√2、y=√3とおく。
{1,x}×{1,y}={1,x,y,xy}を考える。
DATA 1,1,-1,0 !1倍 1+x-y
DATA 2,1,0,-1 !x倍 2+x-xy
DATA -3,0,1,1 !y倍 -3+y+xy
DATA 0,-3,2,1 !xy倍 -3x+2y+xy
DIM M(4,4)
MAT READ M
!!MAT PRINT M; !debug
DIM T(4,4)
MAT T=INV(M)
MAT PRINT T; !1行目 1,x,y,xyの係数
END
LET N=3 !n試合勝ち越し n≧2
LET K=4 !(n+k)勝k敗
SET WINDOW -1,N+K+1,-1,N+K+1
DRAW grid
SET LINE COLOR 4
PLOT LINES: 0,N; 0+50,N+50 !Aが勝ち越しで終わる
SET LINE COLOR 2
PLOT LINES: N,0; N+50,0+50 !Bが勝ち越しで終わる
SET LINE COLOR 1
DIM P(0 TO K) !点(x,y)を通過する場合の数
MAT P=ZER
FOR Y=0 TO (N+K)-1
FOR X=0 TO K
IF Y>X-N AND Y<X+N THEN !2直線の間なら
IF X=0 THEN !左端
LET P(X)=1
ELSE
LET P(X)=P(X)+P(X-1) !累計
END IF
DRAW disk WITH SCALE(0.1)*SHIFT(X,Y)
PLOT TEXT ,AT X+0.1,Y+0.1: STR$(P(X))
ELSE
LET P(X)=0
END IF
NEXT X
NEXT Y
SET AREA COLOR 4 !最後にもう1勝する
DRAW disk WITH SCALE(0.1)*SHIFT(K,N+K)
PLOT TEXT ,AT K+0.1,(N+K)+0.1: STR$(P(K))
PRINT P(K);"通り"
END
DATA 8,5 !縦横の大きさ（交差点の数）
DATA 0,2,2,0,0 !マップ
DATA 1,3,3,2,0
DATA 1,3,3,3,2
DATA 0,1,3,3,3
DATA 0,0,1,3,3
DATA 0,0,0,1,3
DATA 0,0,0,0,1
DATA 0,0,0,0,1
READ M,N !縦横
SET WINDOW -1,MAX(M,N),-1,MAX(M,N)
DRAW grid
DIM P(0 TO N-1) !点(x,y)を通過する場合の数
MAT P=ZER
FOR Y=M-1 TO 0 STEP -1 !左上から右下へ
FOR X=0 TO N-1
READ R !交差点の形状
SELECT CASE R
CASE 0
IF X=0 AND Y=M-1 THEN !始点Aなら
LET P(X)=1
ELSE
LET P(X)=0
END IF
CASE 1
PLOT LINES: X,Y+1; X,Y
CASE 2
LET P(X)=P(X-1)
PLOT LINES: X-1,Y; X,Y
CASE 3
IF X=0 THEN !左端
IF Y=M-1 THEN LET P(X)=1 !始点Aとつながっている
ELSE
LET P(X)=P(X)+P(X-1) !累計 ※パスカルの三角形
END IF
PLOT LINES: X,Y+1; X,Y !縦の経路
PLOT LINES: X-1,Y; X,Y !横の経路
END SELECT
IF P(X)>0 OR R>0 THEN
DRAW disk WITH SCALE(0.1)*SHIFT(X,Y)
PLOT TEXT ,AT X+0.1,Y+0.1: STR$(P(X))
END IF
NEXT X
NEXT Y
PRINT P(N-1);"通り"
END
! １ ─ ２ ─ ３
! ／ ＼ ／ ＼ ／
!４ ─ ５ ─ ６
DATA 9,6 !辺(経路)、点(交差点)の個数
! 1 2 3 4 5 6
DATA 0,1,0,1,1,0 !1
DATA 1,0,1,0,1,1 !2
DATA 0,1,0,0,0,1 !3
DATA 1,0,0,0,1,0 !4
DATA 1,1,0,1,0,1 !5
DATA 0,1,1,0,1,0 !6
READ K,N
DIM V(0 TO K) !経路
DIM M(N,N) !隣接行列（無向グラフ）
MAT READ M
FOR J=1 TO N !始点
CALL visit(0,J,V, K,N,M)
NEXT J
IF C=0 THEN PRINT "解なし"
END
EXTERNAL SUB visit(P,R,V(), K,N,M(,)) !経路をたどる
LET V(P)=R
IF P=K THEN !結果を表示する
LET C=C+1
PRINT "No.";C
MAT PRINT V;
ELSE
FOR J=1 TO N !進行可能な交差点を選ぶ
IF M(R,J)<>0 THEN
LET M(R,J)=M(R,J)-1 !切り離す
LET M(J,R)=M(J,R)-1
CALL visit(P+1,J,V, K,N,M) !次の交差点へ
LET M(R,J)=M(R,J)+1 !戻す
LET M(J,R)=M(J,R)+1
END IF
NEXT J
END IF
END SUB
差し替え
!ケニスバーグの橋
!１
!|| ＼
!２ ─ ３
!|| ／
!４
DATA 7,4 !辺(経路)、点(交差点)の個数
! 1 2 3 4
DATA 0,2,1,0 !1
DATA 2,0,1,2 !2
DATA 1,1,0,1 !3
DATA 0,2,1,0 !4
!ペントミノ F型
!１─２─３
!│ │ │
!４─５─６─７
! │ │ │
! ８─９─10
! │ │
! 11─12
DATA 16,12 !辺(経路)、点(交差点)の個数
! 1 2 3 4 5 6 7 8 9101112
DATA 0,1,0,1,0,0,0,0,0,0,0,0 !1
DATA 1,0,1,0,1,0,0,0,0,0,0,0 !2
DATA 0,1,0,0,0,1,0,0,0,0,0,0 !3
DATA 1,0,0,0,1,0,0,0,0,0,0,0 !4
DATA 0,1,0,1,0,1,0,1,0,0,0,0 !5
DATA 0,0,1,0,1,0,1,0,1,0,0,0 !6
DATA 0,0,0,0,0,1,0,0,0,1,0,0 !7
DATA 0,0,0,0,1,0,0,0,1,0,1,0 !8
DATA 0,0,0,0,0,1,0,1,0,1,0,1 !9
DATA 0,0,0,0,0,0,1,0,1,0,0,0 !10
DATA 0,0,0,0,0,0,0,1,0,0,0,1 !11
DATA 0,0,0,0,0,0,0,0,1,0,1,0 !12
LET DD=A^2-K^2*B !判別式
PRINT DD
LET P=NUMER(DD) !分子
LET Q=DENOM(DD) !分母
LET D=INTSQR(P)/INTSQR(Q)
IF DD>=0 AND D*D=DD THEN !平方数なら
PRINT "√("; (A+D)/2; ")";
IF K>=0 THEN PRINT " + "; ELSE PRINT " - ";
PRINT "√("; (A-D)/2; ")"
ELSE
PRINT "はずせない。"
STOP
END IF
FOR X=1 TO 9 !千の位 条件1
FOR Y=0 TO 9 !一の位
FOR A=0 TO 99-3 !百と十の位
LET N1=X*1000+A*10+Y !xaay
FOR B=A+1 TO 99-2
LET N2=X*1000+B*10+Y !xbby
FOR C=B+1 TO 99-1
LET N3=X*1000+C*10+Y !xccy
FOR D=C+1 TO 99
LET N4=X*1000+D*10+Y !xddy
LET S=N1+N2+N3+N4
IF MOD(S,N1)=0 THEN !条件2
IF MOD(S,N2)=0 THEN
IF MOD(S,N3)=0 THEN
PRINT N1;N2;N3;N4; "タイプ１"
ELSE
IF MOD(S,N4)=0 THEN PRINT N1;N2;N3;N4; "タイプ２"
END IF
ELSE
IF MOD(S,N3)=0 AND MOD(S,N4)=0 THEN PRINT N1;N2;N3;N4; "タイプ３"
END IF
ELSE
IF MOD(S,N2)=0 AND MOD(S,N3)=0 AND MOD(S,N4)=0 THEN PRINT N1;N2;N3;N4; "タイプ４"
END IF
DIM S(5) !集合S
FOR A=1 TO 9 !条件1 C(9,5)=126通り
LET S(1)=A
FOR B=A+1 TO 9-3
LET S(2)=B
FOR C=B+1 TO 9-2
LET S(3)=C
FOR D=C+1 TO 9-1
LET S(4)=D
FOR E=D+1 TO 9
LET S(5)=E
MAT F=ZER !条件2 C(5,2)=10通り
FOR X=1 TO 5-1
FOR Y=X+1 TO 5
LET T=MOD(S(X)+S(Y),10)
LET F(T)=1
NEXT Y
NEXT X
FOR i=1 TO 9
IF F(i)=0 THEN EXIT FOR
NEXT i
IF F(0)=0 AND i>9 THEN MAT PRINT S;
LET A=66
LET B=35
LET C=3890
LET M=CEIL(A/B)*B-A
PRINT M
LET P=MAX(A,2*B)
LET Q=MIN(A,2*B)
FOR T=CEIL(C/P) TO INT(C/Q) !置き換えていく
LET R=C-Q*T
!!!PRINT T;R
IF MOD(R,M)=0 THEN !約数なら
LET K=R/M
PRINT T-K; 2*K !x,Y
END IF
NEXT T
END
考察
a,b,cは互いに素な整数とする。
ax^2+bx+c=(Px+Q)(Sx+T)=PSx^2+(PT+QS)x+QT
PT+QS=b、(PT)(QS)=(PS)(QT)=acなので、PT,QSを2つの解にもつ2次方程式は、t^2-bt+ac=0
2解をα,βとして、
P Q β=QS
S T α=PT
a c
より、
P=gcd(a,α)として、S=a/P、T=α/P、Q=c/T
（終り）
READ N
DIM X(N),Y(N)
FOR i=1 TO N !点の座標を読み込む
READ X(i),Y(i)
PLOT TEXT ,AT X(i)+0.1,Y(i)+0.1: STR$(i)
DRAW disk WITH SCALE(0.1)*SHIFT(X(i),Y(i))
NEXT i
FOR i=1 TO N !点をつなぐ
PLOT LINES: X(i),Y(i);
NEXT i
PLOT LINES: X(1),Y(1) !一筆書き
!線対称
FOR P=1 TO N-1 !対称軸となる2点
FOR Q=P+1 TO N
CALL gcP2LINE(X(P),Y(P),X(Q),Y(Q), A,B,C) !垂直二等分線
SET AREA COLOR 2
FOR i=1 TO N
CALL gcSYMMETRY2(A,B,C,X(i),Y(i), XX,YY) !線対称
FOR K=1 TO N !重なるかどうか確認する
IF ABS(XX-X(K))<1E-10 AND ABS(YY-Y(K))<1E-10 THEN EXIT FOR
NEXT K
IF K>N THEN EXIT FOR !重ならない
!!PLOT TEXT ,AT XX+0.1,YY-0.1: STR$(i)
DRAW disk WITH SCALE(0.1)*SHIFT(XX,YY)
NEXT i
IF i>N THEN !すべての点が重なるなら
SET LINE COLOR 4
CALL gcDRAWLINE(A,B,C)
PRINT "線対称な図形です。"; P;Q
END IF
NEXT Q
NEXT P
!点対称
LET GX=0 !重心を求める
LET GY=0
FOR i=1 TO N
LET GX=GX+X(i)
LET GY=GY+Y(i)
NEXT i
LET GX=GX/N
LET GY=GY/N
SET AREA COLOR 4
PLOT TEXT ,AT GX+0.1,GY+0.1: "G"
DRAW disk WITH SCALE(0.1)*SHIFT(GX,GY)
SET AREA COLOR 2
FOR i=1 TO N !重心で180°回転する
CALL gcSYMMETRY(X(i),Y(i),GX,GY, XX,YY)
FOR K=1 TO N !重なるかどうか確認する
IF ABS(XX-X(K))<1E-10 AND ABS(YY-Y(K))<1E-10 THEN EXIT FOR
NEXT K
IF K>N THEN EXIT FOR !重ならない
PLOT TEXT ,AT XX+0.1,YY-0.1: STR$(i)
DRAW disk WITH SCALE(0.1)*SHIFT(XX,YY)
NEXT i
IF i>N THEN PRINT "点対称な図形です。"
END
!FV.LIB 抜粋
EXTERNAL SUB gcDRAWLINE(L,M,N) !直線Lx+My+N=0を描く
IF (L=0 AND M=0) THEN
PRINT "L=M=0なので、直線が成立しません。"; L;M;N
ELSE
ASK WINDOW x1,x2,y1,y2
IF ABS(L)>ABS(M) THEN !y=±xの傾きより大きいなら ※y軸に平行な直線を含む
PLOT LINES: -(M*y1+N)/L,y1; -(M*y2+N)/L,y2
ELSE
PLOT LINES: x1,-(L*x1+N)/M; x2,-(L*x2+N)/M
END IF
END IF
END SUB
!点A(x1,y1), B(x2,y2)を結ぶ線分ABの垂直二等分線
! 線分ABの中点を通り、線分ABの傾きに垂直な直線 Y-(y1+y2)/2=-(x2-x1)/(y2-y1)(X-(x1+x2)/2) より
EXTERNAL SUB gcP2LINE(x1,y1,x2,y2, L,M,N)
IF (x1=x2 AND y1=y2) THEN
PRINT "2点は同一点なので、線分が成立しません。"; x1;y1;x2;y2
ELSE
LET L=x2-x1
LET M=y2-y1
LET N=-(L*(x1+x2)+M*(y1+y2))/2
END IF
END SUB
EXTERNAL SUB gcSYMMETRY(X,Y,PX,PY, QX,QY) !点Aに対する点対称の点
LET QX=2*PX-X !点(X,Y)と対称点(QX,QY)の中点が点(PX,PY)なので、PX=(X+QX)/2
LET QY=2*PY-Y
END SUB
!線対称（Lx+My+N=0）の点
! 点A(x1,y1)、対称点A'(x2,y2)とする。
! 点A,A'の中点は直線上の点なので、L((x1+x2)/2)+M((y1+y2)/2)+N=0 ∴Lx2+My2=-(Lx1+My1+2N) ←式1
! また、直線AA'と直線とは直交するので、傾き((y2-y1)/(x2-x1))(-L/M)=-1 ∴Mx2-Ly2=Mx1-Ly1 ←式2
! L*式1+M*式2より、(L^2+M^2)x2=-L(Lx1+My1+2N) +M(Mx1-Ly1)=(L^2+M^2)x1-2L(Lx1+My1+N)
! M*式1-L*式2より、(L^2+M^2)y2=-M(Lx1+My1+2N) -L(Mx1-Ly1)=(L^2+M^2)y1-2M(Lx1+My1+N)
EXTERNAL SUB gcSYMMETRY2(L,M,N,PX,PY, QX,QY) !線対称（Lx+My+N=0）の点
LET m3=L*L+M*M
IF m3=0 THEN
PRINT "L=M=0なので、直線が成立しません。"; L;M;N
ELSE
LET t=(L*PX+M*PY+N)/m3
LET QX=PX-2*L*t
LET QY=PY-2*M*t
END IF
END SUB
INPUT PROMPT "題意のnを階乗の形でない形でinputせよ":n
LET s=0
DO
LET q=INT(n/2)
LET r=MOD(n,2)
PRINT "二進数（下から読む)";r;
LET s=s+r
PRINT s
IF q=0 THEN STOP
LET n=q
LOOP
END
問題
町が碁盤の目の様な道路になっており、座標平面上の格子点を動くように散歩するものとする。
その人の座標が(a,b)で
a+b≡0 mod 4のとき、右へ1進む。
a+b≡1 mod 4のとき、上へ1進む。
a+b≡2 mod 4のとき、左へ1進む。
a+b≡3 mod 4のとき、下へ1進む。
と進路をとって進むものとする。
このとき、ある格子点Pから散歩を始めた人が、
進路変更を9回繰り返したとき、格子点Q(0,10)に到着していたという。
さて出発点の格子点Pとして考えられるのはどこですか？
答え (5,5)
SET WINDOW -1,12,-1,12
DRAW grid
FOR A=-1 TO 12 !(a,b)
FOR B=-1 TO 12
DRAW AR WITH ROTATE((A+B)*(2*PI/4))*SHIFT(A,B)
NEXT B
NEXT A
END
EXTERNAL PICTURE AR !矢印を描く
PLOT LINES: 0,0; 0.5,0 !→
PLOT LINES: 0.5,0; 0.3,0.1
PLOT LINES: 0.5,0; 0.3,-0.1
END PICTURE
FOR YS=1 TO 10
FOR XS=1 TO 10
LET X=XS
LET Y=YS
FOR I=0 TO 9
SELECT CASE MOD(X+Y,4)
CASE 0
LET X=X+1
CASE 1
LET Y=Y+1
CASE 2
LET X=X-1
CASE 3
LET Y=Y-1
END SELECT
NEXT I
IF X=0 AND Y=10 THEN PRINT XS;YS
!' PRINT XS;YS;X;Y
NEXT XS
NEXT YS
END
!ケース１
FOR K=1 TO 4 !1234のとき、1235,1250,1500,5000と払う
LET W=10^K
LET B=CEIL(A/W)*W-W/2
IF B>=A THEN
PRINT "支払った金額=";B;"円"
PRINT "おつり=";B-A;"円"
PRINT F(B)-F(B-A);"枚減る"
END IF
IF W>A THEN EXIT FOR !払いすぎた
NEXT K
PRINT
!ケース２
FOR K=1 TO 4 !1234のとき、1240,1300,2000,10000と払う
LET W=10^K
LET B=CEIL(A/W)*W
PRINT "支払った金額=";B;"円"
PRINT "おつり=";B-A;"円"
PRINT F(B)-F(B-A);"枚減る"
IF W>A THEN EXIT FOR !払いすぎた
NEXT K
PRINT
!ケース３
DATA 5,50,500,5000 !5,50,500,5000円がおつりになるようにする
DIM Q(4)
MAT READ Q
FOR P=0 TO 2^4-1 !2^4=16通り
LET T=P
LET B=0
FOR K=1 TO 4
IF MOD(T,2)=1 THEN LET B=B+Q(K)
LET T=INT(T/2)
NEXT K
IF B>A THEN EXIT FOR !払いすぎた
PRINT "支払った金額=";A+B;"円"
PRINT "おつり=";B;"円"
PRINT F(A+B)-F(B);"枚減る"
NEXT P
END
EXTERNAL FUNCTION F(N) !金額nに対する硬貨の枚数を返す
DATA 10000,5000,1000,500,100,50,10,5,1 !金種 ※大きい順
LET C=0
DO WHILE N>0
READ P
LET C=C+INT(N/P)
LET N=MOD(N,P) !次へ
LOOP
LET F=C
END FUNCTION
DIM A(N),B(N) !オス、メス
MAT A=CON !A,B,C,…
MAT B=CON !a,b,c,…
PUBLIC NUMERIC C !場合の数
LET C=0
DIM P(2*N) !並び
LET P(1)=1 !オス（A）から始まる ※オスは正、メスは負で表す
LET A(1)=0
CALL try(2,N,P,A,B)
PRINT C;"通り"
PRINT 2*N*C;"通り" !Aとa、n組
END
EXTERNAL SUB try(K,N,P(),A(),B()) !バックトラック法で検索する
IF K>2*N THEN !すべて並んだ
LET C=C+1
MAT PRINT P;
ELSE
LET W=P(K-1) !1つ前
IF W>0 THEN !オス（A）なら
FOR i=1 TO N !他のオスを並べる
IF A(i)>0 THEN
LET P(K)=i !B
LET A(i)=0
CALL try(K+1,N,P,A,B) !次へ
LET A(i)=1 !元に戻す
END IF
NEXT i
IF B(W)>0 THEN !つがいのメスを並べる
LET P(K)=-W !a
LET B(W)=0
CALL try(K+1,N,P,A,B)
LET B(W)=1
END IF
ELSE !メス（a）なら
FOR i=1 TO N !他のメスを並べる
IF B(i)>0 THEN
LET P(K)=-i
LET B(i)=0 !b
CALL try(K+1,N,P,A,B)
LET B(i)=1
END IF
NEXT i
IF A(-W)>0 THEN !つがいのオスを並べる
LET P(K)=-W !A
LET A(-W)=0
CALL try(K+1,N,P,A,B)
LET A(-W)=1
END IF
LET T=P(1)
FOR M=6 TO 2 STEP -1 !一の位から順にうめていく
FOR i=1 TO 9 !九九の3の段
IF MOD(3*i,10)=T THEN EXIT FOR
NEXT i
IF i>9 THEN
PRINT "解なし"
STOP
ELSE
LET P(M)=i
LET CY=INT(3*i/10)
LET T=i-CY
END IF
NEXT M
IF CY=P(1) THEN MAT PRINT P; !すべてうまったなら
!正6面体
!・─・
!│１│
!・─・─・─・─・
!│２│３│４│５│
!・─・─・─・─・
! │６│
! ・─・
DATA 6 !面数
DATA 0,1,1,1,1,0 !面1 隣接行列
DATA 1,0,1,0,1,1 !面2
DATA 1,1,0,1,0,1 !面3
DATA 1,0,1,0,1,1 !面4
DATA 1,1,0,1,0,1 !面5
DATA 0,1,1,1,1,0 !面6
READ N
DIM M(N,N)
MAT READ M
PUBLIC NUMERIC C !場合の数
LET C=0
DIM Q(N) !各色数の場合の数
MAT Q=ZER
DIM P(N) !パターン
LET P(1)=1 !面1を固定する
CALL try(2,P,Q, N,M,N)
MAT PRINT Q;
END
EXTERNAL SUB try(X,P(),Q(), K,M(,),N) !バックトラック法で探索する
FOR i=1 TO K !k色
FOR J=1 TO X-1 !隣接面を確認する
IF M(X,J)>0 THEN
IF i=P(J) THEN EXIT FOR !同じ色なら
END IF
NEXT J
IF J>X-1 THEN !異なる色なら
LET P(X)=i
IF X=N THEN !全面塗ったなら
DIM F(N) !使用された色数（k色中t色）を確認する
MAT F=ZER
FOR J=1 TO N
LET F(P(J))=1
NEXT J
LET T=0
FOR J=1 TO N
LET T=T+F(J)
NEXT J
FOR J=1 TO T
IF F(J)=0 THEN EXIT FOR
NEXT J
IF J>T THEN !1～t色 ※1,2,3の3色はOK、1,2,4や1,3,5などはNG
CALL CF(N,P, OK)
IF OK=-1 THEN !対称性を考慮する
LET Q(T)=Q(T)+1 !記録する
LET C=C+1
PRINT"No.";C; T;"色" !パターンを表示する
MAT PRINT P;
END IF
END IF
ELSE
CALL try(X+1,P,Q, K,M,N) !次の面へ
END IF
END IF
NEXT i
END SUB
EXTERNAL SUB CF(N,P(), OK) !6面体 バーンサイドの定理（コーシー・フロベニウスの定理）
!展開図を1つに固定する。 面1の部分が、面1から面nになるように展開する。
!正8面体
! ・
! ／２＼
! ・───・───・───・
! ／４＼１／３＼７／５＼８／
!・───・───・───・
! ＼６／
! ・
DATA 8 !面数
DATA 0,1,1,1,0,0,0,0 !面1 隣接行列
DATA 1,0,0,0,0,0,1,1 !面2
DATA 1,0,0,0,0,1,1,0 !面3
DATA 1,0,0,0,0,1,0,1 !面4
DATA 0,0,0,0,0,1,1,1 !面5
DATA 0,0,1,1,1,0,0,0 !面6
DATA 0,1,1,0,1,0,0,0 !面7
DATA 0,1,0,1,1,0,0,0 !面8
!'写像変換テスト
LET XSIZE=600
LET YSIZE=600
LET XH=XSIZE/2
LET YH=YSIZE/2
CALL GINIT(XSIZE,YSIZE)
LET N=8
FOR Y=0 TO YSIZE-1 STEP N !'せん断変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=XS+TAN(RAD(10))*YS
LET YY=YS+TAN(RAD(20))*XS
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$ !'一時停止
CLEAR
LET A=XSIZE/2
FOR Y=0 TO YSIZE-1 STEP N !'正方形変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=A*(XS/A)^2*SGN(XS)
LET YY=A*(YS/A)^2*SGN(YS)
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET A=1/XSIZE
FOR Y=0 TO YSIZE-1 STEP N !'放物変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=XS+A*YS^2
LET YY=YS
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET A=1/XSIZE
FOR Y=0 TO YSIZE-1 STEP N !'放物変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=XS+A*YS^2
LET YY=YS+A*XS^2
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET A=XSIZE/8
FOR Y=0 TO YSIZE STEP N !'双曲変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=XS/(A+ABS(YS))*A
LET YY=YS/(A+ABS(XS))*A
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET L=XSIZE
LET T=40
FOR Y=0 TO YSIZE-1 STEP N !'射影変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=L*XS/(L-YS*SIN(RAD(T)))
LET YY=L*YS*COS(RAD(T))/(L-YS*SIN(RAD(T)))
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET L=XSIZE
LET T=60
FOR Y=0 TO YSIZE-1 STEP N !'三角形変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=2*TAN(RAD(T/2))*XS*(YS+YH)/L
LET YY=YS
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET A=5
LET B=5
FOR Y=0 TO YSIZE-1 STEP N !'波形変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
LET XX=XS+A*SIN(RAD(B*YS))
LET YY=YS+A*SIN(RAD(B*XS))
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
INPUT A$
CLEAR
LET R=XSIZE/2
FOR Y=0 TO YSIZE-1 STEP N !'球面反射変換
LET YS=Y-YH
FOR X=0 TO XSIZE-1 STEP N
LET XS=X-XH
IF XS^2+YS^2<R^2 THEN
LET Z=(2*R*R)/(XS^2+YS^2+R*R)
LET XX=XS*Z
LET YY=YS*Z
ELSE
LET XX=XS
LET YY=YS
END IF
LET C=7
IF MOD(Y,3*N)=0 THEN LET C=2
IF MOD(X,3*N)=0 THEN LET C=4
CALL PSET(XX+XH,YY+YH,C)
NEXT X
NEXT Y
END
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
!'せん断変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
INPUT PROMPT "角度α(0 - 40)=":ALPHA
LET KX=TAN(RAD(ALPHA))
INPUT PROMPT "角度β(0 - 40)=":BETA
LET KY=TAN(RAD(BETA))
LET XA=XSIZE-1+INT(KX*(YSIZE-1))
LET YA=YSIZE-1+INT(KY*(XSIZE-1))
CALL GINIT(XA,YA)
!'せん断変換
!' X'=X+KX*Y
!' Y'=Y+KY*X
!'逆変換
!' X=(X'-KX*Y')/(KX*KY-1)
!' Y=(X'*KY-Y')/(KX*KY-1)
FOR YS=0 TO YA-1
LET Y=YS-YA/2
FOR XS=0 TO XA-1
LET X=XS-XA/2
LET XX=(Y*KX-X)/(KX*KY-1)
LET YY=(X*KY-Y)/(KX*KY-1)
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XA/2,Y+YA/2,R,G,B)
END IF
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!' 正方形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'正方形変換
!' X'=A*(X/A)^2
!' Y'=A*(Y/A)^2
!'逆変換
!' X=SQR(A)*SQR(X')
!' Y=SQR(A)*SQR(Y')
CLEAR
LET MODE=0
SELECT CASE MODE
CASE 0
FOR YS=0 TO YSIZE-1
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET XX=SQR(XSIZE/2)*SQR(ABS(X))*SGN(X)
LET YY=SQR(YSIZE/2)*SQR(ABS(Y))*SGN(Y)
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
END IF
NEXT XS
NEXT YS
CASE 1
FOR YS=0 TO YSIZE-1
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET XX=X
LET YY=SQR(YSIZE/2)*SQR(ABS(Y))*SGN(Y)
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
END IF
NEXT XS
NEXT YS
CASE 2
FOR YS=0 TO YSIZE-1
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET XX=SQR(XSIZE/2)*SQR(ABS(X))*SGN(X)
LET YY=Y
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
END IF
NEXT XS
NEXT YS
END SELECT
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!' 三角形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'三角形変換
!' X'=2*TAN(T/2)*X*Y/L
!' Y'=Y
!'逆変換
!' X=L*X'/(2*TAN(T/2)*Y')
!' Y=Y'
!'INPUT PROMPT "L=":L
LET L=XSIZE-1
!'INPUT PROMPT "角度(0 - 90)=":TH
!'LET T=RAD(TH)
LET T=2*ATN((XSIZE/2)/YSIZE)
CLEAR
FOR YS=1 TO YSIZE-1
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET XX=L*X/(2*TAN(T/2)*(Y+YSIZE/2))
LET YY=Y
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
END IF
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!' 波形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
INPUT PROMPT "A (1 - 10)=":A
INPUT PROMPT "B (1 - 5)=":B
!' 波形変換
!' X'=X+A*SIN(B*Y)
!' Y'=Y+A*SIN(B*X)
!' 波形変換
!' X'=X+A*SIN(B*Y)
!' Y'=Y
!' 逆変換
!' X=X'-A*SIN(B*Y')
!' Y=Y'
LET MODE=0
CLEAR
SELECT CASE MODE
CASE 0
FOR Y=0 TO YSIZE-1
LET XX=MAX(XX,XSIZE-1+INT(A*SIN(B*Y*PI/180)))
NEXT Y
FOR X=0 TO XSIZE-1
LET YY=MAX(YY,YSIZE-1+INT(A*SIN(B*X*PI/180)))
NEXT X
CALL GINIT(INT(XX),INT(YY))
FOR Y=0 TO YSIZE-1 STEP .5
FOR X=0 TO XSIZE-1 STEP .5
LET XA=X+A*SIN(B*Y*PI/180)
LET YA=Y+A*SIN(B*X*PI/180)
LET C=M(X,Y)
CALL RGB(C,RR,GG,BB)
CALL PSET(XA,YA,RR,GG,BB)
NEXT X
NEXT Y
CASE 1
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET XA=X
LET YA=Y-A*SIN(B*X*PI/180)
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN
LET C=M(XA,INT(YA))
CALL RGB(C,RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
END IF
NEXT X
NEXT Y
CASE 2
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET XA=X-A*SIN(B*Y*PI/180)
LET YA=Y
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN
LET C=M(INT(XA),YA)
CALL RGB(C,RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
END IF
NEXT X
NEXT Y
END SELECT
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'射影変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'射影変換
!' X'=L*X/(L-Y*SIN(T))
!' Y'=L*Y*COS(T)/(L-Y*SIN(T))
!'逆変換
!' X=L*COS(T)*X'/(SIN(T)*Y'+L*COS(T))
!' Y=L*Y'/(SIN(T)*Y'+L*COS(T))
!'INPUT PROMPT "L=":L
LET L=XSIZE
INPUT PROMPT "度(-90～90)=":T
CLEAR
FOR YS=0 TO YSIZE-1
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET XX=L*COS(RAD(T))*X/(SIN(RAD(T))*Y+L*COS(RAD(T)))
LET YY=L*Y/(SIN(RAD(T))*Y+L*COS(RAD(T)))
IF XX>=-XSIZE/2 AND XX<=XSIZE/2-1 AND YY>=-YSIZE/2 AND YY<=YSIZE/2-1 THEN
LET C=M(INT(XX+XSIZE/2),INT(YY+YSIZE/2))
CALL RGB(C,R,G,B)
CALL PSET(X+XSIZE/2,Y+YSIZE/2,R,G,B)
END IF
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'扇形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
CLEAR
!'INPUT PROMPT "角度(0 - 180)=":T
FOR T=180 TO 0 STEP -1 !'最大角度探索
LET TH=(XSIZE-1-XS)/(XSIZE-1)*T-(180-(180-T)/2)
LET R=YSIZE-YS
LET XX=R*COS(RAD(TH))
IF XX+XSIZE/2>=0 AND XX+XSIZE/2<XSIZE THEN EXIT FOR
NEXT T
FOR YS=0 TO YSIZE-1 STEP .5
FOR XS=0 TO XSIZE-1 STEP .5
LET TH=(XSIZE-1-XS)/(XSIZE-1)*T-(180-(180-T)/2)
LET R=YSIZE-YS
LET XX=R*COS(RAD(TH))
LET YY=R*SIN(RAD(TH))
LET C=M(XS,YS)
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE,RR,GG,BB)
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'放物変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'放物変換
!' X'=X+A*Y^2
!' Y'=Y+B*X^2
LET A=1/XSIZE
LET B=1/YSIZE
LET XA=XSIZE+A*(YSIZE/2)^2
LET YA=YSIZE+B*(XSIZE/2)^2
LET MODE=0
SELECT CASE MODE
CASE 0
CALL GINIT(INT(XA),INT(YA))
FOR YS=0 TO YSIZE-1 STEP .5
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1 STEP .5
LET X=XS-XSIZE/2
LET XX=X+A*Y^2
LET YY=Y+B*X^2
LET C=M(INT(XS),INT(YS))
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
CASE 1
CALL GINIT(XSIZE,INT(YA))
FOR YS=0 TO YSIZE-1 STEP .5
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1 STEP .5
LET X=XS-XSIZE/2
LET XX=X
LET YY=Y+B*X^2
LET C=M(INT(XS),INT(YS))
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
CASE 2
CALL GINIT(INT(XA),YSIZE)
FOR YS=0 TO YSIZE-1 STEP .5
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1 STEP .5
LET X=XS-XSIZE/2
LET XX=X+A*Y^2
LET YY=Y
LET C=M(INT(XS),INT(YS))
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
END SELECT
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'双曲変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'双曲変換
!' X'=X/(A+ABS(Y))
!' Y'=Y/(B+ABS(X))
!'INPUT PROMPT "A=":A
!'INPUT PROMPT "B=":B
LET A=XSIZE/8
LET B=YSIZE/8
CLEAR
FOR YS=0 TO YSIZE-1 STEP .5
LET Y=YS-YSIZE/2
FOR XS=0 TO XSIZE-1 STEP .5
LET X=XS-XSIZE/2
LET XX=X/(A+ABS(Y))*A
LET YY=Y/(B+ABS(X))*B
LET C=M(INT(X+XSIZE/2),INT(Y+YSIZE/2))
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'三角形変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
CLEAR
LET MODE=0
SELECT CASE MODE
CASE 0
LET X1=XSIZE/2
LET Y1=0
LET X2=0
LET Y2=YSIZE-1
LET X3=XSIZE-1
LET Y3=YSIZE-1
CASE 1
LET X1=XSIZE/2
LET Y1=YSIZE-1
LET X2=0
LET Y2=0
LET X3=XSIZE-1
LET Y3=0
END SELECT
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET XA=(X2-X1)/(Y2-Y1)*(Y-Y1)+X1
LET XB=(X3-X1)/(Y3-Y1)*(Y-Y1)+X1
LET XX=XA+(XB-XA)/XSIZE*X
LET YY=Y
LET C=M(X,Y)
CALL RGB(C,R,G,B)
CALL PSET(XX,YY,R,G,B)
NEXT X
NEXT Y
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!' 方程式 x^n+y^n=r^n を使用して円形変換します(n=2の時)
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
CLEAR
LET N=1.5 !' N=2で円形変換
IF XSIZE>YSIZE THEN
LET R=YSIZE/2
FOR YS=0 TO YSIZE-1
LET Y=YS-YSIZE/2
LET R1=(R^N-ABS(Y)^N)^(1/N)
FOR XS=0 TO XSIZE-1
LET XX=-R1+XS*R1/R*YSIZE/XSIZE
LET YY=Y
LET C=M(XS,YS)
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
ELSE
LET R=XSIZE/2
FOR XS=0 TO XSIZE-1
LET X=XS-XSIZE/2
LET R1=(R^N-ABS(X)^N)^(1/N)
FOR YS=0 TO YSIZE-1
LET YY=-R1+YS*R1/R*XSIZE/YSIZE
LET XX=X
LET C=M(XS,YS)
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XSIZE/2,YY+YSIZE/2,RR,GG,BB)
NEXT YS
NEXT XS
END IF
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'方程式 (x/a)^n+(y/b)^n=1 を使用して楕円形変換します(n=2の時)
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
CLEAR
LET HX=XSIZE/2
LET HY=YSIZE/2
LET MODE=0
LET N=.5 !'N=2の時、楕円形変換
FOR YS=0 TO YSIZE-1
LET Y=YS-HY
LET RY=(1-ABS(Y/HY)^N)^(1/N)
FOR XS=0 TO XSIZE-1
LET X=XS-HX
LET RX=(1-ABS(X/HX)^N)^(1/N)
IF MODE=0 THEN
LET XX=-RY*HX+XS*RY
LET YY=Y
ELSE
LET XX=X
LET YY=-RX*HY+YS*RX
END IF
LET C=M(XS,YS)
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+HX,YY+HY,RR,GG,BB)
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'ドーナツ形変換 (R1>0の時)
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
CLEAR
LET R1=50 !' R1=0で円形変換
LET YYSIZE=YSIZE*2+2*R1
LET XXSIZE=YYSIZE
CALL GINIT(XXSIZE,YYSIZE)
FOR YS=0 TO YSIZE-1 STEP .25
FOR XS=0 TO XSIZE-1 STEP .25
LET TH=(XSIZE-1-XS)/(XSIZE-1)*359-90
LET R=YS
LET XX=(R+R1)*COS(RAD(TH))
LET YY=(R+R1)*SIN(RAD(TH))
LET C=M(XS,YS)
CALL RGB(C,RR,GG,BB)
CALL PSET(XX+XXSIZE/2,YY+YYSIZE/2,RR,GG,BB)
NEXT XS
NEXT YS
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'球面反射変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
!'球面反射変換
!' Z=(2*R*R)/(X*X+Y*Y+R*R)
!' X'=X*Z
!' Y'=Y*Z
!' 逆変換
!' X=X'/Z
!' Y=Y'/Z
LET XO=XSIZE/2
LET YO=YSIZE/2
!'INPUT PROMPT "半径=":R
LET R=MIN(XO,YO)
CLEAR
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF SQR((X-XO)^2+(Y-YO)^2)<R THEN
LET Z=(2*R*R)/((X-XO)*(X-XO)+(Y-YO)*(Y-YO)+R*R)
LET XX=X/Z
LET YY=Y/Z
ELSE
LET XX=X
LET YY=Y
END IF
LET C=M(INT(XX),INT(YY))
CALL RGB(C,RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
NEXT X
NEXT Y
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'マスク画像(2値画像)を使用して、自由形(任意形)変換をします
OPTION BASE 0
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE) !'入力画像(XSIZE*YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY (0,0) M
FILE GETNAME F$,"マスク用画像|*.BMP;*.JPG;*.GIF;*.PNG" !'黒か黒以外
CALL PICTURELOAD(F$,XXSIZE,YYSIZE) !'マスク画像(XXSIZE*YYSIZE)
DIM MASK(0 TO XXSIZE-1,0 TO YYSIZE-1)
ASK PIXEL ARRAY (0,0) MASK
!'INPUT PROMPT "出力画像サイズ XSIZE,YSIZE=":OXSIZE,OYSIZE
LET OXSIZE=XSIZE !'出力画像サイズ(OXSIZE*OYSIZE)
LET OYSIZE=YSIZE
DIM XR(OYSIZE),YR(OXSIZE),YA(OXSIZE)
CALL GINIT(OXSIZE,OYSIZE)
FOR Y=0 TO OYSIZE-1 !'マスク画像表示
FOR X=0 TO OXSIZE-1
LET C=MASK(INT(X*XXSIZE/OXSIZE),INT(Y*YYSIZE/OYSIZE))
CALL RGB(C,RR,GG,BB)
IF RR<>0 OR GG<>0 OR BB<>0 THEN CALL PSET(X,Y,255,255,255) !'黒以外なら白色へ(2値化)
NEXT X
NEXT Y
FOR Y=0 TO OYSIZE-1 !'縮小率計算
FOR X=0 TO OXSIZE-1
CALL GETPOINT(X,Y,RR,GG,BB)
IF RR=255 AND GG=255 AND BB=255 THEN !'白ならカウント
LET XR(Y)=XR(Y)+1
LET YR(X)=YR(X)+1
END IF
NEXT X
NEXT Y
FOR X=0 TO OXSIZE-1 !'ライン毎に比率計算
LET YR(X)=YR(X)/OYSIZE
NEXT X
FOR Y=0 TO OYSIZE-1
LET XR(Y)=XR(Y)/OXSIZE
NEXT Y
FOR Y=0 TO OYSIZE-1
LET XA=0
FOR X=0 TO OXSIZE-1
CALL GETPOINT(X,Y,RR,GG,BB)
IF RR=255 AND GG=255 AND BB=255 THEN
LET XX=XA/XR(Y)*XSIZE/OXSIZE
LET YY=YA(X)/YR(X)*YSIZE/OYSIZE
LET XA=XA+1
LET YA(X)=YA(X)+1
LET C=M(INT(XX),INT(YY))
CALL RGB(C,RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
END IF
NEXT X
NEXT Y
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GETPOINT(X,Y,R,G,B)
ASK PIXEL VALUE(X,Y) C
CALL RGB(C,R,G,B)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
CALL BOXFULL(0,0,XSIZE-1,YSIZE-1,0,0,0)
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB BOXFULL(X0,Y0,X1,Y1,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT AREA:X0,Y0;X1,Y0;X1,Y1;X0,Y1;X0,Y0
END SUB
!'自由形変換で使用するマスク画像のサンプルを生成します
LET XSIZE=600 !'生成画像サイズ
LET YSIZE=600
CALL GINIT(XSIZE,YSIZE)
LET XX=XSIZE/2
LET YY=YSIZE/2
LET R=MIN(XX,YY)
CALL CIRCLEFULL(XX,YY,R,R,7)
CALL SAVE
CALL CIRCLEFULL(XX,YY,R,R/2,7)
CALL SAVE
CALL CIRCLEFULL(XX,YY,R/2,R,7)
CALL SAVE
CALL CIRCLEFULL(XX,YY,R,R,7)
CALL CIRCLEFULL(XX,YY,R*.3,R*.3,0)
CALL SAVE
FOR I=2 TO 4
FOR T=0 TO 359 STEP 360/I
LET X=XX+R/3*COS(RAD(T))
LET Y=YY+R/3*SIN(RAD(T))
CALL CIRCLEFULL(X,Y,R/1.5,R/1.5,7)
NEXT T
CALL SAVE
NEXT I
CALL SECTOR(XX,YSIZE,YSIZE,60,7)
CALL SAVE
CALL SECTOR(XX,YSIZE+YSIZE/4,YSIZE,60,7)
CALL SECTOR(XX,YSIZE+YSIZE/4,YSIZE/3,60,0)
CALL SAVE
FOR I=3 TO 6
CALL POLY(XX,YY,R,7,90,450,360/I)
PAINT XX,YY
CALL SAVE
NEXT I
CALL POLY(XX,YY,R*.99,7,90,90+360*2,144)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*3,135)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*3,108)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*4,160)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*4,96)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*5,150)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*5,100)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*7,84)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*7,105)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*7,126)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*7,140)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*7,168)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*9,162)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*9,108)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*9,81)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*11,132)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*11,110)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*11,165)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*11,99)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*11,88)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*13,104)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*13,117)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*13,130)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*13,156)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*13,78)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*14,112)
CALL TRANS
CALL POLY(XX,YY,R*.99,7,90,90+360*16,128)
CALL TRANS
CALL CIRCLEFULL(XX,YY,R,R,7)
CALL CIRCLEFULL(XX+XX/2,YY,R,R,0)
CALL SAVE
DIM XO(10),YO(10)
SET AREA COLOR 7
LET XO(1)=XSIZE/3
LET YO(1)=YSIZE/3
LET XO(2)=0
LET YO(2)=YSIZE-1
LET XO(3)=XSIZE-1
LET YO(3)=YSIZE-1
LET XO(4)=XSIZE/3*2
LET YO(4)=YSIZE/3
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
LET XO(1)=XSIZE/3
LET YO(1)=0
LET XO(2)=XSIZE/3*2
LET YO(2)=0
LET XO(3)=XSIZE/3*2
LET YO(3)=YSIZE-1
LET XO(4)=XSIZE/3
LET YO(4)=YSIZE-1
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
LET XO(1)=0
LET YO(1)=YSIZE/3
LET XO(2)=0
LET YO(2)=YSIZE/3*2
LET XO(3)=XSIZE-1
LET YO(3)=YSIZE/3*2
LET XO(4)=XSIZE-1
LET YO(4)=YSIZE/3
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
LET XO(1)=XSIZE/3
LET YO(1)=YSIZE/3
LET XO(2)=XSIZE/3
LET YO(2)=YSIZE/3*2
LET XO(3)=XSIZE-1
LET YO(3)=YSIZE-1
LET XO(4)=XSIZE-1
LET YO(4)=0
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
LET XO(1)=XSIZE*.2
LET YO(1)=0
LET XO(2)=XSIZE*.8
LET YO(2)=0
LET XO(3)=XSIZE*.8
LET YO(3)=YSIZE-1
LET XO(4)=XSIZE*.2
LET YO(4)=YSIZE-1
MAT PLOT AREA,LIMIT 4:XO,YO
LET XO(1)=0
LET YO(1)=YSIZE*.2
LET XO(2)=XSIZE-1
LET YO(2)=YSIZE*.2
LET XO(3)=XSIZE-1
LET YO(3)=YSIZE*.8
LET XO(4)=0
LET YO(4)=YSIZE*.8
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
CALL LINE(XSIZE/3*2,0,0,YSIZE/3*2,7)
CALL LINE(XSIZE,(YSIZE+1)/3,(XSIZE+1)/3,YSIZE,7)
PAINT XX,YY
CALL SAVE
LET XO(1)=XSIZE*.3
LET YO(1)=YSIZE*.1
LET XO(2)=XSIZE*.8
LET YO(2)=YSIZE*.2
LET XO(3)=XSIZE*.9
LET YO(3)=YSIZE*.8
LET XO(4)=XSIZE*.1
LET YO(4)=YSIZE*.9
MAT PLOT AREA,LIMIT 4:XO,YO
CALL SAVE
LET SIZE=40
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF MOD(X,2*SIZE)<SIZE THEN LET C=7 ELSE LET C=0
IF MOD(Y,2*SIZE)<SIZE THEN LET C=7-C
CALL PSET(X,Y,C)
NEXT X
NEXT Y
CALL SAVE
LET SIZE=50
LET RR=20
FOR Y=0 TO YSIZE-1+SIZE
FOR X=0 TO XSIZE-1+SIZE
LET X1=INT((X+SIZE/2)/SIZE)*SIZE
LET Y1=INT((Y+SIZE/2)/SIZE)*SIZE
IF (X-X1)^2+(Y-Y1)^2<RR^2 THEN CALL PSET(X-SIZE/2,Y-SIZE/2,7) ELSE CALL PSET(X-SIZE/2,Y-SIZE/2,0)
NEXT X
NEXT Y
CALL SAVE
DO !'画像検索で入手。原画像サイズ1024*1024 自作の専用プログラムにて2dot間隔でスキャン。データー化した。
READ IF MISSING THEN EXIT DO:X,Y
LET X1=X/1024*XSIZE
LET Y1=Y/1024*YSIZE
IF XS=0 THEN
LET XS=X1
LET YS=Y1
END IF
CALL LINE(XS,YS,X1,Y1,7)
LET XA=(1023-X)/1024*XSIZE
LET YA=Y/1024*YSIZE
IF XB=0 THEN
LET XB=XA
LET YB=YA
END IF
CALL LINE(XA,YA,XB,YB,7)
LET XS=X1
LET YS=Y1
LET XB=XA
LET YB=YA
LOOP
PAINT XSIZE/2,YSIZE/2
DATA 512,324,510,322,508,320,506,318,504,316,502,312,500,310,498,308,496,306,494,304,492,302,490,300,488,298,486,294,484,292,482,290,480,288,478,286,476,286,474,284,472,282,470,280,468,278,466,276
DATA 464,274,462,272,460,270,458,268,456,268,454,266,452,264,450,262,448,260,446,260,444,258,442,256,440,256,438,254,436,252,434,252,432,250,430,248,428,248,426,246,424,246,422,244,420,242,418,242,416,240
DATA 414,240,412,238,410,238,408,238,406,236,404,236,402,234,400,234,398,232,396,232,394,232,392,230,390,230,388,230,386,228,384,228,382,228,380,228,378,226,376,226,374,226,372,226,370,224,368,224,366,224
DATA 364,224,362,224,360,224,358,224,356,222,354,222,352,222,350,222,348,222,346,222,344,222,342,222,340,222,338,222,336,222,334,222,332,222,330,222,328,222,326,222,324,222,322,224,320,224,318,224,316,224
DATA 314,224,312,224,310,226,308,226,306,226,304,226,302,228,300,228,298,228,296,228,294,230,292,230,290,230,288,230,286,232,284,232,282,234,280,234,278,234,276,236,274,236,272,238,270,238,268,240,266,240
DATA 264,242,262,242,260,244,258,244,256,246,254,246,252,248,250,248,248,250,246,252,244,252,242,254,240,256,238,258,236,258,234,260,232,262,230,264,228,266,226,268,224,270,222,272,220,274,218,276,216,278
DATA 214,280,212,284,210,286,208,288,206,292,204,294,202,298,200,300,198,304,196,308,194,312,192,316,190,322,188,326,186,332,184,340,182,348,180,358,178,374
DATA 178,386,178,388,178,390,178,392,178,394,178,396,178,398,178,400,178,402,178,404,178,406,178,408,178,410,178,412,178,414,179,416,179,418,179,420,179,422,179,424,180,426,180,428,180,430,181,432
DATA 181,434,181,436,182,438,182,440,183,442,183,444,183,446,184,448,184,450,185,452,186,454,186,456,186,458,187,460,188,462,188,464,189,466,189,468,190,470,191,472,191,474,192,476,193,478,194,480,194,482
DATA 195,484,196,486,197,488,197,490,198,492,199,494,200,496,201,498,202,500,203,502,204,504,205,506,206,508,207,510,208,512,209,514,210,516,211,518,212,520,213,522,214,524,216,526,217,528,218,530,219,532
DATA 220,534,222,536,223,538,224,540,226,542,227,544,228,546,230,548,231,550,232,552,234,554,235,556,236,558,238,560,239,562,241,564,242,566,243,568,245,570,246,572,248,574,249,576,251,578,252,580,254,582
DATA 255,584,257,586,258,588,260,590,261,592,263,594,265,596,266,598,268,600,269,602,271,604,272,606,274,608,276,610,277,612,279,614,281,616,282,618,284,620,286,622,287,624,289,626,291,628,292,630,294,632
DATA 296,634,297,636,299,638,300,640,302,642,304,644,306,646,308,648,309,650,311,652,313,654,314,656,316,658,318,660,320,662,321,664,323,666,325,668,327,670,329,672,330,674,332,676,334,678,336,680,337,682
DATA 339,684,341,686,343,688,345,690,347,692,348,694,350,696,352,698,354,700,356,702,358,704,359,706,361,708,363,710,365,712,367,714,369,716,371,718,372,720,374,722,376,724,378,726,380,728,382,730,384,732
DATA 386,734,388,736,389,738,391,740,393,742,395,744,397,746,399,748,401,750,403,752,405,754,407,756,409,758,410,760,412,762,414,764,416,766,418,768,420,770,422,772,424,774,426,776,428,778,430,780,431,782
DATA 433,784,435,786,437,788,439,790,441,792,443,794,445,796,447,798,449,800,450,802,452,804,454,806,456,808,458,810,460,812,462,814,464,816,466,818,468,820,470,822,471,824,473,826,475,828,477,830,479,832
DATA 481,834,483,836,485,838,487,840,489,842,491,844,492,846,494,848,496,850,498,852,500,854,502,856,504,858,506,860,508,862,510,864,511,866
CALL SAVE
FOR I=1 TO 5
SELECT CASE I
CASE 1
LET M=.5
CASE 2
LET M=.8
CASE 3
LET M=1.5
CASE 4
LET M=3
CASE 5
LET M=8
END SELECT
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF ABS((X-XX)/XX)^M+ABS((Y-YY)/YY)^M<1 THEN CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
NEXT I
FOR I=1 TO 5
IF I=1 THEN LET M=3 ELSE LET M=M+1
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF X=XX AND Y=YY THEN LET TH=0 ELSE LET TH=ANGLE(X-XX,Y-YY)
LET RR=R*.8+R*.2*COS(M*TH)
IF SQR((Y-YY)^2+(X-XX)^2)<RR THEN CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
NEXT I
LET RR=XSIZE/4
LET TH=0
FOR I=1 TO 3
IF I=1 THEN LET B=2 ELSE LET B=3
IF I=3 THEN LET TH=180
FOR Y=0 TO YSIZE-1
LET X1=RR/2+RR/2*SIN(RAD(B*Y))
LET X2=XSIZE-RR/2+RR/2*SIN(RAD(B*Y+TH))
FOR X=INT(X1) TO INT(X2)
CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
NEXT I
FOR I=1 TO 2
FOR Y=0 TO YSIZE-1
LET X1=XSIZE/4*SIN(RAD(Y/(YSIZE/180)))
IF I=2 THEN
LET X2=XSIZE-XSIZE/4*SIN(RAD(Y/(YSIZE/180)))
ELSE
LET X2=XSIZE*.75+XSIZE/4*SIN(RAD(Y/(YSIZE/180)))
END IF
FOR X=INT(X1) TO INT(X2)
CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
NEXT I
FOR I=1 TO 2
FOR X=0 TO XSIZE-1
LET Y1=YSIZE/4+YSIZE/4*SIN(RAD(X/(XSIZE/180)+180))
IF I=2 THEN
LET Y2=YSIZE*.75-YSIZE/4*SIN(RAD(X/(XSIZE/180)+180))
ELSE
LET Y2=YSIZE+YSIZE/4*SIN(RAD(X/(XSIZE/180)+180))
END IF
FOR Y=INT(Y1) TO INT(Y2)
CALL PSET(X,Y,7)
NEXT Y
NEXT X
CALL SAVE
NEXT I
FOR Y=0 TO YSIZE-1
LET X1=XSIZE/4+R/2*SIN(RAD(Y/(YSIZE/180)+180))
LET X2=XSIZE*.75-XSIZE/4*SIN(RAD(Y/(YSIZE/180)+180))
FOR X=INT(X1) TO INT(X2)
CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF X=XX AND Y=YY THEN LET TH=0 ELSE LET TH=ANGLE(X-XX,Y-YY)
LET RR=MIN(XSIZE/5,YSIZE/5)*(1+COS(5*TH+PI/2))
IF SQR((Y-YY)^2+(X-XX)^2)<RR THEN CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF X=XX AND Y=YY THEN LET TH=0 ELSE LET TH=ANGLE(X-XX,Y-YY)
LET RR=MIN(XSIZE/6,YSIZE/6)*(2+COS(5*TH))
IF SQR((Y-YY)^2+(X-XX)^2)<RR THEN CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF ((X-XX)*(X-XX)+SQR(2)*(X-XX)*(Y-YY)+(Y-YY)*(Y-YY)-R/2*R/2)<0 OR ((X-XX)*(X-XX)-SQR(2)*(X-XX)*(Y-YY)+(Y-YY)*(Y-YY)-R/2*R/2)<0 THEN CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
FOR I=2 TO 5
CALL NAMI(XX,YY,R*.6,R/4,I,7)
PAINT XX,YY
CALL SAVE
NEXT I
CALL NAMI(XX,YY,R*.9,20,20,7)
PAINT XX,YY
CALL SAVE
CALL HAGURUMA(XX,YY,R*.9,20,20,7)
PAINT XX,YY
CALL SAVE
LET XO(1)=0
LET YO(1)=0
LET XO(2)=XX
LET YO(2)=YSIZE-1
LET XO(3)=XSIZE-1
LET YO(3)=0
LET X1=XO(1)
LET Y1=YO(1)
FOR X=0 TO XSIZE-1
LET Y=LARGRANGE(XO,YO,3,X)
CALL LINE(X1,Y1,X,Y,7)
LET X1=X
LET Y1=Y
NEXT X
PAINT XX,YY
CALL SAVE
LET XO(1)=0
LET YO(1)=0
LET XO(2)=XSIZE/4
LET YO(2)=YSIZE-1
LET XO(3)=XX
LET YO(3)=YSIZE*.75
LET XO(4)=XSIZE*.75
LET YO(4)=YSIZE-1
LET XO(5)=XSIZE-1
LET YO(5)=0
LET X1=XO(1)
LET Y1=YO(1)
FOR X=0 TO XSIZE-1
LET Y=LARGRANGE(XO,YO,5,X)
CALL LINE(X1,Y1,X,Y,7)
LET X1=X
LET Y1=Y
NEXT X
PAINT XX,YY
CALL SAVE
DIM TT(10)
LET XO(1)=0
LET YO(1)=0
LET TT(1)=0
LET XO(2)=XSIZE*.2
LET YO(2)=YY
LET TT(2)=.5
LET XO(3)=0
LET YO(3)=YSIZE-1
LET TT(3)=1
FOR T=0 TO 1 STEP 1/16
LET X=LARGRANGE(TT,XO,3,T)
LET Y=LARGRANGE(TT,YO,3,T)
IF T=0 THEN
LET X1=X
LET Y1=Y
END IF
CALL LINE(X1,Y1,X,Y,7)
CALL LINE(XSIZE-X1,Y1,XSIZE-X,Y,7)
LET X1=X
LET Y1=Y
NEXT T
LET XO(1)=0
LET YO(1)=0
LET TT(1)=0
LET XO(2)=XX
LET YO(2)=YSIZE*.2
LET TT(2)=.5
LET XO(3)=XSIZE-1
LET YO(3)=0
LET TT(3)=1
FOR T=0 TO 1 STEP 1/16
LET X=LARGRANGE(TT,XO,3,T)
LET Y=LARGRANGE(TT,YO,3,T)
IF T=0 THEN
LET X1=X
LET Y1=Y
END IF
CALL LINE(X1,Y1,X,Y,7)
CALL LINE(X1,YSIZE-Y1,X,YSIZE-Y,7)
LET X1=X
LET Y1=Y
NEXT T
PAINT XX,YY
CALL SAVE
SET TEXT HEIGHT MIN(XSIZE,YSIZE)*.8
SET TEXT COLOR 7
SET TEXT JUSTIFY "LEFT" , "TOP"
PLOT TEXT ,AT 0,0:"Ａ"
CALL SAVE
SUB SAVE
LET NUM=NUM+1
GSAVE STR$(NUM)&".gif"
PRINT NUM
WAIT DELAY 1
CLEAR
END SUB
SUB TRANS
SET AREA COLOR 4
PAINT 0,0
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF GETPOINT(X,Y)=4 THEN CALL PSET(X,Y,0) ELSE CALL PSET(X,Y,7)
NEXT X
NEXT Y
CALL SAVE
END SUB
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL SUB POLY(X,Y,R,C,S,E,ST)
LET X0=X+R*COS(S*PI/180)
LET Y0=Y-R*SIN(S*PI/180)
FOR TH=S+ST TO E STEP ST
LET X1=X+R*COS(TH*PI/180)
LET Y1=Y-R*SIN(TH*PI/180)
CALL LINE(X0,Y0,X1,Y1,C)
LET X0=X1
LET Y0=Y1
NEXT TH
END SUB
EXTERNAL SUB CIRCLEFULL(X,Y,R1,R2,C)
SET COLOR C
DRAW DISK WITH SCALE(R1,R2)*SHIFT(X,Y)
END SUB
EXTERNAL SUB SECTOR(XX,YY,R,A,C)
DIM XO(90-A/2 TO 90+A/2+1),YO(90-A/2 TO 90+A/2+1)
FOR T=90-A/2 TO 90+A/2
LET XO(T)=XX+R*COS(RAD(T))
LET YO(T)=YY-R*SIN(RAD(T))
NEXT T
LET XO(90+A/2+1)=XX
LET YO(90+A/2+1)=YY
SET AREA COLOR C
MAT PLOT AREA,LIMIT A+2:XO,YO
END SUB
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL FUNCTION GETPOINT(X,Y)
ASK PIXEL VALUE(X,Y) C
LET GETPOINT=C
END FUNCTION
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:INT(XS),INT(YS);INT(XE),INT(YE)
END SUB
EXTERNAL SUB NAMI(X,Y,R,R1,N,C)
IF R<R1 THEN LET R1=R
FOR TH=0 TO 360
LET R2=R1*SIN(N*TH*PI/180+PI/2)
LET X1=X+(R+R2)*COS(TH*PI/180+PI/2)
LET Y1=Y-(R+R2)*SIN(TH*PI/180+PI/2)
IF TH=0 THEN
LET X0=X1
LET Y0=Y1
LET XS=X0
LET YS=Y0
END IF
CALL LINE(X0,Y0,X1,Y1,C)
LET X0=X1
LET Y0=Y1
NEXT TH
CALL LINE(X1,Y1,XS,YS,C)
END SUB
EXTERNAL SUB HAGURUMA(X,Y,R,R1,N,C)
IF R<R1 THEN LET R1=R
FOR TH=0 TO 360
LET R2=R1*SGN(SIN(N*TH*PI/180+PI/2))
LET X1=X+(R+R2)*COS(TH*PI/180+PI/2)
LET Y1=Y-(R+R2)*SIN(TH*PI/180+PI/2)
IF TH=0 THEN
LET X0=X1
LET Y0=Y1
LET XS=X0
LET YS=Y0
END IF
CALL LINE(X0,Y0,X1,Y1,C)
LET X0=X1
LET Y0=Y1
NEXT TH
CALL LINE(X1,Y1,XS,YS,C)
END SUB
EXTERNAL FUNCTION LARGRANGE(X(),Y(),N,T)
FOR I=1 TO N
LET R=Y(I)
FOR J=1 TO N
IF I<>J THEN LET R=R*(T-X(J))/(X(I)-X(J))
NEXT J
LET S=S+R
NEXT I
LET LARGRANGE=S
END FUNCTION
!'アフィン変換(回転変換)
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY(0,0) M
LET XM=INT(XSIZE/2) !'回転中心
LET YM=INT(YSIZE/2)
INPUT PROMPT "回転角度=":TH
LET C=COS(RAD(TH))
LET S=SIN(RAD(TH))
LET XA=INT((0-XM)*C-(0-YM)*S+XM)
LET YA=INT((0-XM)*S+(0-YM)*C+YM)
LET XB=INT((0-XM)*C-(YSIZE-1-YM)*S+XM)
LET YB=INT((0-XM)*S+(YSIZE-1-YM)*C+YM)
LET XC=INT((XSIZE-1-XM)*C-(YSIZE-1-YM)*S+XM)
LET YC=INT((XSIZE-1-XM)*S+(YSIZE-1-YM)*C+YM)
LET XD=INT((XSIZE-1-XM)*C-(0-YM)*S+XM)
LET YD=INT((XSIZE-1-XM)*S+(0-YM)*C+YM)
LET XMIN=MIN(MIN(XA,XB),MIN(XC,XD))
LET YMIN=MIN(MIN(YA,YB),MIN(YC,YD))
LET XMAX=MAX(MAX(XA,XB),MAX(XC,XD))
LET YMAX=MAX(MAX(YA,YB),MAX(YC,YD))
CALL GINIT(XMAX-XMIN+1,YMAX-YMIN+1)
!' アフィン変換(回転変換)
!' X'=X*COS(T)-Y*SIN(T)
!' Y'=X*SIN(T)+Y*COS(T)
!' 逆変換
!' X=Y'*SIN(T)+X'*COS(T)
!' Y=Y'*COS(T)-X'*SIN(T)
FOR Y=YMIN TO YMAX
FOR X=XMIN TO XMAX
LET XA=(Y-YM)*SIN(RAD(TH))+(X-XM)*COS(RAD(TH))+XM
LET YA=(Y-YM)*COS(RAD(TH))-(X-XM)*SIN(RAD(TH))+YM
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN
CALL RGB(M(INT(XA),INT(YA)),RR,GG,BB)
CALL PSET(X-XMIN,Y-YMIN,RR,GG,BB)
END IF
NEXT X
NEXT Y
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'アフィン変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1),A(3,3),B(3),D(3,3)
DIM A1(2),B1(2),C1(2),D1(2),E1(2),F1(2),AX(2),BX(2),CX(2),AY(2),BY(2),CY(2)
ASK PIXEL ARRAY(0,0) M
!'入力画像
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1 !'三角形 (XA,YA)-(XB,YB)-(XC,YC)と
LET XB=XSIZE*.8 !'三角形 (XA,YA)-(XC,YC)-(XD,YD)に分割
LET YB=YSIZE*.05
LET XC=XSIZE*.9
LET YC=YSIZE*.8
LET XD=XSIZE*.1
LET YD=YSIZE*.9
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF AREA4(XA,YA,XB,YB,XC,YC,XD,YD,X,Y)=0 THEN CALL PSET(X,Y,0,0,0)
NEXT X
NEXT Y
!'出力画像
LET X1=XSIZE*.1 !'任意の四角形 左上(X1,Y1)- 右上(X2,Y2)-右下(X3,Y3)-左下(X4,Y4)
LET Y1=YSIZE*.3 !'三角形 (X1,Y1)-(X2,Y2)-(X3,Y3)と
LET X2=XSIZE*.9 !'三角形 (X1,Y1)-(X3,Y3)-(X4,Y4)に分割
LET Y2=YSIZE*.1
LET X3=XSIZE*.7
LET Y3=YSIZE*.8
LET X4=XSIZE*.2
LET Y4=YSIZE*.9
!'INPUT PROMPT "ROTATE (0 - 3)=":N
!'CALL ROTATE(N,X1,X2,X3,X4) !'座標回転 (X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4) → (X2,Y2)-(X3,Y3)-(X4,Y4)-(X1,Y1) →
!'CALL ROTATE(N,Y1,Y2,Y3,Y4) !' (X3,Y3)-(X4,Y4)-(X1,Y1)-(X2,Y2) → (X4,Y4)-(X1,Y1)-(X2,Y2)-(X3,Y3)
!' アフィン変換
!' X'=A*X+B*Y+C
!' Y'=D*X+E*Y+F
!'三元連立方程式
!' (A)(XA YA 1) (X1)
!' (B)(XB YB 1)=(X2)
!' (C)(XC YC 1) (X3)
LET A(1,1)=XA
LET A(1,2)=YA
LET A(1,3)=1
LET A(2,1)=XB
LET A(2,2)=YB
LET A(2,3)=1
LET A(3,1)=XC
LET A(3,2)=YC
LET A(3,3)=1
LET B(1)=X1
LET B(2)=X2
LET B(3)=X3
LET AX(1)=B(1)
LET BX(1)=B(2)
LET CX(1)=B(3)
MAT D=INV(A)
MAT B=D*B
LET A1(1)=B(1)
LET B1(1)=B(2)
LET C1(1)=B(3)
!'三元連立方程式
!' (D)(XA YA 1) (Y1)
!' (E)(XB YB 1)=(Y2)
!' (F)(XC YC 1) (Y3)
LET B(1)=Y1
LET B(2)=Y2
LET B(3)=Y3
LET AY(1)=B(1)
LET BY(1)=B(2)
LET CY(1)=B(3)
MAT D=INV(A)
MAT B=D*B
LET D1(1)=B(1)
LET E1(1)=B(2)
LET F1(1)=B(3)
!'三元連立方程式
!' (A)(XA YA 1) (X1)
!' (B)(XC YC 1)=(X3)
!' (C)(XD YD 1) (X4)
LET A(1,1)=XA
LET A(1,2)=YA
LET A(1,3)=1
LET A(2,1)=XC
LET A(2,2)=YC
LET A(2,3)=1
LET A(3,1)=XD
LET A(3,2)=YD
LET A(3,3)=1
LET B(1)=X1
LET B(2)=X3
LET B(3)=X4
LET AX(2)=B(1)
LET BX(2)=B(2)
LET CX(2)=B(3)
MAT D=INV(A)
MAT B=D*B
LET A1(2)=B(1)
LET B1(2)=B(2)
LET C1(2)=B(3)
!'三元連立方程式
!' (D)(XA YA 1) (Y1)
!' (E)(XC YC 1)=(Y3)
!' (F)(XD YD 1) (Y4)
LET B(1)=Y1
LET B(2)=Y3
LET B(3)=Y4
LET AY(2)=B(1)
LET BY(2)=B(2)
LET CY(2)=B(3)
MAT D=INV(A)
MAT B=D*B
LET D1(2)=B(1)
LET E1(2)=B(2)
LET F1(2)=B(3)
WAIT DELAY 2
CLEAR
SET COLOR COLORINDEX (1,0,0)
PLOT AREA : X1,Y1;X2,Y2;X3,Y3
SET COLOR COLORINDEX (0,1,0)
PLOT AREA : X1,Y1;X3,Y3;X4,Y4
FOR YY=0 TO YSIZE-1
FOR XX=0 TO XSIZE-1
FOR I=1 TO 2
IF AREA3(AX(I),AY(I),BX(I),BY(I),CX(I),CY(I),XX,YY)<>0 THEN
CALL SOLVE(A1(I),B1(I),C1(I),D1(I),E1(I),F1(I),XX,YY,X,Y)
IF X>=0 AND X<=XSIZE-1 AND Y>=0 AND Y<=YSIZE-1 THEN
LET CC=M(INT(X),INT(Y))
CALL RGB(CC,RR,GG,BB)
CALL PSET(XX,YY,RR,GG,BB)
EXIT FOR
END IF
END IF
NEXT I
NEXT XX
NEXT YY
END
EXTERNAL SUB SOLVE(A,B,C,D,E,F,XX,YY,X,Y)
!'A*X+B*Y+C=XX
!'D*X+E*Y+F=YY
LET X = -(B*(F-YY)+E*XX-C*E)/(B*D-A*E)
LET Y = (A*(F-YY)+D*XX-C*D)/(B*D-A*E)
END SUB
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL FUNCTION TRIANGLE(X1,Y1,X2,Y2,X3,Y3) !'三角形の面積
LET TRIANGLE=ABS(X1*Y2+X2*Y3+X3*Y1-X2*Y1-X3*Y2-Y3*X1)/2
END FUNCTION
EXTERNAL FUNCTION AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY) !'点(PX,PY)が三角形内か
LET T=TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET A=TRIANGLE(X1,Y1,X2,Y2,PX,PY)
LET B=TRIANGLE(X2,Y2,X3,Y3,PX,PY)
LET C=TRIANGLE(X1,Y1,X3,Y3,PX,PY)
IF ABS(A+B+C-T)<1 THEN LET AREA3=-1 ELSE LET AREA3=0
END FUNCTION
EXTERNAL FUNCTION AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,PX,PY) !'点(PX,PY)が四角形内か
LET A=AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY)
LET B=AREA3(X1,Y1,X4,Y4,X3,Y3,PX,PY)
IF A<>0 OR B<>0 THEN LET AREA4=-1 ELSE LET AREA4=0
END FUNCTION
EXTERNAL SUB ROTATE(N,A,B,C,D)
FOR I=1 TO N
LET T=B
LET B=A
LET A=D
LET D=C
LET C=T
NEXT I
END SUB
!'共一次変換(擬似アフィン変換)
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1)
ASK PIXEL ARRAY(0,0) M
!' 共一次変換
!' X=A*S*T+B*S+C*T+D (0<=S<=1)(0<=T<=1)
!' Y=E*S*T+F*S+G*T+H
!'S=0,T=0 の時,左上(XA,YA) D=XA,H=YA
!'S=1,T=0 の時,右上(XB,YB) B+XA=XB,F+YA=YB B=XB-XA,F=YB-YA
!'S=0,T=1 の時,左下(XD,YD) C+XA=XD,G+YA=YD C=XD-XA,G=YD-YA
!'S=1,T=1 の時,右下(XC,YC) A+XB-XA+XD-XA+XA=XC,E+YB-YA+YD-YA+YA=YC A=XC+XA-XD-XB,E=YA+YC-YD-YB
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1
LET XB=XSIZE*.8
LET YB=YSIZE*.05
LET XC=XSIZE*.9
LET YC=YSIZE*.8
LET XD=XSIZE*.1
LET YD=YSIZE*.9
CLEAR
SET COLOR COLORINDEX(1,0,0)
PLOT AREA : XA,YA;XB,YB;XC,YC;XD,YD
FOR YY=0 TO YSIZE-1
FOR XX=0 TO XSIZE-1
LET S=XX/(XSIZE-1)
LET T=YY/(YSIZE-1)
LET X=INT((XA+XC-XD-XB)*S*T+(XD-XA)*T+(XB-XA)*S+XA) !'共一次変換
LET Y=INT((YA+YC-YD-YB)*S*T+(YD-YA)*T+(YB-YA)*S+YA)
CALL RGB(M(XX,YY),R,G,B)
CALL PSET(X,Y,R,G,B)
NEXT XX
NEXT YY
END
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
!'共一次変換(擬似アフィン変換)
PUBLIC NUMERIC XSIZE,YSIZE
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1),A(4,4),D(4)
ASK PIXEL ARRAY(0,0) M
!'入力画像
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1
LET XB=XSIZE*.8
LET YB=YSIZE*.05
LET XC=XSIZE*.9
LET YC=YSIZE*.8
LET XD=XSIZE*.1
LET YD=YSIZE*.9
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF AREA4(XA,YA,XB,YB,XC,YC,XD,YD,X,Y)=0 THEN CALL PSET(X,Y,0,0,0)
NEXT X
NEXT Y
!'出力画像
LET X1=XSIZE*.1 !'任意の四角形 左上(X1,Y1)- 右上(X2,Y2)-右下(X3,Y3)-左下(X4,Y4)
LET Y1=YSIZE*.3
LET X2=XSIZE*.9
LET Y2=YSIZE*.1
LET X3=XSIZE*.7
LET Y3=YSIZE*.8
LET X4=XSIZE*.2
LET Y4=YSIZE*.9
!'INPUT PROMPT "ROTATE (0 - 3)=":N
!'CALL ROTATE(N,X1,X2,X3,X4) !'座標回転 (X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4) → (X2,Y2)-(X3,Y3)-(X4,Y4)-(X1,Y1) →
!'CALL ROTATE(N,Y1,Y2,Y3,Y4) !' (X3,Y3)-(X4,Y4)-(X1,Y1)-(X2,Y2) → (X4,Y4)-(X1,Y1)-(X2,Y2)-(X3,Y3)
WAIT DELAY 2
CLEAR
SET COLOR COLORINDEX (1,0,0)
PLOT AREA : X1,Y1;X2,Y2;X3,Y3;X4,Y4
!'共一次変換(擬似アフィン変換)
!' X'=A*X*Y+B*X+C*Y+D
!' Y'=E*X*Y+F*X+G*Y+H
!'4元連立方程式
!'A*XA*YA+B*XA+C*YA+D=X1
!'A*XB*YB+B*XB+C*YB+D=X2
!'A*XC*YC+B*XC+C*YC+D=X3
!'A*XD*YD+B*XD+C*YD+D=X4
LET A(1,1)=XA*YA
LET A(1,2)=XA
LET A(1,3)=YA
LET A(1,4)=1
LET D(1)=X1
LET A(2,1)=XB*YB
LET A(2,2)=XB
LET A(2,3)=YB
LET A(2,4)=1
LET D(2)=X2
LET A(3,1)=XC*YC
LET A(3,2)=XC
LET A(3,3)=YC
LET A(3,4)=1
LET D(3)=X3
LET A(4,1)=XD*YD
LET A(4,2)=XD
LET A(4,3)=YD
LET A(4,4)=1
LET D(4)=X4
MAT A=INV(A)
MAT D=A*D
LET A1=D(1)
LET B1=D(2)
LET C1=D(3)
LET D1=D(4)
!'4元連立方程式
!'E*XA*YA+F*XA+G*YA+H=Y1
!'E*XB*YB+F*XB+G*YB+H=Y2
!'E*XC*YC+F*XC+G*YC+H=Y3
!'E*XD*YD+F*XD+G*YD+H=Y4
LET A(1,1)=XA*YA
LET A(1,2)=XA
LET A(1,3)=YA
LET A(1,4)=1
LET D(1)=Y1
LET A(2,1)=XB*YB
LET A(2,2)=XB
LET A(2,3)=YB
LET A(2,4)=1
LET D(2)=Y2
LET A(3,1)=XC*YC
LET A(3,2)=XC
LET A(3,3)=YC
LET A(3,4)=1
LET D(3)=Y3
LET A(4,1)=XD*YD
LET A(4,2)=XD
LET A(4,3)=YD
LET A(4,4)=1
LET D(4)=Y4
MAT A=INV(A)
MAT D=A*D
LET E1=D(1)
LET F1=D(2)
LET G1=D(3)
LET H1=D(4)
FOR YY=0 TO YSIZE-1
FOR XX=0 TO XSIZE-1
IF AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,XX,YY)<>0 THEN
CALL SOLVE(A1,B1,C1,D1-XX,E1,F1,G1,H1-YY,XA,YA)
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN
CALL RGB(M(XA,YA),R,G,B)
CALL PSET(XX,YY,R,G,B)
END IF
END IF
NEXT XX
NEXT YY
END
EXTERNAL SUB SOLVE(A,B,C,D,E,F,G,H,XA,YA)
!' X,Yについて解く(逆変換)
!' A*X*Y+B*X+C*Y+D=0...(1)
!' E*X*Y+F*X+G*Y+H=0...(2)
!' X*(A*Y+B)=-C*Y-D (1)の式より...(3)
!' E*X*Y*(A*Y+B)+F*X*(A*Y+B)+G*Y*(A*Y+B)+H*(A*Y+B)=0 (2)の式に(A*Y+B)を掛ける
!' E*Y*(-C*Y-D) +F*(-C*Y-D) +G*Y*(A*Y+B)+H*(A*Y+B)=0 (3)の式を代入
!' Y^2*(-E*C+A*G)+Y*(-E*D-F*C+G*B+A*H)+(-F*D+H*B)=0 Yについての2次方程式
!' X=(-C*Y-D)/(A*Y+B) (3)の式より変形
LET AA=-E*C+A*G
LET BB=-E*D-F*C+G*B+A*H
LET CC=-F*D+H*B
LET DD=BB*BB-4*AA*CC
IF DD<0 THEN
LET XA=-1
LET YA=-1
EXIT SUB
END IF
LET YA=INT((-BB+SQR(DD))/(2*AA))
LET XA=INT((-C*YA-D)/(A*YA+B))
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN EXIT SUB
LET YA=INT((-BB-SQR(DD))/(2*AA))
LET XA=INT((-C*YA-D)/(A*YA+B))
IF XA>=0 AND XA<=XSIZE-1 AND YA>=0 AND YA<=YSIZE-1 THEN EXIT SUB
LET XA=-1
LET YA=-1
END SUB
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL FUNCTION TRIANGLE(X1,Y1,X2,Y2,X3,Y3) !'三角形の面積
LET TRIANGLE=ABS(X1*Y2+X2*Y3+X3*Y1-X2*Y1-X3*Y2-Y3*X1)/2
END FUNCTION
EXTERNAL FUNCTION AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY) !'点(PX,PY)が三角形内か
LET T=TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET A=TRIANGLE(X1,Y1,X2,Y2,PX,PY)
LET B=TRIANGLE(X2,Y2,X3,Y3,PX,PY)
LET C=TRIANGLE(X1,Y1,X3,Y3,PX,PY)
IF ABS(A+B+C-T)<1 THEN LET AREA3=-1 ELSE LET AREA3=0
END FUNCTION
EXTERNAL FUNCTION AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,PX,PY) !'点(PX,PY)が四角形内か
LET A=AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY)
LET B=AREA3(X1,Y1,X4,Y4,X3,Y3,PX,PY)
IF A<>0 OR B<>0 THEN LET AREA4=-1 ELSE LET AREA4=0
END FUNCTION
EXTERNAL SUB ROTATE(N,A,B,C,D)
FOR I=1 TO N
LET T=B
LET B=A
LET A=D
LET D=C
LET C=T
NEXT I
END SUB
!' 平面射影変換
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM M(0 TO XSIZE-1,0 TO YSIZE-1),A(8,8),D(8)
ASK PIXEL ARRAY(0,0) M
!'入力画像
LET XA=XSIZE*.3 !'任意の四角形 左上(XA,YA)-右上(XB,YB)-右下(XC,YC)-左下(XD,YD)
LET YA=YSIZE*.1
LET XB=XSIZE*.8
LET YB=YSIZE*.05
LET XC=XSIZE*.9
LET YC=YSIZE*.8
LET XD=XSIZE*.1
LET YD=YSIZE*.9
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF AREA4(XA,YA,XB,YB,XC,YC,XD,YD,X,Y)=0 THEN CALL PSET(X,Y,0,0,0)
NEXT X
NEXT Y
!'出力画像
LET X1=XSIZE*.1 !'任意の四角形 左上(X1,Y1)- 右上(X2,Y2)-右下(X3,Y3)-左下(X4,Y4)
LET Y1=YSIZE*.3
LET X2=XSIZE*.9
LET Y2=YSIZE*.1
LET X3=XSIZE*.7
LET Y3=YSIZE*.8
LET X4=XSIZE*.2
LET Y4=YSIZE*.9
!'INPUT PROMPT "ROTATE (0 - 3)=":N
!'CALL ROTATE(N,X1,X2,X3,X4) !'座標回転 (X1,Y1)-(X2,Y2)-(X3,Y3)-(X4,Y4) → (X2,Y2)-(X3,Y3)-(X4,Y4)-(X1,Y1) →
!'CALL ROTATE(N,Y1,Y2,Y3,Y4) !' (X3,Y3)-(X4,Y4)-(X1,Y1)-(X2,Y2) → (X4,Y4)-(X1,Y1)-(X2,Y2)-(X3,Y3)
WAIT DELAY 2
CLEAR
SET COLOR COLORINDEX (1,0,0)
PLOT AREA : X1,Y1;X2,Y2;X3,Y3;X4,Y4
!' 平面射影変換
!' X'=(A*X+B*Y+C)/(G*X+H*Y+1)
!' Y'=(D*X+E*F+C)/(G*X+H*Y+1)
!' A*X+B*Y+C-X'*(G*X+H*Y)=X'
!' D*X+E*Y+F-Y'*(G*X+H*Y)=Y'
!' 八元連立方程式
!'(A)(XA, YA, 1, 0, 0, 0,-X1*XA,-X1*YA) (X1)
!'(B)(XB, YB, 1, 0, 0, 0,-X2*XB,-X2*YB) (X2)
!'(C)(XC, YC, 1, 0, 0, 0,-X3*XC,-X3*YC) (X3)
!'(D)(XD, YD, 1, 0, 0, 0,-X4*XD,-X4*YD) (X4)
!'(E)( 0, 0, 0,XA,YA, 1,-Y1*XA,-Y1*YA)=(Y1)
!'(F)( 0, 0, 0,XB,YB, 1,-Y2*XB,-Y2*YB) (Y2)
!'(G)( 0, 0, 0,XC,YC, 1,-Y3*XC,-Y3*YC) (Y3)
!'(H)( 0, 0, 0,XD,YD, 1,-Y4*XD,-Y4*YD) (Y4)
LET A(1,1)=XA
LET A(1,2)=YA
LET A(1,3)=1
LET A(1,7)=-X1*XA
LET A(1,8)=-X1*YA
LET D(1)=X1
LET A(2,1)=XB
LET A(2,2)=YB
LET A(2,3)=1
LET A(2,7)=-X2*XB
LET A(2,8)=-X2*YB
LET D(2)=X2
LET A(3,1)=XC
LET A(3,2)=YC
LET A(3,3)=1
LET A(3,7)=-X3*XC
LET A(3,8)=-X3*YC
LET D(3)=X3
LET A(4,1)=XD
LET A(4,2)=YD
LET A(4,3)=1
LET A(4,7)=-X4*XD
LET A(4,8)=-X4*YD
LET D(4)=X4
LET A(5,4)=XA
LET A(5,5)=YA
LET A(5,6)=1
LET A(5,7)=-Y1*XA
LET A(5,8)=-Y1*YA
LET D(5)=Y1
LET A(6,4)=XB
LET A(6,5)=YB
LET A(6,6)=1
LET A(6,7)=-Y2*XB
LET A(6,8)=-Y2*YB
LET D(6)=Y2
LET A(7,4)=XC
LET A(7,5)=YC
LET A(7,6)=1
LET A(7,7)=-Y3*XC
LET A(7,8)=-Y3*YC
LET D(7)=Y3
LET A(8,4)=XD
LET A(8,5)=YD
LET A(8,6)=1
LET A(8,7)=-Y4*XD
LET A(8,8)=-Y4*YD
LET D(8)=Y4
MAT A=INV(A)
MAT D=A*D
LET A1=D(1)
LET B1=D(2)
LET C1=D(3)
LET D1=D(4)
LET E1=D(5)
LET F1=D(6)
LET G1=D(7)
LET H1=D(8)
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
!' X,Yについて解く(逆変換)
!' X'=(A*X+B*Y+C)/(G*X+H*Y+1)
!' Y'=(D*X+E*Y+F)/(G*X+H*Y+1)
!' A*X+B*Y+C-X'(G*X+H*Y+1)=0
!' D*X+E*Y+F-Y'(G*X+H*Y+1)=0
!' X,Yについてまとめる
!' X(A-G*X')+Y(B-X'*H)=X'-C
!' X(D-G*Y')+Y(E-Y'*H)=Y'-F
IF AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,X,Y)<>0 THEN
CALL SOLVE(A1-G1*X,B1-X*H1,X-C1,D1-G1*Y,E1-Y*H1,Y-F1,XA,YA)
IF XA>=0 AND YA>=0 AND XA<=XSIZE-1 AND YA<=YSIZE-1 THEN
CALL RGB(M(XA,YA),RR,GG,BB)
CALL PSET(X,Y,RR,GG,BB)
END IF
END IF
NEXT X
NEXT Y
END
EXTERNAL FUNCTION AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY)
LET T=TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET A=TRIANGLE(X1,Y1,X2,Y2,PX,PY)
LET B=TRIANGLE(X2,Y2,X3,Y3,PX,PY)
LET C=TRIANGLE(X1,Y1,X3,Y3,PX,PY)
IF ABS(A+B+C-T)<3 THEN LET AREA3=-1 ELSE LET AREA3=0
END FUNCTION
EXTERNAL FUNCTION AREA4(X1,Y1,X2,Y2,X3,Y3,X4,Y4,PX,PY)
LET A=AREA3(X1,Y1,X2,Y2,X3,Y3,PX,PY)
LET B=AREA3(X1,Y1,X4,Y4,X3,Y3,PX,PY)
IF A<>0 OR B<>0 THEN LET AREA4=-1 ELSE LET AREA4=0
END FUNCTION
EXTERNAL SUB SOLVE(A1,B1,C1,A2,B2,C2,X,Y)
!'A1*X+B1*Y=C1
!'A2*X+B2*Y=C2
LET DD=A1*B2-A2*B1
IF DD=0 THEN
LET X=-1
LET Y=-1
ELSE
LET X=(C1*B2-C2*B1)/DD
LET Y=(A1*C2-A2*C1)/DD
END IF
END SUB
EXTERNAL FUNCTION TRIANGLE(X1,Y1,X2,Y2,X3,Y3)
LET TRIANGLE=ABS(X1*Y2+X2*Y3+X3*Y1-X2*Y1-X3*Y2-Y3*X1)/2
END FUNCTION
EXTERNAL SUB RGB(X,R,G,B)
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
GLOAD N$
LET XSIZE=PIXELX(1)
LET YSIZE=PIXELY(1)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB ROTATE(N,A,B,C,D)
FOR I=1 TO N
LET T=B
LET B=A
LET A=D
LET D=C
LET C=T
NEXT I
END SUB
TCommfile=class(TTextDevice1)
FHandle:THandle;
Limit:TDateTime;
constructor create;
destructor destroy;override;
procedure open(FName:FNameStr; am:AccessMode; og:OrganizationType; len:integer );override;
procedure close;override;
procedure erase(rs:tpRecordSetter; insideofwhen:boolean);override;
procedure initInput(LineNumb:integer;const prom:AnsiString; TimeLimit:double);override;
procedure CharacterInput(var s:AnsiString; option:IOoptions);override;
procedure flush;override;
function DataFoundForRead:boolean;override;
function DataFoundForWrite:boolean;override;
function choose(i1,i2,i3,i4:integer):integer;override;
function askpointer:Ansistring;override;
function TrueFile:boolean;override;
function AskCharacterPending:integer;override;
function AskTypeAhead:boolean;override;
private
function readline:boolean;override;
procedure PortOpen(const FName:string);
procedure readchar(var c:char);
procedure transstring(s:string);
function GetReceiveLength: Integer;
procedure ClearReceiveBuf;
procedure PortClose;
function ReadByte:char;override;
end;
resourceString
s_FailedOpen= 'をオープンできませんでした';
procedure TCommFile.PortOpen(const FName:string);
var
lpCC:TCOMMCONFIG;
size:dWord;
LPCommProp:TCommProp;
LPCOMMTIMEOUTs:TCOMMTIMEOUTs;
SubName:string;
begin
if (FHandle <> INVALID_HANDLE_VALUE) or (FName='') then begin
raise ECommError.Create('');
end;
subName:=ExtractPortName(FName);
if (Length(subName)>=5) and (uppercase(copy(subName,1,3))='COM')
and (subName[4] in ['1'..'9']) and (subName[5] in ['0'..'9'])
and ((Length(subName)=5) or (subName[6] in ['0'..'9'])) then
subName:='\\.\' + subName;
if FHandle = INVALID_HANDLE_VALUE then begin
raise ECommError.Create(FName+s_FailedOpen);
end;
//SetBufferLength; // 送受信バッファ長の設定
GetCommState(FHandle,lpCC.DCB);
size:=sizeOf(lpCC);
if GetDefaultCommConfig(PChar(ExtractPortName(FName)),lpCC,size)
and ((pos(':',Fname)=0) or BuildCommDCB(PChar(FName),lpCC.DCB))
and SetCommState(FHandle,lpCC.DCB) then
else
begin
PortClose;
raise ECommError.Create(FName + s_FailedOpen);
end;
procedure TCommFile.PortClose;
var
Msg : TMsg;
Handle : THandle;
begin
if FHandle <> INVALID_HANDLE_VALUE then
begin
CloseHandle(FHandle); // 通信ポートをクローズ
FHandle := INVALID_HANDLE_VALUE;
end;
end;
procedure TCommFile.open(FName:FNameStr; am:AccessMode; og:OrganizationType; len:integer);
var
ermess:ansistring;
s:string;
begin
if FName='' then setexception(7101);
if isOpen then setexception(7003);
if (rectype=rcDISPLAY) and (og=orgSTREAM) then setexception(7101);
if len<=0 then setexception(7051);
name:=uppercase(FName);
leng:=len;
margin:=len;
AMode:=am;
OrgType:=og;
try
portopen(name);
except
on E:exception do
setexceptionWith(E.Message,7101);
end;
受信バッファが空でないときにCloseHandleを実行するのが原因だとしたら、
DO
ASK CHARACTER PENDING #1:n
IF n=0 THEN EXIT DO
CHARACTER INPUT #1:s$
LOOP
みたいなコードをCLOSE文の直前に追加すれば改善されるはずです。
> CLoseHandleの戻り値をチェックしていないので、クローズが正常に行えないのにBASICのCLOSE文が終了してしまっているのかもしれません。
>
> 受信バッファが空でないときにCloseHandleを実行するのが原因だとしたら、
> DO
> ASK CHARACTER PENDING #1:n
> IF n=0 THEN EXIT DO
> CHARACTER INPUT #1:s$
> LOOP
> みたいなコードをCLOSE文の直前に追加すれば改善されるはずです。
>
DECLARE EXTERNAL FUNCTION CloseHandle
DECLARE EXTERNAL FUNCTION CreateFile
DECLARE EXTERNAL FUNCTION ReadFile
DECLARE EXTERNAL FUNCTION WriteFile
DECLARE EXTERNAL FUNCTION BuildCommDCB
DECLARE EXTERNAL FUNCTION GetCommState
DECLARE EXTERNAL FUNCTION GetCommTimeouts
DECLARE EXTERNAL FUNCTION SetCommState
DECLARE EXTERNAL FUNCTION SetCommTimeouts
LET CONST_GENERIC_READ=BVAL("80000000",16)
LET CONST_GENERIC_WRITE=BVAL("40000000",16)
LET CONST_OPEN_EXISTING=3
LET hComm=CreateFile("COM1",CONST_GENERIC_READ+CONST_GENERIC_WRITE,0,0,CONST_OPEN_EXISTING,0,0) !ハンドルを得る
PRINT hComm
IF hComm<0 THEN
PRINT "オープンできません。"
ELSE
LET DCB$=REPEAT$("#",3*4+4*2+8*1)
LET DCB$(1:2)=DWORD$(LEN(DCB$)) !サイズを設定する
LET rc=GetCommState(hComm, DCB$) !既存の状態を得る
PRINT rc
LET rc=BuildCommDCB("9600,n,8,1,p", DCB$) !通信速度などの変更
PRINT rc
LET rc=SetCommState(hComm, DCB$) !設定する
PRINT rc
!コマンド・レスポンス（計測データを取得する）
LET wData$="BARH"&CHR$(13)&CHR$(10) !データを送信する
LET wLen$=REPEAT$("#",4)
LET rc=WriteFile(hComm, wData$, LEN(wData$), wLen$, 0)
PRINT rc; int32(wLen$,0) !結果と実際に送信した文字数
LET rData$=REPEAT$("#",100) !データを受信する
LET rLen$=REPEAT$("#",4)
LET rc=ReadFile(hComm, rData$, LEN(rData$), rLen$, 0)
PRINT rc; int32(rLen$,0) !結果と実際に受信した文字数
FOR i=0 TO int32(rLen$,0)-1
PRINT rData$(i:i); !1234.5hPa
NEXT i
LET rc=CloseHandle(hComm) !閉じる
PRINT rc
END IF
END
!Win32 API シリアル伝送用（RS-232C）
EXTERNAL FUNCTION BuildCommDCB(lpDef$, lpDCB$)
ASSIGN "kernel32.dll","BuildCommDCBA"
END FUNCTION
EXTERNAL FUNCTION GetCommState(nCid, lpDCB$)
ASSIGN "kernel32.dll","GetCommState"
END FUNCTION
EXTERNAL FUNCTION GetCommTimeouts(hFile, lpCommTimeouts$)
ASSIGN "kernel32.dll","GetCommTimeouts"
END FUNCTION
EXTERNAL FUNCTION SetCommState(hCommDev, lpDCB$)
ASSIGN "kernel32.dll","SetCommState"
END FUNCTION
EXTERNAL FUNCTION SetCommTimeouts(hFile, lpCommTimeouts$)
ASSIGN "kernel32.dll","SetCommTimeouts"
END FUNCTION
!Win32 API ファイルI/O
EXTERNAL FUNCTION CloseHandle(hObject)
ASSIGN "kernel32.dll","CloseHandle"
END FUNCTION
EXTERNAL FUNCTION CreateFile(lpFileName$, dwDesiredAccess, dwShareMode, lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile)
ASSIGN "kernel32.dll","CreateFileA"
END FUNCTION
EXTERNAL FUNCTION ReadFile(hFile, lpBuffer$, nNumberOfBytesToRead, lpNumberOfBytesRead$, lpOverlapped)
ASSIGN "kernel32.dll","ReadFile"
END FUNCTION
EXTERNAL FUNCTION WriteFile(hFile, lpBuffer$, nNumberOfBytesToWrite, lpNumberOfBytesWritten$, lpOverlapped)
ASSIGN "kernel32.dll","WriteFile"
END FUNCTION
!補助ルーチン
EXTERNAL FUNCTION int32(s$,p)
OPTION CHARACTER byte
LET n=0
FOR i=1 TO 4
LET n=n+256^(i-1)*ORD(s$(p+i:p+i))
NEXT i
IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32
END FUNCTION
LET CONST_GENERIC_READ=BVAL("80000000",16)
LET CONST_GENERIC_WRITE=BVAL("40000000",16)
LET CONST_OPEN_EXISTING=3
LET FILE_ATTRIBUTE_NORMAL=BVAL("80",16)
!LET FILE_FLAG_OVERLAPPED=BVAL("40000000",16)
LET hComm=CreateFile("COM1",CONST_GENERIC_READ+CONST_GENERIC_WRITE,0,0,CONST_OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0) !ハンドルを得る
PRINT hComm
IF hComm<0 THEN
PRINT "オープンできません。"
STOP
END IF
!コマンド・レスポンス（計測データを取得する）
!-- PRINT #1:"BARH" !"BARH"+CR+LF
LET wData$="BARH"&CHR$(13)&CHR$(10) !データを送信する
LET wLen$=REPEAT$("#",4)
LET rc=WriteFile(hComm, wData$, LEN(wData$), wLen$, 0)
PRINT rc; int32(wLen$,0) !結果と実際に送信した文字数
!-- LINE INPUT #1: a$ !1234.5hPa (CR+LF)
LET rData$=REPEAT$("#",100) !データを受信する
LET rLen$=REPEAT$("#",4)
LET rc=ReadFile(hComm, rData$, LEN(rData$), rLen$, 0)
PRINT rc; int32(rLen$,0) !結果と実際に受信した文字数
LET F=1998*(1-1/2)*(1-1/3)*(1-1/37) !1998=2×3^3×37より、オイラー関数φ(1998)
PRINT F
PRINT 1998*F/2
!シミュレーション
LET S=0 !場合の数
LET T=0 !和
FOR K=1 TO 1998
IF GCD(1998,K)=1 THEN !互いに素
LET S=S+1
LET T=T+K
!!!PRINT K !debug
END IF
NEXT K
PRINT S;"通り"
PRINT "和=";T
!シミュレーション
LET S=0 !場合の数
LET T=0 !和
FOR A=0 TO 4
FOR B=0 TO 5
FOR C=0 TO 6
LET W=100*A+10*B+C
PRINT W
LET S=S+1
LET T=T+W
NEXT C
NEXT B
NEXT A
PRINT S;"通り"
PRINT "和=";T
END
!シミュレーション
LET S=0 !場合の数
LET T=0 !和
FOR A=1 TO 6 !異なる3つの数A,B,C
FOR B=1 TO 6
IF A-B<>0 THEN
FOR C=1 TO 6
IF (C-A)*(C-B)<>0 THEN
LET W=100*A+10*B+C
IF MOD(W,3)=0 THEN !3の倍数
LET S=S+1
PRINT W
LET T=T+W
END IF
END IF
NEXT C
END IF
NEXT B
NEXT A
PRINT S;"通り"
PRINT "和=";T
END
LET M=4 !m行n列 ※交差点の個数
LET N=5
DIM A(M,N)
MAT A=ZER
LET A(M,1)=1 !始点
LET A(M,2)=2
PUBLIC NUMERIC C !場合の数
LET C=0
CALL try(3,M,2, M,N,A)
PRINT C;"通り"
END
EXTERNAL SUB try(P,Y,X, M,N,A(,))
IF Y=M-1 AND X=1 THEN !終点
IF P>M*N THEN
LET C=C+1 !結果を表示する
PRINT "No.";C
MAT PRINT USING REPEAT$(" ##",N): A
END IF
ELSE
DIM B(M,N)
MAT B=A
IF Y>1 AND A(Y-1,X)=0 THEN !上へ
LET B(Y-1,X)=P
CALL try(P+1,Y-1,X, M,N,B)
LET B(Y-1,X)=0
END IF
IF Y<M AND A(Y+1,X)=0 THEN !下へ
LET B(Y+1,X)=P
CALL try(P+1,Y+1,X, M,N,B)
LET B(Y+1,X)=0
END IF
IF X>1 AND A(Y,X-1)=0 THEN !左へ
LET B(Y,X-1)=P
CALL try(P+1,Y,X-1, M,N,B)
LET B(Y,X-1)=0
END IF
IF X<N AND A(Y,X+1)=0 THEN !右へ
LET B(Y,X+1)=P
CALL try(P+1,Y,X+1, M,N,B)
LET B(Y,X+1)=0
END IF
END IF
END SUB
!シミュレーション
LET S=0
FOR A=1 TO 6 !順列P(6,3)
FOR B=1 TO 6
IF B-A<>0 THEN
FOR C=1 TO 6
IF (C-A)*(C-B)<>0 THEN
LET S=S+(100*A+10*B+C)
END IF
NEXT C
END IF
NEXT B
NEXT A
PRINT S
!組み合わせ
LET S=0
FOR A=1 TO 6-2 !組(a,b,c)
FOR B=A+1 TO 6-1
FOR C=B+1 TO 6
LET S=S+(A+B+C)*(100+10+1)*2
NEXT C
NEXT B
NEXT A
PRINT S
!****** 画面領域、電荷(総数・大きさ・座標位置)の設定 *****
DIM Qi(3),xi(3),yi(3)
LET Nq=3 !描画電荷数のセット
LET Qi(1)=2 !第1番電荷の値セット
LET xi(1)=10 !第1番電荷のx座標セット
LET yi(1)=5 !第1番電荷のy座標セット
LET Qi(2)=2 !第2番電荷の値セット
LET xi(2)=-10 !第2番電荷のx座標セット
LET yi(2)=-5 !第2番電荷のy座標セット
LET Qi(3)=-1 !第3番電荷の値セット
LET xi(3)=-10 !第3番電荷のx座標セット
LET yi(3)=0 !第3番電荷のy座標セット
LET windowX=35 !画面X軸の大きさセット
LET windowY=35 !画面Y軸の大きさセット
SET WINDOW -windowX,windowX,-windowY,windowY
DRAW grid
!**** ここまで ***********
!***************************
! Sub関数とFunction関数
!***************************
FUNCTION V(x,y)!---(x,y)点の合成電位Vの算出関数
LET Vsum=0
FOR nk=1 TO Nq
IF x<>xi(nk) OR y<>yi(nk) THEN
LET Vsum=Vsum+Qi(nk)/SQR((x-xi(nk))^2+(y-yi(nk))^2)
ELSE
PRINT "点電荷位置の電位(無限大)を誤計算したので停止します。"
STOP
END IF
NEXT nk
LET V=Vsum
END FUNCTION
SUB Denkai(x,y,Ex,Ey)!---(x,y)点の合成電界算出関数
LET Ex=0
LET Ey=0
FOR nk=1 TO Nq
LET ri=SQR((x-xi(nk))^2+(y-yi(nk))^2)
LET Ex=Ex+Exi(Qi(nk),x,xi(nk),ri)
LET Ey=Ey+Eyi(Qi(nk),y,yi(nk),ri)
NEXT nk
END SUB
SUB Newton(n,vv,x0,y0,xs,ys,over)!---等電位線の描画開始座標の算出
LET over=0
LET xs=x0+0.001!DELTA
LET ys=y0
DO
CALL Denkai(xs,ys,Exs,Eys)
LET Vxs=V(xs,ys)
LET x1=xs+(Vxs-vv)/Exs
LET Vx1=V(x1,ys)
LET xs=x1
IF vv=0 THEN
IF ABS(Vx1)<=0.0001 THEN EXIT DO
ELSEIF ABS((Vx1-vv)/vv)<=0.001 THEN
EXIT DO
ELSEIF xs>windowX THEN
LET over=1
EXIT DO
END IF
LOOP
END SUB
SUB Vsen(n)!---電荷による等電位線の描画関数
FOR vv=vstart TO vend STEP vstep
CALL Newton(n,vv,xi(n),yi(n),xs,ys,over)
IF over=1 THEN GOTO 10
PLOT LINES:xs,ys;
LET count=0
LET x1=xs
LET y1=ys
DO
CALL Denkai(x1,y1,Ex1,Ey1)
LET kakudo=ANGLE(-Ey1,Ex1)
LET x2=x1+dlv*COS(kakudo)
LET y2=y1+dlv*SIN(kakudo)
LET rck=SQR((x2-xs)^2+(y2-ys)^2)
IF count>=50 AND rck<=0.1 THEN EXIT DO !書き始め点に到達したら出る。
IF ABS(x2)>windowX OR ABS(y2)>windowY THEN EXIT DO !画面外になったら出る。
PLOT LINES:x2,y2;
LET count=count+1
LET x1=x2
LET y1=y2
LOOP
10 PLOT LINES
PRINT "描画完了電位vv=";vv
NEXT vv
END SUB
!**********************
! Main関数
!**********************
LET dlv=0.004 !等電位線の微小描画素線長さの設定
LET dlr=0.01 !電気力線の微小描画素線長さの設定
!---点電荷の位置に赤/青丸印を表示
LET ren=0.2
FOR n=1 TO Nq
IF Qi(n)>0 THEN
SET AREA COLOR "red"
ELSEIF Qi(n)<0 THEN
SET AREA COLOR "blue"
END IF
DRAW disk WITH SCALE(ren)*SHIFT(xi(n),yi(n))
NEXT n
!*** 等電位線の作図 ***
SET LINE COLOR "red"
FOR n=1 TO Nq
PRINT "--- 第";n;"電荷の作図処理中です。---"
IF Qi(n)>0 THEN
SET LINE COLOR "red"
LET kyokusei=1
ELSEIF Qi(n)<0 THEN
SET LINE COLOR "blue"
LET kyokusei=-1
END IF
LET vstart=0.4*kyokusei !数字は描画する|電位|の最大値
LET vend=0*kyokusei !数字は描画する|電位|の最小値
LET vstep=-0.04*kyokusei !|数字|は等電位幅
CALL Vsen(n)
NEXT n
END
> SUB Vsen(n)!---電荷による等電位線の描画関数
> FOR vv=vstart TO vend STEP vstep
> CALL Newton(n,vv,xi(n),yi(n),xs,ys,over)
> IF over=1 THEN GOTO 10
> PLOT LINES:xs,ys;
> LET count=0
> LET x1=xs
> LET y1=ys
> DO
> CALL Denkai(x1,y1,Ex1,Ey1)
> LET kakudo=ANGLE(-Ey1,Ex1)
> LET x2=x1+dlv*COS(kakudo)
> LET y2=y1+dlv*SIN(kakudo)
> LET rck=SQR((x2-xs)^2+(y2-ys)^2)
> IF count>=50 AND rck<=0.1 THEN EXIT DO !書き始め点に到達したら出る。
> IF ABS(x2)>windowX OR ABS(y2)>windowY THEN EXIT DO !画面外になったら出る。
> PLOT LINES:x2,y2;
> LET count=count+1
> LET x1=x2
> LET y1=y2
> LOOP
> 10 PLOT LINES
> PRINT "描画完了電位vv=";vv
> NEXT vv
> END SUB
浮動小数点計算の累積誤差による終点と始点が異なるからです。
2進モードでは、最後の値でループしますが、十進モードなら、
LET rck=(x2-xs)^2+(y2-ys)^2
IF count>500 AND rck<=0.08 THEN EXIT DO !書き始め点に到達したら出る。
LET N=3 !nビット
LET S=2^N-1
LET T=0
FOR A=0 TO S
FOR B=0 TO S
FOR C=0 TO S
IF BITAND(BITAND(A,B),C)=0 THEN !A∩B∩C=φ
LET W=BITOR(BITOR(A,B),C) !A∪B∪C
LET T=T+2^BITCOUNT(W) !Dの自由度
! または
! LET W=BITOR(BITOR(A,B),C) !A∪B∪C
! FOR D=0 TO S
! IF BITOR(W,D)=S THEN LET T=T+1
! NEXT D
END IF
NEXT C
NEXT B
NEXT A
PRINT T;"通り" !13^n
END
EXTERNAL FUNCTION BITCOUNT(N) !正の整数nを2進法表記したときの1の個数を返す
LET C=0
DO WHILE N>0
LET C=C+MOD(N,2)
LET N=INT(N/2)
LOOP
LET BITCOUNT=C
END FUNCTION
また、A,B,C,Dがすべて異なる場合は何通りあるか。
LET N=3 !nビット
LET S=2^N-1
LET T=0
FOR A=0 TO S-2 !組(A,B,C)
FOR B=A+1 TO S-1
FOR C=B+1 TO S
IF BITAND(BITAND(A,B),C)=0 THEN !A∩B∩C=φ
LET W=BITOR(BITOR(A,B),C) !A∪B∪C
LET T=T+2^BITCOUNT(W) !Dの自由度
IF W=S THEN LET T=T-3
! または
! LET W=BITOR(BITOR(A,B),C) !A∪B∪C
! FOR D=0 TO S
! IF (D-A)*(D-B)*(D-C)<>0 THEN !DはA,B,Cと異なる
!
! IF BITOR(W,D)=S THEN LET T=T+1
!
! END IF
! NEXT D
END IF
NEXT C
NEXT B
NEXT A
PRINT T*FACT(3);"通り"
END
EXTERNAL FUNCTION BITCOUNT(N) !正の整数nを2進法表記したときの1の個数を返す
LET C=0
DO WHILE N>0
LET C=C+MOD(N,2)
LET N=INT(N/2)
LOOP
LET BITCOUNT=C
END FUNCTION
> 浮動小数点計算の累積誤差による終点と始点が異なるからです。
> 2進モードでは、最後の値でループしますが、十進モードなら、
> LET rck=(x2-xs)^2+(y2-ys)^2
> IF count>500 AND rck<=0.08 THEN EXIT DO !書き始め点に到達したら出る。
>
> 0.08は、0.06から0.2の範囲でOKのようです。
> したがって、電荷の値や等電位値、幅が違うと調整が必要です。
LET N=4 !A={1,2,3,4}
DIM B(N)
CALL subset(1,1,N,B)
END
EXTERNAL SUB subset(X,K, N,S()) !バックトラック法
IF X>N THEN
PRINT "{";
FOR i=1 TO K-1
PRINT S(i);
NEXT i
PRINT "}"
ELSE
LET S(K)=X
CALL subset(X+1,K+1,N,S)
CALL subset(X+1,K,N,S)
END IF
END SUB
LET N=4 !A={1,2,3,4}
FOR R=0 TO N !r個の要素
FOR K=0 TO COMB(N,R)-1
PRINT Num2CombBit(K,N,R)
NEXT K
PRINT
NEXT R
END
EXTERNAL FUNCTION Num2CombBit(h,N,R) !番号から組合せビットパターンを生成する ※辞書式順序
LET v=h+1
LET j=R
LET A=0
FOR i=N-1 TO 0 STEP -1 !組合せをビット位置とする
LET t=COMB(i,j)
IF v>t THEN
LET A=A+2^i !ビット位置(N-i-1)を１とする
LET j=j-1
LET v=v-t
END IF
NEXT i
LET Num2CombBit=A
END FUNCTION
! 1000桁モードで利用する指数関数
EXTERNAL FUNCTION EXP(x)
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EXP=s(1,1)
END FUNCTION
> 十進BASICがインストールされたフォルダにある
> Libraryフォルダに1000桁モード用の超越関数計算ルーチンのサンプルをおいてあります。
> 計算結果の正確さの評価などはしてないので推奨できるレベルのものではありませんが，
> とりあえず使ってみることはできると思います。
>
> 10進1000桁モードで実行してください。
>
> DECLARE EXTERNAL FUNCTION EXP
> PRINT EXP(1)
> END
>
> ! 1000桁モードで利用する指数関数
> EXTERNAL FUNCTION EXP(x)
> FUNCTION s(y,n)
> LET t=y*x/n
> IF ABS(t)<=EPS(0) THEN
> LET s=y+t
> ELSE
> LET s=y+s(t,n+1)
> END IF
> END FUNCTION
> LET EXP=s(1,1)
> END FUNCTION
>
> 補足
> カイ２乗分布の定義式にΓ関数がでてきますが，nが自然数のときのΓ(n+1/2)は簡単に計算できるので，
> あまり面倒なことをしなくてすむと思います。
>
>
ありがとうございます。これでなんとかなりそうです。感謝いたします。
OPTION ARITHMETIC RATIONAL
DIM A(16)
CALL try(1,A)
END
EXTERNAL SUB try(P,A())
OPTION ARITHMETIC RATIONAL
FOR i=2 TO 8 !0,1,4,9を除く
IF i<>4 THEN
LET A(P)=i !p番目を数字iとする
LET S=1
FOR K=P TO 1 STEP -1 !連続するk桁
LET S=S*A(K)
IF INTSQR(S)^2=S THEN EXIT FOR
NEXT K
IF K<1 THEN
IF P>=15 THEN !15桁以上なら
PRINT P
MAT PRINT A;
ELSE
CALL try(P+1,A) !次へ
END IF
END IF
END IF
NEXT i
END SUB
!'標準正規分布
PUBLIC NUMERIC EPS
LET U=0 !'平均
LET M=1 !'分散
LET EPS=1E-13
FOR X=1 TO 400
LET Y=X/100
PRINT Y;":";INTEGRALNORMAL(U,M,Y);INTEGRAL(U,M,0,Y,100)
NEXT X
END
EXTERNAL FUNCTION INTEGRALNORMAL(U,M,X) !'INTEGRAL(EXP(-(X-U)*(X-U)/2/M/M)) 密度関数を項別積分
LET A=X
LET S=X
FOR I=1 TO 1000
LET A=-A*(X-U)*(X-U)/I/2/M/M
LET S=S+A/(2*I+1)
IF ABS(A)<EPS THEN EXIT FOR
NEXT I
LET INTEGRALNORMAL=S/SQR(2*PI)/M
END FUNCTION
EXTERNAL FUNCTION NORMAL(U,M,X) !'正規分布密度関数
LET NORMAL=EXP(-(X-U)*(X-U)/(2*M*M))/SQR(PI*2)/M
END FUNCTION
EXTERNAL FUNCTION INTEGRAL(U,M,A,B,N) !'数値積分
LET N=N*3
LET H=(B-A)/N
FOR K=0 TO N/3-1
LET S=S+3/8*H*NORMAL(U,M,A+H*3*K)+9/8*H*NORMAL(U,M,A+H*(3*K+1))+9/8*H*NORMAL(U,M,A+H*(3*K+2))+3/8*H*NORMAL(U,M,A+H*(3*K+3))
NEXT K
LET INTEGRAL=S
END FUNCTION
PUBLIC NUMERIC EPS
LET U=0 !'平均
LET M=1 !'分散
INPUT PROMPT "norminv(z) z=":Z !' (0～0.5)
LET EPS=1E-13
LET X=0
DO
LET XX=X
LET X=XX-(INTEGRALNORMAL(U,M,XX)-Z)/NORMAL(U,M,XX) !'ニュートン法
LOOP UNTIL ABS(X-XX)<EPS
PRINT X
END
EXTERNAL FUNCTION NORMAL(U,M,X) !'正規分布密度関数
LET S=1
LET A=1
FOR I=1 TO 1000
LET A=-A*(X-U)*(X-U)/I/2/M/M
LET S=S+A
IF ABS(A)<EPS THEN EXIT FOR
NEXT I
LET NORMAL=S/SQR(PI*2)/M
END FUNCTION
EXTERNAL FUNCTION INTEGRALNORMAL(U,M,X) !'INTEGRAL(EXP(-(X-U)*(X-U)/2/M/M)) 密度関数を項別積分
LET A=X
LET S=X
FOR I=1 TO 1000
LET A=-A*(X-U)*(X-U)/I/2/M/M
LET S=S+A/(2*I+1)
IF ABS(A)<EPS THEN EXIT FOR
NEXT I
LET INTEGRALNORMAL=S/SQR(2*PI)/M
END FUNCTION
LET N=6
INPUT PROMPT "GAMMA(X) X=":U
SELECT CASE N
CASE 2
RESTORE 2
CASE 3
RESTORE 3
CASE 4
RESTORE 4
CASE 5
RESTORE 5
CASE 6
RESTORE 6
CASE 7
RESTORE 7
END SELECT
FOR I=1 TO N
READ X,W
LET S=S+F(X,U)*EXP(X)*W !'ガウス・ラゲール法(半無限区間)
NEXT I
PRINT "Γ(";STR$(U);")=";S
LET H=1/1024
FOR T=-5 TO 5 STEP H
LET SS=SS+F(EXP(PI/2*SINH(T)),U)*PI/2*COSH(T)*EXP(PI/2*SINH(T))*H !'二重指数関数法(半無限区間)
NEXT T
PRINT "Γ(";STR$(U);")=";SS
LET A=1
FOR I=1 TO 30000
LET A=A*((1+1/I)^U)/(1+U/I)
NEXT I
PRINT "Γ(";STR$(U);")=";A/U
2 DATA .5857864376269049511983113,8.5355339059327376220042218E-01
DATA 3.4142135623730950488016887,1.4644660940672623779957782E-01
3 DATA .4157745567834790833115339,7.1109300992917301544959019E-01
DATA 2.2942803602790417198220504,2.7851773356924084880144489E-01
DATA 6.2899450829374791968664158,1.0389256501586135748964920E-02
4 DATA .3225476896193923118003615,6.0315410434163360163596602E-01
DATA 1.7457611011583465756868167,3.5741869243779968664149202E-01
DATA 4.5366202969211279832792854,3.8887908515005384272438168E-02
DATA 9.3950709123011331292335364,5.3929470556132745010379057E-04
5 DATA .2635603197181409102030619,5.2175561058280865247586093E-01
DATA 1.4134030591065167922184080,3.9866681108317592745413335E-01
DATA 3.5964257710407220812231866,7.5942449681707595387653311E-02
DATA 7.0858100058588375569221242,3.6117586799220484544612626E-03
DATA 12.6408008442757826594332193,2.3369972385776227891149085E-05
6 DATA .2228466041792606894643548,4.5896467394996359356828488E-01
DATA 1.1889321016726230307431509,4.1700083077212099411337757E-01
DATA 2.9927363260593140776913253,1.1337338207404497573870619E-01
DATA 5.7751435691045105018398304,1.0399197453149074898913303E-02
DATA 9.8374674183825899177155470,2.6101720281493205947924286E-04
DATA 15.9828739806017017825457916,8.9854790642962123882529205E-07
7 DATA .1930436765603624138382479,4.0931895170127390213043288E-01
DATA 1.0266648953391919503451994,4.2183127786171977992928101E-01
DATA 2.5678767449507462069077862,1.4712634865750527839537418E-01
DATA 4.9003530845264845681017144,2.0633514468716939865705615E-02
DATA 8.1821534445628607910818276,1.0740101432807455221319596E-03
DATA 12.7341802917978137580126425,1.5865464348564201268732622E-05
DATA 19.3957278622625403117125821,3.1703154789955805622713222E-08
END
EXTERNAL FUNCTION F(U,X)
LET F=EXP(-U)*U^(X-1)
END FUNCTION
DEF F(K)=2*K-1 !一般項
LET S=0 !和
LET K=0 !第k項
LET G=0 !第g群
DO
LET G=G+1
PRINT USING "##: ": G;
FOR i=1 TO G
LET K=K+1
PRINT F(K);
LET S=S+F(K)
IF K=45 THEN EXIT DO !45項目なら終了する
NEXT i
PRINT " "; K; S
LOOP
PRINT
PRINT K; F(K) !k項
PRINT S
END
LET S=0 !和
LET K=0 !第k項
LET G=0 !第g群
DO
LET G=G+1
PRINT USING "##: ": G;
FOR i=1 TO G+1
LET K=K+1
IF i=1 THEN
PRINT "1";
LET S=S+1
ELSE
PRINT "2";
LET S=S+2
END IF
IF K=1993 THEN EXIT DO !(1)の解答
!!IF S>2001 THEN EXIT DO !(2)の解答
NEXT i
PRINT K; S
LOOP
PRINT " ←"; i !g群の項
PRINT K !項
PRINT S
END
OPTION ARITHMETIC RATIONAL
DEF F(G,m)=(G-m+1)/m !一般項
LET S=1 !積
LET K=0 !第k項
LET G=0 !第g群
DO
LET G=G+1
PRINT USING "##: ": G;
FOR m=1 TO G
LET K=K+1
PRINT F(G,m);
LET S=S*F(G,m)
IF S=5005 THEN EXIT DO !終了する
NEXT m
PRINT " "; K; S
LOOP
PRINT " ←"; m !g群の項
PRINT K !k項
PRINT S
END
別解 C(g,m)
LET G=1
DO
FOR M=1 TO INT(G/2) !対称性を考慮する
IF COMB(G,M)=5005 THEN EXIT DO
NEXT M
LET G=G+1
LOOP
PRINT G;M
END
LET M=20 !500000
DIM P(M) !mの最大の素因数
MAT P=ZER
LET P(1)=1 !1は素数でない
FOR N=1 TO M
IF P(N)=0 THEN !素数なら
FOR K=N TO M STEP N !倍数を篩う
LET P(K)=N
NEXT K
END IF
NEXT N
!!!MAT PRINT P; !debug
LET C=0
FOR N=1 TO M
LET X=0 !個数
LET T=N !素因数分解する
DO WHILE T>1 !リンクをたどる
LET T=T/P(T)
LET X=X+1
LOOP
IF X>=3 THEN LET C=C+1
NEXT N
PRINT C
END
PUBLIC STRING v$ !変数の定義 ※必要なものだけの列記でもよい
LET v$="ABSn"
PUBLIC NUMERIC N !変数の数
LET N=LEN(v$)
PUBLIC NUMERIC MAX_TERM !最大の項数
LET MAX_TERM=50
!------------------------------ ここまでがサブルーチン
DIM f(0 TO MAX_TERM, 0 TO N), g(0 TO MAX_TERM, 0 TO N)
!CALL PolySet("(1/4)n^4+(1/2)n^3+(1/4)n^2", f) !Σk^3
CALL PolySet("(1/6)n^6+(1/2)n^5+(5/12)n^4-(1/12)n^2- S", f) !Σk^5
!CALL PolySet("(1/8)n^8+(1/2)n^7+(7/12)n^6-(7/24)n^4+(1/12)n^2- S", f) !Σk^7
!CALL PolySet("(1/10)n^10+(1/2)n^9+(3/4)n^8-(7/10)n^6+(1/2)n^4-(3/20)n^2- S", f) !Σk^9
CALL PolySet("(1/2)n^2+(1/2)n -A", g)
DIM q(0 TO MAX_TERM, 0 TO N), r(0 TO MAX_TERM, 0 TO N)
CALL PolyQuotientRemainder(f,g,"n", q,r) !f(n)÷A
CALL PolyPrint(q) !商
PRINT
CALL PolyPrint(r) !余り
PRINT
END
PUBLIC STRING v$ !変数の定義 ※必要なものだけの列記でもよい
LET v$="ABSn"
PUBLIC NUMERIC N !変数の数
LET N=LEN(v$)
PUBLIC NUMERIC MAX_TERM !最大の項数
LET MAX_TERM=50
!------------------------------ ここまでがサブルーチン
DIM f(0 TO MAX_TERM, 0 TO N), g(0 TO MAX_TERM, 0 TO N)
!CALL PolySet("(1/5)n^5+(1/2)n^4+(1/3)n^3-(1/30)n- S", f) !Σk^4
!CALL PolySet("(1/7)n^7+(1/2)n^6+(1/2)n^5-(1/6)n^3+(1/42)n- S", f) !Σk^6
CALL PolySet("(1/9)n^9+(1/2)n^8+(2/3)n^7-(7/15)n^5+(2/9)n^3-(1/30)n- S", f) !Σk^8
!CALL PolySet("(1/11)n^11+(1/2)n^10+(5/6)n^9-n^7+n^5-(1/2)n^3+(5/66)n -S", f) !Σk^10
CALL PolySet("(1/3)n^3+(1/2)n^2+(1/6)n", g)
DIM q(0 TO MAX_TERM, 0 TO N), r(0 TO MAX_TERM, 0 TO N)
CALL PolyQuotientRemainder(f,g,"n", q,r) !f(n)÷B
CALL PolyPrint(q) !商
PRINT
CALL PolyPrint(r) !余り
PRINT
CALL PolySet("(1/2)n^2+(1/2)n -A", g)
DIM t(0 TO MAX_TERM, 0 TO N)
CALL PolyAdd(r,q, t) !Q-S
CALL PolyQuotientRemainder(t,g,"n", q,r) !Q(n)÷A
CALL PolyPrint(q) !商
PRINT
CALL PolyPrint(r) !余り
PRINT
OPTION ARITHMETIC RATIONAL
LET M=3 !Σk^m
DIM P(0 TO M) !重み付きパスカルの三角形
MAT P=ZER
LET P(0)=1 !左端
FOR K=0 TO M !k段
FOR J=K TO 1 STEP -1 !右端から左端へ
LET P(J)=J*P(J-1)+(J+1)*P(J)
NEXT J
MAT PRINT P; !debug
NEXT K
DIM A(0 TO M+1) !係数
MAT A=ZER
FOR K=M TO 0 STEP -1 !ホーナー法による
LET A(0)=A(0)+P(K) !+○の部分
FOR J=M-K+1 TO 1 STEP -1 !×(n-k)の部分
LET A(J)=A(J-1)-K*A(J)
NEXT J
LET A(0)=-K*A(0)
MAT A=(1/(K+1))*A !÷(k+1)の部分
MAT PRINT A; !debug
NEXT K
END
実行結果
1 0 0 0
1 1 0 0
1 3 2 0
1 7 12 6
-9/2 3/2 0 0 0
-5 3/2 1/2 0 0
-1 1/4 1/2 1/4 0
0 0 1/4 1/2 1/4
----------------------------
ベルヌーイ数 B(k)
OPTION ARITHMETIC RATIONAL
LET M=10
DIM P(0 TO M) !重み付きパスカルの三角形
MAT P=ZER
LET P(0)=1 !左端
FOR K=0 TO M !k段
FOR J=K TO 1 STEP -1 !右端から左端へ
LET P(J)=J*P(J-1)+(J+1)*P(J)
NEXT J
MAT PRINT P; !debug
LET B=0
FOR J=0 TO K
LET B=B+(-1)^J*P(J)/(J+1)
NEXT J
PRINT K; B
NEXT K
END
FOR K=3 TO 20
FOR P=1 TO SQR(K^2/12)
!!!PRINT K;P !debug
LET R=SQR(K^2-12*P^2)
IF INT(R)=R THEN !整数なら
LET M=(K-R)/2 !m＜n
LET S=3*M*(K-M)
IF INT(SQR(S))^2=S THEN PRINT M;K-M; K
END IF
NEXT P
NEXT K
END
OPTION ARITHMETIC RATIONAL
LET N=3
PUBLIC NUMERIC C !場合の数
LET C=0
DIM A(N) !分割パターン 3=2+1=1+2=1+1+1
CALL try(1,A,N)
PRINT C;"通り"
END
EXTERNAL SUB try(P,A(),N) !バックトラック法
OPTION ARITHMETIC RATIONAL
FOR K=N TO 1 STEP -1
LET A(P)=K !p番目をkとする
IF N-K=0 THEN !終わったなら
MAT PRINT A; !debug
LET T=0 !分子
FOR J=1 TO P
LET T=T+A(J)
NEXT J
LET S=FACT(T)
FOR J=1 TO P !分母
LET S=S/FACT(A(J))
NEXT J
PRINT S !debug
LET C=C+S
ELSE
CALL try(P+1,A,N-K) !次へ
END IF
LET A(P)=0
NEXT K
END SUB
OPTION ARITHMETIC RATIONAL
LET N=3
PRINT P(N);"通り"
END
EXTERNAL FUNCTION P(N) !漸化式
OPTION ARITHMETIC RATIONAL
IF N=0 THEN
LET P=1
ELSE
LET S=0
FOR K=1 TO N
LET S=S+COMB(N,K)*P(N-K)
NEXT K
LET P=S
END IF
END FUNCTION
または
OPTION ARITHMETIC RATIONAL
LET N=3
DIM F(0 TO N) !漸化式
LET F(0)=1
FOR K=1 TO N
LET S=0 !F[k]を求める
FOR J=1 TO K
LET S=S+COMB(K,J)*F(K-J)
NEXT J
LET F(K)=S
NEXT K
PRINT F(N);"通り"
END
DATA 3 !m種類
DATA 2,1,1 !p,q,…,r個
READ M
DIM A(M)
MAT READ A
LET T=A(1) !C(p,p)
LET S=1
FOR K=2 TO M !C(p+q,q)、…、C(p+q+ … +r, r)
LET T=T+A(K)
LET S=S*COMB(T,A(K))
NEXT K
PRINT S
LET N=10
LET Y=6
!!LET N=14
!!LET Y=8
PUBLIC NUMERIC C !場合の数
LET C=0
DIM M(Y) !ビットパターン
FOR H=0 TO COMB(N,N/2)-1 !1行目
LET M(1)=Num2CombBit(H,N,N/2) !1行目
CALL try(2,M,N,Y)
NEXT H
PRINT C;"通り"
END
EXTERNAL SUB try(P,M(),N,Y)
FOR H=0 TO COMB(N,N/2)-1 !p行目の候補
LET T=Num2CombBit(H,N,N/2)
IF T>M(P-1) THEN !対称性
FOR K=1 TO P-1 !前出パターンとの比較
LET W=BITAND(M(K),T)
LET X=0 !1の個数
DO WHILE W>0
LET X=X+MOD(W,2)
LET W=INT(W/2)
LOOP
IF X<>2 THEN EXIT FOR !2以外はNG
!!IF X<>3 THEN EXIT FOR !3以外はNG
NEXT K
IF K>P-1 THEN !OKなら
LET M(P)=T
IF P=Y THEN !すべて埋まったなら
MAT PRINT M; !debug
DIM F(N) !縦方向を確認する
MAT F=ZER
FOR K=1 TO P
LET W=M(K)
FOR B=1 TO N
IF W=0 THEN EXIT FOR
LET F(B)=F(B)+MOD(W,2)
LET W=INT(W/2)
NEXT B
NEXT K
FOR B=1 TO N
IF F(B)<>Y/2 THEN EXIT FOR
NEXT B
IF B>N THEN !OKなら
LET C=C+1
FOR K=1 TO Y !結果を表示する
PRINT RIGHT$(REPEAT$("0",N-1)&BSTR$(M(K),2),N)
NEXT K
END IF
ELSE
CALL try(P+1,M,N,Y) !次へ
END IF
END IF
END IF
NEXT H
END SUB
EXTERNAL FUNCTION Num2CombBit(h,N,R) !番号から組合せビットパターンを生成する ※辞書式順序
LET v=h+1
LET j=R
LET A=0
FOR i=N-1 TO 0 STEP -1 !組合せをビット位置とする
LET t=COMB(i,j)
IF v>t THEN
LET A=A+2^i !ビット位置(N-i-1)を１とする
LET j=j-1
LET v=v-t
END IF
NEXT i
LET Num2CombBit=A
END FUNCTION
CALL ExGCD(37,32,x,y,c)
PRINT x;y;c
END
EXTERNAL SUB ExGCD(A,B,x,y,c) !拡張ユークリッドの互除法
!A＞0,B＞0に対して、Ax+By=cとなるx,y,c=gcd(A,B)を求める
LET c=A
LET c1=B
LET x=1
LET x1=0
LET y=0
LET y1=1
DO WHILE c1>0
PRINT x;y; c !debug
!PRINT x1;y1; c1 !debug
LET Q=INT(c/c1)
LET R=MOD(c,c1)
PRINT Q;R !debug
LET x2=x-Q*x1
LET y2=y-Q*y1
LET c=c1
LET c1=R
LET x=x1
LET x1=x2
LET y=y1
LET y1=y2
LOOP
END SUB
CALL ExGCD2(37,32,x,y,c)
PRINT x;y;c
PRINT
END
EXTERNAL SUB ExGCD2(a,b, x,y,c) !拡張ユークリッドの互除法
!A＞0,B＞0に対して、Ax+By=cとなるx,y,c=gcd(A,B)を求める
IF b=0 THEN
LET x=1 !a×1+b×0=a
LET y=0
LET c=a
PRINT x;y !debug
ELSE
LET q=INT(a/b)
LET r=MOD(a,b)
PRINT a;b; q !debug
CALL ExGCD2(b,r, u,v,c)
LET x=v
LET y=u-v*q
PRINT x;y; q !debug
END IF
END SUB
DECLARE FUNCTION TIME2000
LET t1=TIME
LET t2=TIME2000
LET t3=TIME
PRINT t1;t2;t3
!
FUNCTION TIME2000 ! 2000年1月1日午前0時からの経過秒数
LOCAL t,d
LET t=TIME
LET d=DATE
IF t>TIME THEN ! TIME関数とDATE関数が同期しないときの対策
LET t=0
LET d=DATE
END IF
LET TIME2000=(INT(d/1000)*365+INT((d/1000-1)/4)+MOD(d,1000))*86400+t
END FUNCTION
END
DECLARE EXTERNAL FUNCTION leapsecond.TIME2000
DECLARE EXTERNAL NUMERIC leapsecond.interleap
LET interleap=2 !【閏秒処理の時期】0=無視,1=UTC実施時,2=JST実施時,3=JST実施日の終了時
LET t1=TIME
LET t2=TIME2000
LET t3=TIME
PRINT t1;t2;t3
END
!
MODULE leapsecond
PUBLIC FUNCTION TIME2000
PUBLIC NUMERIC interleap
SHARE NUMERIC leapDATE,accum1,accum2
DIM month(12)
DATA 0,31,59,90,120,151,181,212,243,273,304,334 ! 各月初日前日までの累計日数
DATA 060101,090101,120701,150701 ! 新たに閏秒が実施される時はyymmdd形式の実施日(JST)を追加。1秒削除は負数(例 -160101)。
! 2000年以降、日本での閏秒実施日(JST) → '06/1/1,'09/1/1,'12/7/1,'15/7/1 午前8時59分59秒終了時
MAT READ month
LET accum1=0
DO
READ IF MISSING THEN EXIT DO : leapDATE
LET accum2=accum1
LET accum1=accum2+SGN(leapDATE)
LOOP
LET leapDATE=ABS(leapDATE)
LET yy=INT(leapDATE/10000)
LET mm=MOD(INT(leapDATE/100),100)
LET leapDATE=yy*365+INT((yy-1)/4+1)+month(mm)+MOD(leapDATE,100)
IF MOD(yy,4)=0 AND mm>=3 THEN LET leapDATE=leapDATE+1
!
EXTERNAL FUNCTION TIME2000 ! 2000年1月1日午前0時からの経過秒数(閏秒対応)
LET t=TIME
LET d=DATE
IF t>TIME THEN ! TIME関数とDATE関数が同期しないときの対策
LET t=0
LET d=DATE
END IF
LET d=INT(d/1000)*365+INT((d/1000-1)/4+1)+MOD(d,1000)
IF interleap>0 THEN ! interleap=閏秒処理の時期 0=無視,1=UTC実施時,2=JST実施時,3=JST実施日の終了時
IF d>leapDATE OR d=leapDATE AND (interleap=1 OR interleap=2 AND t>=32400) THEN ! t=32400→09:00:00
LET t=t+accum1
ELSE
LET t=t+accum2
END IF
END IF
LET TIME2000=(d-1)*86400+t
END FUNCTION
END MODULE
OPTION ARITHMETIC RATIONAL
DATA 3,5,7,11,13,17,19,23,29,31,-1
LET N=10^5
DIM F(0 TO N) !篩い
MAT F=ZER
DO
READ A
IF A<0 THEN EXIT DO
FOR K=0 TO N STEP A !その倍数
LET F(K)=1
NEXT K
LOOP
LET S=0 !和
FOR K=1 TO N
IF F(K)>0 THEN LET S=S+K
NEXT K
PRINT S
END
OPTION ARITHMETIC RATIONAL
LET N=10^5
DATA 3,5,7,11,13,17,19,23,29,31 !互いに素
DIM P(10)
MAT READ P
LET S=0 !和
FOR C=1 TO 2^UBOUND(P)-1 !組み合わせ（ビットパターン）
LET T=C
LET X=0 !1の個数
LET D=1
FOR B=1 TO UBOUND(P) !ビット位置
IF T=0 THEN EXIT FOR
IF MOD(T,2)=1 THEN
LET X=X+1
LET D=D*P(B)
END IF
LET T=INT(T/2) !次へ
NEXT B
LET K=INT(N/D) !項数 k
LET W=K*(K+1)*D/2 !和 d+2d+3d+ … +kd、kd≦n
!集合A,B,Cなら、個数 n(A∪B∪C)=n(A)+n(B)+n(C)-n(A∩B)-n(B∩C)-n(C∩A)+n(A∩B∩C) より
IF MOD(X,2)=1 THEN LET S=S+W ELSE LET S=S-W
NEXT C
PRINT S
END
LET N=5
LET M=N-2
SET WINDOW -1,2*M+1,-M^2,4*M^2/3
!!DRAW grid
CALL gcDRAWLINE(1,0,0) !1本目 Y軸
FOR K=0 TO M !2本目以降
CALL gcDRAWLINE(K,1,-K^2)
NEXT K
PRINT (N^2+N+2)/2
END
!FV.LIB 抜粋
EXTERNAL SUB gcDRAWLINE(L,M,N) !直線Lx+My+N=0を描く
IF (L=0 AND M=0) THEN
PRINT "L=M=0なので、直線が成立しません。"; L;M;N
ELSE
ASK WINDOW x1,x2,y1,y2
IF ABS(L)>ABS(M) THEN !y=±xの傾きより大きいなら ※y軸に平行な直線を含む
PLOT LINES: -(M*y1+N)/L,y1; -(M*y2+N)/L,y2
ELSE
PLOT LINES: x1,-(L*x1+N)/M; x2,-(L*x2+N)/M
END IF
END IF
END SUB
FOR i=1 TO 20
IF i^3+(i+1)^3>(i+2)^3 AND i^4+(i+1)^4<(i+2)^4 THEN
PRINT i;i+1;i+2
PRINT i^3+(i+1)^3 ;">"; (i+2)^3
PRINT i^4+(i+1)^4 ;"<"; (i+2)^4
PRINT
END IF
NEXT i
END
DIM A(2*N+1) !数列
LET A(1)=1
FOR K=1 TO N
LET A(2*K)=A(K)
LET A(2*K+1)=(-1)^K
NEXT K
MAT PRINT A; !1,1,-1,1,1,-1,-1,1,1,1,-1,-1,1,-1,-1,1,…
LET P=0 !p[0]は原点
PLOT LINES: P;
LET D=0 !平面上での向き 0:右、1:上、2:左、3:下
LET P=1 !p[1]は点(1,0)
PLOT LINES: P;
FOR K=1 TO 2*N+1 !p[k]
LET D=D+A(K) !左へ90°、右へ90°回転する
LET P=P+EXP(COMPLEX(0,1)*2*PI*D/4) !各方向へ1だけ移動する
PLOT LINES: P;
!!!PRINT P; D !debug
NEXT K
DATA 32 !値
DATA 10 !データの個数m
DATA 1,2,3,4,6,8,12,16,24,32 !データ
READ X
DIM A(X) !1からxまでの数
MAT A=ZER
READ M
LET S=0
FOR i=1 TO M !ひとつずつ取り出す
READ D
FOR P=MIN(S,X-D) TO 1 STEP -1 !部分和を求める
IF A(P)>0 THEN
LET T=P+D
LET A(T)=A(T)+A(P)
END IF
NEXT P
IF D<=X THEN LET A(D)=A(D)+1
LET S=S+D
NEXT i
BEEP版
(BEEPコマンド 何Hzまで指定できるのだろう?)
!'簡易可聴域検査
LET SW=1
IF SW=0 THEN
LET XMAX=100 !'低音域
LET XMIN=10
ELSE
LET XMAX=20000 !'高音域
LET XMIN=1000
END IF
DO
LET XMID=INT((XMIN+XMAX)/2) !'2分法
DO
PRINT XMID;"Hz"
BEEP XMID,1000
INPUT PROMPT "聞こえましたか (Yes/No/Retry) ":A$
LOOP WHILE A$="R" OR A$="r"
IF SW=0 THEN
IF A$="Y" OR A$="y" THEN LET XMAX=XMID ELSE LET XMIN=XMID !'低音域
ELSE
IF A$="Y" OR A$="y" THEN LET XMIN=XMID ELSE LET XMAX=XMID !'高音域
END IF
LOOP UNTIL ABS(XMAX-XMIN)<10
PRINT "あなたの可聴域は";XMID;"Hzです"
END
LET SW=1
IF SW=0 THEN
LET XMAX=100 !'低音域
LET XMIN=10
ELSE
LET XMAX=20000 !'高音域
LET XMIN=1000
END IF
DO
LET XMID=INT((XMIN+XMAX)/2) !'2分法
DO
PRINT XMID;"Hz"
CALL MAKEWAV("TEST.wav",XMID,1)
PLAYSOUND "TEST.wav"
INPUT PROMPT "聞こえましたか (Yes/No/Retry) ":A$
LOOP WHILE A$="R" OR A$="r"
IF SW=0 THEN
IF A$="Y" OR A$="y" THEN LET XMAX=XMID ELSE LET XMIN=XMID !'低音域
ELSE
IF A$="Y" OR A$="y" THEN LET XMIN=XMID ELSE LET XMAX=XMID !'高音域
END IF
LOOP UNTIL ABS(XMAX-XMIN)<20
PRINT "あなたの可聴域は";XMID;"Hzです"
FILE DELETE "TEST.wav"
END
EXTERNAL SUB MAKEWAV(F$,FREQ,SECOND)
LET CHANNEL=1 !'モノラル
LET SAMPLEBIT=16 !'bit数
LET HEADERSIZE=16
LET WAVETYPE=1
LET SAMPLINGFREQ=48000 !'サンプリング周波数
LET SAMPLESIZE=SAMPLEBIT/8*CHANNEL
LET DATARATE = SAMPLESIZE * SAMPLINGFREQ
LET VOL=.7 !'音量
LET LEVEL=2^(SAMPLEBIT-1)*VOL
LET PCMSIZE=INT(DATARATE*SECOND)
LET WAVEFILESIZE=PCMSIZE+36
IF POS(F$,".")=0 THEN LET F$=F$&".wav"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"RIFF";
PRINT #1:MKL$(WAVEFILESIZE);
PRINT #1:"WAVEfmt ";
PRINT #1:MKL$(HEADERSIZE);
PRINT #1:MKI$(WAVETYPE);
PRINT #1:MKI$(CHANNEL);
PRINT #1:MKL$(SAMPLINGFREQ);
PRINT #1:MKL$(DATARATE);
PRINT #1:MKI$(SAMPLESIZE);
PRINT #1:MKI$(SAMPLEBIT);
PRINT #1:"data";
PRINT #1:MKL$(PCMSIZE);
FOR I=0 TO INT(SAMPLINGFREQ*SECOND)-1
PRINT #1:MKI$(INT(LEVEL*SIN(FREQ*I/SAMPLINGFREQ*2*PI)));
NEXT I
CLOSE #1
END SUB
EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION
EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
LET X=0 !Σi^k
FOR i=1 TO M
LET X=X+i^K
NEXT i
LET X=X/2 !その半分
PRINT X
DIM A(X)
MAT A=ZER
FOR i=1 TO M !ひとつずつ取り出す
LET D=i^K
FOR P=X-D TO 1 STEP -1 !部分和を求める
IF A(P)>0 THEN
LET T=P+D
LET A(T)=A(T)+A(P)
END IF
NEXT P
IF D<=X THEN LET A(D)=A(D)+1
NEXT i
OPTION BASE 0
LET K=24
DIM A(K+3,K+3)
FOR L=4 TO K STEP 4
FOR M=0 TO L/4
FOR N=0 TO L/4
LET A(4*N,4*M)=1
LET A(4*N+1,4*M)=1
LET A(4*N+1,4*M+1)=1
LET A(4*N,4*M+1)=1
LET A(4*N+2,4*M+2)=1
LET A(4*N+3,4*M+2)=1
LET A(4*N+2,4*M+3)=1
LET A(4*N+3,4*M+3)=1
NEXT N
NEXT M
FOR Y=1 TO L
FOR X=1 TO L
IF A(X,Y)=1 THEN LET A(X,Y)=L*(Y-1)+X ELSE LET A(X,Y)=L*L-(L*(Y-1)+X-1)
NEXT X
NEXT Y
PRINT L;"×";L;"魔方陣"
FOR Y=1 TO L
FOR X=1 TO L
PRINT USING "#####":A(X,Y);
NEXT X
PRINT
NEXT Y
PRINT
MAT A=ZER
NEXT L
END
OPTION BASE 0
LET M=30
DIM A(M,M)
FOR N=6 TO M STEP 4
!'N=NN*4+2
LET K=N*2-2
FOR I=1 TO N-2
FOR J=1 TO N-2
IF BITAND(I,2)=BITAND(J,2) THEN
LET K=K+1
LET A(I,J)=K
ELSE
LET K=K+1
LET A(N-1-I,N-1-J)=K
END IF
NEXT J
NEXT I
LET SUM=N*N+1
LET A(0,0)=N-2
LET A(N-1,N-1)=SUM-(N-2)
LET A(0,N-1)=N-1
LET A(N-1,0)=SUM-(N-1)
LET A(0,N-2)=SUM-2*N+3
LET A(N-1,N-2)=SUM-(SUM-2*N+3)
LET A(N-2,0)=2*N-2
LET A(N-2,N-1)=SUM-(2*N-2)
FOR I=1 TO N-3
IF BITAND(I,2)=0 THEN LET J=0 ELSE LET J=N-1
LET A(J,I)=N-2-I
LET A(N-1-J,I)=SUM-(N-2-I)
LET A(I,J)=N-1+I
LET A(I,N-1-J)=SUM-(N-1+I)
NEXT I
PRINT N;"*";N;"魔方陣"
FOR I=0 TO N-1
FOR J=0 TO N-1
PRINT USING" #####":A(I,J);
NEXT J
PRINT
NEXT I
PRINT
NEXT N
END
CALL GINIT(800,400)
SET WINDOW 0,30,-.5,.5
DRAW GRID(1,1)
FOR N=0 TO 5
SET LINE COLOR N+1
FOR X=0 TO 30 STEP 1/16
LET Y=BESSELJ(N,X)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT N
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION INTEGRAL(R,Z) !'ガウス・ルジャンドル
LET A=0
LET B=PI
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO 20
READ X,C
LET S=S+C*F(R,Z,U+V*X)*V
NEXT I
LET INTEGRAL=S/PI
DATA -.9931285991850949,1.7614007139152118E-02
DATA -.9639719272779138,4.0601429800386941E-02
DATA -.9122344282513259,6.2672048334109064E-02
DATA -.8391169718222188,8.3276741576704749E-02
DATA -.7463319064601508,1.0193011981724044E-01
DATA -.6360536807265150,1.1819453196151842E-01
DATA -.5108670019508271,1.3168863844917663E-01
DATA -.3737060887154196,1.4209610931838205E-01
DATA -.2277858511416451,1.4917298647260375E-01
DATA -.0765265211334973,1.5275338713072585E-01
DATA .0765265211334973,1.5275338713072585E-01
DATA .2277858511416451,1.4917298647260375E-01
DATA .3737060887154196,1.4209610931838205E-01
DATA .5108670019508271,1.3168863844917663E-01
DATA .6360536807265150,1.1819453196151842E-01
DATA .7463319064601508,1.0193011981724044E-01
DATA .8391169718222188,8.3276741576704749E-02
DATA .9122344282513259,6.2672048334109064E-02
DATA .9639719272779138,4.0601429800386941E-02
DATA .9931285991850949,1.7614007139152118E-02
END FUNCTION
EXTERNAL FUNCTION F(R,X,T)
LET F=COS(R*T-X*SIN(T))
END FUNCTION
EXTERNAL FUNCTION INTEGRAL2(R,Z) !'ガウス・ラゲール
FOR I=1 TO 6
READ X,W
LET S=S+FF(R,Z,X)*EXP(X)*W
NEXT I
LET INTEGRAL2=S
DATA .2228466041792606894643548,4.5896467394996359356828488E-01
DATA 1.1889321016726230307431509,4.1700083077212099411337757E-01
DATA 2.9927363260593140776913253,1.1337338207404497573870619E-01
DATA 5.7751435691045105018398304,1.0399197453149074898913303E-02
DATA 9.8374674183825899177155470,2.6101720281493205947924286E-04
DATA 15.9828739806017017825457916,8.9854790642962123882529205E-07
END FUNCTION
EXTERNAL FUNCTION FF(R,X,T)
LET FF=EXP(-X*SINH(T)-R*T)
END FUNCTION
EXTERNAL FUNCTION BESSELJ(R,X) !'Rは実数
LET S=INTEGRAL(ABS(R),X)-SIN(ABS(R)*PI)/PI*INTEGRAL2(ABS(R),X)
IF R<0 THEN LET S=S*(-1)^INT(ABS(R))
LET BESSELJ=S
END FUNCTION
CALL GINIT(800,400)
SET WINDOW 0,20,-1,1
DRAW GRID(1,1)
FOR N=0 TO 5
SET LINE COLOR N+1
FOR X=0 TO 20 STEP 1/16
LET Y=BESSELY(N,X)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT N
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION INTEGRAL(R,Z) !'ガウス・ルジャンドル
LET A=0
LET B=PI
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO 50
READ X,C
LET S=S+C*F(R,Z,U+V*X)*V
NEXT I
LET INTEGRAL=S/PI
DATA -.9988664044200710501854594,2.9086225531551409584007243E-03
DATA -.9940319694320907125851082,6.7597991957454015027788782E-03
DATA -.9853540840480058823090096,1.0590548383650969263569681E-02
DATA -.9728643851066920737133441,1.4380822761485574419378909E-02
DATA -.9566109552428079429977456,1.8115560713489390351259943E-02
DATA -.9366566189448779337808749,2.1780243170124792981592069E-02
DATA -.9130785566557918930897356,2.5360673570012390440194878E-02
DATA -.8859679795236130486375410,2.8842993580535198029906373E-02
DATA -.8554297694299460846113626,3.2213728223578016648165827E-02
DATA -.8215820708593359483562541,3.5459835615146154160734611E-02
DATA -.7845558329003992639053052,3.8568756612587675244770150E-02
DATA -.7444943022260685382605363,4.1528463090147697422411979E-02
DATA -.7015524687068222510895463,4.4327504338803275492022287E-02
DATA -.6558964656854393607816249,4.6955051303948432965633014E-02
DATA -.6077029271849502391803818,4.9400938449466314921243581E-02
DATA -.5571583045146500543155229,5.1655703069581138489905296E-02
DATA -.5044581449074642016514591,5.3710621888996246523458797E-02
DATA -.4498063349740387891471315,5.5557744806212517623567426E-02
DATA -.3934143118975651273942293,5.7189925647728383723029315E-02
DATA -.3355002454194373568369883,5.8600849813222445835122437E-02
DATA -.2762881937795319903276453,5.9785058704265457509576405E-02
DATA -.2160072368760417568472845,6.0737970841770216031750015E-02
DATA -.1548905899981459020716286,6.1455899590316663756406786E-02
DATA -.0931747015600861408544504,6.1936067420683243384087510E-02
DATA -.0310983383271888761123290,6.2176616655347262321033107E-02
DATA .0310983383271888761123290,6.2176616655347262321033107E-02
DATA .0931747015600861408544504,6.1936067420683243384087510E-02
DATA .1548905899981459020716286,6.1455899590316663756406786E-02
DATA .2160072368760417568472845,6.0737970841770216031750015E-02
DATA .2762881937795319903276453,5.9785058704265457509576405E-02
DATA .3355002454194373568369883,5.8600849813222445835122437E-02
DATA .3934143118975651273942293,5.7189925647728383723029315E-02
DATA .4498063349740387891471315,5.5557744806212517623567426E-02
DATA .5044581449074642016514591,5.3710621888996246523458797E-02
DATA .5571583045146500543155229,5.1655703069581138489905296E-02
DATA .6077029271849502391803818,4.9400938449466314921243581E-02
DATA .6558964656854393607816249,4.6955051303948432965633014E-02
DATA .7015524687068222510895463,4.4327504338803275492022287E-02
DATA .7444943022260685382605363,4.1528463090147697422411979E-02
DATA .7845558329003992639053052,3.8568756612587675244770150E-02
DATA .8215820708593359483562541,3.5459835615146154160734611E-02
DATA .8554297694299460846113626,3.2213728223578016648165827E-02
DATA .8859679795236130486375410,2.8842993580535198029906373E-02
DATA .9130785566557918930897356,2.5360673570012390440194878E-02
DATA .9366566189448779337808749,2.1780243170124792981592069E-02
DATA .9566109552428079429977456,1.8115560713489390351259943E-02
DATA .9728643851066920737133441,1.4380822761485574419378909E-02
DATA .9853540840480058823090096,1.0590548383650969263569681E-02
DATA .9940319694320907125851082,6.7597991957454015027788782E-03
DATA .9988664044200710501854594,2.9086225531551409584007243E-03
END FUNCTION
EXTERNAL FUNCTION F(N,X,T)
LET F=SIN(X*SIN(T)-N*T)
END FUNCTION
EXTERNAL FUNCTION INTEGRAL2(R,Z) !'ガウス・ラゲール
FOR I=1 TO 6
READ X,W
LET S=S+FF(R,Z,X)*EXP(X)*W
NEXT I
LET INTEGRAL2=S/PI
DATA .2228466041792606894643548,4.5896467394996359356828488E-01
DATA 1.1889321016726230307431509,4.1700083077212099411337757E-01
DATA 2.9927363260593140776913253,1.1337338207404497573870619E-01
DATA 5.7751435691045105018398304,1.0399197453149074898913303E-02
DATA 9.8374674183825899177155470,2.6101720281493205947924286E-04
DATA 15.9828739806017017825457916,8.9854790642962123882529205E-07
END FUNCTION
EXTERNAL FUNCTION FF(N,X,T)
LET FF=(EXP(N*T)+(-1)^N*EXP(-N*T))*EXP(-X*SINH(T))
END FUNCTION
EXTERNAL FUNCTION BESSELY(N,X) !'Nは整数
LET S=INTEGRAL(INT(ABS(N)),X)-INTEGRAL2(INT(ABS(N)),X)
IF N<0 THEN LET S=S*(-1)^INT(ABS(N))
LET BESSELY=S
END FUNCTION
CALL GINIT(400,800)
SET WINDOW 0,5,-1,49
DRAW GRID(1,10)
FOR N=0 TO 5
SET LINE COLOR N+1
FOR X=0 TO 5 STEP 1/16
LET Y=BESSELI(N,X)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT N
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION INTEGRAL(R,Z) !'ガウス・ルジャンドル
LET A=0
LET B=PI
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO 400
READ X,C
LET S=S+C*F(R,Z,U+V*X)*V
NEXT I
LET INTEGRAL=S/PI
DATA -.9999819727039624507107997,4.6263724177190118157440220E-05
DATA -.9999050164693312795671775,1.0769038102183646230364914E-04
DATA -.9997665712667108498622001,1.6920137336541413264932958E-04
DATA -.9995666148626408000179844,2.3070985544248655269465132E-04
DATA -.9993051557937030335325083,2.9220572803523217847223343E-04
DATA -.9989822092480797992371162,3.5368409613102448239639817E-04
DATA -.9985977947971757433952425,4.1514088233419025171823795E-04
DATA -.9981519359718441275385541,4.7657220501003854013133061E-04
DATA -.9976446601486403940368916,5.3797424394626279849881322E-04
DATA -.9970759985107923450247946,5.9934320270831884264722444E-04
DATA -.9964459860317571225964113,6.6067529607738161575318920E-04
DATA -.9957546614667239851797758,7.2196674533702894531306739E-04
DATA -.9950020673471962444031388,7.8321377638390310244817342E-04
DATA -.9941882499768158116647105,8.4441261897085745246513294E-04
DATA -.9933132594276647813762767,9.0555950644549534547199634E-04
DATA -.9923771495366982433589461,9.6665067572141452408517998E-04
DATA -.9913799779021414417532216,1.0276823673654497630797823E-03
DATA -.9903218058797661642331360,1.0886508257457038100719739E-03
DATA -.9892026985790008762180358,1.1495522992128106211745720E-03
DATA -.9880227248588493179127030,1.2103830403000240185954168E-03
DATA -.9867819573236030434401229,1.2711393059342868032230354E-03
DATA -.9854804723183393394746898,1.3318173576538514742077422E-03
DATA -.9841183499241993752558070,1.3924134618298698080684263E-03
DATA -.9826956739534434545500623,1.4529238898903999088514186E-03
DATA -.9812125319442814682424151,1.5133449185458729415321843E-03
DATA -.9796690151554774136346128,1.5736728300154127016475733E-03
DATA -.9780652185607273384489774,1.6339039122536137611976595E-03
DATA -.9764012408428103908462605,1.6940344591775155933476319E-03
DATA -.9746771843875128746551103,1.7540607708935932918534161E-03
DATA -.9728931552773253596853138,1.8139791539246390831213050E-03
DATA -.9710492632849130040397740,1.8737859214364439296000032E-03
DATA -.9691456218663593235845560,1.9334773934642118869862805E-03
DATA -.9671823481541837026768633,1.9930498971386556619114334E-03
DATA -.9651595629501329860638605,2.0524997669117326296387785E-03
DATA -.9630773907177475286294707,2.1118233447819880761749695E-03
DATA -.9609359595747021101129220,2.1710169805194777030769764E-03
DATA -.9587354012849221479049303,2.2300770318902451834521819E-03
DATA -.9564758512504756638175957,2.2889998648803332549695712E-03
DATA -.9541574485032414812063787,2.3477818539193087973829979E-03
DATA -.9517803356963541476176046,2.4064193821032837844401297E-03
DATA -.9493446590954260956830096,2.4649088414174150722575315E-03
DATA -.9468505685695475715990344,2.5232466329578667921869215E-03
DATA -.9442982175820648764404846,2.5814291671532197289820420E-03
DATA -.9416877631811374809315652,2.6394528639853125366129890E-03
DATA -.9390193659900745892537874,2.6973141532095000115583202E-03
DATA -.9362931901974517420997422,2.7550094745743139337060721E-03
DATA -.9335094035470080635511228,2.8125352780405122176822307E-03
DATA -.9306681773273247705187315,2.8698880239995023068591947E-03
DATA -.9277696863612855774691976,2.9270641834911248990910487E-03
DATA -.9248141089953196430062722,2.9840602384207842252760188E-03
DATA -.9218016270884277185954871,3.0408726817759112150766292E-03
DATA -.9187324260009921733361549,3.0974980178417459829955126E-03
DATA -.9156066945833715822067555,3.1539327624164261558923710E-03
DATA -.9124246251642805786483078,3.2101734430253676425153532E-03
DATA -.9091864135389556857127581,3.2662165991349245186867942E-03
DATA -.9058922589571078532953371,3.3220587823653147699542163E-03
DATA -.9025423641106624421955255,3.3776965567027986979745151E-03
DATA -.8991369351212874089139762,3.4331264987110968585623238E-03
DATA -.8956761815277104581948603,3.4883451977420344589220515E-03
DATA -.8921603162728259433664469,3.5433492561453991996620077E-03
DATA -.8885895556905923075185429,3.5981352894779996042038747E-03
DATA -.8849641194927208714846091,3.6526999267119109345042264E-03
DATA -.8812842307551567874694922,3.7070398104418958478769910E-03
DATA -.8775501159043529899810783,3.7611515970919870053700346E-03
DATA -.8737620047033379884859100,3.8150319571212188977839493E-03
DATA -.8699201302375783589148594,3.8686775752284962111698272E-03
DATA -.8660247289006368037951485,3.9220851505565861096203416E-03
DATA -.8620760403796266633790730,3.9752513968952218694674985E-03
DATA -.8580743076404637726773631,4.0281730428833053556957251E-03
DATA -.8540197769129165717857668,4.0808468322101958885308878E-03
DATA -.8499126976754553893166989,4.1332695238160731058231723E-03
DATA -.8457533226399018311131247,4.1854378920913614850439286E-03
DATA -.8415419077358792187286900,4.2373487270752042474954035E-03
DATA -.8372787120950650344058650,4.2889988346529744267133843E-03
DATA -.8329639980352463414719476,4.3403850367528109430467473E-03
DATA -.8285980310441791612005141,4.3915041715411675870411756E-03
DATA -.8241810797632527992526874,4.4423530936173628755499398E-03
DATA -.8197134159709601268177470,4.4929286742071188064528328E-03
DATA -.8151953145661748335154631,4.5432278013550766004930588E-03
DATA -.8106270535512366810024356,4.5932473801162775820470507E-03
DATA -.8060089140148457980409629,4.6429843327465974146282383E-03
DATA -.8013411801147670695408899,4.6924355988921219715957326E-03
DATA -.7966241390603456837717921,4.7415981357774531878946569E-03
DATA -.7918580810948349135640607,4.7904689183929333046974074E-03
DATA -.7870432994775372188722786,4.8390449396807759855446397E-03
DATA -.7821800904657597695620265,4.8873232107200928500007496E-03
DATA -.7772687532965854987012501,4.9353007609108040389399652E-03
DATA -.7723095901684608079888676,4.9829746381564214943643207E-03
DATA -.7673029062226010582357195,5.0303419090456937061217566E-03
DATA -.7622490095242149890255755,5.0773996590331007480390167E-03
DATA -.7571482110435492228260470,5.1241449926181884968072417E-03
DATA -.7520008246367540198902183,5.1705750335237309984552282E-03
DATA -.7468071670265714612889527,5.2166869248727100194130774E-03
DATA -.7415675577828472483404577,5.2624778293641008920039892E-03
DATA -.7362823193028673175571692,5.3079449294474538377007114E-03
DATA -.7309517767915204810096465,5.3530854274962600256418876E-03
DATA -.7255762582412883127123272,5.3978965459800916987183857E-03
DATA -.7201560944120635122659979,5.4423755276355057750066148E-03
DATA -.7146916188107979875460589,5.4865196356357004084407400E-03
DATA -.7091831676709819087034412,5.5303261537589140693743281E-03
DATA -.7036310799319549961457379,5.5737923865555567830799909E-03
DATA -.6980356972180513154891026,5.6169156595140632422686060E-03
DATA -.6923973638175788627161007,5.6596933192254575883731863E-03
DATA -.6867164266616352329403680,5.7021227335466197356318722E-03
DATA -.6809932353027606762649893,5.7442012917622431919151687E-03
DATA -.6752281418934298542273508,5.7859264047454744107697479E-03
DATA -.6694215011643836202482341,5.8272955051172237902900934E-03
DATA -.6635736704028021573464804,5.8683060474041385161751495E-03
DATA -.6576850094303208161420752,5.9089555081952275286750641E-03
DATA -.6517558805808900058493764,5.9492413862971289760781243E-03
DATA -.6457866486784805005578351,5.9891612028880106009251001E-03
DATA -.6397776810146355326093649,6.0287125016700935892623685E-03
DATA -.6337293473258710543088905,6.0678928490207904979513170E-03
DATA -.6276420197709255585470036,6.1066998341424479603344647E-03
DATA -.6215160729078608581704682,6.1451310692106849564133301E-03
DATA -.6153518836710152331070009,6.1831841895213175201140730E-03
DATA -.6091498313478103633347320,6.2208568536358608431990998E-03
DATA -.6029102975554134747834702,6.2581467435255998229208227E-03
DATA -.5966336662172561341638003,6.2950515647142191886022727E-03
DATA -.5903203235394111375405864,6.3315690464189844309628949E-03
DATA -.5839706579868289461990941,6.3676969416904648471811825E-03
DATA -.5775850602594351319941408,6.4034330275507901043933791E-03
DATA -.5711639232680903029249140,6.4387751051304318145637988E-03
DATA -.5647076421104139881398226,6.4737209998035017044218583E-03
DATA -.5582166140464739699464555,6.5082685613215580554381159E-03
DATA -.5516912384743425586808994,6.5424156639459121806008761E-03
DATA -.5451319169055213144777974,6.5761602065784267970506106E-03
DATA -.5385390529402357280771185,6.6095001128907982464259091E-03
DATA -.5319130522426013808051484,6.6424333314523146080662055E-03
DATA -.5252543225156631117752170,6.6749578358560818439973984E-03
DATA -.5185632734763087281676594,6.7070716248437102088909494E-03
DATA -.5118403168300588021679862,6.7387727224284532529292952E-03
DATA -.5050858662457341057667365,6.7700591780167918407246379E-03
DATA -.4983003373300022421535401,6.8009290665284557051185368E-03
DATA -.4914841476018050398710538,6.8313804885148751508303160E-03
DATA -.4846377164666682832312103,6.8614115702760556195172418E-03
DATA -.4777614651908953597361706,6.8910204639758679248527525E-03
DATA -.4708558168756464123890576,6.9202053477557470637147884E-03
DATA -.4639211964309045918245310,6.9489644258467926074984745E-03
DATA -.4569580305493310101361121,6.9772959286802637759200314E-03
DATA -.4499667476800100051254408,7.0051981129964623944557826E-03
DATA -.4429477780020863304479467,7.0326692619519970357554193E-03
DATA -.4359015533982958937793024,7.0597076852254217449761731E-03
DATA -.4288285074283916716771105,7.0863117191212428489981040E-03
DATA -.4217290753024664362621394,7.1124797266722874498941965E-03
DATA -.4146036938541739351926808,7.1382100977404273038361762E-03
DATA -.4074528015138501726538528,7.1635012491156518878117343E-03
DATA -.4002768382815364452305435,7.1883516246134845581049307E-03
DATA -.3930762456999057925777893,7.2127596951707358064427126E-03
DATA -.3858514668270945287453553,7.2367239589395877220304415E-03
DATA -.3786029462094405258537453,7.2602429413800038703817938E-03
DATA -.3713311298541299275564774,7.2833151953504589028870525E-03
DATA -.3640364652017539753578509,7.3059393011969823144523193E-03
DATA -.3567194010987776363862590,7.3281138668405108702741736E-03
DATA -.3493803877699217266500321,7.3498375278625443268834112E-03
DATA -.3420198767904602291254888,7.3711089475890991769913129E-03
DATA -.3346383210584345112450044,7.3919268171729552523959906E-03
DATA -.3272361747667861514661529,7.4122898556741901242482968E-03
DATA -.3198138933754100896110293,7.4321968101389963453301042E-03
DATA -.3123719335831298205674013,7.4516464556767766846559753E-03
DATA -.3049107532995963557400760,7.4706375955355126106658549E-03
DATA -.2974308116171126813314970,7.4891690611754013855249070E-03
DATA -.2899325687823854471148313,7.5072397123407572395804471E-03
DATA -.2824164861682056238403682,7.5248484371301722018385363E-03
DATA -.2748830262450598717866731,7.5419941520649322694076350E-03
DATA -.2673326525526743672313363,7.5586758021556847062071669E-03
DATA -.2597658296714928377720767,7.5748923609673523688483221E-03
DATA -.2521830231940905614771423,7.5906428306822910654563041E-03
DATA -.2445846996965260887841458,7.6059262421616860613108628E-03
DATA -.2369713267096324498984454,7.6207416550051839535287106E-03
DATA -.2293433726902496141656847,7.6350881576087562455906106E-03
DATA -.2217013069923999715079185,7.6489648672207910613208914E-03
DATA -.2140455998384086095186518,7.6623709299964095469511727E-03
DATA -.2063767222899701632088853,7.6753055210500036191364789E-03
DATA -.1986951462191640176836869,7.6877678445059918262339545E-03
DATA -.1910013442794196472066982,7.6997571335477901997953341E-03
DATA -.1832957898764338771781292,7.7112726504649950830574263E-03
DATA -.1755789571390418585100171,7.7223136866987750332333719E-03
DATA -.1678513208900435467306408,7.7328795628854690046045805E-03
DATA -.1601133566169874808878088,7.7429696288983881297822398E-03
DATA -.1523655404429136599481171,7.7525832638878185270413483E-03
DATA -.1446083490970573169060391,7.7617198763192226723225395E-03
DATA -.1368422598855153932227026,7.7703789040096369853407298E-03
DATA -.1290677506618775185092873,7.7785598141622633902280246E-03
DATA -.1212852997978233025539997,7.7862621033992527222645108E-03
DATA -.1134953861536877488644070,7.7934852977926779635077296E-03
DATA -.1056984890489966008584237,7.8002289528936954015129025E-03
DATA -.0978950882329734336873092,7.8064926537598919168345279E-03
DATA -.0900856638550203064125526,7.8122760149808167166089168E-03
DATA -.0822706964351737908853691,7.8175786807016959432297203E-03
DATA -.0744506668345381951926272,7.8224003246453286989376515E-03
DATA -.0666260562256978009362603,7.8267406501321631390445391E-03
DATA -.0587973460631099349045127,7.8305993900985513984936792E-03
DATA -.0509650180534806968726444,7.8339763071131822285162928E-03
DATA -.0431295541261251663379026,7.8368711933916903322708496E-03
DATA -.0352914364033139119485902,7.8392838708094415005411850E-03
DATA -.0274511471706076282298676,7.8412141909124927608138163E-03
DATA -.0196091688471817249394630,7.8426620349267268653477464E-03
DATA -.0117659839561426950046856,7.8436273137651605561844209E-03
DATA -.0039220750948380874980108,7.8441099680334261574144661E-03
DATA .0039220750948380874980108,7.8441099680334261574144661E-03
DATA .0117659839561426950046856,7.8436273137651605561844209E-03
DATA .0196091688471817249394630,7.8426620349267268653477464E-03
DATA .0274511471706076282298676,7.8412141909124927608138163E-03
DATA .0352914364033139119485902,7.8392838708094415005411850E-03
DATA .0431295541261251663379026,7.8368711933916903322708496E-03
DATA .0509650180534806968726444,7.8339763071131822285162928E-03
DATA .0587973460631099349045127,7.8305993900985513984936792E-03
DATA .0666260562256978009362603,7.8267406501321631390445391E-03
DATA .0744506668345381951926272,7.8224003246453286989376515E-03
DATA .0822706964351737908853691,7.8175786807016959432297203E-03
DATA .0900856638550203064125526,7.8122760149808167166089168E-03
DATA .0978950882329734336873092,7.8064926537598919168345279E-03
DATA .1056984890489966008584237,7.8002289528936954015129025E-03
DATA .1134953861536877488644070,7.7934852977926779635077296E-03
DATA .1212852997978233025539997,7.7862621033992527222645108E-03
DATA .1290677506618775185092873,7.7785598141622633902280246E-03
DATA .1368422598855153932227026,7.7703789040096369853407298E-03
DATA .1446083490970573169060391,7.7617198763192226723225395E-03
DATA .1523655404429136599481171,7.7525832638878185270413483E-03
DATA .1601133566169874808878088,7.7429696288983881297822398E-03
DATA .1678513208900435467306408,7.7328795628854690046045805E-03
DATA .1755789571390418585100171,7.7223136866987750332333719E-03
DATA .1832957898764338771781292,7.7112726504649950830574263E-03
DATA .1910013442794196472066982,7.6997571335477901997953341E-03
DATA .1986951462191640176836869,7.6877678445059918262339545E-03
DATA .2063767222899701632088853,7.6753055210500036191364789E-03
DATA .2140455998384086095186518,7.6623709299964095469511727E-03
DATA .2217013069923999715079185,7.6489648672207910613208914E-03
DATA .2293433726902496141656847,7.6350881576087562455906106E-03
DATA .2369713267096324498984454,7.6207416550051839535287106E-03
DATA .2445846996965260887841458,7.6059262421616860613108628E-03
DATA .2521830231940905614771423,7.5906428306822910654563041E-03
DATA .2597658296714928377720767,7.5748923609673523688483221E-03
DATA .2673326525526743672313363,7.5586758021556847062071669E-03
DATA .2748830262450598717866731,7.5419941520649322694076350E-03
DATA .2824164861682056238403682,7.5248484371301722018385363E-03
DATA .2899325687823854471148313,7.5072397123407572395804471E-03
DATA .2974308116171126813314970,7.4891690611754013855249070E-03
DATA .3049107532995963557400760,7.4706375955355126106658549E-03
DATA .3123719335831298205674013,7.4516464556767766846559753E-03
DATA .3198138933754100896110293,7.4321968101389963453301042E-03
DATA .3272361747667861514661529,7.4122898556741901242482968E-03
DATA .3346383210584345112450044,7.3919268171729552523959906E-03
DATA .3420198767904602291254888,7.3711089475890991769913129E-03
DATA .3493803877699217266500321,7.3498375278625443268834112E-03
DATA .3567194010987776363862590,7.3281138668405108702741736E-03
DATA .3640364652017539753578509,7.3059393011969823144523193E-03
DATA .3713311298541299275564774,7.2833151953504589028870525E-03
DATA .3786029462094405258537453,7.2602429413800038703817938E-03
DATA .3858514668270945287453553,7.2367239589395877220304415E-03
DATA .3930762456999057925777893,7.2127596951707358064427126E-03
DATA .4002768382815364452305435,7.1883516246134845581049307E-03
DATA .4074528015138501726538528,7.1635012491156518878117343E-03
DATA .4146036938541739351926808,7.1382100977404273038361762E-03
DATA .4217290753024664362621394,7.1124797266722874498941965E-03
DATA .4288285074283916716771105,7.0863117191212428489981040E-03
DATA .4359015533982958937793024,7.0597076852254217449761731E-03
DATA .4429477780020863304479467,7.0326692619519970357554193E-03
DATA .4499667476800100051254408,7.0051981129964623944557826E-03
DATA .4569580305493310101361121,6.9772959286802637759200314E-03
DATA .4639211964309045918245310,6.9489644258467926074984745E-03
DATA .4708558168756464123890576,6.9202053477557470637147884E-03
DATA .4777614651908953597361706,6.8910204639758679248527525E-03
DATA .4846377164666682832312103,6.8614115702760556195172418E-03
DATA .4914841476018050398710538,6.8313804885148751508303160E-03
DATA .4983003373300022421535401,6.8009290665284557051185368E-03
DATA .5050858662457341057667365,6.7700591780167918407246379E-03
DATA .5118403168300588021679862,6.7387727224284532529292952E-03
DATA .5185632734763087281676594,6.7070716248437102088909494E-03
DATA .5252543225156631117752170,6.6749578358560818439973984E-03
DATA .5319130522426013808051484,6.6424333314523146080662055E-03
DATA .5385390529402357280771185,6.6095001128907982464259091E-03
DATA .5451319169055213144777974,6.5761602065784267970506106E-03
DATA .5516912384743425586808994,6.5424156639459121806008761E-03
DATA .5582166140464739699464555,6.5082685613215580554381159E-03
DATA .5647076421104139881398226,6.4737209998035017044218583E-03
DATA .5711639232680903029249140,6.4387751051304318145637988E-03
DATA .5775850602594351319941408,6.4034330275507901043933791E-03
DATA .5839706579868289461990941,6.3676969416904648471811825E-03
DATA .5903203235394111375405864,6.3315690464189844309628949E-03
DATA .5966336662172561341638003,6.2950515647142191886022727E-03
DATA .6029102975554134747834702,6.2581467435255998229208227E-03
DATA .6091498313478103633347320,6.2208568536358608431990998E-03
DATA .6153518836710152331070009,6.1831841895213175201140730E-03
DATA .6215160729078608581704682,6.1451310692106849564133301E-03
DATA .6276420197709255585470036,6.1066998341424479603344647E-03
DATA .6337293473258710543088905,6.0678928490207904979513170E-03
DATA .6397776810146355326093649,6.0287125016700935892623685E-03
DATA .6457866486784805005578351,5.9891612028880106009251001E-03
DATA .6517558805808900058493764,5.9492413862971289760781243E-03
DATA .6576850094303208161420752,5.9089555081952275286750641E-03
DATA .6635736704028021573464804,5.8683060474041385161751495E-03
DATA .6694215011643836202482341,5.8272955051172237902900934E-03
DATA .6752281418934298542273508,5.7859264047454744107697479E-03
DATA .6809932353027606762649893,5.7442012917622431919151687E-03
DATA .6867164266616352329403680,5.7021227335466197356318722E-03
DATA .6923973638175788627161007,5.6596933192254575883731863E-03
DATA .6980356972180513154891026,5.6169156595140632422686060E-03
DATA .7036310799319549961457379,5.5737923865555567830799909E-03
DATA .7091831676709819087034412,5.5303261537589140693743281E-03
DATA .7146916188107979875460589,5.4865196356357004084407400E-03
DATA .7201560944120635122659979,5.4423755276355057750066148E-03
DATA .7255762582412883127123272,5.3978965459800916987183857E-03
DATA .7309517767915204810096465,5.3530854274962600256418876E-03
DATA .7362823193028673175571692,5.3079449294474538377007114E-03
DATA .7415675577828472483404577,5.2624778293641008920039892E-03
DATA .7468071670265714612889527,5.2166869248727100194130774E-03
DATA .7520008246367540198902183,5.1705750335237309984552282E-03
DATA .7571482110435492228260470,5.1241449926181884968072417E-03
DATA .7622490095242149890255755,5.0773996590331007480390167E-03
DATA .7673029062226010582357195,5.0303419090456937061217566E-03
DATA .7723095901684608079888676,4.9829746381564214943643207E-03
DATA .7772687532965854987012501,4.9353007609108040389399652E-03
DATA .7821800904657597695620265,4.8873232107200928500007496E-03
DATA .7870432994775372188722786,4.8390449396807759855446397E-03
DATA .7918580810948349135640607,4.7904689183929333046974074E-03
DATA .7966241390603456837717921,4.7415981357774531878946569E-03
DATA .8013411801147670695408899,4.6924355988921219715957326E-03
DATA .8060089140148457980409629,4.6429843327465974146282383E-03
DATA .8106270535512366810024356,4.5932473801162775820470507E-03
DATA .8151953145661748335154631,4.5432278013550766004930588E-03
DATA .8197134159709601268177470,4.4929286742071188064528328E-03
DATA .8241810797632527992526874,4.4423530936173628755499398E-03
DATA .8285980310441791612005141,4.3915041715411675870411756E-03
DATA .8329639980352463414719476,4.3403850367528109430467473E-03
DATA .8372787120950650344058650,4.2889988346529744267133843E-03
DATA .8415419077358792187286900,4.2373487270752042474954035E-03
DATA .8457533226399018311131247,4.1854378920913614850439286E-03
DATA .8499126976754553893166989,4.1332695238160731058231723E-03
DATA .8540197769129165717857668,4.0808468322101958885308878E-03
DATA .8580743076404637726773631,4.0281730428833053556957251E-03
DATA .8620760403796266633790730,3.9752513968952218694674985E-03
DATA .8660247289006368037951485,3.9220851505565861096203416E-03
DATA .8699201302375783589148594,3.8686775752284962111698272E-03
DATA .8737620047033379884859100,3.8150319571212188977839493E-03
DATA .8775501159043529899810783,3.7611515970919870053700346E-03
DATA .8812842307551567874694922,3.7070398104418958478769910E-03
DATA .8849641194927208714846091,3.6526999267119109345042264E-03
DATA .8885895556905923075185429,3.5981352894779996042038747E-03
DATA .8921603162728259433664469,3.5433492561453991996620077E-03
DATA .8956761815277104581948603,3.4883451977420344589220515E-03
DATA .8991369351212874089139762,3.4331264987110968585623238E-03
DATA .9025423641106624421955255,3.3776965567027986979745151E-03
DATA .9058922589571078532953371,3.3220587823653147699542163E-03
DATA .9091864135389556857127581,3.2662165991349245186867942E-03
DATA .9124246251642805786483078,3.2101734430253676425153532E-03
DATA .9156066945833715822067555,3.1539327624164261558923710E-03
DATA .9187324260009921733361549,3.0974980178417459829955126E-03
DATA .9218016270884277185954871,3.0408726817759112150766292E-03
DATA .9248141089953196430062722,2.9840602384207842252760188E-03
DATA .9277696863612855774691976,2.9270641834911248990910487E-03
DATA .9306681773273247705187315,2.8698880239995023068591947E-03
DATA .9335094035470080635511228,2.8125352780405122176822307E-03
DATA .9362931901974517420997422,2.7550094745743139337060721E-03
DATA .9390193659900745892537874,2.6973141532095000115583202E-03
DATA .9416877631811374809315652,2.6394528639853125366129890E-03
DATA .9442982175820648764404846,2.5814291671532197289820420E-03
DATA .9468505685695475715990344,2.5232466329578667921869215E-03
DATA .9493446590954260956830096,2.4649088414174150722575315E-03
DATA .9517803356963541476176046,2.4064193821032837844401297E-03
DATA .9541574485032414812063787,2.3477818539193087973829979E-03
DATA .9564758512504756638175957,2.2889998648803332549695712E-03
DATA .9587354012849221479049303,2.2300770318902451834521819E-03
DATA .9609359595747021101129220,2.1710169805194777030769764E-03
DATA .9630773907177475286294707,2.1118233447819880761749695E-03
DATA .9651595629501329860638605,2.0524997669117326296387785E-03
DATA .9671823481541837026768633,1.9930498971386556619114334E-03
DATA .9691456218663593235845560,1.9334773934642118869862805E-03
DATA .9710492632849130040397740,1.8737859214364439296000032E-03
DATA .9728931552773253596853138,1.8139791539246390831213050E-03
DATA .9746771843875128746551103,1.7540607708935932918534161E-03
DATA .9764012408428103908462605,1.6940344591775155933476319E-03
DATA .9780652185607273384489774,1.6339039122536137611976595E-03
DATA .9796690151554774136346128,1.5736728300154127016475733E-03
DATA .9812125319442814682424151,1.5133449185458729415321843E-03
DATA .9826956739534434545500623,1.4529238898903999088514186E-03
DATA .9841183499241993752558070,1.3924134618298698080684263E-03
DATA .9854804723183393394746898,1.3318173576538514742077422E-03
DATA .9867819573236030434401229,1.2711393059342868032230354E-03
DATA .9880227248588493179127030,1.2103830403000240185954168E-03
DATA .9892026985790008762180358,1.1495522992128106211745720E-03
DATA .9903218058797661642331360,1.0886508257457038100719739E-03
DATA .9913799779021414417532216,1.0276823673654497630797823E-03
DATA .9923771495366982433589461,9.6665067572141452408517998E-04
DATA .9933132594276647813762767,9.0555950644549534547199634E-04
DATA .9941882499768158116647105,8.4441261897085745246513294E-04
DATA .9950020673471962444031388,7.8321377638390310244817342E-04
DATA .9957546614667239851797758,7.2196674533702894531306739E-04
DATA .9964459860317571225964113,6.6067529607738161575318920E-04
DATA .9970759985107923450247946,5.9934320270831884264722444E-04
DATA .9976446601486403940368916,5.3797424394626279849881322E-04
DATA .9981519359718441275385541,4.7657220501003854013133061E-04
DATA .9985977947971757433952425,4.1514088233419025171823795E-04
DATA .9989822092480797992371162,3.5368409613102448239639817E-04
DATA .9993051557937030335325083,2.9220572803523217847223343E-04
DATA .9995666148626408000179844,2.3070985544248655269465132E-04
DATA .9997665712667108498622001,1.6920137336541413264932958E-04
DATA .9999050164693312795671775,1.0769038102183646230364914E-04
DATA .9999819727039624507107997,4.6263724177190118157440220E-05
END FUNCTION
EXTERNAL FUNCTION F(R,X,T)
LET F=EXP(X*COS(T))*COS(R*T)
END FUNCTION
EXTERNAL FUNCTION INTEGRAL2(R,Z) !'ガウス・ラゲール
FOR I=1 TO 6
READ X,W
LET S=S+FF(R,Z,X)*EXP(X)*W
NEXT I
LET INTEGRAL2=S
DATA .2228466041792606894643548,4.5896467394996359356828488E-01
DATA 1.1889321016726230307431509,4.1700083077212099411337757E-01
DATA 2.9927363260593140776913253,1.1337338207404497573870619E-01
DATA 5.7751435691045105018398304,1.0399197453149074898913303E-02
DATA 9.8374674183825899177155470,2.6101720281493205947924286E-04
DATA 15.9828739806017017825457916,8.9854790642962123882529205E-07
END FUNCTION
EXTERNAL FUNCTION FF(R,X,T)
LET FF=EXP(-X*COSH(T)-R*T)
END FUNCTION
EXTERNAL FUNCTION BESSELI(R,X) !'Rは実数
LET S=INTEGRAL(ABS(R),X)-SIN(ABS(R)*PI)/PI*INTEGRAL2(ABS(R),X)
IF R<0 THEN LET S=S*(-1)^INT(ABS(R))
LET BESSELI=S
END FUNCTION
CALL GINIT(400,800)
SET WINDOW 0,10,-.1,.9
DRAW GRID(1,10)
FOR N=0 TO 5
SET LINE COLOR N+1
FOR X=0 TO 10 STEP 1/16
LET Y=BESSELK(N,X)
PLOT LINES:X,Y;
NEXT X
PLOT LINES
NEXT N
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION INTEGRAL(R,Z) !'ガウス・ラゲール
FOR I=1 TO 6
READ X,W
LET S=S+FF(R,Z,X)*EXP(X)*W
NEXT I
LET INTEGRAL=S
DATA .2228466041792606894643548,4.5896467394996359356828488E-01
DATA 1.1889321016726230307431509,4.1700083077212099411337757E-01
DATA 2.9927363260593140776913253,1.1337338207404497573870619E-01
DATA 5.7751435691045105018398304,1.0399197453149074898913303E-02
DATA 9.8374674183825899177155470,2.6101720281493205947924286E-04
DATA 15.9828739806017017825457916,8.9854790642962123882529205E-07
END FUNCTION
EXTERNAL FUNCTION FF(R,X,T)
LET FF=EXP(-X*COSH(T))*COSH(R*T)
END FUNCTION
EXTERNAL FUNCTION BESSELK(R,X) !'Rは実数
LET S=INTEGRAL(ABS(R),X)
IF R<0 THEN LET S=S*(-1)^INT(ABS(R))
LET BESSELK=S
END FUNCTION
LET ST=.1
FOR N=0 TO 5
PRINT "BESSEL_J";STR$(N);"(x) 零点"
FOR X=0 TO 30 STEP ST
IF BESSELJ(N,X)*BESSELJ(N,X+ST)<0 THEN !'2分法
LET A=X
LET B=X+ST
DO
LET C=(A+B)/2
IF BESSELJ(N,A)*BESSELJ(N,C)>0 THEN LET A=C ELSE LET B=C
LOOP UNTIL ABS(A-B)<1E-13
PRINT "零点";C
END IF
NEXT X
PRINT
NEXT N
END
EXTERNAL FUNCTION BESSELJ(N,X)
LET M=(X/2)^INT(ABS(N))
LET SIGN=1
FOR K=0 TO 1000
IF K=0 THEN
IF ABS(N)>0 THEN LET M=M/INT(ABS(N))
ELSE
LET M=M/K/(INT(ABS(N))+K)
END IF
IF K>0 THEN LET M=M*X*X/4
LET SS=SS+SIGN*M
IF ABS(M)<1E-15 THEN EXIT FOR
LET SIGN=-SIGN
NEXT K
IF N<0 THEN LET SS=SS*(-1)^INT(ABS(N))
LET BESSELJ=SS
END FUNCTION
OPTION ARITHMETIC NATIVE
LET S=0
LET N=1E+8
FOR I=1 TO N
LET S=S+1/I
NEXT I
PRINT S-LOG(N) !'およそ8桁
PRINT " .5772156649015328606065120"
END
---------------------------------------------------------------------------------------------
OPTION ARITHMETIC DECIMAL_HIGH
LET BETA=4.31913656629145
LET N=800
LET V=1
FOR K=1 TO INT(BETA*N)
LET V=V*N/K
LET S=S+(-1)^(K-1)*V/K
NEXT K
LET S=S-LLOG(N)
LET A=1
LET SS=1
FOR K=1 TO N-2
LET A=-A*K/N
LET SS=SS+A
NEXT K
LET S=S-LEXP(-N)/N*SS
LET SS=.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495146314472498070824809605040144865428362241739976449235362535003337429373377376739427925952582470949160087352039481656708532331517766115286211995015079847937450857057400299213547861466940296043254215190587755352673313992540129674205137541395491116851028079842348775872050384310939973613725530608893312676001724795378367592713515772261027349291394079843010341777177808815495706610750101619166334015227893586796549725203621287922655595366962817638879272680132431010476505963703947394957638906572967929601009015125195950922243501409349871228247949747195646976318506676129063811051824197444867836380861749455169892792301877391072945781554316005002182844096053772434203285478367015177394398700302370339518328690001558193988042707411542227819716523011073565833967348717650491941812300040654693142999297779569303100503086303418569803231083691640025892970890985486825777364288253954925873629596133298574739302
PRINT S !'およそ660桁
PRINT SS
PRINT USING "-%.##########^^^^^^":S-SS
!'LET A=4
!'LET B=5
!'DO
!' LET C=(A+B)/2
!' IF F(C)<0 THEN LET A=C ELSE LET B=C
!'LOOP UNTIL ABS(A-B)<1E-15
!'PRINT C
END
!'EXTERNAL FUNCTION F(X)
!'LET F=X*(LOG(X)-1)-2
!'END FUNCTION
EXTERNAL FUNCTION LLOG(X)
OPTION ARITHMETIC DECIMAL_HIGH
IF X<=0 THEN
CAUSE EXCEPTION 3004
ELSEIF X<1 THEN
LET LLOG=-LLOG(1/X)
ELSEIF X>3 THEN
LET LLOG=2*LLOG(SQR(X))
ELSE ! 1<=x<=3
LET H=(X-1)/(X+1) ! 0<=h<=0.5
LET T=0
LET N=1
LET K=H
LET H2=H^2
DO
LET T=T+K/N
LET N=N+2
LET K=K*H2
LOOP UNTIL K<=1E-1000
LET LLOG=2*T
END IF
END FUNCTION
EXTERNAL FUNCTION LEXP(X)
OPTION ARITHMETIC DECIMAL_HIGH
LET A=1
LET S=1
DO
LET I=I+1
LET A=A*X/I
LET S=S+A
LOOP UNTIL ABS(A)<1E-1000
LET LEXP=S
END FUNCTION
---------------------------------------------------------------------------------------------
OPTION ARITHMETIC DECIMAL_HIGH
LET N=5000
LET S=0
FOR I=1 TO N
LET S=S+1/I
NEXT I
LET S=S-1/2/N-LLOG(N)
LET A=1
FOR K=1 TO 210
LET A=A/N/N
LET S=S+BERNOULLI(2*K)/2/K*A
NEXT K
LET SS=.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495146314472498070824809605040144865428362241739976449235362535003337429373377376739427925952582470949160087352039481656708532331517766115286211995015079847937450857057400299213547861466940296043254215190587755352673313992540129674205137541395491116851028079842348775872050384310939973613725530608893312676001724795378367592713515772261027349291394079843010341777177808815495706610750101619166334015227893586796549725203621287922655595366962817638879272680132431010476505963703947394957638906572967929601009015125195950922243501409349871228247949747195646976318506676129063811051824197444867836380861749455169892792301877391072945781554316005002182844096053772434203285478367015177394398700302370339518328690001558193988042707411542227819716523011073565833967348717650491941812300040654693142999297779569303100503086303418569803231083691640025892970890985486825777364288253954925873629596133298574739302
PRINT S !'およそ690桁
PRINT SS
PRINT USING "-%.##########^^^^^^":S-SS
END
EXTERNAL FUNCTION LLOG(X)
OPTION ARITHMETIC DECIMAL_HIGH
IF X<=0 THEN
CAUSE EXCEPTION 3004
ELSEIF X<1 THEN
LET LLOG=-LLOG(1/X)
ELSEIF X>3 THEN
LET LLOG=2*LLOG(SQR(X))
ELSE ! 1<=x<=3
LET H=(X-1)/(X+1) ! 0<=h<=0.5
LET T=0
LET N=1
LET K=H
LET H2=H^2
DO
LET T=T+K/N
LET N=N+2
LET K=K*H2
LOOP UNTIL K<=1E-1000
LET LLOG=2*T
END IF
END FUNCTION
EXTERNAL FUNCTION BERNOULLI(K) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
LET C=1
LET D=1
LET N=K/2
IF K=1 THEN
LET BERNOULLI=-1/2
ELSEIF MOD(K,2)=1 THEN
LET BERNOULLI=0
ELSE
FOR M=N TO 1 STEP-1
LET T=T+(-1)^M*D*M^(K-1)
LET C=C*(N+M+1)/(N-M+1)
LET D=D+C
NEXT M
LET BERNOULLI=-T*K/(2^K*(2^K-1))
END IF
END FUNCTION
---------------------------------------------------------------------------------------------
OPTION ARITHMETIC DECIMAL_HIGH
LET N=1150
LET BETA=4.97062575954423
LET A=1
LET H=1
FOR K=0 TO INT(BETA*N)
IF K>0 THEN
LET A=A*N*N/K/K
IF K>1 THEN LET H=H+1/K
END IF
LET AA=AA+A*H
LET BB=BB+A
NEXT K
LET C=1
LET CC=1
FOR K=1 TO 2*N
LET C=C*(2*K)*(2*K)*(2*K)/K/K/K/K/16/N/16/N
LET CC=CC+C
NEXT K
LET CC=CC/4/N
LET S=AA/BB-CC/BB/BB-LLOG(N)
LET SS=.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495146314472498070824809605040144865428362241739976449235362535003337429373377376739427925952582470949160087352039481656708532331517766115286211995015079847937450857057400299213547861466940296043254215190587755352673313992540129674205137541395491116851028079842348775872050384310939973613725530608893312676001724795378367592713515772261027349291394079843010341777177808815495706610750101619166334015227893586796549725203621287922655595366962817638879272680132431010476505963703947394957638906572967929601009015125195950922243501409349871228247949747195646976318506676129063811051824197444867836380861749455169892792301877391072945781554316005002182844096053772434203285478367015177394398700302370339518328690001558193988042707411542227819716523011073565833967348717650491941812300040654693142999297779569303100503086303418569803231083691640025892970890985486825777364288253954925873629596133298574739302
PRINT S !'およそ1000桁
PRINT SS
PRINT USING "-%.##########^^^^^^":S-SS
!'LET A=4
!'LET B=5
!'DO
!' LET C=(A+B)/2
!' IF F(C)<0 THEN LET A=C ELSE LET B=C
!'LOOP UNTIL ABS(A-B)<1E-15
!'PRINT C
END
!'EXTERNAL FUNCTION F(X)
!'LET F=X*(LOG(X)-1)-3
!'END FUNCTION
EXTERNAL FUNCTION LLOG(X)
OPTION ARITHMETIC DECIMAL_HIGH
IF X<=0 THEN
CAUSE EXCEPTION 3004
ELSEIF X<1 THEN
LET LLOG=-LLOG(1/X)
ELSEIF X>3 THEN
LET LLOG=2*LLOG(SQR(X))
ELSE ! 1<=x<=3
LET H=(X-1)/(X+1) ! 0<=h<=0.5
LET T=0
LET N=1
LET K=H
LET H2=H^2
DO
LET T=T+K/N
LET N=N+2
LET K=K*H2
LOOP UNTIL K<=1E-1000
LET LLOG=2*T
END IF
END FUNCTION
OPTION ARITHMETIC RATIONAL
DATA 3
DATA 4,4,4 !a+b+c, a^2+b^2+c^2, a^3+b^3+c^3
READ N
DIM A(N)
MAT READ A
DIM B(N) !基本対称式 a+b+c, ab+bc+ca, abc
FOR K=1 TO N
LET S=A(K)
FOR J=1 TO K-1
LET S=S+(-1)^J*A(K-J)*B(J)
NEXT J
PRINT K;S
LET B(K)=(-1)^(K-1)*S/K
NEXT K
MAT PRINT B;
END
LET N=4
DIM A(N)
FOR M=1 TO N !a[m]
LET A(M)=1-EXP(2*PI*COMPLEX(0,1)*M/(N+1))
NEXT M
MAT PRINT A;
FOR K=1 TO N !k乗
LET S=0 !和
FOR M=1 TO N
LET S=S+A(M)^K
NEXT M
PRINT K;S
NEXT K
DIM C(0 TO N) !C[0]t^n+C[1]t^(n-1)+C[2]t^(n-2)+ … +C[n-1]t+C[n]=0の係数
MAT C=ZER
FOR J=0 TO 2^N-1 !2進法n桁
LET T=J
LET P=0 !項の次数（1の個数）
LET S=1
FOR M=1 TO N !解と係数の関係より
IF MOD(T,2)=1 THEN
LET S=S*A(M)
LET P=P+1
END IF
LET T=INT(T/2)
NEXT M
LET C(P)=C(P)+S*(-1)^P
NEXT J
MAT PRINT C;
FOR J=0 TO N !二項係数
PRINT COMB(N+1,J)*(-1)^J;
NEXT J
PRINT
READ N
DIM C(N) !係数 ※基本対称式 -(a+b+c+d), ab+ac+ad+bc+bd+cd, -(abc+abd+acd+bcd), abcd
MAT READ C
DIM T(M)
FOR K=1 TO N !a+b+c+d, a^2+b^2+c^2+d^2, a^3+b^3+c^3+d^3, a^4+b^4+c^4+d^4
LET W=0 !ニュートンの多項式
FOR J=1 TO K-1
LET W=W-C(J)*T(K-J)
NEXT J
LET T(K)=W-K*C(K)
NEXT K
FOR K=N+1 TO M !a^5+b^5+c^5+d^5, a^6+b^6+c^6+d^6, a^7+b^7+c^7+d^7, …
LET W=0 !漸化式
FOR J=1 TO N
LET W=W-C(J)*T(K-J)
NEXT J
LET T(K)=W
NEXT K
MAT PRINT T;
DATA 3
DATA -2,-2,-2 !a+b+c, a^2+b^2+c^2, a^3+b^3+c^3
READ N
DIM A(N)
MAT READ A
DIM B(N) !基本対称式 a+b+c, ab+bc+ca, abc
FOR K=1 TO N
LET S=A(K)
FOR J=1 TO K-1
LET S=S+(-1)^J*A(K-J)*B(J)
NEXT J
PRINT K;S
LET B(K)=(-1)^(K-1)*S/K
NEXT K
MAT PRINT B;
LET M=10 !m乗
DIM T(M)
FOR K=1 TO N !a+b+c, a^2+b^2+c^2, a^3+b^3+c^3
LET T(K)=A(K) !copy it
NEXT K
FOR K=N+1 TO M !a^4+b^4+c^4, a^5+b^5+c^5, a^6+b^6+c^6, …
LET W=0 !漸化式
FOR J=1 TO N
LET W=W+(-1)^(J-1)*B(J)*T(K-J)
NEXT J
LET T(K)=W
NEXT K
MAT PRINT T;
PUBLIC STRING v$ !変数の定義 ※必要なものだけの列記でもよい
LET v$="ABCt"
PUBLIC NUMERIC N !変数の数
LET N=LEN(v$)
PUBLIC NUMERIC MAX_TERM !最大の項数
LET MAX_TERM=50
!------------------------------ ここまでがサブルーチン
DIM f(0 TO 100, 0 TO N), g(0 TO 100, 0 TO N)
CALL PolySet("t^4", f)
CALL PolySet("t^3-At^2+Bt-C", g)
DIM q(0 TO 100, 0 TO N), r(0 TO 100, 0 TO N)
CALL PolyQuotientRemainder(f,g,"t", q,r)
CALL PolyPrintCollect(q,"t") !商
PRINT
CALL PolyPrintCollect(r,"t") !余り ※符号は+,-,+で採用する
PRINT
OPTION ARITHMETIC RATIONAL
LET K=2
FOR B=1 TO 10000
FOR A=1 TO B
LET P=A^K+B^K
LET Q=(A*B)^(K-1)+1
IF MOD(P,Q)=0 THEN PRINT A;B; P/Q; A^K; A^(2*K-1)
NEXT A
NEXT B
END
DIM Q$(27),SCORE(6)
INPUT PROMPT "あなたの年齢は":AGE
INPUT PROMPT "あなたの性別は 男(1) 女(2)":SEX
INPUT PROMPT "年間の走行距離(Km)は":MILEAGE
FOR I=1 TO 27
READ A$
DO
PRINT "No.";I;":";A$;" (Yes/No) ";
INPUT Q$(I)
LET Q$(I)=UCASE$(Q$(I))
LOOP UNTIL Q$(I)="Y" OR Q$(I)="N"
NEXT I
FOR I=1 TO 27
SELECT CASE I
CASE 1 TO 6
IF Q$(I)="Y" THEN LET SCORE(1)=SCORE(1)+1
CASE 7 TO 10
IF Q$(I)="Y" THEN LET SCORE(2)=SCORE(2)+1
CASE 11 TO 15
IF Q$(I)="Y" THEN LET SCORE(3)=SCORE(3)+1
CASE 16 TO 18
IF Q$(I)="N" THEN LET SCORE(4)=SCORE(4)+1
CASE 19 TO 23
IF Q$(I)="Y" THEN LET SCORE(5)=SCORE(5)+1
CASE 24 TO 26
IF Q$(I)="Y" THEN LET SCORE(6)=SCORE(6)+1
CASE 27
IF Q$(I)="N" THEN LET SCORE(6)=SCORE(6)+1
END SELECT
NEXT I
PRINT
PRINT ">>>>>>>>>> 結果 <<<<<<<<<<"
PRINT
SELECT CASE AGE
CASE IS<=29
SELECT CASE MILEAGE
CASE IS<2400
IF SEX=1 THEN
IF SCORE(1)=6 THEN CALL 自己中心的
IF SCORE(2)>=2 AND SCORE(2)<4 THEN CALL ながら
ELSE
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)=4 OR SCORE(3)=5 THEN CALL 不注視
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
END IF
CASE 2400 TO 12000
IF SEX=1 THEN
IF SCORE(1)=6 THEN CALL 自己中心的
IF SCORE(2)>=1 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)>=1 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(5)>=1 AND SCORE(5)<=5 THEN CALL 攻撃的
ELSE
IF SCORE(2)>=1 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(5)=4 OR SCORE(5)=5 THEN CALL 攻撃的
END IF
CASE IS>12000
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
ELSE
IF SCORE(6)=3 OR SCORE(6)=4 THEN CALL 無関心
END IF
END SELECT
CASE 30 TO 59
SELECT CASE MILEAGE
CASE IS<2400
IF SEX=1 THEN
IF SCORE(1)>=1 AND SCORE(1)<=6 THEN CALL 自己中心的
IF SCORE(2)=3 OR SCORE(2)=4 THEN CALL ながら
IF SCORE(3)=4 OR SCORE(3)=5 THEN CALL 不注視
IF SCORE(5)>=1 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=2 AND SCORE(6)<=4 THEN CALL 無関心
ELSE
IF SCORE(1)>=4 AND SCORE(1)<=6 THEN CALL 自己中心的
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)>=2 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(4)>=1 AND SCORE(4)<=3 THEN CALL 配慮不足
IF SCORE(5)>=2 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=2 AND SCORE(6)<=4 THEN CALL 無関心
END IF
CASE 2400 TO 12000
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(5)>=1 AND SCORE(5)<=5 THEN CALL 攻撃的
ELSE
IF SCORE(1)>=4 AND SCORE(1)<=6 THEN CALL 自己中心的
IF SCORE(2)=3 OR SCORE(2)=4 THEN CALL ながら
IF SCORE(3)>=2 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(4)>=1 AND SCORE(4)<=3 THEN CALL 配慮不足
IF SCORE(5)>=1 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=2 AND SCORE(6)<=4 THEN CALL 無関心
END IF
CASE IS>12000
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(4)>=1 AND SCORE(4)<=3 THEN CALL 配慮不足
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=2 AND SCORE(6)<=4 THEN CALL 無関心
ELSE
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
END IF
END SELECT
CASE 60 TO 69
SELECT CASE MILEAGE
CASE IS<2400
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)=4 OR SCORE(3)=5 THEN CALL 不注視
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=1 AND SCORE(6)<=4 THEN CALL 無関心
ELSE
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
END IF
CASE 2400 TO 12000
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)=4 OR SCORE(3)=5 THEN CALL 不注視
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=1 AND SCORE(6)<=4 THEN CALL 無関心
ELSE
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
END IF
CASE IS>12000
IF SEX=1 THEN
IF SCORE(2)>=2 AND SCORE(2)<=4 THEN CALL ながら
IF SCORE(3)=4 OR SCORE(3)=5 THEN CALL 不注視
IF SCORE(5)>=3 AND SCORE(5)<=5 THEN CALL 攻撃的
IF SCORE(6)>=1 AND SCORE(6)<=4 THEN CALL 無関心
ELSE
IF SCORE(3)>=3 AND SCORE(3)<=5 THEN CALL 不注視
END IF
END SELECT
END SELECT
DATA 後からクラクションを鳴らされると腹が立つ
DATA 渋滞時に、横から割り込まれると損した気分になる
DATA 割り込みされそうな時は、車間距離をつめる
DATA 歩行者が道路をゆっくり横断しているとイライラする
DATA 歩行者や自転車に、自分のペースをみだされるのは嫌だ
DATA 何度も信号で止められると、とても嫌な感じがする
DATA カーナビや地図を見ながら運転することがある
DATA 運転中、身支度や飲食をすることがある
DATA 運転中、よくオーディオ、テレビを操作する
DATA 走行中、携帯電話に着信があると、受けてしまう
DATA 前の車のブレーキランプに気づくのが遅れて、慌てることがある
DATA 脇見をしていて、ハッとすることがある
DATA 考え事をしていて、ハッとすることがある
DATA 夜、歩行者や自転車に、ハッとすることがある
DATA カーブミラーに映る他車の位置を見誤ることがある
DATA 体調を整えてから運転する
DATA 初心者マーク、高齢者マークの車を意識して運転する
DATA 後方に注意して運転するほうだ
DATA 追い越しや車線変更をするほうだ
DATA 前方が空いていると、ついスピードが出てしまう
DATA 信号が赤になる前に、急いで交差点に進入することがある
DATA 人から運転が強引だと言われたことがある
DATA カーブでも、スピードを落とさずに走れる
DATA 夜間や悪天候のときは、運転しないようにする
DATA 長距離の運転を控える
DATA 見通しや路面状態がよくても、制限速度より遅めに走る
DATA ちょっとしたことでもよくブレーキを踏む
SUB 自己中心的
PRINT "--------------自己中心的--------------"
PRINT
PRINT "自分のペースを乱されると不快になる傾向が強いようです"
PRINT
PRINT "不快な気持ちが運転にも反映され、知らず知らずのうちに、"
PRINT "的確な認知や判断、操作等ができなくなり、事故の危険性が高くなります"
PRINT
PRINT "イライラは禁物、余裕を持った運転を心がけるように努めましょう"
PRINT
END SUB
SUB ながら
PRINT "--------------ながら--------------"
PRINT
PRINT "運転中に、運転に直接関係のないことに関心が向いてしまう傾向が強いようです"
PRINT
PRINT "人間は同時に複数の作業もできますが、そうした場合、効率が低下したり、"
PRINT "ミスが多くなり、事故の危険性が高くなります"
PRINT
PRINT "運転中は、運転に必要な作業に専念し、急な状況の変化にも対応できるように努めましょう"
PRINT
END SUB
SUB 不注視
PRINT "--------------不注視--------------"
PRINT
PRINT "運転中に、前方の道路交通状況に対する注視を怠ってしまう傾向が強いようです"
PRINT
PRINT "脇見はもちろん、前方を見ていても集中力が低下すると、危険に気づくのが遅れたり、"
PRINT "気づかなかったりで、事故の回避が困難になります"
PRINT
PRINT "道路の状況、他の道路利用者の動きを、常に把握するように心がけて運転しましょう"
PRINT
END SUB
SUB 配慮不足
PRINT "--------------配慮不足--------------"
PRINT
PRINT "他の道路利用者の行動特性や考え方をしっかり理解することに関心がないようです"
PRINT
PRINT "他者や自己の状態をしっかり理解することで、交通場面に応じた状況を想定することもでき、"
PRINT "急な状況の変化にも的確に対応できます"
PRINT
PRINT "他者や周囲の状況に配慮して運転すると、事故の危険性を低くすることができます"
PRINT
END SUB
SUB 攻撃的
PRINT "--------------攻撃的--------------"
PRINT
PRINT "少しでも前に、少しでも早くという気持ちで運転する傾向が強いようです"
PRINT
PRINT "高い速度での運転や度々行う車線変更は、自己だけでなく他の道路利用者の判断や"
PRINT "操作ミスを誘発することで、事故に結びつく可能性を高めます"
PRINT
PRINT "他の人が危ないと感じたり、事故の危険性を高めるような運転はやめましょう"
PRINT
END SUB
SUB 無関心
PRINT "--------------無関心--------------"
PRINT
PRINT "事故の危険性が高い状況を回避しない傾向が強いようです"
PRINT
PRINT "人は十分に注意していてもミスを犯すことがありますが、そのミスが大きなミスに"
PRINT "繋がらないような状況、条件での運転であれば、事故は回避できます"
PRINT
PRINT "頻繁にブレーキを踏まなくてもよい運転に心がけることで、事故の危険性が低くなります"
PRINT
END SUB
END
FOR D=4 TO 500
FOR C=3 TO D-1
FOR B=2 TO C-1
LET WW=F(B,C,D)
IF G(WW)=0 THEN !平方数なら
FOR A=1 TO B-1
LET ZZ=F(A,C,D)
LET YY=F(A,B,D)
LET XX=F(A,B,C)
IF G(ZZ)=0 AND G(YY)=0 AND G(XX)=0 THEN !平方数なら
PRINT A;B;C;D; INTSQR(XX);INTSQR(YY);INTSQR(ZZ);INTSQR(WW)
END IF
NEXT A
END IF
NEXT B
NEXT C
NEXT D
FOR D=4 TO 5000
FOR C=3 TO D-1
LET WW=F(C,D)
IF G(WW)=0 THEN !平方数なら
FOR B=2 TO C-1
LET VV=F(B,D)
LET UU=F(B,C)
IF G(VV)=0 AND G(UU)=0 THEN !平方数なら
FOR A=1 TO B-1
LET ZZ=F(A,D)
LET YY=F(A,C)
LET XX=F(A,B)
IF G(ZZ)=0 AND G(YY)=0 AND G(XX)=0 THEN !平方数なら
PRINT A;B;C;D; INTSQR(XX);INTSQR(YY);INTSQR(ZZ);INTSQR(UU);INTSQR(VV);INTSQR(WW)
END IF
NEXT A
END IF
NEXT B
END IF
NEXT C
NEXT D
A=44のとき、
b x
483 485
240 244
117 125
なので、
117^2+240^2=71289=267
117^2+483^2=246978=496.9688…
240^2+483^2=290889=539.3412…
よって、(a,b,c)=(44,117,240)
作業のシミュレーション
DIM M(20) !b,cの候補
FOR A=1 TO 50 !aを固定する
PRINT "A=";A
LET K=0 !個数
FOR P=1 TO A-1
IF MOD(A^2,P)=0 THEN !約数なら
LET Q=A^2/P
LET B=(Q-P)/2
LET X=(Q+P)/2
IF INT(B)=B AND INT(X)=X THEN !整数なら
IF B<=A THEN EXIT FOR !a＜bに注意する
PRINT B;X
LET K=K+1 !記録する
LET M(K)=B
END IF
END IF
NEXT P
IF K>=2 THEN !式3の確認
FOR i=1 TO K-1 !2つ
FOR J=i+1 TO K
LET T=M(i)^2+M(J)^2
PRINT STR$(M(J));"^2+";STR$(M(i));"^2=";T; "="; SQR(T)
NEXT J
NEXT i
END IF
LET t0=TIME
FOR w=2 TO 30013
IF MOD(w,2)=0 THEN
IF w=2 THEN PRINT w ELSE
ELSE
FOR l=3 TO SQR(w) STEP 2
IF MOD(w,l)=0 THEN EXIT FOR
NEXT l
IF l<=SQR(w) THEN ELSE PRINT w
END IF
NEXT w
FOR n=1 TO 33 !100万までの素数
FOR k=1 TO 5760
LET p=30030*n+A(k)
FOR i=17 TO SQR(p) STEP 2
IF MOD(p,i)=0 THEN EXIT FOR
NEXT i
IF i<=SQR(p) THEN ELSE PRINT p
半角スペースが削除できれば完成です。方法がわかりません。
-----------------------------------------------------------------------------------------------
100 ! 素数階乗n +kの値と個数を求めるprogram
110 LET W=30030 !素数階乗を入力(素数階乗 6,30,210,2310,30030,510510,,,)
120 LET p=w
130 LET z=w
140 ! OPTION BASE 0 ! DIM文より手前の行にOPTION BASE 0を追加する。
150 DIM A(p)
160 DIM B(z)
170 LET t0=TIME
180 LET p=1 ! p の初期値を0とすると、初回 1になる。140の!を削除
190 LET z=1
200 FOR k=1 TO w STEP 2 !素数倍を代入
210 ! PRINT"----------------"
220 ! PRINT "k=+";k
230 FOR n=1 TO 20 !素数倍周期 何周でも可能
240 LET m=w*n+k !素数倍を代入
250 FOR i=3 TO SQR(m) STEP 2 !篩
260 IF MOD(m,i)=0 THEN 300
270 NEXT i
280 ! PRINT m;"@";n
290 LET B(z)=m
300 NEXT n
310 IF B(z)=0 THEN 370
320 LET A(p)=p
330 LET p=p+1
340 LET z=z+1
350 ! PRINT"----------------";p;"個";k ! k定数 kの個数
360 PRINT k ! k定数プリント
370 NEXT k
380 PRINT "----------------"
390 PRINT "k=-1から数えて";p;"個" ! -1は出ません
400 PRINT TIME-t0;"秒で計算しました"
410 END
FOR Z=6 TO 150
FOR U=1 TO Z-5
LET T=U^2+Z^2
FOR X=INTSQR(T/2)+1 TO Z-2
LET W=INTSQR(T-X^2)
IF W^2+X^2=T THEN
FOR Y=X+1 TO Z-1
LET V=INTSQR(T-Y^2)
IF V^2+Y^2=T THEN
LET A=(W^2+(V^2-Z^2))/2 !a+d=w^2とき
LET D=(W^2-(V^2-Z^2))/2
IF A>0 AND INT(A)=A AND INT(D)=D THEN !整数なら
LET B=Y^2-D
LET C=Z^2-D
IF B+C=X^2 AND A+B=U^2 THEN !残りの式を満たすか
PRINT A;B;C;D; U;V;W;X;Y;Z
END IF
END IF
LET A=(X^2+(V^2-Z^2))/2 !a+d=x^2のとき
LET D=(X^2-(V^2-Z^2))/2
IF A>0 AND INT(A)=A AND INT(D)=D THEN !整数なら
LET B=Y^2-D
LET C=Z^2-D
IF B+C=W^2 AND A+B=U^2 THEN !残りの式を満たすか
PRINT A;B;C;D; U;V;W;X;Y;Z
END IF
END IF
PRINT "DATA ";
FOR I=1 TO 100
IF MOD(I,10)>0 THEN
PRINT STR$(I);",";
ELSE
PRINT STR$(I)
IF I<100 THEN PRINT "DATA ";
END IF
NEXT I
END
または
FOR I=1 TO 105
IF A$="" THEN LET A$="DATA "
LET A$=A$&STR$(I)&","
IF MOD(I,10)=0 THEN
LET A$=A$(1:LEN(A$)-1)
PRINT A$
LET A$=""
END IF
NEXT I
PRINT A$(1:LEN(A$)-1)
END
DATA 1,2,3,4,5,6,7,8,9,10
DATA 11,12,13,14,15,16,17,18,19,20
DATA 21,22,23,24,25,26,27,28,29,30
DATA 31,32,33,34,35,36,37,38,39,40
DATA 41,42,43,44,45,46,47,48,49,50
LET k=50
DIM A(k)
MAT READ A
DATA 51,52,53,54,55,56,57,58,59,60
DATA 61,62,63,64,65,66,67,68,69,70
DATA 71,72,73,74,75,76,77,78,79,80
DATA 81,82,83,84,85,86,87,88,89,90
DATA 91,92,93,94,95,96,97,98,99,100
LET i=50
DIM B(i)
MAT READ B
FOR k=1 TO 50
PRINT A(k)
NEXT k
FOR i=1 TO 50
PRINT B(i)
NEXT i
END
こんな感じで宜しいでしょうか?
別件例
-------------------------------
篩の例
FOR l=3 TO SQR(w) STEP 2
IF MOD(w,l)=0 THEN EXIT FOR
NEXT l
昨日、わかったのですが SQR(x) と比べて、素数番号で
篩った方が、かなり計算回数を減らせる。
当たり前の事に気付くのが遅かったと思いました。
計算結果(AMD Athlon 64 3800+ 2.4GMHz)
510510n±k FOR n=1 TO 20
-----------------------------------------
666988(Counter)
-----------------------------------------
10720679
6159.33 秒で計算しました(約1時間42分)
-----------------------------------------
510529 (42332nd prime)
10720679 (709319th prime)
行番号削除可
100 ! 素数階乗n +kの値と個数を求めるprogram
ASK DIRECTORY d$
LET f_name1$="PRIME_BASE" ! ファイル名
LET f1$=d$&"\"&f_name1$&".txt"
PRINT "ファイル保存場所[1] = ";f1$
OPEN #1: NAME f1$
ERASE #1
110 LET W=30030 !素数階乗を入力(素数階乗 6,30,210,2310,30030,510510,,,)
170 LET t0=TIME
180 LET p=1 ! p の初期値を0とすると、初回 1になる。140の!を削除
PRINT #1: -1 ! ファイルの先頭に-1を出力
200 FOR k=1 TO w STEP 2 !素数倍を代入
210 ! PRINT"----------------"
220 ! PRINT "k=+";k
230 FOR n=1 TO 20 !素数倍周期 何周でも可能
240 LET m=w*n+k !素数倍を代入
250 FOR i=3 TO SQR(m) STEP 2 !篩
260 IF MOD(m,i)=0 THEN EXIT FOR
270 NEXT i
IF i>SQR(m) THEN
280 ! PRINT m;"@";n
LET p=p+1
! PRINT"----------------";p;"個";k ! k定数 kの個数
PRINT #1: k ! k定数プリント
EXIT FOR
END IF
300 NEXT n
370 NEXT k
CLOSE #1
380 PRINT "----------------"
390 PRINT "k=-1から数えて";p;"個" ! -1は出ません
400 PRINT TIME-t0;"秒で計算しました"
410 END
REM 素数列生成プログラム
LET k9=5760 !定数kの数
DIM A(k9)
ASK DIRECTORY d$
LET f_name1$="PRIME_BASE" ! ファイル名
LET f1$=d$&"\"&f_name1$&".txt"
PRINT "ファイル保存場所[1] = ";f1$
OPEN #1: NAME f1$ ,ACCESS INPUT
FOR i=1 TO k9
INPUT #1: A(i)
NEXT i
CLOSE #1
LET f_name2$="PRIME_NUMBERS" ! 素数列ファイル名
LET f2$=d$&"\"&f_name2$&".txt"
PRINT "ファイル保存場所[2] = ";f2$;" 素数列ファイル"
OPEN #2: NAME f2$
ERASE #2
LET t0=TIME
PRINT #2: 2 ! ファイルの先頭に2を出力
FOR w=3 TO 30013 STEP 2
CALL prime_check(3,w)
NEXT w
FOR n=1 TO 33 !100万までの素数
FOR k=1 TO k9
CALL prime_check(17,30030*n+A(k))
NEXT k
NEXT n
SUB prime_check(a,b)
FOR i=a TO SQR(b) STEP 2
IF MOD(b,i)=0 THEN EXIT SUB
NEXT i
PRINT #2: b
END SUB
CLOSE #2
PRINT TIME-t0;"秒で計算しました"
END
!'INPUT Z
LET Z=10720679
PRINT LI(Z)
PRINT " 709533.461267678429779"
END
EXTERNAL FUNCTION EI(Z) !'指数積分
LET EULER=.57721566490153286
LET S=LOG(Z)+EULER
LET A=1
FOR K=1 TO 1000
LET A=A*Z/K
LET S=S+A/K
IF ABS(A)<1E-15 THEN EXIT FOR
NEXT K
LET EI=S
END FUNCTION
EXTERNAL FUNCTION LI(Z) !'対数積分
LET LI=EI(LOG(Z))
END FUNCTION
素数番号の意味を説明するために作成しました。
-----------------------------------------------
LET t0=TIME
LET c=9592 !素数の数 99991(9592)
DIM p(c)
LET P(1)=2 ! DIM 素数2を登録
LET c=2 ! DIMの番号
FOR x=3 TO 100000 STEP 2 !10万までの奇数列の篩
FOR i=3 TO SQR(x) STEP 2 !奇数列を奇数列で篩
IF MOD(x,i)=0 THEN 250
NEXT i
LET p(c)=x ! DIM 素数3からを登録
! PRINT p(c) !3～99991素数列プリント
LET c=c+1
250 NEXT x
FOR c=1 TO 1000 ! 素数番号 9592まで
LET z=p(c)
PRINT p(c); INT(LI(Z));c
NEXT c
PRINT TIME-t0;"秒で計算しました"
END
EXTERNAL FUNCTION EI(Z) !'指数積分
LET EULER=.57721566490153286
LET S=LOG(Z)+EULER
LET A=1
FOR K=1 TO 1000
LET A=A*Z/K
LET S=S+A/K
IF ABS(A)<1E-15 THEN EXIT FOR
NEXT K
LET EI=S
END FUNCTION
EXTERNAL FUNCTION LI(Z) !'対数積分
LET LI=EI(LOG(Z))
END FUNCTION
------------------------------------------------
LET M=18
DIM F(0 TO M-1) !各数字の個数
FOR K=1 TO M !桁数
PRINT "K=";K
FOR J=MAX(K-9,1) TO K-2 !最上位を固定する
LET F(0)=J
CALL try(1,K-J,K,F)
NEXT J
NEXT K
END
EXTERNAL SUB try(P,T,K,F()) !バックトラック法で検索する
IF P=K-1 THEN !最下位なら
LET F(P)=MIN(T,9)
!!!MAT PRINT F; !debug
DIM A(0 TO K-1) !作業用
FOR i=0 TO K-1 !copy it
LET A(i)=F(i)
NEXT i
FOR i=0 TO K-1 !数字を並べ替える
LET W=F(i)
IF A(W)=0 THEN EXIT FOR !個数が足りないので、うまく並べられない
LET A(W)=A(W)-1
NEXT i
IF i>K-1 THEN !題意を満たす
FOR i=0 TO K-1
PRINT F(i);
NEXT i
PRINT
END IF
LET F(P)=0
ELSE
IF P<10 THEN !F[p]を設定する ※分割数による
FOR i=0 TO MIN(T,9) !数字0から9まで
LET F(P)=i
CALL try(P+1,T-i,K,F) !次へ
LET F(P)=0
NEXT i
ELSE
IF T=0 THEN
FOR i=P TO K-2 !数字10以上
LET F(i)=0
NEXT i
CALL try(K-1,0,K,F) !最下位へ
END IF
END IF
END IF
END SUB
LET M=18
DIM F(0 TO M-1) !各数字の個数
FOR K=1 TO M !桁数
PRINT "K=";K
LET W=MAX(K-9,1) !0は少なくとも1つ
FOR J=0 TO W-1 !F[10]以降を考慮する
LET F(J)=0
NEXT J
IF K>1 THEN CALL try(W,K,K,F)
NEXT K
END
EXTERNAL SUB try(P,T,K,F()) !バックトラック法で検索する
IF P=K-1 THEN !最下位なら
IF F(P-1)<=T AND T<K THEN !昇順列にする
LET F(P)=T
!!!MAT PRINT F; !debug
DIM A(0 TO K-1),B(0 TO K-1) !作業用
MAT A=ZER
FOR i=0 TO K-1 !数字の個数を数える
LET W=F(i)
LET A(W)=A(W)+1
NEXT i
MAT B=ZER
FOR i=0 TO K-1 !再度、数字の個数を数える
LET W=A(i)
LET B(W)=B(W)+1
NEXT i
FOR i=0 TO K-1 !一致する
IF NOT(A(i)=B(i) AND A(i)<10) THEN EXIT FOR
NEXT i
IF i>K-1 THEN !題意を満たす
FOR i=0 TO K-1
PRINT A(i);
NEXT i
PRINT
END IF
LET F(P)=0
END IF
ELSE
FOR i=F(P-1) TO T !昇順列で分割数を得る
LET F(P)=i
CALL try(P+1,T-i,K,F)
LET F(P)=0
NEXT i
END IF
END SUB
PUBLIC NUMERIC x(100),y(100)
PUBLIC NUMERIC N, A,B,R,Q1,Q2
LET N=3 !2以上
LET A=5 !既知定数
LET B=1
LET R=2
LET Q1=2
LET Q2=3
DIM th(N) !θ[i]
FOR t=0 TO 360/N STEP 0.25 !※調整が必要である
LET th(1)=t
LET x(1)=A+R*COS(RAD(t))
LET y(1)= R*SIN(RAD(t))
!!IF ABS( Q1*(x(1)-A)+R*Q2*COS(ANGLE(x(1)-B,y(1))) )<1E-4 THEN !※調整が必要である
CALL try(2,360-t, th)
!!END IF
NEXT t
END
EXTERNAL SUB try(i,s, th()) !2π=θ[1]+θ[2]+ … +θ[n]
IF i=N THEN
LET th(N)=s
LET x(N)=A+R*COS(RAD(s))
LET y(N)= R*SIN(RAD(s))
LET d2=( Q1*COS(RAD(th(2)))+Q2*COS(ANGLE(x(2)-B,y(2))) )/(2-1)
LET d=( Q1*COS(RAD(s))+Q2*COS(ANGLE(x(N)-B,y(N))) )/(N-1)
IF ABS(d-d2)<1E-4 THEN !※調整が必要である
PRINT "Δ=";d2 !解を表示する
FOR K=1 TO N
PRINT K;th(K);x(K);y(K)
NEXT K
PRINT
END IF
ELSE
FOR t=th(i-1) TO s/(N-i+1) STEP 0.25 !※調整が必要である
LET th(i)=t
LET x(i)=A+R*COS(RAD(t))
LET y(i)= R*SIN(RAD(t))
IF i>2 THEN
LET OK=0
LET d2=( Q1*COS(RAD(th(2)))+Q2*COS(ANGLE(x(2)-B,y(2))) )/(2-1)
LET d=( Q1*COS(RAD(t))+Q2*COS(ANGLE(x(i)-B,y(i))) )/(i-1)
IF ABS(d-d2)<1E-4 THEN LET OK=1 !※調整が必要である
ELSE
LET OK=1
END IF
IF OK<>0 THEN CALL try(i+1,s-t, th)
NEXT t
END IF
END SUB
LET N=8 !2009
LET T=1 !n≦2^k
DO WHILE T<N
LET T=T*2
LOOP
PRINT 2*N-T
END
シミュレーションによる
LET N=8 !2009 !石の個数 ※
DIM A(0 TO N-1) !連番が付いた石
MAT A=ZER
LET P=2 !1つ飛ばし ※
LET i=0 !最初に取り除く石の番号 0～(n-1) ※
LET S=P-1
LET T=0 !取り除いた石の個数
DO WHILE T<N
IF A(i)=0 THEN !石があるなら
LET S=MOD(S+1,P) !(p-1)個飛ばし
IF S=0 THEN !この石を取り除く
PRINT i+1 !debug
LET A(i)=1
LET T=T+1
END IF
END IF
LET i=MOD(i+1,N) !次の石を探す ※
LOOP
END
LET N=2015 !石の個数 ※
DIM A(N) !連番が付いた石
MAT A=ZER
LET P=2 !1つ飛ばし ※
LET i=P !最初に取り除く石の番号 ※
LET S=P-1
LET D=1 !方向 ±1
LET T=0 !取り除いた石の個数
DO WHILE T<N-1
IF A(i)=0 THEN !石があるなら
LET S=MOD(S+1,P) !(p-1)個飛ばし
IF S=0 THEN !この石を取り除く
PRINT i !debug
LET A(i)=1
LET T=T+1
END IF
END IF
IF (D<0 AND i=1) OR (D>0 AND i=N) THEN !折り返す
LET D=-D
IF S>0 THEN LET S=S-1
ELSE
LET i=i+D !次の石を探す
END IF
LOOP
FOR i=1 TO N !残った石を探す
IF A(i)=0 THEN PRINT i;
NEXT i
PRINT
END
DECLARE EXTERNAL SUB q.enQ, q.deQ
DECLARE EXTERNAL FUNCTION q.count
LET N=12 !石の個数 ※
LET P=2 !1つ飛ばし ※
LET S=0
FOR X=1 TO N !環状に並べる
CALL q.enQ(X)
NEXT X
DO WHILE q.count>0
CALL q.deQ(X)
LET S=MOD(S+1,P) !(p-1)個飛ばし
IF S=0 THEN !この石を取り除く
ELSE
PRINT X
CALL q.enQ(X)
END IF
LOOP
END
MODULE q !キュー
SHARE NUMERIC Q(0 TO 5000) !格納領域
SHARE NUMERIC T,B !ポインタ
LET T=0 !先頭
LET B=0 !末尾
PUBLIC FUNCTION count
EXTERNAL FUNCTION count !個数を返す
LET count=MOD(B-T,5000+1)
END FUNCTION
PUBLIC SUB enQ,deQ
EXTERNAL SUB enQ(X) !入れる
LET Q(B)=X
LET B=MOD(B+1,5000+1)
END SUB
EXTERNAL SUB deQ(X) !取り出す
LET X=Q(T)
LET T=MOD(T+1,5000+1)
END SUB
END MODULE
DECLARE EXTERNAL SUB s1.push, s1.pop
DECLARE EXTERNAL FUNCTION s1.count
DECLARE EXTERNAL SUB s2.push, s2.pop
DECLARE EXTERNAL FUNCTION s2.count
LET N=12 !石の個数 ※
LET P=2 !1つ飛ばし ※
LET S=0
LET T=0 !取り除いた石の個数
FOR X=N TO 1 STEP -1 !1列に並べる
CALL s1.push(X)
NEXT X
FOR K=1 TO N*N !p=2のとき、n≧2^k ※半分ずつ減っていく
PRINT "K=";K !奇数は「行き」、偶数は「帰り」
IF MOD(K,2)<>0 THEN LET C=s1.count ELSE LET C=s2.count
DO WHILE C>0
IF MOD(K,2)<>0 THEN CALL s1.pop(X) ELSE CALL s2.pop(X)
LET S=MOD(S+1,P) !(p-1)個飛ばし
IF S=0 THEN !この石を取り除く
LET T=T+1
IF T=N-1 THEN EXIT FOR !残り1個なら
ELSE
PRINT X; !スタックの底から
IF MOD(K,2)<>0 THEN CALL s2.push(X) ELSE CALL s1.push(X)
END IF
IF MOD(K,2)<>0 THEN LET C=s1.count ELSE LET C=s2.count !次へ
LOOP
PRINT
IF S>0 THEN LET S=S-1 !折り返す
NEXT K
END
MODULE s1 !スタック
SHARE NUMERIC STK(5000) !格納領域
SHARE NUMERIC SP !スタック・ポインタ
LET SP=0
PUBLIC FUNCTION count
EXTERNAL FUNCTION count !個数を返す
LET count=SP
END FUNCTION
PUBLIC SUB push,pop
EXTERNAL SUB push(X) !入れる
LET SP=SP+1
LET STK(SP)=X
END SUB
EXTERNAL SUB pop(X) !取り出す
LET X=STK(SP)
LET SP=SP-1
END SUB
END MODULE
MODULE s2 !スタック
SHARE NUMERIC STK(5000) !格納領域
SHARE NUMERIC SP !スタック・ポインタ
LET SP=0
PUBLIC FUNCTION count
EXTERNAL FUNCTION count !個数を返す
LET count=SP
END FUNCTION
PUBLIC SUB push,pop
EXTERNAL SUB push(X) !入れる
LET SP=SP+1
LET STK(SP)=X
END SUB
EXTERNAL SUB pop(X) !取り出す
LET X=STK(SP)
LET SP=SP-1
END SUB
END MODULE
DIM A(5000) !連番が付いた石
FOR N=1 TO 100 !石の個数 ※
FOR P=2 TO N
MAT A=ZER
LET i=P !最初に取り除く石の番号
LET S=P-1
LET D=1 !方向 ±1
LET T=0 !取り除いた石の個数
DO WHILE T<N-1
IF A(i)=0 THEN !石があるなら
LET S=MOD(S+1,P) !(p-1)個飛ばし
IF S=0 THEN !この石を取り除く
!!!PRINT i !debug
LET A(i)=1
LET T=T+1
END IF
END IF
IF (D<0 AND i=1) OR (D>0 AND i=N) THEN !折り返す
LET D=-D
IF S>0 THEN LET S=S-1
ELSE
LET i=i+D !次の石を探す
END IF
LOOP
FOR i=1 TO N !残った石を探す
IF A(i)=0 THEN EXIT FOR
NEXT i
IF i=josephus(N,P,N) THEN PRINT N;P;i !一致するなら
NEXT P
NEXT N
END
EXTERNAL FUNCTION josephus(N,S,K) !ヨセフス数（Josephus Number）
LET ret=S*K
DO WHILE ret>N
LET ret=INT( ((ret-N)*S-1)/(S-1) )
LOOP
LET josephus=ret
END FUNCTION
DATA 2 !項数
DATA 2,2 !1=1/2+1/2の意
!!DATA 3 !項数
!!DATA 2,3,6 !1=1/2+1/3+1/6
READ K
FOR i=1 TO K-1
READ A
PRINT "+1/";STR$(A);
NEXT i
READ A !残り2項
PRINT "+1/";STR$(A+1);"+1/";STR$(A*(A+1))
DATA 2 !項数
DATA 2,2 !1=1/2+1/2の意
!!DATA 3 !項数
!!DATA 2,3,6 !1=1/2+1/3+1/6
READ K
FOR i=1 TO K-1
READ A
PRINT "+1/";STR$(A);
NEXT i
PRINT
READ M !残り2項
FOR A=1 TO SQR(M) !約数
IF MOD(M,A)=0 THEN
LET B=M/A
PRINT " +1/";STR$(A*(A+B));"+1/";STR$(B*(A+B))
END IF
NEXT A
OPTION ARITHMETIC RATIONAL !有理数モード
LET K=3 !項数
DIM B(K)
PUBLIC NUMERIC C !場合の数
LET C=0
CALL try(1,1,2,K,B) !1=1/2+ …
PRINT C;"通り"
END
EXTERNAL SUB try(P,R,A,K,B()) !バックトラック法で検索する
OPTION ARITHMETIC RATIONAL !有理数モード
IF P=K THEN !最後の項なら
IF NUMER(R)=1 THEN !単位分数なら
LET C=C+1
FOR i=1 TO K-1 !結果を表示する
PRINT "+1/";STR$(B(i));
NEXT i
PRINT "+1/";STR$(DENOM(R))
END IF
ELSE
FOR i=A TO (K-P+1)/R !項数がm個のとき、R=1/a+1/b+ … +1/c≦m/aより
LET B(P)=i !p項目
LET S=R-1/i !残り
IF S>0 THEN CALL try(P+1,S,i,K,B) !次へ
NEXT i
END IF
END SUB
異なる単位分数の和では、
サブルーチン部分を、
EXTERNAL SUB try(P,R,A,K,B()) !バックトラック法で検索する
OPTION ARITHMETIC RATIONAL !有理数モード
IF P=K THEN !最後の項なら
IF NUMER(R)=1 AND DENOM(R)>B(K-1) THEN !単位分数なら
LET C=C+1
FOR i=1 TO K-1 !結果を表示する
PRINT "+1/";STR$(B(i));
NEXT i
PRINT "+1/";STR$(DENOM(R))
END IF
ELSE
FOR i=A TO (K-P+1)/R !項数がm個のとき、R=1/a+1/b+ … +1/c≦m/aより
LET B(P)=i !p項目
LET S=R-1/i !残り
IF S>0 THEN CALL try(P+1,S,i+1,K,B) !次へ
NEXT i
END IF
END SUB
!(1) 1,2,4,8,16,( ),26,38,62,74,･･･
!mとmの各桁の積との和、すなわちm=16なら、次は16+1×6=22
LET M=1
FOR N=1 TO 10
PRINT M;
LET T=M
LET S=1 !各桁の積
DO WHILE T>0
LET S=S*MOD(T,10)
LET T=INT(T/10)
LOOP
LET M=M+S
NEXT N
PRINT
!(2) 1,2,4,6,16,12,64,24,36,48,( ),･･･
!mの約数の個数がn個になる最小のもの
!n=3のとき、4=1,2,4
!n=5のとき、16=1,2,4,8,16
FOR N=1 TO 11
LET M=0
DO
LET M=M+1
LET K=0 !約数の個数
FOR D=1 TO M
IF MOD(M,D)=0 THEN LET K=K+1
NEXT D
LOOP UNTIL K=N
PRINT M;
NEXT N
PRINT
!(3) 1,3,4,7,6,12,8,15,13,( ),･･･
!nの約数の和、すなわちn=6なら約数は1,2,3,6なので、1+2+3+6=12
FOR N=1 TO 10
LET S=0 !約数の和
FOR D=1 TO N
IF MOD(N,D)=0 THEN LET S=S+D
NEXT D
PRINT S;
NEXT N
PRINT
!(4) 66,72,53,34,25,29,85,( ),･･･
!数字の並びがx[k]=ab…cなら、x[k+1]=a^2+b^2+ … +c^2
LET X=66
FOR K=1 TO 8
PRINT X;
LET T=X !次へ
LET S=0
DO WHILE T>0
LET S=S+MOD(T,10)^2
LET T=INT(T/10)
LOOP
LET X=S
NEXT K
PRINT
!(5) 0,1,10,2,100,11,1000,3,20,( ),･･･
!nを素因数分解する。n=(2^a)(3^b)…(p^c)のとき、指数をc…baと並べる。
!n=3=(2^0)(3^1)のとき、10
!n=5=(2^0)(3^0)(5^1)のとき、100
!n=6=(2^1)(3^1)のとき、11
!n=8=2^3のとき、3
DATA 15
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47 !素数列
READ M
DIM P(M)
MAT READ P
LET D$="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" !数字
FOR N=1 TO 10
LET S$=""
FOR i=1 TO M !因数分解
LET A=0
LET T=N
DO WHILE MOD(T,P(i))=0
LET A=A+1
LET T=T/P(i)
LOOP
LET S$=D$(A+1:A+1) & S$
IF P(i)>N THEN EXIT FOR
NEXT i
IF LEN(S$)>1 THEN !0サプレス
DO WHILE S$(1:1)="0"
LET S$=S$(2:LEN(S$))
LOOP
END IF
PRINT " ";S$;
NEXT N
PRINT
!(6) 14,91,62,53,64,96,48,11,( ),･･･
!n^2すなわち1,4,9,16,25,…を1491625…と並べて、2つずつ並べていく。
LET S$=""
FOR N=1 TO 11
LET S$=S$ & STR$(N^2)
IF LEN(S$)>1 THEN !次へ
LET L=LEN(S$)
PRINT S$(1:2);" ";
LET S$=S$(3:L)
END IF
NEXT N
PRINT
!!OPTION ARITHMETIC RATIONAL !多桁の整数
LET N=1234 !2011 !2015 !2014 !2012
LET K=1 !k個（k桁）
LET R=1
DO !わり算の筆算による
LET P=1 !(1)÷n、(11)÷n、(111)÷n、…、(11…1)÷nの余り
LET R=MOD(R,N)
IF R=0 THEN EXIT DO !Rep(k,1)で見つかったなら
FOR P=2 TO 9 !(p)÷n、(pp)÷n、(ppp)÷n、…、(pp…p)÷nの余り
IF MOD(R*P,N)=0 THEN EXIT DO !Rep(k,p)で見つかったなら
NEXT P
LET R=R*10+1 !次へ
LET K=K+1
LOOP
PRINT K;"個の";P
END
FOR n=3 TO 6
PRINT n;
LET p=n*((2-1)/2)*((3-1)/3)+MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)+(2-1)
PRINT p
NEXT n
FOR n=7 TO 120
PRINT n;
LET p=(n*1*2*4*6/(2*3*5*7))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210+4-1
PRINT p
NEXT n
FOR n=3 TO 24
PRINT n;
LET p=n*((2-1)/2)*((3-1)/3)+MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)+(2-1)
PRINT p
NEXT n
FOR n=25 TO 48
PRINT n;
LET p=n*(1*2*4/(2*3*5))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5-MOD(n,6)/6-MOD(n,10)/10-MOD(n,15)/15+MOD(n,30)/30+3-1
PRINT p
NEXT n
FOR n=49 TO 120
PRINT n;
LET p=(n*1*2*4*6/(2*3*5*7))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210+4-1
PRINT p
NEXT n
FOR n=121 TO 168
PRINT n;
LET p=(n*1*2*4*6*10/(2*3*5*7*11))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231-MOD(n,210)/210-MOD(n,330)/330-mod(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155+MOD(n,2310)/2310+5-1
PRINT p
NEXT n
FOR n=3 TO 24
PRINT n;
LET p=n*((2-1)/2)*((3-1)/3)+MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)+(2-1)
PRINT p
NEXT n
FOR n=25 TO 48
PRINT n;
LET p=n*(1*2*4/(2*3*5))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5-MOD(n,6)/6-MOD(n,10)/10-MOD(n,15)/15+MOD(n,30)/30+3-1
PRINT p
NEXT n
FOR n=49 TO 120
PRINT n;
LET p=(n*1*2*4*6/(2*3*5*7))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210+4-1
PRINT p
NEXT n
FOR n=121 TO 168
PRINT n;
LET p=(n*1*2*4*6*10/(2*3*5*7*11))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155+MOD(n,2310)/2310+5-1
PRINT p
NEXT n
FOR n=169 TO 288
PRINT n;
LET p=(n*1*2*4*6*10*12/(2*3*5*7*11*13))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11+MOD(n,13)/13-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77-MOD(n,26)/26-MOD(n,39)/39-MOD(n,65)/65-MOD(n,91)/91-MOD(n,143)/143+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231+MOD(n,78)/78+MOD(n,130)/130+MOD(n,182)/182+MOD(n,195)/195+MOD(n,455)/455+MOD(n,1001)/1001+MOD(n,273)/273+MOD(n,286)/286+MOD(n,429)/429+MOD(n,715)/715-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155-MOD(n,390)/390-MOD(n,910)/910-MOD(n,2002)/2002-MOD(n,1365)/1365-MOD(n,3003)/3003-MOD(n,5005)/5005-MOD(n,546)/546-MOD(n,1430)/1430-MOD(n,2145)/2145-MOD(n,858)/858+MOD(n,2310)/2310+MOD(n,2730)/2730+MOD(n,10010)/10010+MOD(n,15015)/15015+MOD(n,6006)/6006+MOD(n,4290)/4290-MOD(n,30030)/30030+(6-1)
PRINT p
NEXT n
FOR n=3 TO 24
PRINT n;
LET p=n*((2-1)/2)*((3-1)/3)+MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)+(2-1)
PRINT p
NEXT n
FOR n=25 TO 48
PRINT n;
LET p=n*(1*2*4/(2*3*5))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5-MOD(n,6)/6-MOD(n,10)/10-MOD(n,15)/15+MOD(n,30)/30+3-1
PRINT p
NEXT n
FOR n=49 TO 120
PRINT n;
LET p=(n*1*2*4*6/(2*3*5*7))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210+4-1
PRINT p
NEXT n
FOR n=121 TO 168
PRINT n;
LET p=(n*1*2*4*6*10/(2*3*5*7*11))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155+MOD(n,2310)/2310+5-1
PRINT p
NEXT n
FOR n=169 TO 288
PRINT n;
LET p=(n*1*2*4*6*10*12/(2*3*5*7*11*13))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11+MOD(n,13)/13-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77-MOD(n,26)/26-MOD(n,39)/39-MOD(n,65)/65-MOD(n,91)/91-MOD(n,143)/143+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231+MOD(n,78)/78+MOD(n,130)/130+MOD(n,182)/182+MOD(n,195)/195+MOD(n,455)/455+MOD(n,1001)/1001+MOD(n,273)/273+MOD(n,286)/286+MOD(n,429)/429+MOD(n,715)/715-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155-MOD(n,390)/390-MOD(n,910)/910-MOD(n,2002)/2002-MOD(n,1365)/1365-MOD(n,3003)/3003-MOD(n,5005)/5005-MOD(n,546)/546-MOD(n,1430)/1430-MOD(n,2145)/2145-MOD(n,858)/858+MOD(n,2310)/2310+MOD(n,2730)/2730+MOD(n,10010)/10010+MOD(n,15015)/15015+MOD(n,6006)/6006+MOD(n,4290)/4290-MOD(n,30030)/30030+(6-1)
PRINT p
NEXT n
FOR n=289 TO 360
PRINT n;
LET p=(n*1*2*4*6*10*12*16/(2*3*5*7*11*13*17))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11+MOD(n,13)/13+MOD(n,17)/17-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77-MOD(n,26)/26-MOD(n,39)/39-MOD(n,65)/65-MOD(n,91)/91-MOD(n,143)/143-MOD(n,34)/34-MOD(n,51)/51-MOD(n,85)/85-MOD(n,119)/119-MOD(n,187)/187-MOD(n,221)/221+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231+MOD(n,78)/78+MOD(n,130)/130+MOD(n,182)/182+MOD(n,195)/195+MOD(n,455)/455+MOD(n,1001)/1001+MOD(n,273)/273+MOD(n,286)/286+MOD(n,429)/429+MOD(n,715)/715+MOD(n,102)/102+MOD(n,170)/170+MOD(n,238)/238+MOD(n,374)/374+MOD(n,442)/442+MOD(n,255)/255+MOD(n,357)/357+MOD(n,561)/561+MOD(n,663)/663+MOD(n,595)/595+MOD(n,935)/935+MOD(n,1105)/1105+MOD(n,1309)/1309+MOD(n,1547)/1547+MOD(n,2431)/2431-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155-MOD(n,390)/390-MOD(n,910)/910-MOD(n,2002)/2002-MOD(n,1365)/1365-MOD(n,3003)/3003-MOD(n,5005)/5005-MOD(n,546)/546-MOD(n,1430)/1430-MOD(n,2145)/2145-MOD(n,858)/858-MOD(n,510)/510-MOD(n,714)/714-MOD(n,1122)/1122-MOD(n,1326)/1326-MOD(n,1190)/1190-MOD(n,1870)/1870-MOD(n,2210)/2210-MOD(n,2618)/2618-MOD(n,3094)/3094-MOD(n,4862)/4862-MOD(n,1785)/1785-MOD(n,2805)/2805-MOD(n,3315)/3315-MOD(n,3927)/3927-MOD(n,4641)/4641-MOD(n,7293)/7293-MOD(n,6545)/6545-MOD(n,7735)/7735-MOD(n,12155)/12155-MOD(n,17017)/17017+MOD(n,2310)/2310+MOD(n,2730)/2730+MOD(n,10010)/10010+MOD(n,15015)/15015+MOD(n,6006)/6006+MOD(n,4290)/4290+MOD(n,3570)/3570+MOD(n,5610)/5610+MOD(n,6630)/6630+MOD(n,7854)/7854+MOD(n,9282)/9282+MOD(n,14586)/14586+MOD(n,13090)/13090+MOD(n,15470)/15470+MOD(n,24310)/24310+MOD(n,34034)/34034+MOD(n,19635)/19635+MOD(n,23205)/23205+MOD(n,36465)/36465+MOD(n,51051)/51051+MOD(n,85085)/85085-MOD(n,30030)/30030-MOD(n,39270)/39270-MOD(n,46410)/46410-MOD(n,72930)/72930-MOD(n,102102)/102102-MOD(n,170170)/170170-MOD(n,255255)/255255+MOD(n,510510)/510510+(7-1)
PRINT p
NEXT n
> FOR n=25 TO 48
> PRINT n;
> LET p=n*(1*2*4/(2*3*5))+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5-MOD(n,6)/6-MOD(n,10)/10-MOD(n,15)/15+MOD(n,30)/30+3-1
> PRINT p
> NEXT n
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97 !素数列
DIM P(25)
MAT READ P
LET X=1 !分子
LET Y=1 !分母
FOR i=1 TO K
LET X=X*(P(i)-1) !1,2,4,6,10,12,16,18,…
LET Y=Y*P(i) !2,3,5,7,11,13,17,19,…
NEXT i
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
LET C=0
FOR J=1 TO 2^K-1 !k個kからm個を選ぶ C(k,m)通り
LET T=J
LET S=1 !その積
LET B=0 !1の個数
FOR i=1 TO K !k桁の2進法に展開する
IF MOD(T,2)=1 THEN
LET S=S*P(i)
LET B=B+1
END IF
LET T=INT(T/2)
NEXT i
LET C=C+(-1)^(B+1)*MOD(N,S)/S
NEXT J
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97 !素数列
DIM P(25)
MAT READ P
LET X=1 !分子
LET Y=1 !分母
FOR i=1 TO K
LET X=X*(P(i)-1) !1,2,4,6,10,12,16,18,…
LET Y=Y*P(i) !2,3,5,7,11,13,17,19,…
NEXT i
DIM C(P(K)^2 TO P(K+1)^2-1)
MAT C=ZER
FOR J=1 TO 2^K-1 !k個からm個を選ぶ C(k,m)通り
LET T=J
LET S=1 !その積
LET B=0 !1の個数
FOR i=1 TO K !k桁の2進法に展開する（ビットパターン）
IF MOD(T,2)=1 THEN
LET S=S*P(i)
LET B=B+1
END IF
LET T=INT(T/2)
NEXT i
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
LET C(N)=C(N)+(-1)^(B+1)*MOD(N,S)/S
NEXT N
NEXT J
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
PRINT N; N*X/Y+C(N)+K-1;"個"
NEXT N
DIM C(0 TO K) !係数
MAT C=ZER
FOR P=0 TO 2^K-1 !組み合わせ
LET T=P
LET S=1 !その積
LET M=0 !1の個数
FOR B=1 TO K !k桁の2進法表記（ビットパターン）
IF MOD(T,2)=1 THEN
LET S=S*X(B)
LET M=M+1
END IF
LET T=INT(T/2)
NEXT B
LET C(M)=C(M)+(-1)^M*S !符号を考慮する
NEXT P
MAT PRINT C; !c[0]x^4+c[1]x^3+c[2]x^2+c[3]x+c[4]
END
問題
4つの文字による基本対称式を求めよ。
LET D$="abcdefghijklmnopqrstuvwxyz"
DIM S$(K) !文字がk個ずつ
FOR i=1 TO K
LET S$(i)=""
NEXT i
FOR P=1 TO 2^K-1 !組み合わせ
LET T=P
LET A$="" !その積
LET M=0 !1の個数
FOR B=1 TO K !k桁の2進法表記（ビットパターン）
IF MOD(T,2)=1 THEN
LET A$=A$ & D$(B:B)
LET M=M+1
END IF
LET T=INT(T/2)
NEXT B
LET S$(M)=S$(M) & "+" & A$
!プライムコンビ 1848 K=13
OPTION ARITHMETIC RATIONAL
LET t0=TIME
LET A1=78
DIM A(A1) !p2
LET B1=286
DIM B(B1) !p3
LET C1=715
DIM C(C1) !p4
LET D1=1287
DIM D(D1) !p5
LET E1=1716
DIM E(E1) !p6
LET F1=1716
DIM F(F1) !p7
LET G1=1287
DIM G(G1) !p8
LET H1=715
DIM H(H1) !p9
LET J1=286
DIM J(J1) !p10
LET K1=78
DIM K(K1) !p11
LET L1=13
DIM L(L1) !p12
ASK DIRECTORY d$
LET f_name3$="PRIME_COMBI_P2" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i2=1 TO A1
INPUT #3: A(i2)
NEXT i2
CLOSE #3
LET f_name3$="PRIME_COMBI_P3" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i3=1 TO B1
INPUT #3: B(i3)
NEXT i3
CLOSE #3
LET f_name3$="PRIME_COMBI_P4" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i4=1 TO C1
INPUT #3: C(i4)
NEXT i4
CLOSE #3
LET f_name3$="PRIME_COMBI_P5" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i5=1 TO D1
INPUT #3: D(i5)
NEXT i5
CLOSE #3
LET f_name3$="PRIME_COMBI_P6" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i6=1 TO E1
INPUT #3: E(i6)
NEXT i6
CLOSE #3
LET f_name3$="PRIME_COMBI_P7" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i7=1 TO F1
INPUT #3: F(i7)
NEXT i7
CLOSE #3
LET f_name3$="PRIME_COMBI_P8" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i8=1 TO G1
INPUT #3: G(i8)
NEXT i8
CLOSE #3
LET f_name3$="PRIME_COMBI_P9" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i9=1 TO H1
INPUT #3: H(i9)
NEXT i9
CLOSE #3
LET f_name3$="PRIME_COMBI_P10" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR ia=1 TO J1
INPUT #3: J(ia)
NEXT ia
CLOSE #3
LET f_name3$="PRIME_COMBI_P11" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR ib=1 TO K1
INPUT #3: K(ib)
NEXT ib
CLOSE #3
LET f_name3$="PRIME_COMBI_P12" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR ic=1 TO L1
INPUT #3: L(ic)
NEXT ic
CLOSE #3
! LET format$="#." & REPEAT$("#",999)
LET p=1*2*4*6*10*12*16*18*22*28*30*36*40/(2*3*5*7*11*13*17*19*23*29*31*37*41)
FOR n=1681 TO 1848
PRINT n;
LET s2=0
LET s3=0
LET s4=0
LET s5=0
LET s6=0
LET s7=0
LET s8=0
LET s9=0
LET sa=0
LET sb=0
LET sc=0
LET p1=(n*p)+MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11+MOD(n,13)/13+MOD(n,17)/17+MOD(n,19)/19+MOD(n,23)/23+MOD(n,29)/29+MOD(n,31)/31+MOD(n,37)/37+MOD(n,41)/41
FOR i2=1 TO A1
LET p2=(-MOD(n,A(i2))/A(i2))+s2
LET s2=p2
NEXT i2
FOR i3=1 TO B1
LET p3=(MOD(n,B(i3))/B(i3))+s3
LET s3=p3
NEXT i3
FOR i4=1 TO C1
LET p4=(-MOD(n,C(i4))/C(i4))+s4
LET s4=p4
NEXT i4
FOR i5=1 TO D1
LET p5=(MOD(n,D(i5))/D(i5))+s5
LET s5=p5
NEXT i5
FOR i6=1 TO E1
LET p6=(-MOD(n,E(i6))/E(i6))+s6
LET s6=p6
NEXT i6
FOR i7=1 TO F1
LET p7=(MOD(n,F(i7))/F(i7))+s7
LET s7=p7
NEXT i7
FOR i8=1 TO G1
LET p8=(-MOD(n,G(i8))/G(i8))+s8
LET s8=p8
NEXT i8
FOR i9=1 TO H1
LET p9=(MOD(n,H(i9))/H(i9))+s9
LET s9=p9
NEXT i9
FOR ia=1 TO J1
LET pa=(-MOD(n,J(ia))/J(ia))+sa
LET sa=pa
NEXT ia
FOR ib=1 TO K1
LET pb=(MOD(n,K(ib))/K(ib))+sb
LET sb=pb
NEXT ib
FOR ic=1 TO L1
LET pc=(-MOD(n,L(ic))/L(ic))+sc
LET sc=pc
NEXT ic
LET z=p1+p2+p3+p4+p5+p6+p7+p8+p9+pa+pb+pc+MOD(n,304250263527210)/304250263527210+(13-1)
PRINT z
NEXT n
PRINT TIME-t0;"秒で計算しました"
END
LET t0=TIME
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41 !K=13
LET k9=13
LET k1=13
DIM P(k9)
MAT READ P
ASK DIRECTORY d$
LET f_name7$="PRIME_COMBI_P2" ! ファイル名
LET f7$=d$&"\"&f_name7$&".txt"
PRINT "ファイル保存場所[7] = ";f7$
OPEN #7: NAME f7$
ERASE #7
LET N=k1
LET S=0
FOR A=1 TO N-1 !2組(A,B)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N
LET k9=B
LET BB=p(k9)
LET S=AA*BB
!PRINT AA;"*";BB;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-2 !3組(A,B,C)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-1
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N
LET k9=C
LET CC=p(k9)
LET S=AA*BB*CC
! PRINT AA;"*";BB;"*";CC;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-3 !4組(A,B,C,D)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-2
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-1
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N
LET k9=D
LET DD=p(k9)
LET S=AA*BB*CC*DD
! PRINT AA;"*";BB;"*";CC;"*";DD;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-4 !5組(A,B,C,D,E)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-3
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-2
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-1
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N
LET k9=E
LET EE=p(k9)
LET S=AA*BB*CC*DD*EE
! PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-5 !6組(A,B,C,D,E,F)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-4
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-3
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-2
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-1
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N
LET k9=F
LET FF=p(k9)
LET S=AA*BB*CC*DD*EE*FF
! PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-6 !7組(A,B,C,D,E,F,G)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-5
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-4
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-3
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-2
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-1
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N
LET k9=G
LET GG=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG
! PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-7 !8組(A,B,C,D,E,F,G,H)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-6
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-5
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-4
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-3
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-2
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N-1
LET k9=G
LET GG=p(k9)
FOR H=G+1 TO N
LET k9=H
LET HH=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG*HH
! PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"*";HH;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G*H
NEXT H
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-8 !9組(A,B,C,D,E,F,G,H,I)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-7
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-6
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-5
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-4
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-3
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N-2
LET k9=G
LET GG=p(k9)
FOR H=G+1 TO N-1
LET k9=H
LET HH=p(k9)
FOR I=H+1 TO N
LET k9=I
LET II=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG*HH*II
! PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"*";HH;"*";II;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G*H*I
NEXT I
NEXT H
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-9 !10組(A,B,C,D,E,F,G,H,I,J)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-8
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-7
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-6
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-5
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-4
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N-3
LET k9=G
LET GG=p(k9)
FOR H=G+1 TO N-2
LET k9=H
LET HH=p(k9)
FOR I=H+1 TO N-1
LET k9=I
LET II=p(k9)
FOR J=I+1 TO N
LET k9=J
LET JJ=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG*HH*II*JJ
!PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"*";HH;"*";II;"*";JJ;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G*H*I
NEXT J
NEXT I
NEXT H
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-10 !11組(A,B,C,D,E,F,G,H,I,J,K)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-9
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-8
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-7
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-6
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-5
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N-4
LET k9=G
LET GG=p(k9)
FOR H=G+1 TO N-3
LET k9=H
LET HH=p(k9)
FOR I=H+1 TO N-2
LET k9=I
LET II=p(k9)
FOR J=I+1 TO N-1
LET k9=J
LET JJ=p(k9)
FOR K=J+1 TO N
LET k9=K
LET KK=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG*HH*II*JJ*KK
!PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"*";HH;"*";II;"*";JJ;"*";KK;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G*H*I*J*K
NEXT K
NEXT J
NEXT I
NEXT H
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
!PRINT "-----------------------"
LET N=k1
LET S=0
FOR A=1 TO N-11 !12組(A,B,C,D,E,F,G,H,I,J,K,L)
LET k9=A
LET AA=p(k9)
FOR B=A+1 TO N-10
LET k9=B
LET BB=p(k9)
FOR C=B+1 TO N-9
LET k9=C
LET CC=p(k9)
FOR D=C+1 TO N-8
LET k9=D
LET DD=p(k9)
FOR E=D+1 TO N-7
LET k9=E
LET EE=p(k9)
FOR F=E+1 TO N-6
LET k9=F
LET FF=p(k9)
FOR G=F+1 TO N-5
LET k9=G
LET GG=p(k9)
FOR H=G+1 TO N-4
LET k9=H
LET HH=p(k9)
FOR I=H+1 TO N-3
LET k9=I
LET II=p(k9)
FOR J=I+1 TO N-2
LET k9=J
LET JJ=p(k9)
FOR K=J+1 TO N-1
LET k9=K
LET KK=p(k9)
FOR L=K+1 TO N
LET k9=L
LET LL=p(k9)
LET S=AA*BB*CC*DD*EE*FF*GG*HH*II*JJ*KK*LL
!PRINT AA;"*";BB;"*";CC;"*";DD;"*";EE;"*";FF;"*";GG;"*";HH;"*";II;"*";JJ;"*";KK;"*";LL;"=";s
!PRINT #7:s !ファイル出力
! LET S=S+A*B*C*D*E*F*G*H*I*J*K*L
NEXT L
NEXT K
NEXT J
NEXT I
NEXT H
NEXT G
NEXT F
NEXT E
NEXT D
NEXT C
NEXT B
NEXT A
OPTION ARITHMETIC RATIONAL !多桁の整数
LET M=10000 !金額
DATA 8 !種類
DATA 1,5,10,50,100,500,1000,5000 !硬貨
READ K
DIM C(K),N(K)
MAT READ C
FOR i=1 TO K !十分多くある
LET N(i)=INT(M/C(i))
NEXT i
DIM F(0 TO M) !kは金額、f[k]は場合の数
MAT F=ZER
LET F(0)=1 !1通り
FOR i=1 TO K
FOR X=M TO 0 STEP -1 !この金額kから、さらに
IF F(X)>0 THEN
FOR J=N(i) TO 1 STEP -1 !硬貨c[i]を、1からm[i]個
LET W=X+C(i)*J
IF W<=M THEN LET F(W)=F(W)+F(X)
NEXT J
END IF
NEXT X
NEXT i
PRINT F(M);"通り" !18155171408 通り
END
OPTION ARITHMETIC RATIONAL !多桁の整数
LET M=50 !金額
DATA 4 !種類
DATA 1,5,10,50 !硬貨
DATA 50,10,5,1 !個数
READ K
DIM C(K),A(K)
MAT READ C
MAT READ A
DIM F(0 TO M) !kは金額、f[k]は場合の数
MAT F=ZER
LET F(0)=1 !1通り
FOR i=1 TO K
FOR X=M TO 0 STEP -1 !この金額kから、さらに
IF F(X)>0 THEN
FOR J=A(i) TO 1 STEP -1 !硬貨c[i]を、1からm[i]個
LET W=X+C(i)*J
IF W<=M THEN LET F(W)=F(W)+F(X)
NEXT J
END IF
NEXT X
NEXT i
PRINT F(M);"通り"
END
DIM T1(0 TO M),T2(0 TO M) !作業用
DIM P(0 TO M) !係数
LET P(0)=1
FOR X=1 TO K
MAT T1=ZER
FOR J=0 TO N(X) !n[x]個
LET W=C(X)*J
IF W>M THEN EXIT FOR !x^mを上限とする
LET T1(W)=1
NEXT J
MAT T2=ZER !乗算 t2=p*t1
FOR i=0 TO M
FOR J=0 TO M
IF i+J<=M THEN LET T2(i+J)=T2(i+J)+P(i)*T1(J) !x^mを上限とする
NEXT J
NEXT i
MAT P=T2 !copy it
NEXT X
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101 !素数列
DIM P(26)
MAT READ P
LET X=1 !分子
LET Y=1 !分母
FOR i=1 TO K
LET X=X*(P(i)-1) !1,2,4,6,10,12,16,18,…
LET Y=Y*P(i) !2,3,5,7,11,13,17,19,…
NEXT i
DIM C(P(K)^2 TO P(K+1)^2-1)
MAT C=ZER
FOR J=1 TO 2^K-1 !k個からm個を選ぶ
LET T=J
LET S=1 !その積
LET B=-1 !符号 ※奇数個は正、偶数個は負
FOR i=1 TO K !k桁の2進法に展開する（ビットパターン）
IF MOD(T,2)=1 THEN
LET S=S*P(i)
LET B=-B
END IF
LET T=INT(T/2)
NEXT i
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
LET C(N)=C(N)+B*MOD(N,S)*Y/S
NEXT N
NEXT J
FOR N=P(K)^2 TO P(K+1)^2-1 !結果を表示する
PRINT N; (N*X+C(N))/Y+K-1;"個"
NEXT N
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
LET C(N)=C(N)+B*MOD(N,S)*Y/S
NEXT N
で、Y/SはFOR文内では定数ですから外に出します。この方が速いです。
Ver3.1
OPTION ARITHMETIC RATIONAL !有理数
LET t0=TIME
LET K=16 !個数 ※1以上
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101 !素数列
DIM P(26)
MAT READ P
LET X=1 !分子
LET Y=1 !分母
FOR i=1 TO K
LET X=X*(P(i)-1) !1,2,4,6,10,12,16,18,…
LET Y=Y*P(i) !2,3,5,7,11,13,17,19,…
NEXT i
DIM C(P(K)^2 TO P(K+1)^2-1)
MAT C=ZER
FOR J=1 TO 2^K-1 !k個からm個を選ぶ
LET T=J
LET S=1 !その積
LET B=-1 !符号 ※奇数個は正、偶数個は負
FOR i=1 TO K !k桁の2進法に展開する（ビットパターン）
IF MOD(T,2)=1 THEN
LET S=S*P(i)
LET B=-B
END IF
LET T=INT(T/2)
NEXT i
LET YS=Y/S
FOR N=P(K)^2 TO P(K+1)^2-1 !範囲
LET C(N)=C(N)+B*MOD(N,S)*YS
NEXT N
NEXT J
FOR N=P(K)^2 TO P(K+1)^2-1 !結果を表示する
PRINT N; (N*X+C(N))/Y+K-1;"個"
NEXT N
OPTION ARITHMETIC COMPLEX
PUBLIC NUMERIC P(100)
FOR I=1 TO 100
READ K
LET P(I)=COMPLEX(.5,K) !'ゼータ関数 非自明な零点 http://www.dtc.umn.edu/~odlyzko//zeta_tables/index.html
NEXT I
DATA 14.134725142
DATA 21.022039639
DATA 25.010857580
DATA 30.424876126
DATA 32.935061588
DATA 37.586178159
DATA 40.918719012
DATA 43.327073281
DATA 48.005150881
DATA 49.773832478
DATA 52.970321478
DATA 56.446247697
DATA 59.347044003
DATA 60.831778525
DATA 65.112544048
DATA 67.079810529
DATA 69.546401711
DATA 72.067157674
DATA 75.704690699
DATA 77.144840069
DATA 79.337375020
DATA 82.910380854
DATA 84.735492981
DATA 87.425274613
DATA 88.809111208
DATA 92.491899271
DATA 94.651344041
DATA 95.870634228
DATA 98.831194218
DATA 101.317851006
DATA 103.725538040
DATA 105.446623052
DATA 107.168611184
DATA 111.029535543
DATA 111.874659177
DATA 114.320220915
DATA 116.226680321
DATA 118.790782866
DATA 121.370125002
DATA 122.946829294
DATA 124.256818554
DATA 127.516683880
DATA 129.578704200
DATA 131.087688531
DATA 133.497737203
DATA 134.756509753
DATA 138.116042055
DATA 139.736208952
DATA 141.123707404
DATA 143.111845808
DATA 146.000982487
DATA 147.422765343
DATA 150.053520421
DATA 150.925257612
DATA 153.024693811
DATA 156.112909294
DATA 157.597591818
DATA 158.849988171
DATA 161.188964138
DATA 163.030709687
DATA 165.537069188
DATA 167.184439978
DATA 169.094515416
DATA 169.911976479
DATA 173.411536520
DATA 174.754191523
DATA 176.441434298
DATA 178.377407776
DATA 179.916484020
DATA 182.207078484
DATA 184.874467848
DATA 185.598783678
DATA 187.228922584
DATA 189.416158656
DATA 192.026656361
DATA 193.079726604
DATA 195.265396680
DATA 196.876481841
DATA 198.015309676
DATA 201.264751944
DATA 202.493594514
DATA 204.189671803
DATA 205.394697202
DATA 207.906258888
DATA 209.576509717
DATA 211.690862595
DATA 213.347919360
DATA 214.547044783
DATA 216.169538508
DATA 219.067596349
DATA 220.714918839
DATA 221.430705555
DATA 224.007000255
DATA 224.983324670
DATA 227.421444280
DATA 229.337413306
DATA 231.250188700
DATA 231.987235253
DATA 233.693404179
DATA 236.524229666
FOR X=2 TO 100
PRINT X;":";π(X)
NEXT X
END
EXTERNAL FUNCTION π(X) !'素数個数関数
OPTION ARITHMETIC COMPLEX
LET S=R(X)-T(X)
!'FOR M=1 TO INT(LOG2(X)) !'第3項
!' IF U(M)<>0 THEN
!' LET A=X^(1/M)
!' RESTORE
!' LET SS=0
!' FOR I=1 TO 7 !'ガウス・ラゲール求積
!' READ TT,W
!' LET SS=SS+F2(TT)*EXP(TT-A)*W
!' NEXT I
!' LET S=S+U(M)/M*(SS-LOG(2))
!' END IF
!'NEXT M
LET π=S
DATA .1930436765603624138382479,4.0931895170127390213043288E-01
DATA 1.0266648953391919503451994,4.2183127786171977992928101E-01
DATA 2.5678767449507462069077862,1.4712634865750527839537418E-01
DATA 4.9003530845264845681017144,2.0633514468716939865705615E-02
DATA 8.1821534445628607910818276,1.0740101432807455221319596E-03
DATA 12.7341802917978137580126425,1.5865464348564201268732622E-05
DATA 19.3957278622625403117125821,3.1703154789955805622713222E-08
END FUNCTION
EXTERNAL FUNCTION F2(T)
OPTION ARITHMETIC COMPLEX
LET F2=1/T/(T*T-1)/LOG(T)
END FUNCTION
EXTERNAL FUNCTION R(X) !'リーマン関数(主要項)
OPTION ARITHMETIC COMPLEX
FOR M=1 TO INT(LOG2(X))
IF U(M)<>0 THEN LET S=S+U(M)/M*LI(X^(1/M))
NEXT M
LET R=S
END FUNCTION
EXTERNAL FUNCTION EI(Z) !'指数積分
OPTION ARITHMETIC COMPLEX
LET EULER=.57721566490153286
LET S=LOG(Z)+EULER
LET A=1
FOR K=1 TO 1000
LET A=A*Z/K
LET S=S+A/K
IF ABS(A)<1E-15 THEN EXIT FOR
NEXT K
LET EI=S
END FUNCTION
EXTERNAL FUNCTION LI(Z) !'対数積分
OPTION ARITHMETIC COMPLEX
LET LI=EI(LOG(Z))
END FUNCTION
!'EXTERNAL FUNCTION T(X) !'振動項(うまく収束しない)
!'OPTION ARITHMETIC COMPLEX
!'FOR M=1 TO INT(LOG2(X))
!' IF U(M)<>0 THEN
!' FOR K=1 TO 100
!' LET PP=P(K)/M
!' LET S=S+U(M)/M*(LI(X^PP)+LI(X^CONJ(PP)))
!' NEXT K
!' END IF
!'NEXT M
!'LET T=S
!'END FUNCTION
EXTERNAL FUNCTION T(X) !'振動項
OPTION ARITHMETIC COMPLEX
FOR M=1 TO INT(LOG2(X))
FOR K=1 TO 100
IF U(M)<>0 THEN LET S=S+U(M)/M*2*SQR(X)/ABS(P(K))/LOG(X)*COS(IM(P(K))*LOG(X)-ANGLE(RE(P(K)),IM(P(K))))
NEXT K
NEXT M
LET T=S
END FUNCTION
EXTERNAL FUNCTION U(N) !'メビウス関数
OPTION ARITHMETIC COMPLEX
FOR K=1 TO N
IF GCD(K,N)=1 THEN
LET S=S+COS(2*PI*K/N)
END IF
NEXT K
LET U=INT(S+.1)
END FUNCTION
EXTERNAL FUNCTION GCD(M,N)
OPTION ARITHMETIC COMPLEX
DO WHILE N<>0
LET TT=MOD(M,N)
LET M=N
LET N=TT
LOOP
LET GCD=M
END FUNCTION
OPTION ARITHMETIC NATIVE
FOR I=2 TO 100
PRINT I;":";PRIMECOUNT(I)
NEXT I
END
EXTERNAL FUNCTION PRIMECOUNT(N) !'素数個数関数
OPTION ARITHMETIC NATIVE
FOR I=2 TO N
LET FL=0
FOR J=2 TO INT(SQR(I))
IF MOD(I,J)=0 THEN
LET FL=1
EXIT FOR
END IF
NEXT J
IF FL=0 THEN LET C=C+1
NEXT I
LET PRIMECOUNT=C
END FUNCTION
FOR n=3 TO 48
PRINT n;
LET p=MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)
PRINT p
NEXT n
FOR n=49 TO 120
PRINT n;
LET p=MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210
PRINT p
NEXT n
FOR n=121 TO 168
PRINT n;
LET p=MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155+MOD(n,2310)/2310
PRINT p
NEXT n
! ζ(x) X=500 を求めるプログラム
100 OPTION ARITHMETIC RATIONAL
101 LET t0=TIME
110 LET format$="#." & REPEAT$("#",1140)
120 LET p=3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949129833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132000568127145263560827785771342757789609173637178721468440901224953430146549585371050792279689258923542019956112129021960864034418159813629774771309960518707211349999998372978049951059731732816096318595024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303598253490428755468731159562863882353787593751957781857780532171226806613001927876611195909216420199
130 LET b=-16596380640568557229852123088077134206658664302806671892352650993155331641220960084014956088135770921465025323942809207851857992860213463783252745409096420932509953165466735675485979034817619983727209844291081908145597829674980159889976244240633746601120703300698329029710482600069717866917229113749797632930033559794717838407415772796504419464932337498642714226081743688706971990010734262076881238322867559275748219588404488023034528296023051638858467185173202483888794342720837413737644410765563213220043477396887812891242952336301344808165757942109887803692579439427973561487863524556256869403384306433922049078300720480361757680714198044230522015775475287075315668886299978958150756677417180004362981454396613646612327019784141740499835461/8365830
140 LET q=1
150 FOR n=1 TO 500 ! 階乗数
160 LET k=n*q
170 LET q=k
180 NEXT n
190 LET z=(-1*b*2^499)/k*p^500
200 PRINT USING format$: z
210 PRINT TIME-t0;"秒で計算しました"
220 END
! Sieve of Sundaram サンダラムの篩(ふるい)
! 素数リスト作成プログラム
LET t0=TIME
ASK DIRECTORY d$
LET t0=TIME
LET f_name1$="PRIME_N_P100003" ! ファイル名
LET f1$=d$&"\"&f_name1$&".txt"
PRINT "ファイル保存場所[1] = ";f1$
OPEN #1: NAME f1$
ERASE #1
PRINT #1:2
PRINT #1:3
LET N=50005 !素数100003まで生成 99991(9592nd prime)
DIM A(N)
FOR I=1 TO N
LET A(I)=0
NEXT I
LET A(1)=1
LET S=3
LET D=4
LET U=INT(N/3)
100 FOR I=D TO N STEP S
LET A(I)=1
NEXT I
LET S=S+2
200 LET D=D+3
IF A(D)=0 THEN 200
IF D>(N/3) THEN 300
GOTO 100
300 FOR I=1 TO N
IF A(I)=1 THEN 400
LET z=I*2+1
PRINT #1:z
400 NEXT I
> 私の個人的予想では、プログラムで書きました。
>
> FOR n=1 TO 2
> PRINT n;
> PRINT n-1
> NEXT n
>
> FOR n=3 TO 48
> PRINT n;
> LET p=MOD(n,2)/2+MOD(n,3)/3-MOD(n,2*3)/(2*3)
> PRINT p
> NEXT n
>
> FOR n=49 TO 120
> PRINT n;
> LET p=MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,15)/15-MOD(n,21)/21-MOD(n,35)/35+MOD(n,30)/30+MOD(n,42)/42+MOD(n,70)/70+MOD(n,105)/105-MOD(n,210)/210
> PRINT p
> NEXT n
>
> FOR n=121 TO 168
> PRINT n;
> LET p=MOD(n,2)/2+MOD(n,3)/3+MOD(n,5)/5+MOD(n,7)/7+MOD(n,11)/11-MOD(n,6)/6-MOD(n,10)/10-MOD(n,14)/14-MOD(n,22)/22-MOD(n,15)/15-MOD(n,21)/21-MOD(n,33)/33-MOD(n,35)/35-MOD(n,55)/55-MOD(n,77)/77+MOD(n,30)/30+MOD(n,42)/42+MOD(n,66)/66+MOD(n,70)/70+MOD(n,105)/105+MOD(n,110)/110+MOD(n,165)/165+MOD(n,385)/385+MOD(n,154)/154+MOD(n,231)/231-MOD(n,210)/210-MOD(n,330)/330-MOD(n,462)/462-MOD(n,770)/770-MOD(n,1155)/1155+MOD(n,2310)/2310
> PRINT p
> NEXT n
>
> END
山中氏のプログラムを少しいじってみました。
OPTION ARITHMETIC RATIONAL
DIM P(25)
MAT READ P
DATA 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97
PRINT "SELECT CASE N"
FOR K=1 TO 10
IF K=1 THEN
PRINT "CASE 2 TO 8"
ELSE
PRINT "CASE";P(K)^2;"TO";P(K+1)^2-1
END IF
LET X=1
LET Y=1
FOR I=1 TO K
LET X=X*(P(I)-1)
LET Y=Y*P(I)
NEXT I
PRINT "P=N*";STR$(X/Y);
LET L=0
FOR J=1 TO 2^K-1
LET T=J
LET S=1
LET B=-1
FOR I=1 TO K
IF MOD(T,2)=1 THEN
LET S=S*P(I)
LET B=-B
END IF
LET T=INT(T/2)
NEXT I
IF B<0 THEN PRINT "-"; ELSE PRINT "+";
LET S$="MOD(N,"&STR$(S)&")/"&STR$(S)
PRINT S$;
LET L=L+LEN(S$)
IF L>1000 THEN
LET L=0
PRINT
PRINT "P=P";
END IF
NEXT J
IF K>1 THEN PRINT "+";STR$(K-1) ELSE PRINT
NEXT K
PRINT "CASE ELSE"
PRINT "P=0"
PRINT "END SELECT"
END
LET P1=3.141592653589793
LET E=2.718281828459045
FOR X= 3 TO 12
FOR N= 1 TO 500
LET P=(2*P1*n)
LET Z=(1/(n^x*(E^P-1)))+R
LET R=Z
NEXT N
NEXT X
PRINT Z
END
OPTION ARITHMETIC NATIVE
LET S=0
FOR N=1 TO 100
LET S=S+1/N^3/(EXP(2*PI*N)-1)
NEXT N
PRINT 7/180*PI^3-2*S
LET S=0
FOR N=1 TO 100
LET S=S+1/N^7/(EXP(2*PI*N)-1)
NEXT N
PRINT 19/56700*PI^7-2*S
END
とりあえず下記のプログラムでゼータ関数計算できます
OPTION ARITHMETIC COMPLEX
LET X=COMPLEX(.5,14)
DO
LET X=X-ZETA(X)/DF(X)
LOOP UNTIL ABS(ZETA(X))<1E-12
PRINT X
END
EXTERNAL FUNCTION DF(X)
OPTION ARITHMETIC COMPLEX
LET H=1/128
LET DF=(ZETA(X+H)-ZETA(X))/H
END FUNCTION
EXTERNAL FUNCTION ZETA(S)
OPTION ARITHMETIC COMPLEX
FOR M=1 TO 300
LET SS=0
FOR J=1 TO M
LET SS=SS+(-1)^(J-1)*COMB(M-1,J-1)*J^(-S)
NEXT J
LET SUM=SUM+SS*2^(-M)
IF ABS(SUM-S0)<1E-12 THEN
LET ZETA=SUM/(1-2^(1-S))
EXIT FUNCTION
END IF
LET S0=SUM
NEXT M
STOP
END FUNCTION
!ゼータ関数 無限級数
OPTION ARITHMETIC RATIONAL
LET t0=TIME
LET A1=300
DIM A(A1) !(1/(n^3*e^(2*pi*n)-1))
ASK DIRECTORY d$
LET f_name3$="ZATA_300_7" ! ファイル名
LET f3$=d$&"\"&f_name3$&".txt"
!PRINT "ファイル保存場所[3] = ";f3$
OPEN #3: NAME f3$ ,ACCESS INPUT
FOR i2=1 TO A1
INPUT #3: A(i2)
NEXT i2
CLOSE #3
LET A=935686379017925191250796553673194052656087227132291731219603613975701972323372795070695707341051694333041461416617798292371870729138153420944855330166120553231062822792396969033035360742846471276962070515879208592530422237728427074787476956806821438649529241985758293460776861047916507563818694858789693813033935181462985075817986091401949987781387743696302049044433168708633425757646360787940379289393388500551855962450087280840910692903919579357382237509178105019962393425014909447675389857239761822966852476224426083709633194368749215953739803792878253703381223654493097348243698510213924057817098878283764085832228580612853735483995801712437547770824140608563623408511336820377837558294827506581439784956022278968540875346486789721414494706684449204326539775370091752190464631981938297646713105054959842789605364543275838448245221799947599825254618548523356213744489
LET B=500000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
LET C=A/B
PRINT C*2
END
---------------------------------------
n^7
LET A=3741927693004140332863323157154235280467492756639334868567736653531814410941068770273590457531817355482005567002520408237720864547747721915916632587337776871933554687440080221071837310612327048769869521368660532830662354618883340779056093909806287487307684737302990106378585033070689464667036609902257636263307834325932679257576365681308595684841223259003559811275552937939579468842247542992272639058147977458713961480879276330002345365041104429191683348220167165522183005997757054728185792689086254331004637345347886072827617812926614305566197373185614245504655532125170388501140465714366951122966623111461256342374237003511786934661579718335126518422632496452302601740010396932535438346433415789501967033598982822413606269794652725843767089198596350512947505152492439682962193409574018904035316878264253458871562563344052079407237129934768119930808096245605085658529547003491997
LET B=2000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
LET C=A/B
PRINT C*2
END
!'/1
!'| f(x)dx
!'/-1
LET A=1
!'INPUT PROMPT "下限 =":A
INPUT PROMPT "上限 =":B
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO 15
READ X,W
LET S=S+W*FUNC(U+V*X)*V
NEXT I
PRINT S
PRINT LOG(B)
DATA -0.991455371120813,0.022935322010529
DATA -0.949107912342759,0.063092092629979
DATA -0.864864423359769,0.104790010322250
DATA -0.741531185599394,0.140653259715525
DATA -0.586087235467691,0.169004726639267
DATA -0.405845151377397,0.190350578064785
DATA -0.207784955007898,0.204432940075298
DATA 0.000000000000000,0.20948214108472
DATA 0.991455371120813,0.022935322010529
DATA 0.949107912342759,0.063092092629979
DATA 0.864864423359769,0.104790010322250
DATA 0.741531185599394,0.140653259715525
DATA 0.586087235467691,0.169004726639267
DATA 0.405845151377397,0.190350578064785
DATA 0.207784955007898,0.204432940075298
END
EXTERNAL FUNCTION FUNC(X)
LET FUNC=1/X
END FUNCTION
!'/1
!'| f(x)dx
!'/-1
LET N=8
LET H=1/N/7
DIM X(N),W(N)
LET I=1
LET X(1)=-1
LET X(N)=1
LET W(1)=2/N/(N-1)
LET W(N)=W(1)
PRINT " 零点 重み"
FOR XX=-1+H TO 1-H STEP H
LET LO=XX
LET HI=XX+H
IF LEGENDREDIFF(N-1,LO)*LEGENDREDIFF(N-1,HI)<0 THEN
DO
LET M=(LO+HI)/2
IF LEGENDREDIFF(N-1,LO)*LEGENDREDIFF(N-1,M)<0 THEN LET HI=M ELSE LET LO=M
LOOP UNTIL ABS(LO-HI)<1E-13
LET I=I+1
LET X(I)=LO
LET W(I)=WEIGHT(N,X(I))
PRINT I;":";X(I);W(I)
END IF
NEXT XX
LET A=1
INPUT PROMPT "LOG(X) X=":B
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO N
LET S=S+W(I)*F(U+V*X(I))*V
NEXT I
PRINT S
PRINT LOG(B)
END
EXTERNAL FUNCTION F(X)
LET F=1/X
END FUNCTION
EXTERNAL FUNCTION LEGENDRE(K,X)
LET OLDP=1
LET P=X
FOR N=1 TO K-1
LET NEWP=((2*N+1)*X*P-N*OLDP)/(N+1)
LET OLDP=P
LET P=NEWP
NEXT N
LET LEGENDRE=P
END FUNCTION
EXTERNAL FUNCTION LEGENDREDIFF(N,X)
LET LEGENDREDIFF=(N*X*LEGENDRE(N,X)-N*LEGENDRE(N-1,X))/(X*X-1)
END FUNCTION
EXTERNAL FUNCTION WEIGHT(N,X)
LET WEIGHT=2/N/(N-1)/LEGENDRE(N-1,X)^2
END FUNCTION
!'/1
!'| f(x)dx/(1-x)^α/(1+x)^β
!'/-1
LET N=10
LET ALPHA=1 !'α,β>-1 整数のみ
LET BETA=2
LET H=1/N/8
DIM X(N),W(N)
PRINT " 零点 重み"
FOR XX=-1+H TO 1-H STEP H
LET LO=XX
LET HI=XX+H
IF P(ALPHA,BETA,N,LO)*P(ALPHA,BETA,N,HI)<0 THEN
DO
LET M=(LO+HI)/2
IF P(ALPHA,BETA,N,LO)*P(ALPHA,BETA,N,M)<0 THEN LET HI=M ELSE LET LO=M
LOOP UNTIL ABS(HI-LO)<1E-13
LET I=I+1
LET X(I)=(LO+HI)/2
LET W(I)=LAMDA(ALPHA,BETA,N,X(I))
PRINT I;":";X(I);W(I)
END IF
NEXT XX
INPUT PROMPT "下限 =":A
INPUT PROMPT "上限 =":B
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO N
LET S=S+W(I)*F(U+V*X(I))*V/(1-X(I))^ALPHA/(1+X(I))^BETA
NEXT I
PRINT S
PRINT B^3/3-A^3/3
END
EXTERNAL FUNCTION F(X)
LET F=X*X
END FUNCTION
EXTERNAL FUNCTION P(A,B,N,Z) !'Jacobi polynomials ※ガンマ関数gamma(n+1)を階乗fact(n)で代用
FOR M=0 TO N
LET S=S+COMB(N,M)*FACT(A+B+N+M)/FACT(A+M)*((Z-1)/2)^M
NEXT M
LET P=S*FACT(A+N)/FACT(N)/FACT(A+B+N)
END FUNCTION
EXTERNAL FUNCTION DIFFP(K,A,B,N,Z) !'d^k/dz^k P(A,B,N,Z)
LET DIFFP=FACT(A+B+N+K)/2^K/FACT(A+B+N)*P(A+K,B+K,N-K,Z)
END FUNCTION
EXTERNAL FUNCTION LAMDA(A,B,N,X)
LET LAMDA=-(2*N+A+B+2)/(N+A+B+1)*FACT(N+A)*FACT(N+B)/FACT(N+A+B)/FACT(N+1)*2^(A+B)/DIFFP(1,A,B,N,X)/P(A,B,N+1,X)
END FUNCTION
!'/1
!'|f(x)dx*SQR(1-x^2)
!'/-1
LET N=5000
!'INPUT PROMPT "下限 =":A
INPUT PROMPT "上限 =":B
LET A=1
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO N
LET X=COS((2*I-1)/2/N*PI)
LET XX=U+V*X
LET S=S+SQR((B-XX)*(XX-A))*FUNC(XX)
LET SS=SS+SQR(1-X*X)*FUNC(XX)*V
NEXT I
PRINT S*PI/N;SS*PI/N
PRINT LOG(B)
END
EXTERNAL FUNCTION FUNC(X)
LET FUNC=1/X
END FUNCTION
!'/1
!'|f(x)dx/SQR(1-x^2)
!'/-1
LET N=5000
INPUT PROMPT "下限 =":A
INPUT PROMPT "上限 =":B
LET U=(B+A)/2
LET V=(B-A)/2
FOR I=1 TO N
LET X=COS(I*PI/(N+1))
LET XX=V*X+U
LET W=PI/(N+1)*SIN(I*PI/(N+1))^2
LET S=S+FUNC(XX)/SQR(1-X*X)*W*V
NEXT I
PRINT S
PRINT B^4/4-A^4/4
END
EXTERNAL FUNCTION FUNC(X)
LET FUNC=X^3
END FUNCTION
!'/∞
!'| f(x)dx*exp(b*(x-a))/(x-a)^α (α>-1)
!'/a
LET N=8
LET EPS=1E-12
DIM XX(N),WW(N)
LET H=1/N
LET ALPHA=2 !'整数のみ
PRINT " 零点 重み"
FOR X=0 TO 50 STEP H
IF L(N,ALPHA,X)*L(N,ALPHA,X+H)<0 THEN
LET A=X
LET B=X+H
DO
LET C=(A+B)/2
IF L(N,ALPHA,A)*L(N,ALPHA,C)<0 THEN LET B=C ELSE LET A=C
LOOP UNTIL ABS(A-B)<EPS
LET I=I+1
LET XX(I)=C
LET WW(I)=WEIGHT(N,ALPHA,C)
PRINT I;":";XX(I);WW(I)
END IF
NEXT X
LET A=0
INPUT PROMPT "GAMMA(X) X=":U
FOR I=1 TO N
LET S=S+WW(I)*F(XX(I),U)*EXP(XX(I)-A)/(XX(I)-A)^ALPHA
NEXT I
PRINT S
END
EXTERNAL FUNCTION F(U,X)
LET F=EXP(-U)*U^(X-1)
END FUNCTION
EXTERNAL FUNCTION L(N,A,X) !'ラゲール陪関数
LET OLDLL=1
LET LL=A+1-X
FOR K=1 TO N-1
LET NEWLL=((2*K+1+A-X)*LL-(K+A)*OLDLL)/(K+1)
LET OLDLL=LL
LET LL=NEWLL
NEXT K
LET L=NEWLL
END FUNCTION
EXTERNAL FUNCTION WEIGHT(N,A,X)
LET WEIGHT=FACT(N+A)*X/FACT(N)/((N+1)*L(N+1,A,X))^2
END FUNCTION
OPTION ARITHMETIC NATIVE
FOR N=2 TO 10000000
LET FL=0
FOR J=2 TO INT(SQR(N))
IF MOD(N,J)=0 THEN
LET FL=1
EXIT FOR
END IF
NEXT J
IF FL=0 THEN LET COUNT=COUNT+1
IF MOD(N,100000)=0 THEN PRINT N;COUNT
!' IF N>=9999990 AND N<=10000000 THEN PRINT N;COUNT
NEXT N
END
LET t0=TIME
LET K=10^6 !2からkまで
DIM D(K) !k'
MAT D=CON
LET S=0 !Σgcd(k,k')
FOR N=2 TO K !エラトステネスの篩いによる
!!!PRINT N;D(N) !k,k' debug
IF D(N)=1 THEN !素数なら
LET S=S+1 !p'=1
FOR J=N*N TO K STEP N !倍数を篩う
LET dK=J/N+N*D(J/N) !k'=a'b+ab'
LET D(J)=dK
NEXT J
ELSE !合成数なら
LET S=S+GCD(N,D(N))
END IF
NEXT N
PRINT S !結果を表示する
PRINT TIME-t0
END
EXTERNAL FUNCTION gcd(a,b) !最大公約数 a,b≧0
DO UNTIL b=0
LET t=b
LET b=MOD(a,b)
LET a=t
LOOP
LET gcd=a
END FUNCTION
INPUT PROMPT "GAMMA(X) X=":U
LET H=1/1024
FOR T=-4 TO 4 STEP H !' Tの範囲を修正(FOR T=-2 TO 2 STEP H としても、まだ大丈夫なようです)
LET SS=SS+F(EXP(PI/2*SINH(T)),U)*PI/2*COSH(T)*EXP(PI/2*SINH(T))*H !'二重指数関数法(半無限区間)
NEXT T
PRINT "Γ(";STR$(U);")=";SS
END
EXTERNAL FUNCTION F(U,X)
LET F=EXP(-U)*U^(X-1)
END FUNCTION
> 2進モード、複素数モードで
> プログラムが中断された場合（中断した場合）、配列メモリの解放がされない。
> 「メモリが足りません」となって、再度実行できない。
>
> DIM A(5*10^7) !ほぼ上限
> LET A(-1)=1 !ここで中断させる
> END
>
>
> DIM A(5*10^7) !ほぼ上限
> LET T=0
> DO WHILE T=0 !ここで「中断」
> LOOP
> END
>
>
>
!'素数判定 Miller-Rabin法
OPTION ARITHMETIC RATIONAL
LET L=100000000000000 !'100兆
FOR N=L+1 TO L+10001 STEP 2
IF ISPRIME(N)=1 THEN
!'PRINT N
LET COUNT=COUNT+1
END IF
NEXT N
PRINT COUNT;"個"
END
EXTERNAL FUNCTION ISPRIME(N)
OPTION ARITHMETIC RATIONAL
IF N = 2 THEN
LET ISPRIME=1
EXIT FUNCTION
END IF
IF N = 1 OR MOD(N , 2) = 0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
LET D = (N - 1) / 2
LET S = 0
DO WHILE MOD(D , 2) = 0
LET D = INT(D / 2)
LET S=S+1
LOOP
FOR I=1 TO 10
LET ISP=0
READ A !' n < 341550071728321 なら a = 2, 3, 5, 7, 11, 13, 17
DATA 2,3,5,7,11,13,17,23,29,31
LET ISP = 0
LET R = POWMOD(A, D, N)
IF R = 1 OR R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
FOR J = 0 TO S-1
IF R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
NEXT J
IF ISP=0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
NEXT I
LET ISPRIME=1
END FUNCTION
EXTERNAL FUNCTION POWMOD(B,P,M)
OPTION ARITHMETIC RATIONAL
LET RESULT = 1
DO WHILE P > 0
IF MOD(P , 2)= 1 THEN
LET RESULT = MOD(RESULT * B , M)
END IF
LET B = MOD(B * B, M)
LET P = INT(P / 2)
LOOP
LET POWMOD=RESULT
END FUNCTION
! ζ(x)1000桁 X=偶数を求めるプログラム
OPTION ARITHMETIC RATIONAL
LET t0=TIME
LET format$="#." & REPEAT$("#",999)
LET p=PI
FOR K=2 TO 100 STEP 2
LET q=1
FOR n=1 TO k ! 階乗数
LET ka=n*q
LET q=ka
NEXT n
LET b=BERNOULLI(K)
IF b<0 THEN LET L=-1 ELSE LET L=1
LET z=(L*b*2^(k-1))/q*p^k
PRINT "zeta(";k;")";
PRINT USING format$: z
NEXT k
PRINT TIME-t0;"秒で計算しました"
END
EXTERNAL FUNCTION BERNOULLI(K) !'ベルヌーイ定数
OPTION ARITHMETIC RATIONAL
LET C=1
LET D=1
LET N=K/2
IF K=1 THEN
LET BERNOULLI=-1/2
ELSEIF MOD(K,2)=1 THEN
LET BERNOULLI=0
ELSE
FOR M=N TO 1 STEP-1
LET T=T+(-1)^M*D*M^(K-1)
LET C=C*(N+M+1)/(N-M+1)
LET D=D+C
NEXT M
LET BERNOULLI=-T*K/(2^K*(2^K-1))
END IF
END FUNCTION
! Ramanujan ζ(2n+1)
OPTION ARITHMETIC DECIMAL_HIGH
LET t0=TIME
FOR n=1 TO 10 STEP 2
LET f=2^(2*n)*pi^(2*n+1)
LET S=0
FOR k1=0 TO n+1
LET S=S+((-1)^(k1+1))*BERNOULLI(2*k1)/FACT(2*k1)*BERNOULLI(2*n+2-2*k1)/FACT(2*n+2-2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 330
LET q=2*PI*k2
LET S1=S1+(k2^(-2*n-1))/(EX(q)-1)
NEXT k2
LET zeta=f*S-2*S1
PRINT 2*n+1;zeta
NEXT n
PRINT TIME-t0;"秒"
END
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s = 0
FOR i=0 TO k-2
LET s = s + comb(k,i)*b(i)
NEXT i
LET b(k-1) = - s / k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
!1000桁モードで利用する指数関数
EXTERNAL FUNCTION EX(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EX=s(1,1)
END FUNCTION
!'Method of False Position
INPUT T
LET X2=1
LET X1=T
DO
LET X=X1-(X2-X1)/(F(X2)-F(X1))*F(X1)
LET X2=X1
LET X1=X
PRINT X
LOOP UNTIL ABS(F(X))<1E-13
PRINT X;X^3
!'Householder's Method
INPUT PROMPT "X=":T
LET XX=T
DO
LET X=XX
LET XX=X-F(X)/DF1(X)*(1+F(X)*DF2(X)/2/DF1(X)^2)
PRINT XX
LOOP UNTIL ABS(X-XX)<1E-13
PRINT X;X^3
!'Muller's Method
INPUT T
LET X1=T
LET X2=(1+T)/2
LET X3=1
DO
LET Q=(X3-X2)/(X2-X1)
LET A=Q*F(X3)-Q*(1+Q)*F(X2)+Q^2*F(X1)
LET B=(2*Q+1)*F(X3)-(1+Q)^2*F(X2)+Q^2*F(X1)
LET C=(1+Q)*F(X3)
LET DD=B^2-4*A*C
IF DD>0 THEN
LET X4=X3-(X3-X2)*2*C/MAX(B+SQR(DD),B-SQR(DD))
ELSE
LET X4=X3-(X3-X2)*2*C/B
END IF
LET X1=X2
LET X2=X3
LET X3=X4
LOOP UNTIL ABS(F(X4))<1E-13
PRINT X4;X4^3
!'Halley's Irrational Formula
INPUT T
LET X=T
DO
LET J=DF1(X)^2-2*F(X)*DF2(X)
IF J=<0 THEN LET J=0 ELSE LET J=SQR(J)
LET X1=X+(-DF1(X)+J)/DF2(X)
LET X2=X+(-DF1(X)-J)/DF2(X)
IF ABS(F(X1))<ABS(F(X2)) THEN LET X=X1 ELSE LET X=X2
PRINT X
LOOP UNTIL ABS(F(X))<1E-13
PRINT X;X^3
!'求積法
LET A=1
LET B=2
PRINT BOOLES(A,B)
PRINT DURAND(A,B)
PRINT HARDYS(A,B)
!'PRINT WOOLHOUSE(A,B)
PRINT WOOLHOUSE2(A,B)
PRINT WEDDLE(A,B)
PRINT B^3/3-A^3/3
END
EXTERNAL FUNCTION F(X)
LET F=X^2
END FUNCTION
EXTERNAL FUNCTION BOOLES(A,B)
LET X=A
LET H=(B-A)/4
LET BOOLES=2*H/45*(7*F(X)+32*F(X+H)+12*F(X+2*H)+32*F(X+3*H)+7*F(X+4*H))
END FUNCTION
EXTERNAL FUNCTION DURAND(A,B)
LET X=A
LET H=(B-A)/5
LET DURAND=H*(2/5*F(X)+11/10*F(X+H)+F(X+2*H)+F(X+3*H)+11/10*F(X+4*H)+2/5*F(X+5*H))
END FUNCTION
EXTERNAL FUNCTION HARDYS(A,B)
LET X=A
LET H=(B-A)/6
LET HARDYS=H/100*(28*F(X)+162*F(X+H)+220*F(X+3*H)+162*F(X+5*H)+28*F(X+6*H))
END FUNCTION
EXTERNAL FUNCTION SHOVELTON(A,B)
LET H=(B-A)/10
LET X=A
LET SHOVELTON=5*H/126*(8*(F(X)+F(X+10*H))+35*(F(X+H)+F(X+3*H)+F(X+7*H)+F(X+9*H))+15*(F(X+2*H)+F(X+4*H)+F(X+6*H)+F(X+8*H))+36*F(X+5*H))
END FUNCTION
EXTERNAL FUNCTION WOOLHOUSE(A,B)
LET H=(B-A)/10
LET X=A
LET WOOLHOUSE=5*H*(223/3969*(F(X)+F(X+10*H))+5875/18144*(F(X+H)+F(X+9*H))+4625/10584*(F(X+3*H)+F(X+7*H))+41/112*F(X+4*H))
END FUNCTION
EXTERNAL FUNCTION WOOLHOUSE2(A,B)
LET H=(B-A)/28
LET X=A
LET WOOLHOUSE2=14*H*(7/195*(F(X)+F(X+28*H))+16807/66690*(F(X+2*H)+F(X+26*H))+128/285*(F(X+7*H)+F(X+21*H))+71/135*F(X+14*H))
END FUNCTION
EXTERNAL FUNCTION WEDDLE(A,B)
LET X=A
LET H=(B-A)/6
LET WEDDLE=3*H/10*(F(X)+5*F(X+H)+F(X+2*H)+6*F(X+3*H)+F(X+4*H)+5*F(X+5*H)+F(X+6*H))
END FUNCTION
!'悪魔の階段
SET WINDOW 0,1,0,1
DRAW GRID(.1,.1)
LET H=1/128
FOR X=0 TO 1-H STEP H !' 0<=X<1
LET A$=TERNARY$(X)
IF POS(A$,"1")>0 THEN
FOR I=1 TO LEN(A$)
IF A$(I:I)="1" THEN
FOR J=I+1 TO LEN(A$)
IF A$(J:J)="1" OR A$(J:J)="2" THEN LET A$(J:J)="0"
NEXT J
EXIT FOR
END IF
NEXT I
END IF
IF POS(A$,"2")>0 THEN
FOR I=1 TO LEN(A$)
IF A$(I:I)="2" THEN LET A$(I:I)="1"
NEXT I
END IF
PLOT LINES: X,BINARY(A$);
NEXT X
PLOT LINES:1,1
END
EXTERNAL FUNCTION TERNARY$(X) !'10進小数 to 3進小数 (0<=X<1)
!'LET B$="0."
FOR I=1 TO 10
LET A$=MID$("012",MOD(INT(X*3),3)+1,1)
LET B$=B$&A$
LET X=X*3-INT(X*3)
NEXT I
LET TERNARY$=B$
END FUNCTION
EXTERNAL FUNCTION BINARY(X$) !'2進小数 to 10進小数
FOR I=1 TO LEN(X$)
IF X$(I:I)="1" THEN
LET S=S+2^(-I)
END IF
NEXT I
LET BINARY=S
END FUNCTION
-----------------------------------------------------------------------------------------
SET WINDOW 0,1,0,1
DRAW GRID(.1,.1)
FOR N=0 TO 3
SET LINE COLOR N+1
FOR X=0 TO 1 STEP 1/32
PLOT LINES: X,CANTOR(N,X);
NEXT X
PLOT LINES
NEXT N
END
EXTERNAL FUNCTION CANTOR(N,X) !'カントル関数
IF N=0 THEN
LET CANTOR=X
ELSE
IF X>=0 AND X<1/3 THEN
LET CANTOR=1/2*CANTOR(N-1,3*X)
ELSEIF X>=1/3 AND X<2/3 THEN
LET CANTOR=1/2
ELSEIF X>=2/3 AND X<=1 THEN
LET CANTOR=1/2+1/2*CANTOR(N-1,3*X-2)
END IF
END IF
END FUNCTION
!'Greatest Common Divisor
SET WINDOW 1,3,0,1.2
SET POINT STYLE 7
FOR M=1 TO 50
FOR N=1 TO 100
PLOT POINTS : N/M,GCD(1,N/M)
NEXT N
NEXT M
!'Relatively Prime
!'DIM M(100,100)
!'SET COLOR MIX(0) 1,1,1
!'SET COLOR MIX(1) 0,0,0
!'SET COLOR MIX(2) 1,1,1
!'SET COLOR MIX(3) 1,1,1
!'SET COLOR MIX(4) 1,1,1
!'SET COLOR MIX(5) 1,1,1
!'SET COLOR MIX(6) 1,1,1
!'SET COLOR MIX(7) 1,1,1
!'FOR Y=1 TO 99
!' FOR X=1 TO 99
!' LET M(X,Y)=MOD(GCD(X,Y),8)
!' NEXT X
!'NEXT Y
!'SET WINDOW 0,1,1,0
!'MAT PLOT CELLS, IN 0,0; 1,1: M
END
EXTERNAL FUNCTION GCD(M,N) !'最大公約数
DO WHILE N<>0
LET T=MOD(M,N)
LET M=N
LET N=T
LOOP
LET GCD=M
END FUNCTION
!'Irreducible Fraction
OPTION ARITHMETIC COMPLEX
LET R=30
DIM M(-R TO R,-R TO R)
FOR Y=1 TO R
FOR X=1 TO R
IF GCD(X,Y)=1 AND ISPRIME(COMPLEX(X,Y))<>0 THEN
LET M(X,Y)=1
LET M(-X,Y)=1
LET M(X,-Y)=1
LET M(-X,-Y)=1
END IF
NEXT X
NEXT Y
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1,1 : M
END
EXTERNAL FUNCTION GCD(M,N) !'最大公約数
OPTION ARITHMETIC COMPLEX
DO WHILE N<>0
LET T=MOD(M,N)
LET M=N
LET N=T
LOOP
LET GCD=M
END FUNCTION
EXTERNAL FUNCTION ISPRIME(Z)
OPTION ARITHMETIC COMPLEX
FOR I=1 TO INT(SQR(RE(Z)))
FOR J=1 TO INT(SQR(IM(Z)))
LET ZZ=Z/COMPLEX(I,J)
IF FRAC(RE(ZZ))=0 AND FRAC(IM(ZZ))=0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
NEXT J
NEXT I
LET ISPRIME=1
END FUNCTION
EXTERNAL FUNCTION FRAC(Z)
OPTION ARITHMETIC COMPLEX
LET FRAC=Z-INT(Z)
END FUNCTION
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC COMPLEX
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
!'Ice Fractal
PUBLIC NUMERIC X,Y,ALPHA
CALL GINIT(800,800)
INPUT PROMPT "LEVEL=":N
LET MODE=0
SELECT CASE MODE
CASE 0
LET L=600
LET X=100
LET Y=700
FOR I=1 TO 3
CALL RECURSIVE(N,L)
CALL TURN(120)
NEXT I
CASE 1
LET L=600
LET X=100
LET Y=700
FOR I=1 TO 4
CALL RECURSIVE(N,L)
CALL TURN(90)
NEXT I
CASE 2
LET L=600
LET X=100
LET Y=600
CALL TURN(60)
FOR I=1 TO 3
CALL RECURSIVE(N,L)
CALL TURN(-120)
NEXT I
CASE 3
LET L=500
LET X=150
LET Y=650
CALL TURN(90)
FOR I=1 TO 4
CALL RECURSIVE(N,L)
CALL TURN(-90)
NEXT I
CASE 4
LET L=600
LET X=100
LET Y=700
FOR I=1 TO 4
CALL RECURSIVE2(N,L)
CALL TURN(90)
NEXT I
CASE 5
LET L=400
LET X=200
LET Y=600
CALL TURN(90)
FOR I=1 TO 4
CALL RECURSIVE2(N,L)
CALL TURN(-90)
NEXT I
END SELECT
END
EXTERNAL SUB RECURSIVE(LEV,L)
IF LEV=0 THEN
CALL MOVE(L)
ELSE
CALL RECURSIVE(LEV-1,L/2)
CALL TURN(120)
CALL RECURSIVE(LEV-1,L/4)
CALL TURN(-180)
CALL RECURSIVE(LEV-1,L/4)
CALL TURN(120)
CALL RECURSIVE(LEV-1,L/4)
CALL TURN(-180)
CALL RECURSIVE(LEV-1,L/4)
CALL TURN(120)
CALL RECURSIVE(LEV-1,L/2)
END IF
END SUB
EXTERNAL SUB RECURSIVE2(LEV,L)
IF LEV=0 THEN
CALL MOVE(L)
ELSE
CALL RECURSIVE2(LEV-1,L/2)
CALL TURN(90)
CALL RECURSIVE2(LEV-1,L/3)
CALL TURN(-180)
CALL RECURSIVE2(LEV-1,L/3)
CALL TURN(90)
CALL RECURSIVE2(LEV-1,L/2)
END IF
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET COLOR 7
END SUB
EXTERNAL SUB MOVE(L)
PLOT LINES:X,Y;
LET X=X+L*COS(ALPHA*PI/180)
LET Y=Y-L*SIN(ALPHA*PI/180)
PLOT LINES:X,Y;
END SUB
EXTERNAL SUB TURN(R)
LET ALPHA=MOD(ALPHA+R+360,360)
END SUB
!'Cesaro Fractal
PUBLIC NUMERIC X,Y,ALPHA,R1,L1,L2,CC,XX,YY
CALL GINIT(800,800)
INPUT PROMPT "LEVEL=":N
RESTORE 2
READ XX,YY,R1
1 DATA .5,.288675134,60 !'SQR(3)/6=0.2886...
2 DATA .5,.45,85
3 DATA .3,.4,85
LET CC=YY/TAN(RAD(R1))
LET L1=XX-CC
LET L2=CC/COS(RAD(R1))
LET X=100
LET Y=700
LET L=600
FOR I=1 TO 4
CALL RECURSIVE(N,L)
CALL TURN(90)
NEXT I
END
EXTERNAL SUB RECURSIVE(LEV,L)
IF LEV=0 THEN
CALL MOVE(L)
ELSE
CALL RECURSIVE(LEV-1,L*L1)
CALL TURN(R1)
CALL RECURSIVE(LEV-1,L*L2)
CALL TURN(-2*R1)
CALL RECURSIVE(LEV-1,L*L2)
CALL TURN(R1)
CALL RECURSIVE(LEV-1,L*(1-(XX+CC)))
END IF
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET COLOR 7
END SUB
EXTERNAL SUB MOVE(L)
PLOT LINES:X,Y;
LET X=X+L*COS(ALPHA*PI/180)
LET Y=Y-L*SIN(ALPHA*PI/180)
PLOT LINES:X,Y;
END SUB
EXTERNAL SUB TURN(R)
LET ALPHA=MOD(ALPHA+R+360,360)
END SUB
!'LindenmayerSystem
DIM P$(128)
INPUT PROMPT "MODE =":MODE
INPUT PROMPT "LEVEL=":N
LET X0=0
LET Y0=0
LET L=10
LET TH=0
FOR I=32 TO 128
LET P$(I)=CHR$(I)
NEXT I
SELECT CASE MODE
CASE 1
LET PARA$="F"
LET P$(ORD("F"))="F+F--F+F" !'Koch curve
LET TH=0
LET R=60
CASE 2
LET PARA$="F"
LET P$(ORD("F"))="F+F-F-F-F+F+F+F-F" !'Peano curve
LET TH=0
LET R=90
CASE 3
LET PARA$="F+F+F+F"
LET P$(ORD("F"))="F-F+F+FFF-F-F+F" !'Quadratic Koch island
LET TH=0
LET R=90
CASE 4
LET PARA$="F+F+F+F"
LET P$(ORD("F"))="-F+F-F-F+F+FF-F+F+FF+F-F-FF+FF-FF+F+F-FF-F-F+FF-F-F+F+F-F+" !'32-segment curve
LET TH=0
LET R=90
CASE 5
LET PARA$="YF"
LET P$(ORD("X"))="YF+XF+Y" !'Sierpinski arrowhead
LET P$(ORD("Y"))="XF-YF-X"
LET TH=0
LET R=60
CASE 6
LET PARA$="FX"
LET P$(ORD("X"))="X+YF++YF-FX--FXFX-YF+" !'Peano-Gosper curve
LET P$(ORD("Y"))="-FX+YFYF++YF+FX--FX-Y"
LET TH=0
LET R=60
CASE 7
LET PARA$="FXF--FF--FF"
LET P$(ORD("F"))="FF" !'Sierpinski triangle
LET P$(ORD("X"))="--FXF++FXF++FXF--"
LET TH=0
LET R=60
CASE 8
LET PARA$="F+XF+F+XF"
LET P$(ORD("X"))="XF-F+F-XF+F+XF-F+F-X" !'Square curve
LET TH=0
LET R=90
CASE 9
LET PARA$="FX"
LET P$(ORD("X"))="X+YF+" !'Dragon curve
LET P$(ORD("Y"))="-FX-Y"
LET TH=0
LET R=90
CASE 10
LET PARA$="L"
LET P$(ORD("L"))="+RF-LFL-FR+" !'Hilbert curve
LET P$(ORD("R"))="-LF+RFR+FL-"
LET TH=0
LET R=90
CASE 11
LET PARA$="X"
LET P$(ORD("X"))="XFYFX+F+YFXFY-F-XFYFX" !'Hilbert curve2
LET P$(ORD("Y"))="YFXFY-F-XFYFX+F+YFXFY"
LET TH=0
LET R=90
END SELECT
CALL MAKEPARA$(P$,PARA$,N)
CALL TURTLE(PARA$,0,X0,Y0,L,TH,R)
CALL TURTLE(PARA$,1,X0,Y0,L,TH,R)
END
EXTERNAL SUB MAKEPARA$(P$(),PARA$,N)
FOR LEV=1 TO N
LET W$=""
FOR K=1 TO LEN(PARA$)
LET W$=W$&P$(ORD(PARA$(K:K)))
NEXT K
LET PARA$=W$
NEXT LEV
END SUB
EXTERNAL SUB TURTLE(PARA$,FLG,XX,YY,LL,TT,RR)
DIM X(200),Y(200),T(200)
LET SP=1
LET XMIN=1E+10
LET XMAX=-1E+10
LET YMIN=1E+10
LET YMAX=-1E+10
LET TH=TT
LET R=RR
LET X0=XX
LET Y0=YY
LET L=LL
FOR I=1 TO LEN(PARA$)
SELECT CASE PARA$(I:I)
CASE "+"
LET TH=TH+R
CASE "-"
LET TH=TH-R
CASE "F"
LET X1=X0+L*COS(TH*PI/180)
LET Y1=Y0-L*SIN(TH*PI/180)
IF FLG<>0 THEN CALL LINE(X0,Y0,X1,Y1,7)
LET X0=X1
LET Y0=Y1
LET XMIN=MIN(XMIN,X0)
LET XMAX=MAX(XMAX,X0)
LET YMIN=MIN(YMIN,Y0)
LET YMAX=MAX(YMAX,Y0)
CASE "G"
LET X1=X0+L*COS(TH*PI/180)
LET Y1=Y0-L*SIN(TH*PI/180)
LET X0=X1
LET Y0=Y1
CASE "["
LET X(SP)=X0
LET Y(SP)=Y0
LET T(SP)=TH
LET SP=SP+1
CASE "]"
LET SP=SP-1
LET X0=X(SP)
LET Y0=Y(SP)
LET TH=T(SP)
CASE ELSE
END SELECT
NEXT I
IF FLG=0 THEN
LET MAXSIZE=800
LET MINSIZE=400
LET XSIZE=INT(XMAX-XMIN)
LET YSIZE=INT(YMAX-YMIN)
LET R=YSIZE/XSIZE
IF XSIZE>MAXSIZE THEN LET XSIZE=MAXSIZE
IF XSIZE<MINSIZE THEN LET XSIZE=MINSIZE
IF YSIZE/XSIZE<>R THEN LET YSIZE=INT(XSIZE*R)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW XMIN,XMAX,YMAX,YMIN
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END IF
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
SET COLOR C
PLOT LINES
PLOT LINES:XS,YS;XE,YE
END SUB
!'String Rewriting System
INPUT PROMPT "LEVEL=":LEV !' (1<=LEV<=5)
DIM A(3^LEV,3^LEV),B(3^LEV,3^LEV),P(3,3),Q(3,3)
RESTORE 5
READ A(1,1) !'初期値
MAT READ P,Q
1 DATA 1 !'Cantor Dust
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,0,0
DATA 1,0,1
2 DATA 1
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
3 DATA 0 !'Cantor Square Fractal
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
!'
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
4 DATA 0 !'Haferman Carpet
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
!'
DATA 0,1,0
DATA 1,0,1
DATA 0,1,0
5 DATA 1 !'Box Fractal
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,1,0
DATA 1,0,1
6 DATA 1 !'格子
DATA 0,1,0
DATA 1,0,1
DATA 0,1,0
!'
DATA 1,0,1
DATA 0,1,0
DATA 1,0,1
7 DATA 1
DATA 1,1,1
DATA 0,0,0
DATA 1,1,1
!'
DATA 1,0,1
DATA 1,0,1
DATA 1,0,1
8 DATA 0
DATA 1,1,1
DATA 1,0,1
DATA 1,1,1
!'
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
9 DATA 1 !'Sierpinski Carpet
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,1,1
DATA 1,0,1
DATA 1,1,1
10 DATA 1
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,1,1
DATA 0,0,0
DATA 1,1,1
11 DATA 0
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
!'
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
LET M=1
FOR N=1 TO LEV
FOR I=1 TO M
FOR J=1 TO M
SELECT CASE A(I,J)
CASE 0
FOR K=1 TO 3
FOR L=1 TO 3
LET B((I-1)*3+K,(J-1)*3+L)=P(K,L)
NEXT L
NEXT K
CASE 1
FOR K=1 TO 3
FOR L=1 TO 3
LET B((I-1)*3+K,(J-1)*3+L)=Q(K,L)
NEXT L
NEXT K
END SELECT
NEXT J
NEXT I
MAT A=B
LET M=M*3
NEXT N
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1,1 : A
END
---------------------------------------------------------------------------------------------------
PUBLIC NUMERIC P(3,3),Q(3,3)
INPUT PROMPT "LEVEL=":LEV !' LEV=1～4
DIM A(3,3)
MAT READ P,Q
MAT A=Q !'初期値
DATA 0,0,0 !'Cantor Dust
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,0,0
DATA 1,0,1
SET WINDOW 0,1,1,0
SET AREA COLOR 4
PLOT AREA :0,0;0,1;1,1;1,0
CALL RECURSIVE(LEV,A,0,0,1,1,1/3)
END
EXTERNAL SUB RECURSIVE(N,A(,),XS,YS,XE,YE,H)
IF N>0 THEN
FOR K=0 TO 2
FOR L=0 TO 2
IF A(K+1,L+1)=0 THEN
CALL RECURSIVE(N-1,P,XS+L*H,YS+K*H,XS+L*H+H,YS+K*H+H,H/3)
ELSE
CALL RECURSIVE(N-1,Q,XS+L*H,YS+K*H,XS+L*H+H,YS+K*H+H,H/3)
END IF
NEXT L
NEXT K
ELSE
MAT PLOT CELLS, IN XS,YS ; XE,YE : A
END IF
END SUB
!'Henon Map
SET POINT STYLE 1
LET MODE=2
SELECT CASE MODE
CASE 0
LET ALPHA=1.4
LET BETA=.3
SET WINDOW -1.3,1.3,-1.3,1.3
CASE 1
LET ALPHA=.2
LET BETA=.9991
SET WINDOW -4,4,-4,4
CASE 2
LET ALPHA=.2
LET BETA=-.9999
SET WINDOW -.2,1.2,-1.2,.2
END SELECT
FOR I=1 TO 100000
LET XX=1-ALPHA*X*X+Y
LET YY=BETA*X
LET X=XX
LET Y=YY
PLOT POINTS:X,Y
NEXT I
END
!'Mira Fractal
PUBLIC NUMERIC A
SET WINDOW -30,30,-30,30
SET POINT STYLE 1
RESTORE 2
READ A,B,X,Y
1 DATA .2,1,12,0
2 DATA .31,1,12,0
3 DATA .4,1,12,0
4 DATA .7,.9998,9,0
5 DATA .7,.9998,12.1,0
6 DATA .7,.9998,15,0
FOR I=1 TO 50000
LET XX=B*Y+F(X)
LET YY=-X+F(XX)
LET X=XX
LET Y=YY
PLOT POINTS:X,Y
NEXT I
END
EXTERNAL FUNCTION F(X)
LET F=A*X+2*(1-A)*X*X/(1+X*X)
END FUNCTION
!'Butterfly Function
LET XSIZE=600
LET YSIZE=600
CALL GINIT(XSIZE,YSIZE)
SET WINDOW -20,20,20,-20
SET POINT STYLE 1
FOR Y=-20 TO 20 STEP 40/YSIZE
FOR X=-20 TO 20 STEP 40/XSIZE
WHEN EXCEPTION IN
LET C=MOD(F(X,Y),8)
USE
END WHEN
SET POINT COLOR C
PLOT POINTS:X,Y
NEXT X
NEXT Y
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION F(X,Y)
LET A=1
LET F=(X*X-Y*Y)*SIN((X+Y)/A)/(X*X+Y*Y)
END FUNCTION
!'Gauss Map
OPTION ARITHMETIC COMPLEX
SET WINDOW -1,1,1,-1
SET POINT STYLE 1
FOR Y=-1 TO 1 STEP 1/512
FOR X=-1 TO 1 STEP 1/512
LET Z=COMPLEX(X,Y)
WHEN EXCEPTION IN
LET C=ABS(F(Z))*8
USE
END WHEN
SET POINT COLOR INT(C)
PLOT POINTS : X,Y
NEXT X
NEXT Y
END
EXTERNAL FUNCTION F(Z)
OPTION ARITHMETIC COMPLEX
LET F=COMPLEX(RE(1/Z)-INT(RE(1/Z)),IM(1/Z)-INT(IM(1/Z)))
END FUNCTION
!'Barnsley's Tree
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KL=50
LET S=COMPLEX(-3,-3)
LET E=COMPLEX(3,3)
LET C=COMPLEX(.6,1.1)
SET WINDOW RE(S),RE(E),IM(E),IM(S)
LET D=(E-S)/SIZE
FOR CR=RE(S) TO RE(E) STEP RE(D)
FOR CI=IM(S) TO IM(E) STEP IM(D)
LET Z=COMPLEX(CR,CI)
LET FL=0
FOR K=0 TO KL
LET Z=C*(Z-SGN(RE(Z)))
IF ABS(Z)>2 THEN
LET FL=1
EXIT FOR
END IF
NEXT K
IF FL=1 THEN
LET CC=MOD(K,7)
CALL PSET(CR,CI,CC+1)
END IF
NEXT CI
NEXT CR
END
EXTERNAL SUB PSET(X,Y,C)
OPTION ARITHMETIC COMPLEX
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC COMPLEX
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
!'Cactus Fractal
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KL=50
LET S=COMPLEX(-1,-1)
LET E=COMPLEX(1,1)
SET WINDOW RE(S),RE(E),IM(E),IM(S)
LET D=(E-S)/SIZE
FOR CR=RE(S) TO RE(E) STEP RE(D)
FOR CI=IM(S) TO IM(E) STEP IM(D)
LET C=COMPLEX(CR,CI)
LET Z=C
LET FL=0
WHEN EXCEPTION IN
FOR K=0 TO KL
LET Z=CSIN(Z/C)
IF ABS(Z)>2 THEN
LET FL=1
EXIT FOR
END IF
NEXT K
USE
END WHEN
IF FL=1 THEN
LET CC=MOD(K,7)
CALL PSET(CR,CI,CC+1)
END IF
NEXT CI
NEXT CR
END
EXTERNAL FUNCTION CSIN(Z)
OPTION ARITHMETIC COMPLEX
LET I=SQR(-1)
LET CSIN=(EXP(I*Z)-EXP(-I*Z))/(2*I)
END FUNCTION
EXTERNAL SUB PSET(X,Y,C)
OPTION ARITHMETIC COMPLEX
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC COMPLEX
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0 , XSIZE-1 , YSIZE-1, 0
SET POINT STYLE 1
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL SUB LINE(XS,YS,XE,YE,C)
OPTION ARITHMETIC COMPLEX
SET COLOR C
PLOT LINES:XS,YS;XE,YE
END SUB
!'Elementary Cellular Automaton
CALL GINIT(800,400)
DIM M(50,25)
INPUT PROMPT "RULE=":RULE !' 0<RULE<=255(2^8-1)
LET M(25,1)=1 !'初期値
FOR Y=1 TO 24
FOR X=1 TO 50
IF X-1>=1 THEN LET CC=4*M(X-1,Y)
LET CC=CC+2*M(X,Y)
IF X+1<=50 THEN LET CC=CC+M(X+1,Y)
IF BITAND(RULE,2^CC)>0 THEN
LET M(X,Y+1)=1
END IF
NEXT X
NEXT Y
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1,1 : M
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
!'SET COLOR MIX(0) 0,0,0
!'SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
!'Totalistic Cellular Automaton
CALL GINIT(800,400)
DIM M(50,25)
INPUT PROMPT "RULE=":RULE !'0<RULE<=2186(3^7-1)
LET M(25,1)=1 !'初期値
!'LET M(25,1)=2
LET C$=RIGHT$("000000"&NSTR$(RULE,3),7)
FOR Y=1 TO 24
FOR X=1 TO 50
IF X-1>=1 THEN LET CC=M(X-1,Y) ELSE LET CC=0
LET CC=CC+M(X,Y)
IF X+1<=50 THEN LET CC=CC+M(X+1,Y)
LET C=VAL(C$(7-CC:7-CC))
LET M(X,Y+1)=C
NEXT X
NEXT Y
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1,1 : M
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 1,1,1
SET COLOR MIX(1) .5,.5,.5
SET COLOR MIX(2) 0,0,0
!'SET COLOR MIX(3) 1,0,1
!'SET COLOR MIX(4) 0,1,0
!'SET COLOR MIX(5) 0,1,1
!'SET COLOR MIX(6) 1,1,0
!'SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION NSTR$(X,N) !'N進法
DO
!' LET A$=MID$("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",MOD(X,N)+1,1)
LET A$=STR$(MOD(X,N))
LET B$=A$&B$
LET X=INT(X/N)
LOOP UNTIL X=0
LET NSTR$=B$
END FUNCTION
!'Barnsley's Fern
RANDOMIZE
SET WINDOW -5,5,0,10
SET POINT STYLE 1
FOR I=1 TO 1000000
SELECT CASE INT(RND*4)
CASE 0
LET XX=.85*X+.04*Y
LET YY=-.04*X+.85*Y+1.6
CASE 1
LET XX=-.15*X+.28*Y
LET YY=.26*X+.24*Y+.44
CASE 2
LET XX=.2*X-.26*Y
LET YY=.23*X+.22*Y+1.6
CASE 3
LET XX=0
LET YY=.16*Y
END SELECT
PLOT POINTS:XX,YY
LET X=XX
LET Y=YY
NEXT I
END
!'Recurrence Plot
CALL GINIT(600,600)
SET WINDOW -10,10,-10,10
FOR Y=-10 TO 10 STEP 1/32
FOR X=-10 TO 10 STEP 1/32
LET C=ABS(SIN(X)-SIN(Y))*7+1
!' LET C=ABS(TAN(X)-TAN(Y))+1
!' LET C=ABS(SEC(X)-SEC(Y))
!' LET C=ABS(X*X-Y*Y)+1
CALL PSET(X,Y,MOD(INT(C),8))
NEXT X
NEXT Y
END
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
!'Reverend Back's Abbey Floor
LET A$="01"
FOR I=1 TO 4
LET B$=A$&A$&REV$(A$)
LET A$=B$
NEXT I
LET L=LEN(A$)
DIM M(L,L)
FOR X=1 TO L
FOR Y=1 TO L
LET M(X,Y)=MOD(VAL(A$(X:X))+VAL(A$(Y:Y)),2)
NEXT Y
NEXT X
SET WINDOW 0,1,0,1
MAT PLOT CELLS, IN 0 , 0 ; 1 , 1 : M
END
EXTERNAL FUNCTION REV$(X$)
LET S$=""
FOR I=LEN(X$) TO 1 STEP -1
LET S$=S$&X$(I:I)
NEXT I
LET REV$=S$
END FUNCTION
!'Thue-Morse Sequence
LET A$="01"
FOR N=1 TO 6
LET B$=""
FOR I=1 TO LEN(A$)
SELECT CASE A$(I:I)
CASE "0"
LET B$=B$&"01"
CASE "1"
LET B$=B$&"10"
END SELECT
NEXT I
LET A$=B$
NEXT N
!'Mephisto Waltz Sequence
!'LET A$="0"
!'FOR N=1 TO 5
!' LET B$=""
!' FOR I=1 TO LEN(A$)
!' SELECT CASE A$(I:I)
!' CASE "0"
!' LET B$=B$&"001"
!' CASE "1"
!' LET B$=B$&"110"
!' END SELECT
!' NEXT I
!' LET A$=B$
!'NEXT N
LET L=LEN(A$)
DIM M(L,L)
FOR X=1 TO L
FOR Y=1 TO L
LET M(X,Y)=MOD(VAL(A$(X:X))+VAL(A$(Y:Y)),2)
NEXT Y
NEXT X
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1 , 1 : M
END
!'Logistic Map
SET WINDOW 0,1,0,1
LET R=4
FOR NN=1 TO 6
SET LINE COLOR N+1
FOR X=0 TO 1 STEP 1/128
LET XX=X
FOR N=1 TO NN
LET XX=R*XX*(1-XX)
NEXT N
PLOT LINES: X,XX;
NEXT X
PLOT LINES
NEXT NN
END
!'MoirePattern
SET WINDOW -1,1,-1,1
DO
FOR T=2*PI TO 0 STEP -PI/180*15
SET DRAW MODE EXPLICIT
DRAW BOX WITH ROTATE(0)
DRAW BOX WITH ROTATE(T)
WAIT DELAY .1
SET DRAW MODE HIDDEN
CLEAR
NEXT T
LOOP
END
EXTERNAL PICTURE BOX
FOR X=-.3 TO .3 STEP 1/128
PLOT LINES:X,-.6;X,.6
NEXT X
END PICTURE
!'Delannoy Number
FOR J=0 TO 7
FOR I=0 TO 7
PRINT USING "######":D(I,J);
NEXT I
PRINT
NEXT J
END
EXTERNAL FUNCTION D(A,B)
IF A=0 AND B=0 THEN
LET D=1
ELSEIF A<0 OR B<0 THEN
LET D=0
ELSE
LET D=D(A-1,B)+D(A,B-1)+D(A-1,B-1)
END IF
END FUNCTION
-------------------------------------------------------------------------------------
OPTION ARITHMETIC DECIMAL_HIGH
OPTION BASE 0
LET N=100
DIM M(N,N)
LET K=3
FOR X=0 TO N/2
FOR Y=0 TO N/2
LET M(X,Y)=MOD(D(X,Y),K)
NEXT Y
NEXT X
FOR X=N/2 TO 0 STEP -1
FOR Y=0 TO N/2
LET M(N-X,Y)=MOD(D(X,Y),K)
NEXT Y
NEXT X
FOR X=0 TO N
FOR Y=N/2 TO 0 STEP -1
LET M(X,N-Y)=MOD(D(X,Y),K)
NEXT Y
NEXT X
FOR X=N/2 TO 0 STEP -1
FOR Y=N/2 TO 0 STEP -1
LET M(N-X,N-Y)=MOD(D(X,Y),K)
NEXT Y
NEXT X
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1 , 1 : M
END
EXTERNAL FUNCTION D(N,K) !'Delannoy Number
OPTION ARITHMETIC DECIMAL_HIGH
FOR I=0 TO N
LET S=S+COMB(K,I)*COMB(N+K-I,K)
NEXT I
LET D=S
END FUNCTION
!'Pythagorean Triple
CALL GINIT(600,600)
SET WINDOW -200,200,-200,200
FOR X=0 TO 200
FOR Y=0 TO 200
!' IF X>=Y AND FRAC(SQR(X*X-Y*Y))=0 THEN
IF FRAC(SQR(X*X+Y*Y))=0 THEN
CALL PSET(X,Y,7)
CALL PSET(-X,Y,7)
CALL PSET(X,-Y,7)
CALL PSET(-X,-Y,7)
END IF
NEXT Y
NEXT X
END
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL FUNCTION FRAC(Z)
LET FRAC=Z-INT(Z)
END FUNCTION
!'Kaprekar Number
FOR I=4 TO 100000
LET A$=STR$(I*I)
FOR J=1 TO LEN(A$)-1
LET L$=A$(1:J)
LET R$=A$(J+1:LEN(A$))
IF VAL(L$)+VAL(R$)=I THEN PRINT I;":";I*I;L$;"+";R$
NEXT J
NEXT I
END
!'Heart Curve
SET WINDOW -3,3,-4.5,1.5
FOR T=0 TO 360
LET R=2-2*SIN(RAD(T))+SIN(RAD(T))*SQR(ABS(COS(RAD(T))))/(SIN(RAD(T))+1.4)
LET X=R*COS(RAD(T))
LET Y=R*SIN(RAD(T))
PLOT LINES:X,Y;
NEXT T
WAIT DELAY 2
CLEAR
SET WINDOW -20,20,-20,20
FOR T=0 TO 360
LET X=16*SIN(RAD(T))^3
LET Y=13*COS(RAD(T))-5*COS(RAD(2*T))-2*COS(RAD(3*T))-COS(RAD(4*T))
PLOT LINES:X,Y;
NEXT T
END
-----------------------------------------------------------------------------------------------
!'Heart Surface
CALL GINIT(600,600)
SET WINDOW -2,2,-2,2
FOR Z=2 TO -2 STEP -1/256
FOR X=-2 TO 2 STEP 1/256
IF (X^2+Z^2-1)^3-X^2*Z^3<0 THEN CALL PSET(X,Z,7)
NEXT X
NEXT Z
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET COLOR 7
END SUB
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
!'Cannabis Curve
SET WINDOW -3,3,-1,5
LET A=1
FOR T=0 TO 360 STEP 1/8
LET R=A*(1+9/10*COS(RAD(8*T)))*(1+COS(RAD(24*T))/10)*(9/10+COS(RAD(200*T))/10)*(1+SIN(RAD(T)))
LET X=R*COS(RAD(T))
LET Y=R*SIN(RAD(T))
PLOT LINES:X,Y;
NEXT T
END
!'Teardrop Curve
SET WINDOW -1.2,1.2,-1.2,1.2
DRAW GRID(.1,.1)
FOR M=0 TO 7
PLOT LINES
FOR T=0 TO 360
LET X=COS(RAD(T))
LET Y=SIN(RAD(T))*SIN(RAD(T/2))^M
PLOT LINES:X,Y;
NEXT T
NEXT M
END
!'Nested Polygon
SET WINDOW -1,1,-1,1
LET N=5
DIM X(N),Y(N),XX(N),YY(N)
FOR I=0 TO 359 STEP 360/N
LET K=K+1
LET X(K)=SIN(RAD(I))
LET Y(K)=COS(RAD(I))
PLOT LINES:X(K),Y(K);
NEXT I
PLOT LINES:X(1),Y(1)
!'LET C=0
!'SET AREA COLOR C
!'MAT PLOT AREA:X,Y
LET A=9
LET B=1
DO
FOR I=1 TO N
LET XX(I)=(A*X(I)+B*X(MOD(I,N)+1))/(A+B)
LET YY(I)=(A*Y(I)+B*Y(MOD(I,N)+1))/(A+B)
PLOT LINES:XX(I),YY(I);
NEXT I
PLOT LINES:XX(1),YY(1)
!'LET C=MOD(C+1,2)
!'SET AREA COLOR C
!'MAT PLOT AREA:XX,YY
MAT X=XX
MAT Y=YY
LOOP UNTIL SQR((X(2)-X(1))^2+(Y(2)-Y(1))^2)<.03
END
!'Truchet Tiling
CALL GINIT(600,600)
RANDOMIZE
LET H=50
FOR Y=H TO 600-H STEP 2*H
FOR X=H TO 600-H STEP 2*H
IF RND<.5 THEN CALL P1(X,Y,H) ELSE CALL P2(X,Y,H)
!' IF RND<.5 THEN CALL L1(X,Y,H) ELSE CALL L2(X,Y,H)
NEXT X
NEXT Y
END
EXTERNAL SUB P1(X,Y,H)
PLOT LINES
FOR I=270 TO 360
LET XX=X-H+H*COS(RAD(I))
LET YY=Y-H-H*SIN(RAD(I))
PLOT LINES:XX,YY;
NEXT I
PLOT LINES
FOR I=90 TO 180
LET XX=X+H+H*COS(RAD(I))
LET YY=Y+H-H*SIN(RAD(I))
PLOT LINES:XX,YY;
NEXT I
END SUB
EXTERNAL SUB P2(X,Y,H)
PLOT LINES
FOR I=180 TO 270
LET XX=X+H+H*COS(RAD(I))
LET YY=Y-H-H*SIN(RAD(I))
PLOT LINES:XX,YY;
NEXT I
PLOT LINES
FOR I=0 TO 90
LET XX=X-H+H*COS(RAD(I))
LET YY=Y+H-H*SIN(RAD(I))
PLOT LINES:XX,YY;
NEXT I
END SUB
EXTERNAL SUB L1(X,Y,H)
PLOT LINES:X,Y-H;X-H,Y
PLOT LINES:X+H,Y;X,Y+H
END SUB
EXTERNAL SUB L2(X,Y,H)
PLOT LINES:X,Y-H;X+H,Y
PLOT LINES:X-H,Y;X,Y+H
END SUB
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
SET LINE COLOR 7
END SUB
!'Spherical Code
CALL GINIT(600,600)
LET RR=150
LET X=300
LET Y=300
LET M=9
CALL CIRCLE(X,Y,RR,7)
LET T=360/M
LET R=1/(CSC(RAD(T/2))-1)*RR
FOR TH=0 TO 360 STEP T
CALL CIRCLE(X+(RR+R)*COS(RAD(TH)),Y-(RR+R)*SIN(RAD(TH)),R,7)
NEXT TH
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL SUB CIRCLE(X,Y,R,C)
SET COLOR C
DRAW CIRCLE WITH SCALE(R)*SHIFT(X,Y)
END SUB
!'Swirl
CALL GINIT(601,601)
SET WINDOW -300,300,300,-300
FOR N=1 TO 6
CLEAR
FOR Y=-300 TO 300
FOR X=-300 TO 300
IF X=0 AND Y=0 THEN LET T=0 ELSE LET T=ANGLE(X,Y)
LET R=SQR(X*X+Y*Y)
LET C=SIN(6*COS(RAD(R))-N*T)
CALL PSET(X,Y,128+C*128,128+C*128,128+C*128)
NEXT X
NEXT Y
WAIT DELAY 1
NEXT N
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB
EXTERNAL SUB PSET(X,Y,R,G,B)
LET RR=MIN(255,MAX(0,INT(R)))
LET GG=MIN(255,MAX(0,INT(G)))
LET BB=MIN(255,MAX(0,INT(B)))
SET COLOR COLORINDEX(RR/255,GG/255,BB/255)
PLOT POINTS:X,Y
END SUB
!'Maurer Rose
SET WINDOW -1,1,-1,1
RESTORE 1
READ N,D
1 DATA 4,119
2 DATA 6,71
3 DATA 3,29
4 DATA 3,41
5 DATA 3,61
6 DATA 3,131
7 DATA 3,149
8 DATA 4,13
9 DATA 4,31
10 DATA 4,41
11 DATA 4,71
12 DATA 4,83
13 DATA 4,101
14 DATA 4,149
15 DATA 5,31
16 DATA 5,83
FOR I=1 TO 360
LET T=T+D
LET R=SIN(N*RAD(T))
LET X=R*COS(RAD(T))
LET Y=R*SIN(RAD(T))
PLOT LINES:X,Y;
NEXT I
END
FOR x=1 TO 100001 STEP 4
PRINT
PRINT "X=";x
FOR n=1 TO 3
LET H=(((1+SQR(x))/2)^n-((1-SQR(x))/2)^n)/(((1+SQR(x))/2)-((1-SQR(x))/2))
PRINT n;H
NEXT n
NEXT X
PRINT
PRINT TIME-t0;"秒で計算しました"
PRINT DATE$;"/"; TIME$
END
基本的にフィボナッチ数列を求めるプログラムから開発しました。
一般的に知られているヒィボナッチ数列
X=5 のものです。これ以外にも一から奇数列に沢山あることがわかりました。
Ramanujan ζ(2n+1) 奇数の探究中です。
奇数列には、素数があります。
FOR n=1 TO 100
LET x=(6*n-1)/3
LET y=(6*n+1)/3
PRINT n;x+y;x;y
NEXT n
END
100 REM Haferman Carpet
110 REM http://mathworld.wolfram.com/HafermanCarpet.html
120 DIM h0(3,3),h1(3,3)
130 DATA 1,1,1
140 DATA 1,1,1
150 DATA 1,1,1
160 MAT READ h0
170 DATA 0,1,0
180 DATA 1,0,1
190 DATA 0,1,0
200 MAT READ h1
210 LET n=5
220 SET bitmap SIZE 3^n, 3^n
230 SET WINDOW 0,3^n-1, 0,3^n-1
240 MAT PLOT CELLS, IN 0,0; 3^n-1,3^n-1: h0
250 FOR k=n TO 1 STEP -1
260 PAUSE
270 LET s=3^k
280 FOR a=0 TO 3^n-s STEP s
290 FOR b=0 TO 3^n-s STEP s
300 ASK PIXEL VALUE(a, b) p
310 IF p=0 THEN
320 MAT PLOT CELLS, IN a,b;a+s-1,b+s-1: h0
330 ELSE
340 MAT PLOT CELLS, IN a,b;a+s-1,b+s-1: h1
350 END IF
360 NEXT b
370 NEXT a
380 NEXT k
390 END
! Cohen 2000 MOD(x,4)=1(-)Ramanujan ζ(2n+1) zeta(x)1000桁精度
OPTION ARITHMETIC DECIMAL_HIGH
PRINT DATE$;"/"; TIME$
LET t0=TIME
LET Na=0
FOR n=5 TO 9 STEP 4
LET Na=Na+2
LET f=((2*PI)^n)/(FACT(n+1)*(n-1))
LET S=0
LET w= INT((n+1)/4)
FOR k1=0 TO w
LET S=S+((-1)^(k1))*(n+1-4*k1)*comb(n+1,2*k1)*BERNOULLI(n+1-2*k1)*BERNOULLI(2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 365 !数値溢れ370まで
LET q=2*PI*k2
LET S1=S1+(EX(q)*((1+(4*PI*k2)/(n-1))-1))/((k2^n)*(EX(q)-1)^2)
NEXT k2
LET zeta=f*S-2*S1
PRINT n;zeta+Ramanujan(Na)
NEXT n
PRINT TIME-t0;"秒"
PRINT DATE$;"/"; TIME$
END
EXTERNAL FUNCTION Ramanujan(n) !zeta(x) MOD(x,4)=3
OPTION ARITHMETIC DECIMAL_HIGH
FOR n=1 TO n
LET f=2^(2*n)*pi^(2*n+1)
LET S=0
FOR k1=0 TO n+1
LET S=S+((-1)^(k1+1))*BERNOULLI(2*k1)/FACT(2*k1)*BERNOULLI(2*n+2-2*k1)/FACT(2*n+2-2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 360
LET q=2*PI*k2
LET S1=S1+(k2^(-2*n-1))/(EX(q)-1)
NEXT k2
LET Ramanujan=f*S-2*S1
NEXT n
END FUNCTION
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s=0
FOR i=0 TO k-2
LET s=s+comb(k,i)*b(i)
NEXT i
LET b(k-1)=-s/k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
!1000桁モードで利用する指数関数
EXTERNAL FUNCTION EX(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EX=s(1,1)
END FUNCTION
!1/tanh(pi) 参照 (93)(Cohen 2000). http://mathworld.wolfram.com/RiemannZetaFunction.html
OPTION ARITHMETIC DECIMAL_HIGH
LET t0=TIME
FOR n=5 TO 101 STEP 4 !1000桁なので、1つ求めるのに3分前後
PRINT n;Cohen(n)
NEXT n
PRINT TIME-t0;"秒"
END
EXTERNAL FUNCTION Cohen(n)
OPTION ARITHMETIC DECIMAL_HIGH
LET n=n
LET f=((2*PI)^n)/(FACT(n+1)*(n-1))
LET S=0
LET w= INT((n+1)/4)
FOR k1=0 TO w
LET S=S+((-1)^(k1))*(n+1-4*k1)*comb(n+1,2*k1)*BERNOULLI(n+1-2*k1)*BERNOULLI(2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 365 !数値溢れ370まで
LET q=2*PI*k2
LET S1=S1+(EX(q)*((1+(4*PI*k2)/(n-1))-1))/((k2^n)*(EX(q)-1)^2)
NEXT k2
LET Cohen=f*S-2*S1
END FUNCTION
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s=0
FOR i=0 TO k-2
LET s=s+comb(k,i)*b(i)
NEXT i
LET b(k-1)=- s / k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
!1000桁モードで利用する指数関数
EXTERNAL FUNCTION EX(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EX=s(1,1)
END FUNCTION
! 1/tanh(pi)
OPTION ARITHMETIC DECIMAL_HIGH
LET t0=TIME
LET x=PI
LET SINH1=0
LET COSH1=0
FOR n=0 TO 225 !225まで
LET SINH1=SINH1+x^(2*n+1)/FACT(2*n+1)
LET COSH1=COSH1+x^(2*n)/FACT(2*n)
PRINT n;1/(SINH1/COSH1)
NEXT n
PRINT SINH1/COSH1
PRINT 1/(SINH1/COSH1)
PRINT TIME-t0;"秒"
END
! ζ(2n) zeta(x)1000桁
OPTION ARITHMETIC DECIMAL_HIGH
LET t0=TIME
FOR n=2 TO 100 STEP 2 !452まで
LET z=2^(n-1)*ABS(BERNOULLI(n))*PI^n/FACT(n)
PRINT n;z
NEXT n
PRINT TIME-t0;"秒"
END
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s=0
FOR i=0 TO k-2
LET s=s+comb(k,i)*b(i)
NEXT i
LET b(k-1)=- s / k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
! Cohen 2000 MOD(x,4)=1(-)Ramanujan ζ(2n+1) zeta(x)1000桁精度
OPTION ARITHMETIC DECIMAL_HIGH
PRINT DATE$;"/"; TIME$
LET t0=TIME
FOR n=101 TO 105 STEP 4
LET Na=(N-1)/2
LET f=((2*PI)^n)/(FACT(n+1)*(n-1))
LET S=0
LET w= INT((n+1)/4)
FOR k1=0 TO w
LET S=S+((-1)^(k1))*(n+1-4*k1)*comb(n+1,2*k1)*BERNOULLI(n+1-2*k1)*BERNOULLI(2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 365 !数値溢れ370まで
LET q=2*PI*k2
LET S1=S1+(EX(q)*((1+(4*PI*k2)/(n-1))-1))/((k2^n)*(EX(q)-1)^2)
NEXT k2
LET zeta=f*S-2*S1
PRINT n;zeta+Ramanujan(Na)
NEXT n
PRINT TIME-t0;"秒"
PRINT DATE$;"/"; TIME$
END
EXTERNAL FUNCTION Ramanujan(n) !zeta(x) MOD(x,4)=3
OPTION ARITHMETIC DECIMAL_HIGH
FOR n=1 TO n
LET f=2^(2*n)*pi^(2*n+1)
LET S=0
FOR k1=0 TO n+1
LET S=S+((-1)^(k1+1))*BERNOULLI(2*k1)/FACT(2*k1)*BERNOULLI(2*n+2-2*k1)/FACT(2*n+2-2*k1)
NEXT k1
LET S1=0
FOR k2=1 TO 360
LET q=2*PI*k2
LET S1=S1+(k2^(-2*n-1))/(EX(q)-1)
NEXT k2
LET Ramanujan=f*S-2*S1
NEXT n
END FUNCTION
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s=0
FOR i=0 TO k-2
LET s=s+comb(k,i)*b(i)
NEXT i
LET b(k-1)=-s/k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
!1000桁モードで利用する指数関数
EXTERNAL FUNCTION EX(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EX=s(1,1)
END FUNCTION
LET format$="#." & REPEAT$("#",999)
LET t0=TIME
LET f=0
FOR s=1000 TO 1100 STEP 1
LET z=ZETA(s)
PRINT s;
PRINT USING format$:z
NEXT s
PRINT TIME-t0;"秒で計算しました"
PRINT DATE$;"/"; TIME$
END
EXTERNAL FUNCTION ZETA(s)
OPTION ARITHMETIC RATIONAL
LET f=0
FOR n=1 TO 10
LET f=f+1/n^s
NEXT n
LET ZETA=f
END FUNCTION
LET format$="#." & REPEAT$("#",999)
LET t0=TIME
LET f=0
LET s=3318
LET f=0
FOR n=1 TO 5
LET f=f+1/n^s
PRINT USING format$:f
NEXT n
PRINT s;
PRINT USING format$:f
PRINT TIME-t0;"秒で計算しました"
PRINT DATE$;"/"; TIME$
END
!zeta(-n)=bernoulli(n+1)/(n+1)*(-1)^n
OPTION ARITHMETIC RATIONAL
LET format$="#." & REPEAT$("#",999)
FOR n=0 TO 18
LET ZETA=BERNOULLI(n+1)/(n+1)*(-1)^n
! PRINT n;ROUND(ZETA,999) !1000桁モード
PRINT n;
PRINT USING format$:ZETA
NEXT n
END
EXTERNAL FUNCTION BERNOULLI(n) !'ベルヌーイ定数 ゼロ有り
OPTION ARITHMETIC RATIONAL
DIM b(0 TO n)
LET b(0)=1
IF n=0 THEN LET BERNOULLI=1
FOR k=2 TO n+1
LET s=0
FOR i=0 TO k-2
LET s=s+comb(k,i)*b(i)
NEXT i
LET b(k-1)=- s / k
LET BERNOULLI=b(k-1)
NEXT k
END FUNCTION
1000桁モードにすると誤差が出てます。
高精度計算サイトで50桁の精度確認済です。以外の精度は、わかりません。
1000桁モード用
!zeta(-n)=bernoulli(n+1)/(n+1)*(-1)^n
OPTION ARITHMETIC DECIMAL_HIGH
FOR n=1 TO 100 !最小値1から
LET ZETA=BERNOULLI(n+1)/(n+1)*(-1)^n
PRINT n;ZETA
NEXT n
END
EXTERNAL FUNCTION BERNOULLI(K) !'ベルヌーイ定数
OPTION ARITHMETIC DECIMAL_HIGH
LET C=1
LET D=1
LET N=K/2
IF K=1 THEN
LET BERNOULLI=-1/2
ELSEIF MOD(K,2)=1 THEN
LET BERNOULLI=0
ELSE
FOR M=N TO 1 STEP-1
LET T=T+(-1)^M*D*M^(K-1)
LET C=C*(N+M+1)/(N-M+1)
LET D=D+C
NEXT M
LET BERNOULLI=-T*K/(2^K*(2^K-1))
END IF
END FUNCTION
! 1000桁モードで利用する指数関数
DECLARE EXTERNAL FUNCTION EXP
REM カイ二乗分布の確率分布関数による計算。数値積分ではないことに注意。
!マチン（Machin）の公式 π/4=4*ArcTan(1/5)-ArcTan(1/239)
OPTION ARITHMETIC DECIMAL_HIGH !1000桁モード
LET p=0
!テイラー展開より、ArcTan(x)=x-x^3/3+x^5/5-x^7/7+ …
!第n項 {16/5^(2n-1)-4/239^(2n-1)}/(2n-1) 符号はnが奇数なら正
LET k=1
LET t=16/5
DO
LET last=p
LET p=p+t/k
LET t=t/(-5*5)
LET k=k+2
LOOP WHILE p<>last
PRINT (k-1)/2 !繰り返し回数 debug
LET k=1
LET t=4/239
DO
LET last=p
LET p=p-t/k
LET t=t/(-239*239)
LET k=k+2
LOOP WHILE p<>last
PRINT (k-1)/2 !繰り返し回数 debug
REM カイ二乗分布の確率分布関数による計算。1000桁モードで実行のこと。数値積分ではないことに注意。ここからENDまで。
OPEN #1:NAME "D:\zzzzzzzzzzz.txt"
ERASE #1
LET a1=0
LET a2=0
LET b1=0
LET b2=400
PRINT "nを半角英数で入力してください。(例)2"
INPUT n
FUNCTION GAMMA(w)
IF MOD(w,2)=1 THEN GOTO 100
IF MOD(w,2)=0 THEN GOTO 200
100 LET V=1
FOR I=w TO 1 STEP -2
LET V=I/2*V
NEXT I
LET GAMMA=V*SQR(p)
GOTO 300
200 LET V=1
FOR I=w/2 TO 1 STEP -1
LET V=I*V
NEXT I
LET GAMMA=V
GOTO 300
300 END FUNCTION
LET SUN=1
LET TUE=1
FOR i=1 TO 1000
IF TUE<10^(-1000) THEN EXIT FOR ! TUE<10^(-1000)の(かっこ内)の累乗の数値を変えて、計算精度を落として、早く終了させることができる。
LET TUE=TUE*chisquared/(n+2*i)
LET SUN=SUN+TUE
NEXT i
LET bb1000=INT(SQR(chisquared/2)^n/GAMMA(n)*EXP(-chisquared/2)*SUN*10^1000+0.5)/10^1000
PRINT bb1000
PRINT #1: bb1000
LET bbketa=INT(bb1000*10^keta+0.5)/10^keta
PRINT bbketa
PRINT #1: bbketa
CLOSE #1
END
EXTERNAL FUNCTION EXP(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EXP=s(1,1)
END FUNCTION
! 1000桁モードで利用する指数関数
DECLARE EXTERNAL FUNCTION EXP
REM カイ二乗分布の確率分布関数による計算。数値積分ではないことに注意。
!マチン（Machin）の公式 π/4=4*ArcTan(1/5)-ArcTan(1/239)
OPTION ARITHMETIC DECIMAL_HIGH !1000桁モード
LET p=0
!テイラー展開より、ArcTan(x)=x-x^3/3+x^5/5-x^7/7+ …
!第n項 {16/5^(2n-1)-4/239^(2n-1)}/(2n-1) 符号はnが奇数なら正
LET k=1
LET t=16/5
DO
LET last=p
LET p=p+t/k
LET t=t/(-5*5)
LET k=k+2
LOOP WHILE p<>last
PRINT (k-1)/2 !繰り返し回数 debug
LET k=1
LET t=4/239
DO
LET last=p
LET p=p-t/k
LET t=t/(-239*239)
LET k=k+2
LOOP WHILE p<>last
PRINT (k-1)/2 !繰り返し回数 debug
OPEN #1:NAME "D:\zzzzzzzzzzz.txt"
ERASE #1
LET a1=0
LET a2=0
LET b1=0
LET b2=400
PRINT "nを半角英数で入力してください。(例)2"
INPUT n
FUNCTION GAMMA(w)
IF MOD(w,2)=1 THEN GOTO 100
IF MOD(w,2)=0 THEN GOTO 200
100 LET V=1
FOR I=w TO 1 STEP -2
LET V=I/2*V
NEXT I
LET GAMMA=V*SQR(p)
GOTO 300
200 LET V=1
FOR I=w/2 TO 1 STEP -1
LET V=I*V
NEXT I
LET GAMMA=V
GOTO 300
300 END FUNCTION
REM カイ二乗分布の確率分布関数による計算。1000桁モードで実行のこと。数値積分ではないことに注意。ここからENDまで。
DO
LET bm1=(b1+b2)/2
LET SUN=1
LET TUE=1
FOR J=1 TO 1000
IF TUE<10^(-1000) THEN EXIT FOR ! TUE<10^(-1000)の(かっこ内)の累乗の数値を変えて、計算精度を落として、早く終了させることができる。 ! TUE<10^(-12)の(かっこ内)の累乗の数値を変えて、計算精度を落として、早く終了させることができる。
LET TUE=TUE*bm1/(n+2*J)
LET SUN=SUN+TUE
NEXT J
LET bm1sm11000=INT(SQR(bm1/2)^n/GAMMA(n)*EXP(-bm1/2)*SUN*10^1000+0.5)/10^1000
IF bm1=a1 OR bm1=a2 OR bm1=am1 OR bm1=b1 OR bm1=b2 THEN EXIT DO
IF bm1sm11000<alpha THEN LET b1=bm1
IF alpha=<bm1sm11000 THEN LET b2=bm1
PRINT b1 ! 画面に表示する演算経過PRINT b1を消した方が数倍早くなる。
PRINT #1: b1 !残しておくと演算経過をD:\に残せて良い場合もあるが、場合によってはPRINT #1: b1を消した方が早くなる。
LET b11000=INT(b1*10^keta+0.5)/10^keta
LET b21000=INT(b2*10^keta+0.5)/10^keta
IF b11000=b21000 THEN LET bb=b11000
IF b11000=b21000 THEN EXIT DO
LOOP
PRINT bb
PRINT #1: bb
CLOSE #1
END
EXTERNAL FUNCTION EXP(x)
OPTION ARITHMETIC DECIMAL_HIGH
FUNCTION s(y,n)
LET t=y*x/n
IF ABS(t)<=EPS(0) THEN
LET s=y+t
ELSE
LET s=y+s(t,n+1)
END IF
END FUNCTION
LET EXP=s(1,1)
END FUNCTION
SET BITMAP SIZE 800,640
SET WINDOW 125,150,29,49 !'日本
!''''SET BITMAP SIZE 600,600
!''''SET WINDOW 129.5,132.5,31,34
OPEN #1:NAME "world_50m.txt" !'「world_10m.txt」「world_50m.txt」「world_110m.txt」のいずれか。パスを指定。
SET #1: ENDOFLINE CHR$(10)
DO
INPUT #1,IF MISSING THEN EXIT DO:A$
IF A$<>"" THEN
LET Z=POS(A$," ")
LET X=VAL(A$(1:Z))
LET Y=VAL(A$(Z+1:LEN(A$)))
PLOT LINES:X,Y;
ELSE
PLOT LINES
END IF
LOOP
CLOSE #1
END
SET BITMAP SIZE 800,600
SET WINDOW -180,180,-3,3
OPEN #1:NAME "world_50m.txt" !'「world_10m.txt」「world_50m.txt」「world_110m.txt」のいずれか。パスを指定。
SET #1: ENDOFLINE CHR$(10)
DO
INPUT #1,IF MISSING THEN EXIT DO:A$
IF A$<>"" THEN
LET Z=POS(A$," ")
LET KEIDO=VAL(A$(1:Z))
LET IDO=VAL(A$(Z+1:LEN(A$)))
LET X=KEIDO
LET Y=INVGD(RAD(IDO)) !'メルカトル図法
!' LET Y=5/4*INVGD(4/5*RAD(IDO)) !'ミラー図法
PLOT LINES:X,Y;
ELSE
PLOT LINES
END IF
LOOP
CLOSE #1
SET LINE STYLE 3
FOR KEIDO=-180 TO 180 STEP 30
FOR IDO=-90 TO 90 STEP 15
LET X=KEIDO
LET Y=INVGD(RAD(IDO))
!' LET Y=5/4*INVGD(4/5*RAD(IDO))
PLOT LINES:X,Y;
NEXT IDO
PLOT LINES
NEXT KEIDO
FOR IDO=-90 TO 90 STEP 15
FOR KEIDO=-180 TO 180 STEP 30
LET X=KEIDO
LET Y=INVGD(RAD(IDO))
!' LET Y=5/4*INVGD(4/5*RAD(IDO))
PLOT LINES:X,Y;
NEXT KEIDO
PLOT LINES
NEXT IDO
END
EXTERNAL FUNCTION INVGD(X) !'逆グーデルマン関数
LET INVGD=ATANH(SIN(X))
END FUNCTION
EXTERNAL FUNCTION ATANH(X)
IF ABS(X)=1 THEN
LET ATANH=SGN(X)*9999 !' 無限大
ELSE
LET ATANH=LOG((1+X)/(1-X))/2 !'arc-hyperbolic tangent
END IF
END FUNCTION
SET BITMAP SIZE 800,400
SET WINDOW -180,180,-90,90
OPEN #1:NAME "world_50m.txt" !'「world_10m.txt」「world_50m.txt」「world_110m.txt」のいずれか。パスを指定。
SET #1: ENDOFLINE CHR$(10)
DO
INPUT #1,IF MISSING THEN EXIT DO:A$
IF A$<>"" THEN
LET Z=POS(A$," ")
LET KEIDO=VAL(A$(1:Z))
LET IDO=VAL(A$(Z+1:LEN(A$)))
LET X=KEIDO*COS(RAD(IDO))
LET Y=IDO
PLOT LINES:X,Y;
ELSE
PLOT LINES
END IF
LOOP
CLOSE #1
SET LINE STYLE 3
FOR KEIDO=-180 TO 180 STEP 30
FOR IDO=-90 TO 90 STEP 15
LET X=KEIDO*COS(RAD(IDO))
LET Y=IDO
PLOT LINES:X,Y;
NEXT IDO
PLOT LINES
NEXT KEIDO
FOR IDO=-90 TO 90 STEP 15
FOR KEIDO=-180 TO 180 STEP 30
LET X=KEIDO*COS(RAD(IDO))
LET Y=IDO
PLOT LINES:X,Y;
NEXT KEIDO
PLOT LINES
NEXT IDO
END
SET BITMAP SIZE 800,400
SET WINDOW -180,180,-PI/2,PI/2
OPEN #1:NAME "world_50m.txt" !'「world_10m.txt」「world_50m.txt」「world_110m.txt」のいずれか。パスを指定。
SET #1: ENDOFLINE CHR$(10)
DO
INPUT #1,IF MISSING THEN EXIT DO:A$
IF A$<>"" THEN
LET Z=POS(A$," ")
LET KEIDO=VAL(A$(1:Z))
LET IDO=VAL(A$(Z+1:LEN(A$)))
LET TH=0
FOR J=1 TO 10
LET TH=TH-(SIN(2*TH)+2*TH-PI*SIN(RAD(IDO)))/(2*COS(2*TH)+2) !'ニュートン法
NEXT J
LET X=KEIDO*COS(TH)
LET Y=PI/2*SIN(TH)
PLOT LINES:X,Y;
ELSE
PLOT LINES
END IF
LOOP
CLOSE #1
SET LINE STYLE 3
FOR KEIDO=-180 TO 180 STEP 30
FOR IDO=-90 TO 90 STEP 15
LET TH=0
FOR J=1 TO 10
LET TH=TH-(SIN(2*TH)+2*TH-PI*SIN(RAD(IDO)))/(2*COS(2*TH)+2)
NEXT J
LET X=KEIDO*COS(TH)
LET Y=PI/2*SIN(TH)
PLOT LINES:X,Y;
NEXT IDO
PLOT LINES
NEXT KEIDO
FOR IDO=-90 TO 90 STEP 15
FOR KEIDO=-180 TO 180 STEP 30
LET TH=0
FOR J=1 TO 10
LET TH=TH-(SIN(2*TH)+2*TH-PI*SIN(RAD(IDO)))/(2*COS(2*TH)+2)
NEXT J
LET X=KEIDO*COS(TH)
LET Y=PI/2*SIN(TH)
PLOT LINES:X,Y;
NEXT KEIDO
PLOT LINES
NEXT IDO
END
CALL GINIT
!'SET WINDOW 0,24,-90,90
SET WINDOW 7,3.5,-24,30 !'オリオン座
OPEN #1:NAME "catalog.dat" !'パスを指定。
SET #1: ENDOFLINE CHR$(10)
DO
LINE INPUT #1,IF MISSING THEN EXIT DO:A$
IF A$(76:77)<>" " THEN
LET RA_HOUR=VAL(A$(76:77))
LET RA_MIN=VAL(A$(78:79))
LET RA_SEC=VAL(A$(80:83))
LET DEC_DEG=VAL(A$(84:86))
LET DEC_ARMIN=VAL(A$(87:88))
LET DEC_ARSEC=VAL(A$(89:90))
LET VMAG=VAL(A$(103:106))
!' LET B_V=VAL(A$(110:113))
LET X=RA2POS(RA_HOUR,RA_MIN,RA_SEC)
LET Y=DEC2POS(DEC_DEG,DEC_ARMIN,DEC_ARSEC)
SELECT CASE VMAG
CASE IS<1
CALL CIRCLE(X,Y,5,7)
CASE 1 TO 2
CALL CIRCLE(X,Y,4,7)
CASE 2 TO 3
CALL CIRCLE(X,Y,3,7)
CASE 3 TO 4
CALL CIRCLE(X,Y,2,7)
CASE IS>4
CALL PSET(X,Y,7)
END SELECT
END IF
LOOP
CLOSE #1
END
EXTERNAL FUNCTION RA2POS(HOUR, MIN, SEC)
LET RA2POS= HOUR + MIN/60 + SEC/3600
END FUNCTION
EXTERNAL FUNCTION DEC2POS(DEG, ARCMIN, ARCSEC)
LET S= DEG
IF DEG < 0 THEN
LET S=S-ARCMIN/60-ARCSEC/3600
ELSE
LET S=S+ARCMIN/60+ARCSEC/3600
END IF
LET DEC2POS=S
END FUNCTION
EXTERNAL SUB PSET(X,Y,C)
SET POINT COLOR C
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GINIT
!'SET BITMAP SIZE XSIZE,YSIZE
!'SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
CLEAR
END SUB
EXTERNAL SUB CIRCLE(X,Y,RR,C)
ASK BITMAP SIZE XSIZE,YSIZE
ASK WINDOW X1,X2,Y1,Y2
SET COLOR C
DRAW DISK WITH SCALE(RR*(X2-X1)/XSIZE,RR*(Y2-Y1)/YSIZE)*SHIFT(X,Y)
END SUB
OPTION ARITHMETIC RATIONAL !有理数モード
FOR N=1681 TO 1848 !K=13 19110297600/131710070791
LET P=MOD(N,2)/2+MOD(N,3)/3-MOD(N,6)/6+MOD(N,5)/5-MOD(N,10)/10-MOD(N,15)/15+MOD(N,30)/30+MOD(N,7)/7-MOD(N,14)/14-MOD(N,21)/21+MOD(N,42)/42-MOD(N,35)/35+MOD(N,70)/70+MOD(N,105)/105-MOD(N,210)/210+MOD(N,11)/11-MOD(N,22)/22-MOD(N,33)/33+MOD(N,66)/66-MOD(N,55)/55+MOD(N,110)/110+MOD(N,165)/165-MOD(N,330)/330-MOD(N,77)/77+MOD(N,154)/154+MOD(N,231)/231-MOD(N,462)/462+MOD(N,385)/385-MOD(N,770)/770-MOD(N,1155)/1155+MOD(N,2310)/2310+MOD(N,13)/13-MOD(N,26)/26-MOD(N,39)/39+MOD(N,78)/78-MOD(N,65)/65+MOD(N,130)/130+MOD(N,195)/195-MOD(N,390)/390-MOD(N,91)/91+MOD(N,182)/182+MOD(N,273)/273-MOD(N,546)/546+MOD(N,455)/455-MOD(N,910)/910-MOD(N,1365)/1365+MOD(N,2730)/2730-MOD(N,143)/143+MOD(N,286)/286+MOD(N,429)/429-MOD(N,858)/858+MOD(N,715)/715-MOD(N,1430)/1430-MOD(N,2145)/2145+MOD(N,4290)/4290+MOD(N,1001)/1001-MOD(N,2002)/2002-MOD(N,3003)/3003+MOD(N,6006)/6006-MOD(N,5005)/5005+MOD(N,10010)/10010+MOD(N,15015)/15015-MOD(N,30030)/30030+MOD(N,17)/17-MOD(N,34)/34-MOD(N,51)/51+MOD(N,102)/102-MOD(N,85)/85+MOD(N,170)/170+MOD(N,255)/255-MOD(N,510)/510-MOD(N,119)/119+MOD(N,238)/238+MOD(N,357)/357
長いので、途中省略
LET P=P+MOD(N,3951302123730)/3951302123730+MOD(N,921970495537)/921970495537-MOD(N,1843940991074)/1843940991074-MOD(N,2765911486611)/2765911486611+MOD(N,5531822973222)/5531822973222-MOD(N,4609852477685)/4609852477685+MOD(N,9219704955370)/9219704955370+MOD(N,13829557433055)/13829557433055-MOD(N,27659114866110)/27659114866110+MOD(N,1448810778701)/1448810778701-MOD(N,2897621557402)/2897621557402-MOD(N,4346432336103)/4346432336103+MOD(N,8692864672206)/8692864672206-MOD(N,7244053893505)/7244053893505+MOD(N,14488107787010)/14488107787010+MOD(N,21732161680515)/21732161680515-MOD(N,43464323361030)/43464323361030-MOD(N,10141675450907)/10141675450907+MOD(N,20283350901814)/20283350901814+MOD(N,30425026352721)/30425026352721-MOD(N,60850052705442)/60850052705442+MOD(N,50708377254535)/50708377254535-MOD(N,101416754509070)/101416754509070-MOD(N,152125131763605)/152125131763605+MOD(N,304250263527210)/304250263527210
LET p1=P*131710070791
PRINT STR$(p1)!&","; !168個
NEXT N
END
----------------------------------------
DATA を見ると
!OPTION ARITHMETIC RATIONAL !有理数モード
LET N=49 !K=4 8/35
LET P=MOD(N,2)/2+MOD(N,3)/3-MOD(N,6)/6+MOD(N,5)/5-MOD(N,10)/10-MOD(N,15)/15+MOD(N,30)/30+MOD(N,7)/7-MOD(N,14)/14-MOD(N,21)/21+MOD(N,42)/42-MOD(N,35)/35+MOD(N,70)/70+MOD(N,105)/105-MOD(N,210)/210
LET p1=P*35
LET R=72 !DATAの個数(120-49+1)
DIM A(R)
LET A(1)=P1 !p1=28
LET S=P1
!PRINT 49;S
LET R=2
FOR N=49+1 TO 120 STEP 1
IF ISPRIME(N)=1 THEN
LET S=S-(-27 ) !35-8
! PRINT n;S
LET A(R)=S
LET R=R+1
ELSE
LET S=S+(-8 ) !等差減少
! PRINT n;S
LET A(R)=S
LET R=R+1
END IF
NEXT N
!FOR R=1 TO 72
! PRINT A(R) !DATA プリント
!NEXT R
LET R=1
FOR N=49 TO 120 !K=4 8/35
LET pn=(n*8+A(R))/35
PRINT n;pn+3
LET R=R+1
NEXT n
END
EXTERNAL FUNCTION ISPRIME(N)
! OPTION ARITHMETIC RATIONAL
IF N = 2 THEN
LET ISPRIME=1
EXIT FUNCTION
END IF
IF N = 1 OR MOD(N , 2) = 0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
LET D = (N - 1) / 2
LET S = 0
DO WHILE MOD(D , 2) = 0
LET D = INT(D / 2)
LET S=S+1
LOOP
FOR I=1 TO 10
LET ISP=0
READ A !' n < 341550071728321 なら a = 2, 3, 5, 7, 11, 13, 17
DATA 2,3,5,7,11,13,17,23,29,31
LET ISP = 0
LET R = POWMOD(A, D, N)
IF R = 1 OR R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
FOR J = 0 TO S-1
IF R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
NEXT J
IF ISP=0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
NEXT I
LET ISPRIME=1
END FUNCTION
EXTERNAL FUNCTION POWMOD(B,P,M)
! OPTION ARITHMETIC RATIONAL
LET RESULT = 1
DO WHILE P > 0
IF MOD(P , 2)= 1 THEN
LET RESULT = MOD(RESULT * B , M)
END IF
LET B = MOD(B * B, M)
LET P = INT(P / 2)
LOOP
LET POWMOD=RESULT
END FUNCTION
!OPTION ARITHMETIC RATIONAL !有理数モード
LET R=360 !DATAの個数(2208-1849+1)
DIM A(R)
LET S=45086430862710
LET A(1)=S
LET R=2
FOR N=1849+1 TO 2208 STEP 1
IF ISPRIME(N)=1 THEN
LET S=S-(-4860900544813 ) !5663533044013-802632499200
! PRINT n;S
LET A(R)=S
LET R=R+1
ELSE
LET S=S+(-802632499200 )
! PRINT n;S
LET A(R)=S
LET R=R+1
END IF
NEXT N
LET R=1
FOR N=1849 TO 2208 !K=14 802632499200/5663533044013
LET pn=(n*802632499200+A(R))/5663533044013
PRINT n;pn+13
LET R=R+1
NEXT n
LET R=600 !DATAの個数(2808-2209+1)
DIM B(R)
LET S=99561214908855
LET B(1)=S
LET R=2
FOR N=2209+1 TO 2808 STEP 1 !CASE 2209 TO 2808
IF ISPRIME(N)=1 THEN
LET S=S-(-9968041656757 )!11573306655157-1605264998400
! PRINT n;S
LET B(R)=S
LET R=R+1
ELSE
LET S=S+(-1605264998400 )
! PRINT n;S
LET B(R)=S
LET R=R+1
END IF
NEXT N
LET R=1
FOR N=2209 TO 2808 !K=15 1605264998400/11573306655157
LET pn=(n*1605264998400+B(R))/11573306655157
PRINT n;pn+14
LET R=R+1
NEXT n
LET R=672 !DATAの個数(3480-2809+1)
DIM C(R)
LET S=553533983592098
LET C(1)=S
LET R=2
FOR N=2809+1 TO 3480 STEP 1
IF ISPRIME(N)=1 THEN
LET S=S-(-40762420985117) !47183480978717-6421059993600
! PRINT n;S
LET C(R)=S
LET R=R+1
ELSE
LET S=S+(-6421059993600)
! PRINT n;S
LET C(R)=S
LET R=R+1
END IF
NEXT N
LET R=1
FOR N=2809 TO 3480 !K=16 6421059993600/47183480978717
LET pn=(n*6421059993600+C(R))/47183480978717
PRINT n;pn+15
LET R=R+1
NEXT n
END
EXTERNAL FUNCTION ISPRIME(N)
! OPTION ARITHMETIC RATIONAL
IF N = 2 THEN
LET ISPRIME=1
EXIT FUNCTION
END IF
IF N = 1 OR MOD(N , 2) = 0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
LET D = (N - 1) / 2
LET S = 0
DO WHILE MOD(D , 2) = 0
LET D = INT(D / 2)
LET S=S+1
LOOP
FOR I=1 TO 10
LET ISP=0
READ A !' n < 341550071728321 なら a = 2, 3, 5, 7, 11, 13, 17
DATA 2,3,5,7,11,13,17,23,29,31
LET ISP = 0
LET R = POWMOD(A, D, N)
IF R = 1 OR R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
FOR J = 0 TO S-1
IF R = N - 1 THEN
LET ISP = 1
END IF
LET R = POWMOD(R, 2, N)
NEXT J
IF ISP=0 THEN
LET ISPRIME=0
EXIT FUNCTION
END IF
NEXT I
LET ISPRIME=1
END FUNCTION
EXTERNAL FUNCTION POWMOD(B,P,M)
! OPTION ARITHMETIC RATIONAL
LET RESULT = 1
DO WHILE P > 0
IF MOD(P , 2)= 1 THEN
LET RESULT = MOD(RESULT * B , M)
END IF
LET B = MOD(B * B, M)
LET P = INT(P / 2)
LOOP
LET POWMOD=RESULT
END FUNCTION
!---------------------------------------- Ver.767 以前の起動時文字サイズ設定
SET TEXT font "ＭＳ ゴシック",10
SET TEXT HEIGHT ABS(worldy(11)-worldy(0))
!----------------------------------------
OPTION ARITHMETIC NATIVE
LET T=TIME
LET ST=1000000
FOR I=1 TO ST*10 STEP ST
LET L=PRIMECOUNT(I,I+ST-1)
LET S=S+L
PRINT I+ST-1;":";L;S
NEXT I
PRINT TIME-T
LET T=TIME
PRINT ST*10;":";PRIMECOUNT(1,ST*10)
PRINT TIME-T
END
EXTERNAL FUNCTION PRIMECOUNT(S,E)
OPTION ARITHMETIC NATIVE
FOR I=S TO E
LET FL=0
FOR J=2 TO INT(SQR(I))
IF MOD(I,J)=0 THEN
LET FL=1
EXIT FOR
END IF
NEXT J
IF I>=2 AND FL=0 THEN LET C=C+1
NEXT I
LET PRIMECOUNT=C
END FUNCTION
OPTION CHARACTER BYTE
OPEN #1:NAME "primecount.dll"
DO
READ IF MISSING THEN EXIT DO: X$
FOR I=1 TO LEN(X$) STEP 2
PRINT #1:CHR$(BVAL(MID$(X$,I,2),16));
NEXT I
LOOP
DATA "4D5A90000300000004000000FFFF0000B800000000000000400000000000000000000000000000000000000000000000000000000000000000000000000100000E1FBA0E00B4"
DATA "09CD21B8014CCD21546869732070726F6772616D2063616E6E6F742062652072756E20696E20444F53206D6F64652E0D0D0A2400000000000000B5F57342F1941D11F1941D11"
DATA "F1941D11F8EC8E11F3941D11F1941C11B6941D11EFC68E11F2941D11EFC68811F0941D119EE2B611E5941D119EE28311E8941D119EE2B711A6941D11EA09B611F0941D11EA09"
DATA "8611F0941D11EA098011F0941D1152696368F1941D11000000000000000000000000000000000000000000000000504500004C010300256F73560000000000000000E0000221"
DATA "0B010A00007000000010000000B00000C028010000C0000000300100000000100010000000020000050001000000000005000100000000000040010000100000000000000200"
DATA "4001000010000010000000001000001000000000000010000000CC3001005000000000300100CC0000000000000000000000000000000000000000000000000000001C310100"
DATA "1000000000000000000000000000000000000000000000000000000000000000000000008C2A0100480000000000000000000000000000000000000000000000000000000000"
DATA "0000000000000000000000000000555058300000000000B00000001000000000000000040000000000000000000000000000800000E055505831000000000070000000C00000"
DATA "006C000000040000000000000000000000000000400000E0555058320000000000100000003001000002000000700000000000000000000000000000400000C0000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000332E393100555058210D090208CC53114CCA1B3E25FA090100B768000000DC0000260A0031FEFFFFFF558BEC83E4C08B450CDD0083EC34535657E80A0004F2"
DATA "8B4D10DD018BF88BF2BEFBFFC70D3BF20F8F160100007C083BF80F870C098D4C242851FFB1DBEF041C516A016A000352503895988B5C24408B44DB76BBFD243C83C424890620"
DATA "890E243B032C3FD15BB76D9B000A3B132841C50BC70918DB96DDB302071C000FDF6CDD293807BEEDDEBE2033FF897C0D8D77025203FC9608DD1C24ED7F2BEF5D02CCDC545908"
DATA "DFE0F6C40175368B0DBAFFFFFB20575653521A0C0BC2741D83C60183D700897424303F34EFBEFFEE4930D8D92B417BD4EB08700168DDD885DB16DEBDFC7C207F07837C027217"
DATA "06180075100008DDCCEDFBC750C48CBC0C834CD3006FDDDB93C08C63FF007F0E8BF83903200F866EF6FFB9530F2D925F5E5B8BE55DC3CC00ADFDB7C277FF1433C9890C012804"
DATA "3BC17E0A50FF150ABB6EBB77A0E856041A10420C503C87AFFDDEBC085268F96A0377489E02BA6F6F6F2320C3B8131319A304D020C705052419B98CDC090A0F2809C32CC6BE66"
DATA "A4FC30652C34183832D68C5C12913C810940CEF066E408E3446FC38BFFF471C2B377FF018F837D080074050A135BDBE2C253577D85BFE1BFA50BC07D1447610CF7D8F7DA83D8"
DATA "08E99ACE7513890E1B18131A145F776B2E181416751BDC143E33ECDFBAEED2F7F1070C05C20B4F794EEB538BD81CBBFF7F655418D1EBD1D9D1EAD1D80BDB75F424C8F7B9DDEF"
DATA "B6644491041403D1720E3B247708074DB735DC2876082B4F1B1118070C10B0FFAD6D4D07777B83DA005F5BC21000CC00D0BE2C9C833D05ED0F84861308DEFE50D88C0FAEBD76"
DATA "0425807F103D801FF6F2F6DF04750FD93C24668B040383E07FF87F8D76C3DD77B727855530EB00F30F7E2C660F28B25658BA6EA15007C803F87360045E2ECDED7EC018540580"
DATA "FAD0D3CAA9DF3ADE1550504C3DFF03DE7D11F3CA3D32D6352CB7040A7F0BD6FDDD4BC30ADD4F78FF2EFF7B24BAED039044D483C2140808B1851F7703048914DC1383FA102EDB"
DATA "4BF766814A79D8C2C1015E0B3458B335215A0CB08340BBDD01BB955CC866D9EE69C21D197001749F8B6C08562A0760265CC9B110822EAFF96EB3E3588019F4FB0419C38D95DB"
DATA "1F0C7F11B1529B29AD74516681097F87EF788C022C1981A9B680751FD9FA6DD872CBCBDF8085C315BA95190D96BEB9ED6710E9251A17F07F752CA9270FFE5E9A16222568081E"
DATA "EBCC4198EB22E57F4FCE16F2EB255174B0DDD8DB2D1632D9E9A280B8A95C66DA1810FE40235AC3EF34C52D826BABF0C8EECBF82C196E3BECC22CDDC9C31B111804C8BE8C3D84"
DATA "58EF74D32C20F0D9C0D9AE61DA3A59DF84107D980B4BDBFF1FBD85C0743CDEE985D2791ED94C8BC881E3C75FBFF19E81C10283D000FB83D22C7272166C2C1D17D8DA5EFB37D2"
DATA "141CC21575B8D95C530319D8DCDE8E6A0868BEBB602AAC70C3B76FAB88C37A0C756E750733C033FAFECE6E06C30F1E6F1893EBE90629B7DB75C73E10A3CC400F299209DF8829"
DATA "EC969E6523C9791B5ECF0F28D7BB56B3BB782008266117D00A21AFFAFBBABB594E0BFF05338462C01F0EEBC9ECEFDF5FE63BC7755B393D177E81FF0D07897DFC10162BFD7BDC"
DATA "75055E9C397D102C2F64B1677D2C93C745FCFEFA06404F47EBE16B48260E6CD0E92181BFB7BB2AC3EB6ADF0275590C1A6814E96EE93F96E4206959598BF03BF79E0C43B0C57E"
DATA "EF56FF353305DFA4E415D062ED2BD07B17D5378B2B14B6FBFB972506834E04FFEB18151FEA597505845DFDFCC3C20324572E015933C040F1C20C6F70F2B0650C6380F9BF8B5D"
DATA "088FEDFD771D8945E485F6750C3915E47BC55CAEE976FB65FC003BF0AD83FEA52EA12390782EE09A83084E812D18E400F6ED9CD92796114C056742C01261E13BC9832E0527FE"
DATA "C3245FAC70B68187501357742FF6BA77D8520611D5F66AB28DD96ED8264F340321689FDD0621657F648B09EB1D0D0D36B804EC8B530932132D5AB00B94E5BF65E81FDA4AB409"
DATA "C4F7D14A99DCC48511B72EED7508C18B550C1DC40C3FA5CB595D1822E5562FEFBAF68BF1C6460E7E632A1CB88946486C898E020BB70E046889648B7208C231BEFBD80874128B"
DATA "07D5C08548708A387D83DBDED1E08B46CC45D4C874160A081F70B7EC2E084730FC0415F640706B775BA94E0315026401EB0AB8590393EDB740041CC65E860405DBDD0B05FA8E"
DATA "8D4DF03A07E48B420FFE42E9C4BE067AA3D665EB0C460FB6DB646FC70E3AE1A65975F11C591D78C3B7250A35E502DCF08B89BC8A97DBFF05168A068A09880E468A0E8808C18A"
DATA "84C9B0D26FFF75F35E384DFC7407ECF8836070FD77737DBB2D24098AC375F02E74158B96AD6BDB8F4A128A123ACA36401743F5051FB6FDBB401B36EB0B80F965740C044519EF"
DATA "8BD0FBFF67FF4880383074FA8B8E81538A183A195B7501488A0A404288220223BBF4F68047005E819FE13816BB74DC18907A05953BF16C2B70045D1B51518A9FB6B1F66D1402"
DATA "1074198D37F050E7F8B62F18BA2889CC5F4804EB1118080CB4ED4515130818AD06E71AC15D653AE0FA5D7866074D097D5BEEF085EF423F2D931439411C40A503F70A1BBF65DD"
DATA "3DAC1E5E3832086B5A5D6848326412DF3E5311A184693F1CC7417BF8BB6FE13BD975220A42486A165E8930AF80F8B7AD21D9F7F25B9D39A776D96EDF766F040C7E05B4EB02F2"
DATA "83C00939C77709B6F1C2CF3A22EBC357AE18741EAD141B5EFAB7BB270F9FC05A833A2D0F94C18BE3CB8BC1C7FF37FECED98B7D553F2D8BF37506C6032D8D7301EC235CD87E00"
DATA "7E158A4E0154F0FE8B808A00B7DB5BE38A004606453845183DC0036E03F0BFB5D40C56B579CB3D052BDE035D328CF00381A1A0530EA73CE15F686F06748D4E028F7503C60645"
DATA "8B470CDADC68F1ED2F070448790662C4012D6DA3FD6F73647C0B996A645FF7FF5D79C20F595A469E0A0A030016F6A1022FBCE114015F6780393030D0213C447A8D4101AE670C"
DATA "13F0BA4620E60AB15000F4AE41F8332ECC602C05D98033C5B61BCDB1FEFC28A39D1457F60CC0B70B175C5B5375E45103D451FF7004C365B706305743C11485F043680B8C7089"
DATA "187B8B736D38A0D0D63EBBE9A31B048EAB7DD8D088497DD44A2BC10A83EDEDB9425B0848F301515084F2FB60671CC01A03C703C8B5425BF16183BF4605C607CB1AF445D47B76"
DATA "89B61250081BC756740A1E22D8BD91631895FB33CD5B0F444F933163C08618C78C0B35F264B87F2C47245657DC743538B4C3EC353ECC30B517C630BE5539E77D03890499326E"
DATA "B0FC0C2575235EE83BD83019E44A0FD87C76D86C2CDC68121EC00BC100591016960A97C83E3A074FF4B7F81B19CF61C1E914BAFF07565323B6566EF9CA33DB3BCA92740B078A"
DATA "DB0EA13D3B37340349FEC65A0F0AFC148D5E02D562900DDC6B161014197F64065FD99A83A1D0FE866184D7A1BB6DED803B2D3B192D287D182130540FD78DBFFEC824E0047888"
DATA "416A65B171F0CC66E22EAC598B3C5527AF70EBDF96FEC980E1E080C17036C6400B4A2BB010A1C809910B66503FCC6D10C018A34EF7DB1BDBE1D0BF735E558B4F0483E3E081E1"
DATA "63C81B0D2EB5C327650BC18BB102B643ADB9301AF5195F79039B866FE015A955ECEB106FFEEB071285D6752331188B071A1364816FA576B98810EB0F53DC6A0D589B098F4489"
DATA "85DBDC56978C3BC2F2B41D4AF4487F596A6DF8071682144C8B57042355BD0B1BB7F82A0FBF0D236981E2317F5B28DCEC45CC664707B79AF839760203C36F0DDA5DCA836DFC69"
DATA "46240FACC8CE602AFF04C1E90446FF4D141DA163AD83ECD87DAE0C7C5152F84CC60205DA318D38899166A0ED1BB8B60446107D48EBEE3BCAFE37F84A7E1639B080C33A8818EB"
DATA "09FEC1378CBDD0C6CDFE40FFA911D16A30564CAD357D474C95030D89ED840F4B8D7BD3F08DB134653662AE3B70A40784722A2525FE853F3423D32B3E53591BD1780F7F064CB7"
DATA "A1EBC372091A2BD7EB0D082DB4E156B72C13D3958BFE9D3BD3A7DF196E4EB9E86A29C17219535152E8568185F6446C043058725540D8BABE51C7D3DC0B5F7C1E7F055F725DC0"
DATA "5A86AA6025244649F33360251F0A72180A09A97B4F895DF00C86001EBA0C4A1B145B9DFC538185857676F25677D7D9C5C0A911A94E6E5A637EB06390C29310DA9C76D747A974"
DATA "D91910153B99DB71287D81573F393466C70418BD7AC394109B6DE67F1C5644E030583F0176530C4083E6321B592805032B6BE098C05123CF55302C01CD8843B9D578FF8CFF79"
DATA "26F7DF7FCB210C7C1883AE81FF02C31B5730253059D6536C5F04261078815F565BFAC950F25E5630C6EB6C53524FD9568A88DB175383C84922D026F0D8740D6A926C04DE7806"
DATA "BB53F4D803CE6847020B0461505F1466778B2C18FF8BCF1C0FDC6CB2C0815B5A595EC0905B03212257C05F5727671B2DEE13A838C7DBA2A30DC8127F1585D5E6CAB570B0ADD8"
DATA "944B958D3C96F9B6A3BBF0FBC9982BC88C50295157A976BB2D13065774D848E90F9C5F0D2D50FAF8FC7C2D70A928220A06832FF18A07478446F98847FE2A01B063133E68CE41"
DATA "CEEB1C19C0C08DC144C61F4646070658ECCF09B8EDE5ED745F0445745A66751930203B6BE01E185610DFE756224376727961741E41741C251156F209ECA0EB30180C66EB1706"
DATA "1F840CAE071CD14464A157128D5E1C8F95212E2DFFB7AAA9148987BCC62F7D0B831383FF2872E67D2271C9B55C720B049F33F6E22D447E7845F438560042E110C6025EE22895"
DATA "DD003740C3F8E039AF98740E8D6811D91BED3CC219C172838546864DC7A6005605D741DBC38FA2558E8905C26E6F46B6190E18066A025A2B1F84ECB27DB6EA2849F1DCE9050F"
DATA "C462FB1C729C83744E0B09AF153A58070C97C7E3AC06A8158E7631A2706306DF96BF51936A10DD5DE0DD01D807E851DD065A0F5A6D05F0A7CC9DED708FE16B68C70022386516"
DATA "12992E859C3D6C6404D907369B4431766CEB874173B1F7CC643C44413E3D5DB0AD5D3015F2FBD8230E140199ECB3190B60EBCE176065DBDEBE700B57E31A7457EB480239BB6D"
DATA "ADB6200D1DE40403C115017809E1930F58EB8E50EB85017003F275831E4F9F99B36F177FAEC00B12D9E840DD18CB1A1F9B90173C8681C118FC2797BB1B15A1DC87A71AFF248D"
DATA "161F0E3BD861B49BC9EB92FF89CEBE93CF0834EB802CF31B0B24270664401C18E1C421277FBC14EB0710DC3B4242B85CDD16458AF051AA83F082AF018FD023C6213A68050E9A"
DATA "85F13D90344DD3DD0A157B03848D969FD3344DD3AB2EB70F060B1A344DC3CCD5A4B018568DE61838D0E12770143681BE03B6F42D0A6DBB486C4EE4660812239A6871A94DC0D8"
DATA "B8C665C836F40BD126BE663BC87555304D9A6B829B7A7E82027E1AF02330C1D76FAC53226AAD4C3A5C74A0FB3DEC394CEB6622DC05FE4818731BE4F5510810306AA542FBB60C"
DATA "415459F90E6493DD00BF592FDAE98E447A0E43F83BB2EE3722F6C32075ED0B534210753EE281E98FFC577F80FF97E0DF3B057511668B9D5C8F80CF0280E7FEB33FEB04BFFB76"
DATA "FF66BB3F1366899D5E14D9AD05BB919CD9E589956CEEBBBB770C9BDDBD6006C6857005009B8A8D6107177AA3FFD0E1D0F9D0C18AC1244E0FBEC07A0404D856F942DB8BDA03D8"
DATA "782366B0363B00D9C9671D17DBFC635D10AD78E5D0FDD0C58AC58AE085B0B2DB01D0E4010AC48BAD1C7BDB0318F53CDDD8C309EBF601ED7EAC157D06E8C3DBBD6254DBADCE9E"
DATA "DDFC05F685694074088307C3070139C0DA11A094C3442C0960CF1C05A92DDEC154C55B814D203E9AC221BF635980BD1C007F0AC70766C5B7027402D9E04F86CBB6B4C0C4E081"
DATA "E0D01805F01C235923479D4B163C66C0B491ABE4ED860E74A904DBE80BEC944EE050ED301B28E5DB4FD9386681667C810A312D03D96D0827ADBD15C90070FCDCE1B970A0D2B7"
DATA "C2D9F02C9AD9FDDDD92161076D5470E60020CA7FCFA840DB5B0D06D96C03C3406884A6979F06B80791C332B07B4FBD1D182F420425F83D046551D38D77DD0211AB0A0DCB7FEE"
DATA "52DF2D8E060E8B0A0FA4C8FCE10B0FD3DDDEA2048CDB2C249B0AA93E006303B635301508430110C3896EEF40E5B72C5AC322165AA0EE3D0E1E3820F99B04728F952B080CB808"
DATA "44850E6AA8D829A21428B2163343AC55D7133E939DBD743D6B5F582A7521B6C091431883FA99075D7818E40B640CDD00DCAEBBC160393145E1DC1D0FCC3B6DD5FDC19EB84D73"
DATA "C7DCFEA2E8BFCDC8908C28D4C403769803EB919EE4EB96A834626C244CEDC5C3061C5663673DAEAE54112029CAC8AFA1571B11DFA00C15B7E0C02024F2C3A18C1537C0D34C74"
DATA "16D9A8CFF78A83830DED1F540E03EE8D5117281740CBDB9D3168516223A009A2F422F8EDA5183022C7465C09A368836608ADFBF6253247897E140270C686C8D04306B87BD7CC"
DATA "4B012131D0A06A0D3D5292591268ECAEE1FF7668402CB511059A7D1C2D6A0C20EDCE141BD85D466CFC08A1F60BC580DD6D316C1D35BD593136F631E7626576875E51B959C346"
DATA "A0B1432F08066538DA815A45CF64F5F05A40A0112E4EFD118510E806D1F6743AF94009815CE2FAA10954DAF889067FFA41FBDCE15969345F69789E3F6709EF1118089C23AB59"
DATA "1946E316B8C8C8B3DE84F8F821DB6CF746246407504C0D2C32211332343C401332211344485C0F8464873DA6108D8B7E78375B8A688C1AC25F750F81FFBC84C976B12C57A51D"
DATA "EC9AEDE48613F33B6C23F47BA0FF28364C593B3DA5143FD7307020C7BE91833F00754436E5F8101E118236BFCEBEE8B584170BC1DF58285793C016912712BACFC1F88B35FFD6"
DATA "E313B4987650C7AED6A8085E33C6930A20CA261CD2EB5424474C0940222DC081F13657DAF86C098D5D801734AFC356704075D1AFDD20A3305764072457F09C8C9C8C9C0C18A0"
DATA "10A4FC8D6DAFBB21003B2413A874162C630B8CA03F0D08A404EF2FF6367124A1CE420928C7053827C5226FC01B15893BFEA327998D60BB3AC1F45063CFDA0E0810B0FF215815"
DATA "9C08366B6376141A23AC60B3824D10AC08ACC30D0FB163791854638B3D32D6C2F7BACD1C253AD73FA343850C201D443D30A00532D2D7391BC24128D166075C5E5FE809860760"
DATA "F52DA2BB682B47ECE0F030D3E7561F30A9C50367CEAC06743501B659455E0EEEF6AB868527DA52C5B759B827A875C1631FAC761F5632488D86F83B53B4129C14031A4B57D600"
DATA "037BCA8BC75F44570C490ACC44795359344B739785E4C349DB939486C01AF12C390C4DC1C364474095A34C51B8A7195F150E3CB5FE05657B9F052B6A2A712103591421C935A9"
DATA "F54CCC73B07C56EF573E244F1B080756F505229F91CF38F656E6D754D2600A7609B5185ED59B2E6E61B8AEEB0F91660E859E63D885F8FFD183C6047972ECABD40177EFF2A130"
DATA "1968074058FC597D9FDCCC548F12F413381D182B748EF70404AE1C535435340DDDEEB32A534FB8BBFCBE2000873BDFCB9BFBC6730F8B074670D083C7FE72F167ED92AE512823"
DATA "6169ED7A2736E20C8D02311522CF022DC87320F0088ED7100BF5828A423FCCD2E037D8FDDC8A3FB9CD11DDA207D805E6A0166E55463E49ED280C0F895D0BB9B137D5DB746816"
DATA "2410757DF0EED6B6D413DC0533EF040B3BFB724B8FBDBB8F5C390774ED0C3EFF3736128907FFD10E7BB3D34F1242393DBE12AD1A3DF177475D0BDCC6BABDD8558B0AEBAB34E4"
DATA "8ABF420D031CB606207311B6B7205C448B00080A04EBE620E04B9E666924E028E0473C099CE076237183A90CE3406C29C7F5BC1119A5DE60352E1F13271CC1922AC48414184C"
DATA "CF25224615550F2118D65F000FBB5B8DF4ACC2672559DE59238D238633363A58494C5693B4B86A0270E1606A40975E567AEFC2D116B3C136FB6B26068D90FFD707475E8FEC20"
DATA "FCEC0C3BC27336832FDDB7FFC0058348FBFF66C740560A894803081FC640217F6B87770C3388482FA12F25408D50FB81C6E016FE7F403BD672CD535766394DE6E00EED607BB6"
DATA "B619E8650A03182804FF16BCB7CD03C3BE29DA3BDE7C028BDE3963F6BABF1D6E7D6BBF0624A19F56761BFBFB5183051B208D8831074A733193B3DB970E8360C080601F800733"
DATA "009FDD6E6B769C200A2F690F9203CE943B2BF599E3D172D2BB627CA2EB0B092CDC6811BC4E7E72B5F80B717BA0575C04FE744AFCBB13DEFE8A09F6C101744D0408750B325C85"
DATA "3D8BAFC5BFF5F783E61F1AC1F805C1E6060319F48A5600623C07CF9CBD01DF99460468A0F98D460C3558DE0A1F1F17BCC84660280447FFF66DBDD126967C8E3394F34235417D"
DATA "81CF37067B0B06809F80EB71C6EAFF5BB1478154056AF658EB0A8D43FFF7D81BB606CE9620F5535419FF2F427C38D926F83E579B3325F0893EC102CF045F45E009B953D6351B"
DATA "040A0893742C8F35FEC7AF5926C7069F4383FB030F8C33343116C100F32850795BF6D08E12EE19EBF6CEBFADDC30E12B09368886218D704EC0405B677E5E5164A5FFBBD51F94"
DATA "40051D8D4EF43BC872E282C2D038166E832796811AAB14FF9BED207CB905442C8EC44705BC5A9FE2DF889FD150293AB6188D27163CC2B16AAB3D8447A7598D1E83855BF1018A"
DATA "0655EA6A4857FB6B786239F889C8C00DCB4116B6CF3E53EB3330803E3D3358C622F56F30962D534A89BC3F5653506B6D7749EA479503F32C8873E4BEB35840AE250A00B563EE"
DATA "C2F9B0ED200F595BB725C092EAE125C00021E4BDD0B60B94E9105316567568D5FB1672550CC70144E55AEA68B5F75D0E0804137A33D1660679223A17FCB322B5B6BB05774612"
DATA "EB3CFFA8D20BD3EEDFBEED88024289398A1E0FB6C350465A5C190E880207DA131E23D73AF78D56BC23530C880146606E84A86FA8051D322F75A980FB20BD80775F0AFB09759F"
DATA "4904C642FFDCBB6D66C3E690E9363C1F043C1E5E98B17F0646EBF34EEBE318D00741373EE9A04510FF01AB4333B7E97BBB034641225C74F9AD261C751F66C1F64681EF560180"
DATA "3812043BE75ABBCDEB0DC42BC6C4C3D1E9BB7B6C07A212497C025C42D0C975F1CB976E6CC3C17455A308824B7447D66D4103D33D51502C23E4D666AE4D0D29DEDC3DE9393759"
DATA "5B672203181A87A5DBB154462C28086B070031FBDB7D7C301041D5C95E5B2B832000CC1AED2151360C53ABD1E5C168BC0F828168040105BB8D86BED0E8208818E0ECDA63643E"
DATA "6268A108D03BC3619B80EDEFDB381875038975FC78FC9453531DAE0DC48D7D26273D0B533DB844DB4D453F734A80F4407342872ED4DFA3C1E7028D040FF53650B1C23ED89B24"
DATA "3BF374293E03FE57564098187BE2480DB471B8F1C92D8B5E96B2BA6A055A343874C5E73AAD17E80A7B23776933741023637490B702073075F8F05746706B2FB541502B42D1F8"
DATA "40AA090F346A41B81C73C66DEBDCD974388E59D10D2A1BFF3A3235B7448BF425221963DDAC1A41FC2AEC53736CA182B55CE7590B498BEF2E0E562FBB50BE04572F9EC35A0227"
DATA "255858B4259A426A1310216CA071127378784095C180D152350FE020C3981121BE8DA7250B004745387877632B10641E5ED5A8CDD6936C038D2BE0E170E66F0F2031E333C550"
DATA "8965E8C3DC054390970782F0645F8ADFAD213F4D09890D0A595F08418811BE51A579CB420B3518220C877335D3567A7B53C506C645574BF4D8E85B3FF08D7B10C20D8B4E4ECF"
DATA "330C38B052B0BDB90C0C000F4B442918450DC685E2C677B81932A28D55E88953485B0CB6B702313586405F8D494B044E38E2DF7E4C86148D4486106E234074BB9B4D148BD744"
DATA "5D2E7401B7771FBCCA407F477CD87575CE807D88742464E4026B9082563A3F37A318F49CB8EDEBC9408BBF4112813963736DE09EA176C8F594EC01B607D70B864611A1A6AC55"
DATA "443B948A08D27C170B3E672ABC90118F5E2FBE4F587A39580CEC6814D38BC81677C02EF4088E4B480C953F3CBB2DE64808E045BA9B39530CC506735B914F0856CB5492041136"
DATA "D32BB48EE552C37DD826324D4E5C9025D4EF6E2DC010DDC099B990DC3BC772EF11B80EDE81C109AC041A225C9BA06B998B502EB445E34F602DE183FA05ED4108DC8C067B9610"
DATA "0198E614A5ED17F45E60894E609E04CF16970E6D11B6BA348B7E2DADF0FBED64393183C10C81F95F7CEDA714FDF04BED643D8E0A3A09C74664835B7E3D90CF213F870F816E3D"
DATA "91845E1CF273C83D93854E3D8D82213F87FC3E3D8F862E3D92F919E4CF8A1E3DB5028D0E3DB4A38570E60788EA64507BDFAD74FFD2C098EB07E0510CCF0E87D56B5B5335B8FA"
DATA "142CC00E97750D3550B1E194B9E22C9BBE0FC20C1B441A029F4946F8DC5F28064ADDBF4EE640BBBB642EB0D0223472851B09F7271DBD03A3D984EB656BF888C74AA556B67973"
DATA "0B84336C6590B1F007088027F000AD759C7C97330C11EDB7776FDE07BE4F59EB1085F38F8BC60D11471FEBB123FDC1E0100BF08976F7D607845E5F7C148021909FB9562FFC02"
DATA "1E83C9FFF2AE9201F7D91025DC468B2C80FD0D77DEE840AB380D2463C7FC5F7E8B02DC322DA4F21583E8047417140D36D8040DC3481CDBD91CB4E7B8CE05120B08B1F1E23C11"
DATA "F96568C01BB438BC9BEE1C57505D02DE1E56310FB7C8687E04B1FDF6B202080CC1E1A0C18D7E10AB00B97F77060CBEC72C2BCEBF388A1401331683FF8810404F75F78D861D64"
DATA "1308E50F074A4E1C6081EC1C05F0852400CE608D85E8FAF48E70A15C1F7604228CBF37F1F5587C52FC8D888405C54089CF44DFE3F48A85EEFAD410206168DBC2BD308D9DEF10"
DATA "37C80203A9F7025F8677162BC1FE8D940D1F59D01F246052198A430183C3027566EBD853D66A2B0C70FC6F5089DDABCF7B2A50692C60C22E4DB6746E531715FD571E5764B065"
DATA "D734534C5F954420FC602D280DBCA924FFD4FB3024378C4566620E804C061D9DE7EDF7108A8C0556EB1112027415208BDD38DC48888C0630BB889C08EB22BA4FF8BFEB5246C7"
DATA "85E4469FB5FA8EEDF2C9290B8B95058D71CBF6ADFE1E03D08D5A93FB19770A640E8D3C5BA9C551203AD70E0C20F8ED46B0E0E003C627413BCF72C6473119036E5B30363814E7"
DATA "BC1010AFA1B805FD22D94770507F6C08F215DF3E178B77685F206D204504AFD922C443F11238E43B351E36462E292EA31A56E4FE56EA62FF46A1248947688B2D365614ED8704"
DATA "A23197EB8E8B170C410892AAC399C58BC122C089B6061F6DB076FE101EB6E09802037F2C4894385DFC74458F48DE1AB99D5F22FD75128303657B90EBDB16FC8AA309C17B591C"
DATA "EBC43BFCB18CCB228920AC944F1526190F9731A0106C4B5B99898F3B870E517311F88E2F086814C008DE46D7EAB8E3D0C59179016C77DF97C0303DF00A72E781E7FD6146B6D2"
DATA "AA740BE968CB7D9CB531C72498FC561136C93C9F63E87B128C37A1ED38481F8D431C569FD242DF897B38BD152C9E73CEE80F8633F69FE89625EE52D3AD75EF8A0E84C90CFB9A"
DATA "96CCC6224629C9A1A046EEEDE6218B4DE46BC930B9E08DB1B75B53A3BBE0C2EB2B8AF66429343EDFDDD06A025832E08A801CCC08443B1D02D7B7724DB33BF876EA91DB0C5FB5"
DATA "0359D0B8E9E00D77ADDD5B107DE0044172E98B9BC74308DAEF200E6106D96A0689430C78B4F5EF36A78948D45A668B31668930CA02BB874B35CC4A398BF3466CA2324EE2F7D2"
DATA "1BBF031D0409C176F65E7EFFFFBD39162C30233B1EB9FEE4080840497582162EF6F98B4304575562AC602DB4F20708B3AACAEDF0E77BEBA73935E74154FE69498423FFBE0882"
DATA "F491E71430834DE0FF0C187E2A16DBDCDF8B5F68F30B6D8122F2F63B718A57A233323D20F45B8B4D6EB395581446B9889B128BE058ABF8FBF3A58323FE38321C830B28149519"
DATA "34A03D058BB64DDC9D25110CB9440B3C6839D0A0371AA31BBB6853D52CA2F646D99E36DB700236EAF6059D010CDD76D01292829291E104089EE5D90708080C0C1416BE6051D8"
DATA "F8057D10674C73B14B192E690C450621EBE819DB7DAB8F3D047D814C181C88B6D2C0185E5DE764E900B018619345BAFC1BD3C8E6FFB5B613DB1BB248CDB81D13F5D771927E49"
DATA "D13566EB30CEEB2580C9D95D782081FB35531CB7A7937D168604D0E00069DD8304B3683D126AFD10344E8A7CC00559A72CA053129D1889362C1A355F0338E88B87A10A500CB8"
DATA "25077220B4C0A0E1EEF68D5F50AF080610817BF863C46CC0C1361A031B837B000AA8010C33610F06C8BDA6DB487540D405521504BF60E16B668685FF8AB2C1625D9A3C962561"
DATA "815A95E25D27027CB8041A86BC3ADB57E3EF5E7BC36F5BDBF87468139A105E3918754F684EB65A0DB81713D6FFB692ADEC7835C764E220B485BD5606790C4F38D09A93E71FEA"
DATA "C044400D6CB353538F2DCA4310CC961DB6D9BF802BC712D00DD7440CE94CC04A86E867EF0DBAC2D5751B3998938D6184164BB60275D4AC444CB734997F6E07840B442CF030B5"
DATA "395FF912110A85ACBA16535328210483C7BCE385065797B4743BE77E345811AB7EA130CE74285789383E58E0A336031B56AC831559C2A3CE9304D730A49249181CD05E0B9780"
DATA "BC9C0CC850F04622837E269078D61C16706C850C51034F4B9BD8886C9784A83D6830F74910612018F5EAEBBEF1A442C70A06682D105D982C44421E2803BE576EA5495B58FFA5"
DATA "9466A5E011BAE52EF4006A4CE4086AB7CACDFDB9450D168985D8050B30FDCFEED80F9185DC14E0FD058DDC95DE7C3E9FD89DD4B5D0BDCC668C95F8C89123C7068DEC9DC885C4"
DATA "9A7973E4A5C0ADBC9C8F85F0B68D35DB857E4D0454F4C76F017ADB6F73AE6AE81B49FC18E408AE01AFB5D008977D11DAC672638BEC05BCA4BA8B3A89D893AAA08DB6769C1A98"
DATA "AB2E73851CF43732B51031252ABE176DA8DA5230C007A139058CCECEC2EBC3AC44A8E64F915D1513E110A25DA54849C4FFE04B42281197144F53D31F0851B2EFAFF083B83DFB"
DATA "7CABAC4800017E136A043D65E88307B8D47CEB0880C8C108F59A5194780448837706A549A81303C931E83D743FA217F5BDD7F82C41E45990C383F03A906332D6BA182C80E808"
DATA "B6B58F54CB3BDE73545775B98C73AF7871149E758A1760E9CEDD8D0D8B815D58010731169F5081CC7B042137F2D06D3C139DF40065F0C31381ED21DB20E0E831896BC140A207"
DATA "726F085AABEE50C642FB5C2166A0128A1378889C0D062FFD885DFDC6455659EB153B2A6EA1B27DD6C916FC50415114BFB1454B702855F86A03522115DB6E22FC51D070B0A11A"
DATA "94E3A1506F108ABF1528D49CF45AA24DF9C1E008247C1ECE0BC140F05E5B42E2167133108D48BF7277110DC84BD8B420403B0F2832C428204730F6D12DB2E03451DC88DC50FB"
DATA "6CB7CED000570AD85097F0717A2EDE2EBF6EEC0B56A466D828F60F03752B2A366AA22D119DE8D6446FC3DFD358EB2F031C15B7B9121304D7302BEA05A0C640361BCE664E00B6"
DATA "B2B1A76C29600589423FE120772079A401D56A03326424D1D8A736002C7C769982A04C0D16F583F93C721CFB137CC7B7BF2D83E70F83E60F245E5F75056B7856F7C7032DB8D1"
DATA "1F2914C1E972E203EABCB1BDD07229A8FF2495133F87C7BA036CDFFA511C047203E00303C81785F7D866BB3E341E8D3090073EB49004B541375D4403709423D1BE076CCD6D37"
DATA "288847010502560859C68D4832B6C75CCCEF5996B1642B25010202ED3C9BE4A6902383C64375DD409E018806170304D3345DD77BFC03F407ECE4DCD334CD7FD48B448EE48944"
DATA "8FE4E8E8EC4DD3344DECF0F0F4F4F80077D334F8FCFC8D04DB74EF10DE4DF003F80DFFF403382D7050D34458645960B381BD90A10BFD11982121B8A3110E2BC920BC7D8D7431"
DATA "677C39FC8324E1726C7B0DFDE3FC7740BCF7D9694E0EC11D406C4B93F92BEBBA674F3FC021BC900BD003F40C776B85AD1C6D033E6F51EE015AB01790E7EF01B29B23C8D35D42"
DATA "ABEE29028892F0960D902724B3B9365ED92D03B271563CA6E9BA855B067003788086A6699A889098A0B39B9AA6699A1C1C18181414699AA66910100C0C08C3489AA608040423"
DATA "84A6E9BA05CC03D4E4F88FB325B896B7B58B0F08035B088713BB0D80854DCC00B33A60FBE104F7C17E74248AFAC10C4E903753CF1075EF87068DA42481DBFF1F8B01BAFFFEFE"
DATA "7E03D083F0FF33C22F04A9D1B0DDDD780181748341FC393284E446A9FECD994A0B9806077402EBCD8D41FF4926D9FE652BC1C309FEFD059D4590FCB055A108B9A8BAFE7EED0B"
DATA "5A0851BD902B450F6A3304D45A7B17F57FE28BF22BF08A08880C06CC034F75F3329D4015AA113821595013BD455AF1EBC6DD5DB9DD00920F2404CDA2D8105E16786141E42D72"
DATA "F1E9ED11770E098AB9ADC058251B776CF0DF700544FB6A0E593BC81BC023C1050837D51DA8A67A063DD978C3C142077313544D144859AE947D7B346A3BF07516B496F5B70BC1"
DATA "430AB576E5DF1088063BD07E13D6DC1269401075AAD04A8DE802827E01461185FEDD17027E1A8A0BD5060FBEC943EB036AEEAD04EEF68808404A167FE96EEA0985AA21FE7812"
DATA "803B357C0DF930B2E0024BF53974F7FE153104FF41509D115D7D12577757D065D486109BDD5150BC5DC23CC04106B7D8C1EBD10FAAA36CCB563D23DA70BB35A8E2ED418B091F"
DATA "FBBEA63E504D84252475FC0DBE0025FE133BFA740881C3CFC428BFFF7F357C8BEF062433D23BC2743BCA750E5C6675BB540F94506DEB4226013CE2055C034FFC47C5C1EA150B"
DATA "856B5F780B0BD00B0F26B6EBFBDF96AA13F5D97C1F03D20BD303C981C7656FBB775D2D083C85D674E4460BCFAE668948037218D1085B203014838D7244AF03DCB5B8D9D5A608"
DATA "D0500C430E45E0500B366A0B53115E8DAEAA9BEA7EFCA5A566A51A7914DC8943DAB6F6978A45E289030FBF250C042BE432089521B22F242D16E2C1149C695EB803015806A111"
DATA "42FAC5DF3B0D867502F3D982514F2360E9C26E553318ED466423E0651415474548101B01AE950B0E7F1C4C46C02018641C0878CBB218281840BB758EFA64D80507F08FF76417"
DATA "23E05FA3C84D0703D1EB47716104BCE51814237104744D77F02D1C4462E6DE9528677414282B76094E2B115062EB181B121CFA163DE4B27710144D8BCAFA5A8795DED96A5213"
DATA "5D3CE9D439028C6D0CAFA240A562A169158A5462C848BC721681FA950E0D5AE07F878357578BF983FAD331C28B0F16F8E103740C2B6B07EEE9159A6F436DF65B8603C10610CA"
DATA "DD0D030E237CECF3AB580A0A843B6727EA60D6DD7E1202D880F94073150420737C53C02F17ADD0D3EAC37E80E11FD3E80C706A33A309C3B13E7A87E390ED1048BFF7FF23C80B"
DATA "D07A7B9EF76EFCF0FCA2BD0D5A80670477853F4706B1AEE3CA661A180C27092320822D14A3052C60B25CD4684D4F8A5F3745251A278978045DDB0AF5D66C070843060CF6C1BF"
DATA "412E6AEF0B095804C789FD6CD3FDC9152683480402129384CB1173D8C83724910412084C73C8488E081090BA40A487230E4ABFD133A558BB502662103105124D0679C8601108"
DATA "D1E904C9600B436D0312025D903B720523CB112EC30FFBEDD484C32323490C10A8040A08A8850FF9900804A81002A820BDDF78A962EB24B9000C0E23C174356836172D04A006"
DATA "080CAF6E6F299C29C4A0EB21A4C15AA5777CFE83C902F4AD0EDBC8F7FBFD0BCBEBF02220FC4503203E02B0C2D820221BE39C3ECA605B65E7EA0B0CEB2E1838B43E7B20150533"
DATA "1FBB01B7A8E1E03731089620397D200674A37F1B7D1C74268520E1FFFB6FECEED90010D958101F605A6060E1D907145D3BDB1F50EB348B4820A0E3082DDD43B6803CDD1F60FA"
DATA "7A28DF60DD35DD36D39053DE3006BC321BB021F6410810CDD35D02B826FE0808FB0431F6D33CF702EF845919DF0B34192A620496C390F35BB72F051E2F48741E020B4817816D"
DATA "9482870E57EB66D2FB9EAFE3B0190D5598100FF70476DBDEEE1DEE211640C1E802430741741539B3BD6DCB071A13EB150623C22202F1DBDF59090A033D395D2021D94150D91F"
DATA "06F5E0B6E0DD06DD1F231C8CC0E4414656931482563B00CBAD6FDB1D0EB65043251D14845DEC0FD8B5DD01334F0F5916F70C4B17D66A6BEC4016F6BA05101B19B9DE881CFB65"
DATA "0F849A3EB919C4D61D0809904F21C9C96134BE594A5437097AD3CD1A62D9EEDCDC19DFE010D997ECBFDA90F6C4057B4CEB48150F2C1AC8200FECEB32157A1E1EB6C18E4C0880"
DATA "EB07D95619EA643BD9BBFE02A1CE1084A3440F63FFFAA8151CB1C3F325FB479A8BDAA468B209103C4E91AB33C70F107F2B6A379F5DEC81C100FAB56FD8EA37C2CEBD7D0DDD45"
DATA "EC405FDBDE04ABA198EB5342DC224341DB466C0481D33BD2FDF256A0AD0AC3D9C8D209A15BB4E0B803C28A7D22275D234A6D8427692A7DD1EDC40BDB6DEC0DF0BF814DECA80E"
DATA "CE998285F0EBE06E5ABF5CDD826B2807D1EB295FC936E2F08041784BFDE13A5AABCBCD9311D3AD111EB1010B7693EFDA49A2116C2B5EF977127577E37D0801477E1E07037F18"
DATA "0B5802D5580351BEAB04C110BB08046A05EB17196204380805F91AB05DA810AC06A846052D32DE5AD41068D90203C0446113376020120CC555983B8F2D78D07F74644083F81D"
DATA "7CEEA50F03CC128E5E06F1E89176601851B5CD09BCB86CCBF42005F824683E918B166DA028DC1E2E102F5EEC081D465305EA53449A4B3917C3FEBAAAF837046F9CEB9B38B8ED"
DATA "3D6232E124232034536B5C1615D9962208D054D036180CAEC810156504AAB0390C4170F1756B01389A43165C6CC26057141E5D2C686C110B3EBADC1DB71650229D8F5F6B0409"
DATA "532C04E3049B43AFFD97C5E2FF73208D4318500692B6F7C2D94955C423BBC0FE50171B10BB700B65662021FF805030F76C489B314B665DBA8595AEE12B472750DDBE0E866DE7"
DATA "43104650BDF79BB9F70801C70424C033BA38840A99625927121163C20B41738BE35B1EE73606D58030FC75C91339286718B416FB2DD001DC1805FE03F704900F6D2CEBD8E30B"
DATA "C1D1FE2CEA812A752828444B229CC56895FD6F3412FFDD91D99836025B0EB8F8D497021C73F46623CE5E511B344C46584BE473B4F03B5B0D12F761FFC5308C1B385C35741BC8"
DATA "33654475FD37A4EED9C0DDEA2FD96D755BDE130733D2E9BCA3450E13A9A5E519FB43756B400F4D5D92DDC7A4D308BA7897CDEB9DEB36B6D3F614D1650C2808726483B10175BF"
DATA "2CDD0F084A4D0EE656BEEFFF8B21A92D5A4B0C5EA23BB858F1B0BAF666091A7D51104D6D96EC6D4D45260DD8151487A90255EA550E252786A98FC3D726EA35FC10B486D0D10F"
DATA "9BDD7DFCB9FC658FE881ED0EDBE2109BD9F36C855B07702396F7D0251A66037B532B6E594A0CD96D0C2A83EA00DA518A24B70A372BFA62BBDAA8DBEA9B651047B2B9865911B7"
DATA "9B0C23106EF8E20DB4119C0948E8DEF182B709D7BF0DF5D9EB181680F384FFBC701A05C677D78F0A7456654074480DDA83447061C740D70FAE9BEB2E00B956CDF5DC9817195C"
DATA "C0BBD53D1D06BB632E046DB7A06543753A2F9D08BF588119F42FE59B105C219D681C49888285C6848BE50208F1565DB4ED9A48DE8D78FF2ECBB6345652430234254648753BAA"
DATA "DF0313480F85A5D7857C1E1048D52547A6040601019EB3E7EC50D21612220B1116BF39794E040A08518D7E1857FF4A3520BDB50EBC49BB628128B4DA4E5D162E4E85A6251D3B"
DATA "CEFD62C1C58D4D9746104C48B0DBD8AADD4F03890ED44E1A50411ED233D170B0E24932EA9D5582485CB5174825CA8F1B833E77EEDD04C57A0B56F70C08FF36D2320066F685BE"
DATA "35A80B5A5FBFC4EFA51A6E153CF5A0CC711D8D0409B1D4A7E2C889386BFF308918DF0A18526C28FE247CD31AEB280CA3F424280086A9786810F1881D33FFDC014BBC13153E2C"
DATA "837E04462A2E6C5F0D07D3573726187B435DC60829DBE87CDC295FB6515F579157092975E2D31F9EA45A5CE68762FF34C5390835F62C87B45290E8148A1D942B7DE4AD0FA8D5"
DATA "052FF03C3BF4801ED06A1E3A39B10BAE0790BB098D34B04F00FED2391EB48BC7EB6D6A18D7F83BDD99C1E0FB750FCA0CD0506A0A28D09E41435DFC2F3E56F410460B57077517"
DATA "CF6FB4056C3428E488893EEBAD386545EA5289F73243BD19AF559ED867546176568DD9BFD85115667584D0B46A11C6BC860A168C73B8BEAF2DE250F883FBE0776FB8EB3536ED"
DATA "5E61F185DBE7C3EB544050AFE8408A09BC92DDC2A78526455E95EBECA25379579210D09E04A9C0FF602D47F4063EF0206B18258424266CBCC04B84D11B6AE04F58F7F162216C"
DATA "05A7734CDBC5426CEFAF4D1CF1B301460FC05AB74642BF13562C912D557BDD7932D08C0E56C24804938DD2EF0697A73B044C0DE01001A3076A0815D00BA041264E91B861CE30"
DATA "89CE406D0DCE8D3A435634F64D57EB30815619C0273B84080F0C407E741D3D626577AA76CB56FB4F023B81154AEBE217A4AB5AC771CAF30AB00A4FD5BD40786616DBD079335E"
DATA "46B0FB3A8884375245A87636548CBBCDCFF725E3E2683F0D6C047074C7A8213C789605A40488F60BF556395004A2F16BF60C03F90785F6B74E3BC672EC6BC90CB7A3D951876F"
DATA "73051E02A6CEE27429C8B3146320D062E0311A91997C0B7F4B1B2D41AB5268598A742C6267BA2203080B7543C563400D6EF8284E14F756A8D17FDFD1BEA2A104EB55FF775CDB"
DATA "B785F6AE0CF0598D709E2C514883E8B0C017A00FE8E80674218312DF2758162487EBB93E74F9F90A3C746B0B7070EB0A0F34A2E77878DAA55015500866B8811FD016D18EE0F4"
DATA "D6A3E01E518B42F8233EA3D30BD80BE4C3D75C8DDC06EDFCCCEF0AD196052E456C0404DB4F6079EE976DF7D489476017753E0D64D0C747648C461DBB3D7C112C4EA3DE4DDC08"
DATA "FC03BFA1BD8C0E397D198B04508B575C8944114851891BD745DC10A75CF85EC206CA569B431F0164531085862F9DE059EB194C8B29B160394E1F8E171B61A568619689932541"
DATA "2CDB060AD06415C8849D8C04805D0E84A811825C88E18888C7591EF10C0FE99E058404AED40C576245C18A66641644EB8AB6FC0CE117FA0EFAF30F82810DFE2BFB8D4703F804"
DATA "E077EDD77275238851220F593BD87348B822B8D019A90802E303C3A08E00DD520F508420B513D2397AA516C0153E745C326EF02FC1FF02E934B8EC7C0BD0DB02D13D0DEC065F"
DATA "016A5026D117249200B572DBD9B8AA214585EC6632C596B9B43F2CF941530737441858B526BE5E757A488342F08A2146837042029E2E572C57584940A2BE24BF294F20143747"
DATA "745813D0035948E84320482012B84D5AFA113668F939FF0455413C03C181F70226DA0D455527B90B011C1BF602C448C6C28BC23A3F81B6172C5C31C8A15BB45B61148A057106"
DATA "331144BA085CC00818751848BA41FD97C4F972098B580803D91B0A4213682B5AD528A6E8E103DA3DB2CC4F6AFEEDBD105B0680C914342DBE406532A050F8172FD6613D898109"
DATA "65230D500360386C54B34CF675972D135019AC080134FA563AC924C1E81F71960105A11039833A444C80A4E822620F98EC68C0F9BD003610EA30BBD0D20EF818083B1DB05016"
DATA "400BF846D83A72EE52041254D8B2CA550D45E81665811856E4591E6D15DC85D2BD04662C166C5BAB1ECB28118F4959CD100723558F25984F94EDD0117418EE50FE0A24A9A937"
DATA "98363FB18C681495BF471A4536B49057DA8EE63A0F42640A5076E2C256211E63C353664BE4CA86CCBBFB75B4AC7D5D591F405C9A378E050C2A515918CB40770BCDEE953C762A"
DATA "0C8D454F4C8BC89FA2BFDB2BCEA2D1F940542BD9F58DFE38BF0F10B575BD964CBE1A9DD157D017896DA51F23F613F6F2139168102001C7E681F7D955898C1D5E5300AC7A1AAB"
DATA "BA5AA36AB454E174BF400B19ECC441E40C47888C0514B76EB8084BB21C47AD403DF635DA304C6D5398605006C58AB6CE0864FBDD928893861084C887080D96107A47761CB682"
DATA "0C1F18687142504E58CE59DE35FFAB835C080FB6EBF48A5514845453C417F5011D751E77123DABC5B380A14123412540084CD7E30337A1DAC91538F904273025A4725BC64024"
DATA "B1894EA8D2146C5552985C880AD7A35CD0686389CE72C4BE08BD25819DE984B530992D2C33E5EDEE1B5453FEFE743B433483FA08366ADFFA043BF2762EDF768D5CB3532F48EA"
DATA "506CDD1D7B0412CCAAC53077E71D8290A1B90B0C93A953BDB7B0648F86F516EB0A3E55C3AF4104EBB827084B2EF774336F2D58C860606BA5B6D068AF740210672E54850B665C"
DATA "3C236D1F01BFC6890222C3254C9B6CD9DE1029FF711C02182828C28D0CD4466D55F166EA01170A5A95AB1DFFD15B0B6EF1543EEA428BC1E6209AC7DAA21DC933D2E6A9A241F1"
DATA "7605ED97EEB5BB5D76511F95A486646C52510D96151A433A5F1312866058E1EAF70844B9C00815DDDD8F022429628FBF11FF8A5E5518E33BD37E1F25E81DBF068BCA49381886"
DATA "3BCB75F6250DF82D5A467C483BC27D015C07BD4483189F915D247512C66003C500994524C9D8DE8AC6D6B11728E5CE0F95C0B368B920FC3E35441B93AA757DF1FB9CD1562744"
DATA "5F8D43CDF71517B805D77237783F086281D7E87DB6FC52C4A3468B0D431CA51C305EE966B41150741209CA5B0341AB1652038AF4022D042FF474AC6EF4453A8258213C6D95E0"
DATA "40B3F61DE298D49320592057F460D6CE0EC19668A36FB97285EF74332076F6B1F814ACCFF80F8FA3B81C385D35F806B7771ACB7EBBD019B042BC36E57716B9F1FB4235B27468"
DATA "C707B983C75361802D3E1ABC0C3002D66C5DFF283F62F8F065B71BD41AB322B033750406EB06F4BA59055F2653D962EE2FF7EE70C15A5D8E593708382E54806EEE65E4131820"
DATA "4D4640C9CE9A3D07A585854957951DB10C7A9F5DAE96511A20C1912B1CC8183128051C1C978C3C972014101CE01F543BF4827F7E3C8142B851D1DFDD7734FB60DB55AC2674BA"
DATA "583F8721411474B61FE846F878C9011C4611DD5001A11969350CDC532C259C0390EC2426800364795FDB1C565A90EBAC296302DF20836C916F07080C9D0C32C81014183632C8"
DATA "60830E20072428C820830C2C303414830C321C383C60836C27DB4012404407830C32C8484C50540C32D82058825C6032C8208364686CC820830C707478C9284E327CB680C42E"
DATA "B9E4B2840A888C90B9E4924B94989CE4924B2EA0A4A872C925CFBCC0C4263B975CC8CCB2D0B9E4B24BB80AD8DCE4924B2EE0E4E8924B2EB9ECD4F04B2EB9E4F4F8FCC05E32C9"
DATA "0001040801B24B2EBBEC0C18100A142EB9E492181C2024B9E4924B282C30E4924B2E34383C904B2EBB40B24448924B2E9B4C4450544B2EB9E4585C605B5DD289183376749506"
DATA "92080ED03B058C4B7C06646C0411FC08DC0069C9C88030285A90A24D5187DC2C7017545AD868DF466C404636490C0410114046066408140C4606646418101C14066464402018"
DATA "24646440461C3830CF80FC063CFDDC3440DC0119199038443C1919909148404C440A34550340ECA38A03C928D8D9EA0B7A32D78D4301EC7747712AB650E849BB7F028CE2EB75"
DATA "87F8885DF9C64521EF2896FA0A7CF8C645F9460D1CC5147F74130FEA6BAAF08D135062E82A5A41E668388B8654B407073758A268916AF10C865403A37C66301A908FD90C08C7"
DATA "2B815390A2D560200D1437387BA1DBA6804DCC32480AC5D981E1362DDBA5DA0F84480605F002BD29D8AA18D2E3B881EBFF3FDCC1F6458C5718F47E81FB014B18DA4A118127D8"
DATA "245C8ED00BF085F0750D6B037CF4126BDCB10B17DA068D22ABAB10AB580FEDD6E2C68365A5568D1C15E4A50002FEDF04A0DC604F8D47019983E21F03C2B6E0DA37578D570181"
DATA "0AB365D45EF8DBEDFFD879054A83CAE0428D74596A1F4C592BCA40D3E0DFCEC685608506B08D2283CAFFD309A07DF9E2F7D28554EB05837C0557C7DEFE5883F3EB6E8BC79936"
DATA "5923D15A81E740FD7E7B57514F83CFE047882BCF5BE8DBAD233B8D4C338B3903FACCE0066F2BFE6D390472223955E0EB1B302B25E2EDEE631E118D7A011F3BFA7262FF01736B"
DATA "F485234A0148638DCD10176211C779D1E097F756AD11BE9F9E59210699A3BAB722A17D0A8D912B4FD0BD6C75F3AB66DC0143A1F35C18847F0B990DFB3BD97D0D23AB016E506C"
DATA "206A7E498F0BF7095D5B782B45D426E4261AA51C4178BE852DD1C4E2A517CD1415689FC114D1F14DF746CFCAD3E795202955DCF7D75EAA6DB5C1E02D9DB9E8CE23CFB7775D23"
DATA "A01FEEA80B75D8891275D46BD40CD4D3E68ED16F10FC1B5F787CD38B5D02C1E60246F85A2BCE3BD07C51B4876F0E318974954F640590170EDDF54A79E90AAC4E8D46822C0419"
DATA "56A9D0574E28186EA3565C77030966618513A982A666DE9F1CC88BC6E64E83CEE046E0003F84D64D93A6318D3C167D1E0A4B29048883D88939E82034BCD6D8EB1FAE1EAA7201"
DATA "9B6869E888F2A9FE03E9318BA538B2F0CF4879DE9ED42103102EC150787A7AA99F8B2734801E9164A46F8D052821C951016E7B3652A9215233DB973B1D051D86A1B8580F8C1F"
DATA "31818FD9AE2A9B4D8BC1B1205F8A1565B0C6BEDC6C03B1580962A633BA0D00AC65EA6C8165153CA6521B9067CEE6D69294DAEEECED7C8DA6CF23CEA4EF110B7DA4CB61CDFD14"
DATA "7DD4B1D6A97DD047290620C9A673FD768456D3E342C8F7D91BC9F390EB028FB00BD96D680B5D65F940CC4AB74A5B1CCCE2E75904E588366F05C711207505891947904048FA50"
DATA "713280BC902D712D78C9200354747864A8400E6FCF7828408E8A7C053232F2712C7C70F264E4138E0FDC8470712C20030532847C841C905C807C8D607BA9455633F60A88A81D"
DATA "9536A0466C90E3088CB26CDB069E9805B402A8A4AABF2CCBA09CB094394D247517828E40C8174378159785825F4C8955AC8A027D0C083CB6FF8D820A080D750342EBEB53B330"
DATA "1742FFAC8ADF970B0F871C0292782A8D48CF80416F77F1F90877062E4AEBDFAB248B09A98D3A58143A012105E4087EA160C9BE83E82B741DD00250DB130D08407CD8A055379B"
DATA "CEEBB0F2D08CDBB5021FFFEBA4AD080FEB9B51C1C8769BB9A85476AB4E7F8BB75D7FAF3C49223C2DD13AC374BB3C43176DFFEE0F8E2F4C3C457E0A2C643C019A217AB911BD7F"
DATA "06EB894A6A0BEB849C74865FE6160A594B7961144377BBF6B607731CF3FE73E878EB1A3CFF125FE2397F1A34B419730A3DB42AC3880747EBA6ECE6B60309B0FC2E7DE24768EB"
DATA "764D67938E8A4472883B00489F2DC59B02A47526D14D3974F6EB614346BA1859D50B1D2BB87683A2EBBB103274C32CFC6B6E6E51E94B148D4AFEB1AC0621F62064076A09144F"
DATA "2052E71B69103D300896C5DAD3ED4D980A075911F70712B0F0B3B655A0C083F92C313C57B82C757BB6A9265276AD14EBBF7D20749B6DB6475570FF74C45BB414BBDA5A8D19A8"
DATA "4790894BE5002AA3A2EF39B586FF6FB87610807DF7057C03FE45F74F178911A3F16EE1F165DD21EB596A0A0824B8A6806D0A94CFB5BE7CB1DD6D152119F9206BC915BEE2ECF2"
DATA "2F8D4C31D081F950147F09FAE3A9B6C3DD81B9510FA0EB0B28E40B0F676E5DCE1AF195BF24B4D88A6F77674F803FA5F48D45C45BB428B53D8B89921C9D9C045AFB56AD0F9798"
DATA "7D02F7A4272ACBD6D809A0AF0718A4ED6E7BB72B1C3D6B54219D3DB0EB595B34755BD62D0AB979B0F36095706C6FBDAC3BC2DDE8D11D41E4DCAE3F16DE1013194B4481C2E70D"
DATA "59C42653B16D0AAC22C5E892F8AD3A8A8448ACBEAC0383C154D07C5BAB13B684419C6B1F83B845591C01A23903720EC637B3C58BF37BB8C0BA8D5DB86403184CC0CE2430BEA1"
DATA "5B142267E8430A94D4A55E7C3375CEB9EDE323C1DD7E44AFE03B068D0C87759066D9DCBF22C9663BD70F83205D08C717F773F3EFBFFDBF0DCF0F8709BEBF3FCE770D5DDF5A1B"
DATA "DCC8AE3477B01013D6751F416FFF0BEAF745CC56153975C8751004C4750BB9BC7D63D4CE25B323C675214308D6B6ED1F17397304751239910E7ACC024B0435D7C875B349C8CB"
DATA "ED032E26A8055798C9A80355DAED97A29C52528D4405C44DA48D42D4B665DB05A01BA0A4B41202EA37EA70B514AFD257FC8D3402A4F36CE57398F0B422BF35207E77FC740366"
DATA "AD3C02836DA002446D6C0B249C169C15BBF73FB6B6DEFF630EA87D7F9081C102C0E0D46F742BC47E37D5DC85FF782B02F012B083D8C2D165D420D46ED0FF8BD603F60BF0C1EA"
DATA "1F1F0BC22B7DBBC347F3755D317FCE044D5628B59B150A794268E39B80ED74FBF003CEF6400174D649DCFB8DBEB535B5D8D16DDC6A1FD1EF0BF85C0653DBB6C1E209E84F4E38"
DATA "AE4358FAC275D137B07405665CD4DDE622DA6E14771134D46AD0D0D86EED81FA14057534B0D69BF6B2754B19D6E0DA091CDA00BA7B6B6F782341DE750775DE41EB0EF306E2AF"
DATA "2D60EBD4DA56D6B8FF741B75846A722302C95890D0D02032C412C7494DB5D66627BE032431EBEEE3E3DB3B669AD60B4D90938B42C6BD302CB06D05CA0F4D4D1ED6BDEFDB8DAC"
DATA "94C075C8004825390538AE5BA3B00EC4110491AC0029B6A61E000A7B4D4075990B2FDC3D55CA4210EB2F9594048B5134D642F68EBA51165C3BB8A7020F08B511A256E042A3C1"
DATA "2F880BB674BED01ADB0F0247C01BC90289570613B5108895D94BD374A5020360ABDC7397A6699A21596DC6B1742E5080DE35230BD2578BC69F0BBB4A03FBC17DE17FD807F7A6"
DATA "BAC07465448D9BB0660F6F06037597CD6E4E100456205E307F07034F6677B3D9127F577F5F6F6640046E50D9ECBACD76607E701867137F6F7F77E0EF07BD7F7F708DAB8DBF05"
DATA "4A75A35364A09624495487EDAD6F59176F608DF18D7F10238A1620B6EF900F47C1BE6C2F6157AD1689171804044975F3503545A5628F09D80278DBC246470FF7585EA7BAF9B0"
DATA "BF8BF22BD02BCA518BC2201688175026AC107642482C19243EB27864DE744B148A46E16B96B9B441B41E7721AF1CA3E82DCA68015623D0FE000B0B75A0009B9CA0D0C4E56433"
DATA "5A06D4D8FB3FA8FBBFCA5ACF06C643022DEB04052085C6ED8EE27D0866E275372A669C602B99CF5007C7385AA02E5090A066C895ED6FEF28D40D0420883066C7430301303976"
DATA "E9841A486582033BD02F742E56C197FC132FB82362AB782C2A061D74DCE2F01BF7BBCD136846604640025A348D3BBAAD8AA607A083F922C04A5F57D18A882D2758142840E7EB"
DATA "40220F1D8A1B902296EA1688B8833053F27D0305EB1B1C489BEE5F8819A99F2ACA8BD969C9104DA181ADD285C66518C169194398D2C9F07F4D8D84080CEDBCECC1F84D683283"
DATA "87C18D6ABFD806F7DBC6B6A5AD9B1355EA3BE6F3E21C9833D1FD04D185DB790FE0DE6723BF355B1B98101883830A548BCBC1FB0761B68503D707116700EB59B7C6981D3BBCB9"
DATA "230872220E1A6C407DC400B56D6B5B0704C63FBC791FB80226701595F0C103DE076C1B743376BEEFE237B605BEDD84A88B1023D623CE371120FE8C2C1BC41A04D6A7CE25CB49"
DATA "B39EBEFE90EAC250F0FE771047C7E406D94109B6077D7D4706790E59E8E4E0EA065BC1C52556B22340078B5BBC7C0939700439300221757C5E8E2C7075F4F9C04DACC003C900"
DATA "5CA259B055C90DE0AB70D1D59A4DB1942511B1B101570CF98B56B5AF94D882B8F065A4AB0A1BB29C3C0DF9C1A4A446B334CD32069094B0B096A581373EBC83C6FCACC0C03CB6"
DATA "4F5E8D81C7FF7E3BC0F8690B14686B3125F4C8FEF00B7AA9C18BD0858B1F0BC1B6A483E6E0F8040F03C7D9E0ED5A0F357FCA0400C791E5A739FFC7C003F8F03668A6A8B832E2"
DATA "00F47FE05E5EF8C1E1EE0BF15E00E90BCA911D18DA48891AAD0045B814686692F0F00EA23372C81800F9F2F21C79F248F6F600B94DFAFA4780C9F38CFAF6F27206A7268DA786"
DATA "04A8450CC9C8E4E0E8B7761630D6C77D0CFD10BA6319CC102343CA9F0C43C9D19622DA5F6DA7FA5B593602F0F4E255DA33D923C8446BE3DD3381E3BF5A0A36CBC8B2D1A8F658"
DATA "C84CD0438BB79C34B8F0350D5DE0B3713EF0774B5545803A653334EF88F20B7DA8E08E05E2E9463696F8E64F7D7BC6F660E0A054048E8A39768D28741D7BA0781BED3036EF1D"
DATA "469313F0930EEE607411590991803D8F96E33BDD751821D81CD496E61BA788A56B769B967D302DCB24454DC0585CB588BA244BA9F3B2456B2E9699068A1069FE34CB09BCCA1C"
DATA "0A3BDAD97090E5E4BCBC5F6DA865D9C2545289B8B867F1659CBF8C9781C689F64502E33CF88A7C3119938CC688F689F672D29C7488C6F6C6F0C803F21CB07DEF0BF90520871C"
DATA "7DB04C1643C846F089A476BC486184890075A42367F14A75EA89DBE4B65B7321E0E8F01801E59C4A9728DF30B48B7D140830988E83C3BE9AA6298F02D5A07BB45F0666428D42"
DATA "02C642462F95FE771B79F283FF157E036A155FB701EE1081E7C62CC7EEFEA3CC12BC086CB45575955DF2E424E07C991CDD03DB0B312D20C146AE012DCFBC5B88261D55EA8688"
DATA "32F7DE75A87E7B369AB92822350AE8EB3586B1EDE1E08AE8354E33E0C5D1D45EA8D8948D5A040F10B416687876AD8EB55507E42BE0E36D6E04EFA577DCE07D0CA06DADB00C00"
DATA "BF1F5BF0ACB7D4A0019BD6237E0996EF36DE36181216C4C1EF36C8670BF78D3C5AF444AD0206C0184A6689360005C6A8F85FAA2EDAD2423C970125C88D143068BB024BCFBCD3"
DATA "28D07311C0D6BE3673CCF8C962543FA5BE5AC1F413DD1818172AE51AD080C16C671F63400116AF434498E49B0116E0C645EB0F4B6415834B2536FDEB023C357D0E40EB44C5B1"
DATA "09F10A70FBC603304B3BDA73F25907FFC6DF283C2500FE032AD880240FBECB885803C62D0CA2E1440104618C86DAF69ABE3D3075054B59F63906CDB5459D3817CE10BAF659F8"
DATA "2F6CAE01CCC2FECA80E20D80C2CE500A82D0455940D1EE4BC1124B8BE9D0890D05E6E6E6E6CC8915C8891DC48935C0893D5F69B6EFBC668C18E8060DDC20B82CCDD26C1405B4"
DATA "25B02DDB98E1DCAC9C8F9A56D407040AAF513DD84F07EB28F81E0A85C72320B6BFDD6B0FA11C19E8D413E8C809E8C008B502F709E24194055F8482B20A847F130A0EAE1C4E18"
DATA "6A012C8A5804FEA26B15FBE2A0AE680ADAB8788715EA18D823685BA3C2402803426CD5916A7CEFC051531E05757FC0B2D4163AE201E8376FF3A3472A907F01411004F37C749E"
DATA "2030D941413A363ACB418953D032372A34A0D64441ADBCD4B6ED99903F061019F658A2D4B86DC91C1A33DB3B7FA9DA685BC2191504DFF8258BBFBD512D88194120FA5B58C38B"
DATA "D8F11BD10244202B9D52A1ADF1DA8BD3311B6F26FA5301B0345F33014B5AD536DAD6986622F6299F4005599E6D5371C804070408028FA29FE5100120F7C3A17D550B750A023D"
DATA "BA8ECAEB7AB511E10202BB01076E01DCA2168A740BFC130DF5A97AAA9B0C94EB05557DB5538B33880302EDA6ABBAE800060BC68C6AD7942BDF5E57042574C38D2D11874BC205"
DATA "B80649BB6B6D6BED5F119929C306984B833DCF360902080139BF167BF77E81F7C2A32CC78BCABEA2909C3C4DF71F3BCF98CBCE6040E0B7179C204E295F23D15E5BD062CD350B"
DATA "992C0761F7CD6C6F6ED1750F9580F340C30D4009A05C90AAE99B8F50DAEA5F6675FC2C226A105A599EED093ACA0807080410BC1F9EE5022001520681CAA3B335AA1A3FEDA20C"
DATA "91AA566FC6BFA99DD4055E82911708DD120BD7E8AD7B2E702EBD36E023CBDDF97586103F117519000150026A9A1D36C3A90760E57DA0DD9083F933D023C235A7AF2EF8DD0CEB"
DATA "AEF0D814BA069FA81109F8D9B1C8F8ECB622D9C7F8C27428BDCCB9E6E41B0C1620D7C142D8738C05EDC505A080390CC3F1029AA01DE8F6396F344BB5C0571A3EE7300814EC6F"
DATA "F78DEA0FAE5DFAF084C079B15EA94C6439D9769BCE0809040408E9DE93E5021001A982BBCE87DBF8F88BC8BB0E231B2A8D0AD28C7525570740BFCBCE7E3C830CCECEBF0623C7"
DATA "E6BAB7AD54402D2DC07F2C0D0B2D2EF6782EC82D4F2DD0BA553040E680B2F7D2574053B7150BD0CD07FFAB72F1E18837819F50726A77A10BB76759CD8EF48284C9CFBAC32BC0"
DATA "5A8AD0840A049939694E040802D3370CE1F3CA01BE85CE918EC37424208F9C2C2040C37512DB8DA6C90A7AD61683E9C51D32C833D881E9C6E9CACA029AE00CCA053327436BB4"
DATA "8543777FAD15BDA0171A6E8090419375159934644537985DC361046D08E0572D5527026A16B0D111FC0A3459F6D88854118803D42D626823400A0A66440F6BAE047200920F8A"
DATA "305DF773F38944FF8A409089C4900454038017201534A40F8A02C90190308A30354DD7C543062703140C0415344DD783FC03F4ECE4BD8610200F0DFFF449054DD3034854680F"
DATA "210F39008BCC8B7CC075CF1E8AD021CC900BE008BC482AF8612C0F8BCC85420E818BCC699AAE8B5B0680038890982A689AA6A0A8B0C3EB0E21400F2305DC03480597A6E4F48C"
DATA "080FCE0260009D24558C5542280CB4AAA7A849FA1B77FDEA8B6A69A0F013757D5814230F2BD4C417C5FB8ACA10A6401A411A20131DE6FA7B7F058A14A818B853A3441D4C3232"
DATA "580FA4F488BA9A8B8CF80974321009DE87FD18705313EBFCA1044F0D800854A3673C88DCEF47390D2B743F21F655DC7544FBD698FF742C7109E2B78D288C7419F0516A554755"
DATA "076151A8D34B10AD0C58DCCE09B7CFD6C0814D57205833F43BDF74294D5011A050EB03ECAD93E77B3B19F80F08E22B9F7BB1EC1C6ECF1310028802B1A5E4E01C6E3A45092C90"
DATA "99C92015B498E1150CD50B1A6DE77FA16A828F6652DD8BD666833ADCBD5007C383044F75F4D5E72BD1362A6E4B85011B040A5666B5A26688DC17150EA402D74EC23052AA6C45"
DATA "B00A568B1468E4AA2AD0E1685483128D52671F83AC82092F6EBA658FB9DD318702EBD0950DD4ECA6AA8EF0FBEFF22BF18CEDB619E40E27EB227B2BF217A85C41DB0C061808C5"
DATA "45B751EBB64FA783EB50055E515734D208CC79FB78DB45F048AA6A5016444AFE3730B723118E1B64C91360A682D935CC67540C42F8F675F52B0DD1F8485D5CB83C3C4040055A"
DATA "DF2BD025CC6EA50A0B0C02504A93541DC9D4BCEF781600EDAD1E0F027E0C046703C4DA8E1BDF905506090C12483C0C16CF3014741447557CFA884CECD68FA82A315D47463481"
DATA "F3DF32C9883E457A48FCDF37A8DB0B28502852032452808FF17323232ADE611252F483BA105550F88FB0AB93A2B713508D1B0464A3AB60C3149928A5553A74795B2AAC2C0606"
DATA "3B74762DA668FB52A58B0CB3898F0CA6A2234BD17CB3A71744B3A8F76191A808C0EBB7B617264533BDA842648BB71ADE630F81790483DF51E5520CD8BD46C03951CFDAA651BB"
DATA "C16FB0BB0390EB0B088B6B4B0852F4FF5697896B0C55515058595D595B91826445A54B914BD4A00B950811DB03B24DD4E8C11BC9E388940C15D0200C64076F56A045E466D500"
DATA "60B732017C1F020A73470FAB70A5C8F10424EBF132461765AC51D4BE951AC641BC0097A373EEDCC4205E91892A6034CA3C06AD5C3C76CF3C8B02F476B701E92E34263A610825"
DATA "0AE4A5FB852A5CA43A41027519141100DAB6B503F857046C041AA0177014CFEB8B1BC0D15C1BA15D8A01C343E1188F8BF16C9DEB46E78034DC1702A4CDD37CAEE4185FCEC6C5"
DATA "BD5B81BD4D65EB888BDF770570C858D80CF10A56312B63D933B6A84764133A8E4E4661832E0089AC588519442BECFE395D0C0F8645A6895DBF467988370B9DE8D18D3C092B1B"
DATA "58EA8D9BE0651015F38BD9A3F8DD101F843475F803C92BCF8BF9B77F8812393BE803F6C1EB11CB03205A05A5D68D2C14ED4234DA16053B17B9D62DD2DD104789103F3DA2500B"
DATA "E2520BC5EE6D618FA7213B7404413E5B888F6C26EC1C373BDF5FDE255660900B5803F09F2FD66ACBF8FB90AA92A3B94EE4BADBA5DE1DD97A2ED176B70810310FBE31AA32923B"
DATA "CAA5E5E4E950CEF8F808166DB234C48D4BE8CBF9F3E79AEAA848830AC9414851CED6FA68FF4DACFF95850CD2855DEF120F87C0FEE6DB3950752AB9F5C4C28D40088166F0CFFA"
DATA "156E97A25613C1E202EF1035E0822801CE3C9A01A2B117FB044602D95ACD8536008030003418467C0BA7FFD1D3C2FF492B0D4B31FE2FCAAF482F17C4830F74D366793E4B1A02"
DATA "510A593FF80D6894048224C88BC42500526B558BD1CEBF33D2C41BED948BAE1BC32D000D850B7497D4E97F53D00B194DC6C7DF1E49D4B741B35AB62067268E8E4C47E18A07AE"
DATA "5923BA354CF7FF3AE772063AE3770202E63AC709C3B7810E8816BBF3D1F35B75375A0A96B9FF0072CCD97525456C715B8F5664390BE2EE04100C764E0E390810100B41FC2BDD"
DATA "5C295423D1E9D1DB21CFB37C04C9F314103CCBC8C90C08101408C19105B10C015EFABD841182649A0BC8B7806BF1AD3B0FAFE1237CF6CD5A5305A6720309E103D32E0E1911C1"
DATA "FF25B3919191B1F405F0ECE42B1105D9D00000FB2E2FA20216531AFCF20AB95C35A357E601F36CF6B057F03F07330409073C7936D91FBF073043008090392286CC0006BBAC7C"
DATA "652B30477F07FF6A24674FE07F36206CB3BDA60C7F5E07C0C0FF17FFCD773FCAF2497103F16042A20D8D59F3F8C21F6EA501F8F2FF60078174616E00636F730073696D6F6466"
DATA "FBDEFD03A86C6F6F72076365696C0F6124BD21E1DF9B7870313007613CF7DE16F92373693A6703272FFE7F2BFB00706F77E4A0FF35C26821A2DA0FC9FF9BFC7D124B08040808"
DATA "0300040C678C7DD8017F022F3E40FF00EFE49803260B9D0798C0FCDB4218403B054B00450052004EC7BABFD04CA70032002E0044094C1B466C90B1FFFB734672656507536574"
DATA "56616C750B47FEC2B71D416CD0632B4315457869745072DA5BDBDD0E6573F56D0004186F0072E973E6DAE6015564F901E305324833580B0B1D0496208334038D088E32200332"
DATA "8F9091033220039293B4E906E49202B5034F0973F70431B348013A006DC7204D733A007300642C5F834D36584D012011790100E9662363172F2F1113505CC3209F0741441163"
DATA "03AC61ACDB5F620572134E2B7613BA49EE864F2574006F530770AEFB5BE61125537500670373177393DC7D004A0B6C00796E277BCD7DAE3B702F691BA3610B5BB2D7758768E3"
DATA "1F620D75133761B365666111AFA3366CD8B0978F837B929D0D1B7767797BDFB061C37773674761DE0BD6754F751B643123AD03F6B9CB0F54AD2173135758B7EC754764E11527"
DATA "750FAC5BD64D4DB36E336B750F1B36EC857B6F675B61C3860D4F473FCDF6F88E23483A6D6D3AE900642CCBD67DCD204D20087900000B2F2FD2667B7008FF4D034144651BFB64"
DATA "8FF06D6265DC4E6F760B4F63746F0AD03FECD2647074144175677573741EA17B0DBF6C43076EC8417072B58FF0B1784D617263BF656272750BEFBDD79A238A0A675F575EF7DE"
DATA "7B534B47433779437BABBDF73F3B3323C4757264186C3BD69E4F5E095468127313CF0ED61E5765647C0C5475094D6FEFB9D9B16E10537507433B37B0FDDE7B2F27231F005F3D"
DATA "783F18F82E266674D85F00FB5F796EE05CC07403310D667215F833605B646F5F68791ABC601FDEFB5F636162606C641F0E9C39E40D7B7371727432063BF00E1C0AAB07AF0736"
DATA "D3F411D56E2F698D209F41AC91317293230D000A30D731185B4CD3530123B08E6D361D1349F74719EC753C05174F1741211FB9ED0209573600DD33014F935CF7112D23418DBF"
DATA "C720B12FD248DD20BD9F4D6D1B1B6BBA4C1763641366536D2B56ACAE1B68C9730961950535DDD769EB8775ED696796453ED70D6E21F5764B9835DDFB1F69191F6C7A27BA2F59"
DATA "F7D99F545F27641F633BB9C1466573206DE71F072FF635F36F751BCBAC1B903151632E1949E5FB62DD59556D15730F296B572BF6BD99BBD79D72694164DF73DF236FF9BBA96C"
DATA "D9877309AF2F272D4B33D09D5ED7AF1B287715D947846E6C4D293D016393098403214F61296FC67BBC6EA339352B05DF2B3661394493CD972E73934C09EF326E31CDAEEB0EEF"
DATA "65093DEB2061703BCCBAD98463DF5D4F6FEDB184B324A9196D511242C9945731EF846E40B8656F43475497F726241B7219616D9F234B10C62E17C7D8846593309337C1923C64"
DATA "43643F320038A184911EED61156505031BF60E039F4B4F496F888437BF77E1672039C0426F363244F611A5646F35AEFB224C70A957762F72432D69259D75398B064886EC3BBF"
DATA "345FC9DE58F7551178B92FB10D58D9100EB9C5BF9E9B48D8F539EF6F6D7F3B10EC92CF6F1F05E7979021EC6357388D96F138BC49037533C985AD04EB4737B92F58436DE5EB68"
DATA "43486593F55564036B5F8B850DC82F69FF2497BDC363475730C1797B875337F928002909E3D4E973E9CD0D806C5B498F01399F270E335E2183B3AF24DFB213B99F5738B0538F"
DATA "02711F51936C29E373BF57326637191C0E831B71700FE1F5E03D0B6D9DD11942385B368533640BE4C9635F000207AFF00898094F9E3CF2400AAEF810A0114012F2E4C923ADF8"
DATA "13A0183019234F9E3CACE01A701B001CAB3C79E4C9B01E701FAAA8204021C893278FA850783079147A223D79F2A7F8FCF0FFD04D1B088C3D1D813366DB56FBD4FCC0AC159F2B"
DATA "002B52AC4C3724594C396243D0BDB3B6E3E52E01073C0589B1CF375967256D7BAF1BE19B3D4B6B4D77053E3663933465614511215B50047A80654DA720A017E2AEAA200128F2"
DATA "00C824204800102103C844841043200332810110200332208202083026431001B2A34886680101268C11D8000101612190CB01023B1B95ADB2DFFF014DC865E6141B14016023"
DATA "4B84002FEF6D64CB46F71100FFFFFF15D88182838485868788898A8B8C8D8E8F909192939495FFFFFFFF969798999A9B9C9D9E9FA0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1"
DATA "B2B3B4B5FFFFFFFFB6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5FFFFFFFFD6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF"
DATA "F0F1F2F3F4F5FF5B83FFF6F7F8F9FAFBFCFDFE4E89030405060708090A0BFFFFFFFF0C0D0E0F101112131415161718191A1B1C1D1E1F202122232425262728292A2BFFFFFFFF"
DATA "2C2D2E2F303132333435363738393A3B3C3D3E3F406162636465666768696A6B8DA8FFFF6C6D6E6F707172737475767778797A5B5C5BAAECAFB0601F7B7C7D7E7FFFFF548530"
DATA "7F41424344454647E21210FF48494A4B4C4D4E4FCF5354854D78A9EA58595A7F1F650900617FFE94314A467EE4DD5F2A4923514E414E0007494E46004C546CE44453177F894A"
DATA "64A297482F5D29FE3F57696E646F775374617469331755E7C6FEFF7365724F626A656374496E666F726D1857391BB1DBB76D4C616E4118697665507B757013ED77CF660F4600"
DATA "4D51616765426F7831DF4896E8550053DB520048C8DB839200D98031BB400302B95C0E103BD06CB09F763E43D0BB07D80F2107B25B1F0642D4D88BAC3B07A203B33F1C2B0B01"
DATA "7B850D3A271DED0B21A7E4B0F98FC023752507F25B1F3198CC15F6223B356A3F38EECF970CB0DD4F5B4FB43F52EC75AF908D54AC03B00FDF9017D92B56995F584D004875AF59"
DATA "8B039E6E820A100202666E29A67579730300E465C922670345EFCF10C100910005461C90FF800A2E8C4C614310000020802460847AB314122DD5FFB222854515085195910203"
DATA "5315128C0AD07690DFFEA001020408A403D66082798221A6DF07233F3F79A1A5819FE0FC407E80A8D923A4772FC1A3DAA3D081FE07320436C840B52F4185FCDF0DB65FCFA2E4"
DATA "A21A00E5A2E8A25B7EBBFB7C7EA1FE510503DA5EDA5F5FDA6ADA3298DCFE4AD3D8DEE0F939317E8D159CA0D3CB54D3344DD303504C4844404DD3344D3C342C24180C9AA6B934"
DATA "04A6F8F4F0EC699AA669E8E4E0DCD8A6E99AA6D4D0CC2FC8C0E906699AB4ACA49C0394A6699AA68C80786C60DDA6699A5C584C382C097901699AEE64D1A624031C140CD334CD"
DATA "A504A5FCF4E4D44DD3344DC4B09C8C7870344DD3346860585048D3344DD34038302820AC692E4D1808A4F4E8DC2FD3344DF7A4D003C4B4A0904DD3344D7C686058441C23C29E"
DATA "333FB700047610D8D5C40F01AB73B9BDE4DBF8B2C03BB748B8C820DD613B03D73037160302344D33D803070418050DD2344DD30609070C08C860830C090A1B0B06FBDE0B573B"
DATA "070F57107C41BAC113110312172132C86083350F4143D860830D50335217530760830D36575F597B6C1748D334DD6DAB20701C7260837D2FC72F80B38107830D32D8821F8384"
DATA "8F91830CD234299EA1A40D36C8606FA7B79FCEC23908831FD70B180733C29B8A5858B119BF4495273FCF1E9426071400A26C1D7079E4C9931A601B641FA7C81367CF9E3CC021"
DATA "B80E1F580D0750F6ECD9930F34101FB00507A81E174F9E3C7B1812071420100C2C0BE4D9B32724152FA01C0F1C199E3C79F6981107901888168017D493274F78227423702490"
DATA "CFCF4F9BA76C25A76426A7582A81449DF8FFCB0E6B98842F10290113306121BB30E3010717A2ECCC461F2F100899D91F24B99D740D2E0B2EF003E8B84D17EC287F002FF4BCFB"
DATA "F55A61035B53B4C20385EA81968BE3FCD538D93018F740C8FF038190A6C168E118FF20237F0161F247622005934B72B20F902EA002400BC8059EE4495EFA08409C0C50C30F21"
DATA "3FE44924F41280969816FFCF3FF920BCBE1904BFC91B8E34A1EDCCCE1BC2D34E40FFFFFFFF20F09EB5702BA8ADC59D6940D05DFD25E51A8E4F19EB83407196D795430E058DB7"
DATA "FFFFFF29AF9E40F9BFA044ED81128F8182B940BF3CD5A6CFFF491F783C406FFFFFFFFFC6E08CE980C947BA93A841BC856B5527398DF770E07C42BCDD8EDEF99DFBEB7EFFFFFF"
DATA "FFAA5143A1E676E3CCF2292F84812644281017AAF8AE10E3C5C4FA44EBA7D4F3F7D4FFFFFFEBE14A7A95CF4565CCC7910EA6AEA019E3A3460D65170C758186FFFFFFBFACC948"
DATA "4D5842E4A793393B35B8B2ED534DA7E55D3DC55D3B8B9E925AFF5DFF97F812D7A120C054313761D1FD8B5A8BD8255DE0FFFFFF89F9DB67AA95F8F327BFA2C85DDD806E4CC99B"
DATA "97208A025260C425FDCFDA87FFCDCC0100FB3F713D0AD7A370FFFFFFFF04F83F5A643BDF4F8D976E1283F53FC3D32C6519E25817B7D1F13FD00F23FFFFFFFF84471B47ACC5A7"
DATA "EE3F40A6B6696CAF05BD3786EB3F333DBC427AE5D594BFD6E7FFFFFFFF3FC2FDFDCE61841177CCABE43F2F4C5BE14DC4BE9495E6C93F92C4533B7544CDFFFFFFFF14BE9AAF3F"
DATA "DE67BA943945AD1EB1CF943F2423C6E2BCBA3B31618B7A3F615559FFF6FFFFC17EB1537C12BB5F3FD7EE2F8D06BE928515FB44233FA5E939A527EAFFFFFFFF7FA82A3F7DACA1"
DATA "E4BC647C46D0DD553E637B06CC23547783FF91813D91FA3A19FF37FEFF7A63254331C0AC3C2189D138824797D3FDD73BDC8858081BB1E8FFFFFFFFE386A6033BC684454207B6"
DATA "997537DB2E3A33711CD223DB32EE49905A39A687BEFFFFFFFFC057DAA582A6A2B532E268B211A7529F4459B7102C2549E42D36344F53AECE6BFFFFFFFF258F5904A4C0DEC27D"
DATA "FBE8C61E9EE7885A57913CBF508322184E4B6562FD838F41A17FFBAF06947D112DDE9FCED2C804DD4A2C44603D0D01170C41498088BF3C13105CA0014865617008DA4FFE4465"
DATA "7374726F7953697A65096BDFFE176743757272656E74546805616449641326765B2078636F6488691465722221B7DB7F6F6D6D616E644C1165411F456EC54F20384973F16F72"
DATA "466536B73543761A0273511A54007A13804D09A0817C49630C53B5DD6B0791474E2C6B6585FBF69DAD61426D7D4D6D756C65488063106C9B055711532E45812D9B6DB56F9D0D"
DATA "43D6FD0DE44465A24164649873FE80DCED6C7353516570D1B6CDDE12E65F6BF5753DDAF6660F53746412612A69B982AD751B3C437209630A2F63CB0AB70EC9411F537012342C"
DATA "1CECDB46692F547970654161721A706C3B7410F957611A744087BF808DEB3A4E616D6CB5B75D78A77076699D6ECC47F6B6DDBD346E677343576964416855546F4D314B60B3B7"
DATA "3F427974692CF1DA0B9FE143DF23517572795003C22B9C088368E6E8CC58B64D548F6BC119287C8F21191AC9796DB3F7BA5657289D73A7092D7BAC8DBD50DD0A410B074F454D"
DATA "097E6C86C621EBAE433561676D8511EE2D556E684E64785970157678EEFC49837C1C656C2FB447386275674172615930D7B60B6DE3D7A4B72D59BB5B125261692D4D0F1DAE84"
DATA "854C08767D45052F1887941539C30A2A363DD852650C4C6F610F627221823BB49C8C36B5C495DB5D001E52746CD57769096E42DB37434D459818BA161B4221C5CF41209F66E9"
DATA "633D57C369E45F76F65AC34B786D705FB86B0C09D51BD848FF745F6E756D5F74BB73211BB7B6B94671C906690F875F69EF00DB1CB604382165966DAEB560161005124B64B37F"
DATA "84E22CBB6B01171605060401FFFFFF6408E44819841A09085E12400B12131C9038050A3418080939B7FFFFFF34060615321C18532D8C08150BF0B6025646F06005C1F0970117"
DATA "4908A5F96FFF06076B3E3909240C00280909162B1B07090C88FF03F209094704080518639267A874BFF065FBDB0D4F1108020A050B070C0601097FFBDF6D0408080D0A060A22"
DATA "152640062A561618267A230AAEB537F738084C101803060F0E1CAF6BDEDED676010807083205B403050F16B6FFF6DB100501070F0D092006182B06122A1E376FFF6DD902391C"
DATA "1107227508130B05126E1C0A16FFEDFFED0B1A0B790611390A26071A072B7F266A450715470A2B181EEDF67FFB2430122E23E520250B0F380A410B0A11E7C001A66FEDED7761"
DATA "6C061C284C0C5C210528D3890C1D546DFBFFFFDA08181B57F08A01230D0C08080C29089E3D17F0702C3AC0FEFFB7C20E09303B190A1324373513701D496F1F750C13121BFBFF"
DATA "E6DE2517191CE7AC272911144C4F4854C32E781A86A1FDFF7F3512E00A0D3E070D06880CF037012EA8D5321807C82BC2EE207C29261E07364A0604660B55FF9F90BB16212A32"
DATA "F04F011C23F0780187F01B01FFFFFFFFF01003F066011B1616086DF00901702A6C4FF024021212260D0E3042F0F4003485DFDAFF070A12170E0623071914869D405420192F54"
DATA "B6DBB7857D706ED037181437E70E050010BDED0ADF130847053A4A010E61B0880F0F5BB8FDB69B25927005090F231E17EE461E3FFFBFF06D72D147180A1BB20E340D15311D4C"
DATA "2EA90CF00B0103D9FDF24F4999D099F0EB0312002612ED770B14B8838408B1E19806A1368C0BA7EC9C173A0EBD02434C032FAFF0BF05D001C228101D5124F06FF200370A8693"
DATA "0708724829090BE1C676F30C05100507F064FAC38A194F3D6168BF0852230B0640E278FB6FCF764EE30A0B3B1A1AF002026F2B650C2D747F5F9F09F0EA0478F05E0B2E1C4F0F"
DATA "CAFFAFCC7B01F06C0904C004481C04200C1CDD39D7A065090203F0F812025B6A97CE8402900400644E819C10046010B00476AC7F659401A3AA8A01B9EC7C810C0051E0AD09C3"
DATA "4C1B00256FD4A0850F0201E0000221D60A04E8C8AFED0050C517DFACE204E8B0E91005BED9A46205EA071901F78EC5827D1E40012A029BEDD9B2070610D3074D2CCD91C24C14"
DATA "7800DBA9E4437EF807F0CA104007B26E20A7FC2F2E7482ED0A41F007AE95906E150BFBEB0423EC602EDC0A34827557FB5D23BB85748324279A77402E3B8B6C782640441D53BE"
DATA "276E0EB629C04F656FDB340C4D49B345270ECE4283886EF71B641742042351800000004000200100FF000000000000000000807C2408010F85B901000060BE00C000108DBE00"
DATA "50FFFF57EB109090909090908A064688074701DB75078B1E83EEFC11DB72EDB80100000001DB75078B1E83EEFC11DB11C001DB73EF75098B1E83EEFC11DB73E431C983E80372"
DATA "0DC1E0088A064683F0FF747489C501DB75078B1E83EEFC11DB11C901DB75078B1E83EEFC11DB11C975204101DB75078B1E83EEFC11DB11C901DB73EF75098B1E83EEFC11DB73"
DATA "E483C10281FD00F3FFFF83D1018D142F83FDFC760F8A02428807474975F7E963FFFFFF908B0283C204890783C70483E90477F101CFE94CFFFFFF5E89F7B9EB0200008A07472C"
DATA "E83C0177F7803F0A75F28B078A5F0466C1E808C1C01086C429F880EBE801F0890783C70588D8E2D98DBE000001008B0709C0743C8B5F048D84300020010001F35083C708FF96"
DATA "3C200100958A074708C074DC89F95748F2AE55FF964020010009C07407890383C304EBE16131C0C20C0083C7048D5EFC31C08A074709C074223CEF771101C38B0386C4C1C010"
DATA "86C401F08903EBE2240FC1E010668B0783C702EBE28BAE442001008DBE00F0FFFFBB0010000050546A045357FFD58D871F02000080207F8060287F585054505357FFD558618D"
DATA "4424806A0039C475FA83EC80E93CEDFEFF0000004800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "0000000000000000000080E9001040CB001003000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005C3001003C3001000000000000000000"
DATA "0000000069300100543001000000000000000000000000000000000000000000743001008230010092300100A2300100B030010000000000BE300100000000004B45524E454C"
DATA "33322E444C4C0056434F4D5039302E444C4C00004C6F61644C69627261727941000047657450726F634164647265737300005669727475616C50726F74656374000056697274"
DATA "75616C416C6C6F6300005669727475616C467265650000005F76636F6D705F666F726B0000000000256F735600000000FE300100010000000100000001000000F4300100F830"
DATA "0100FC300100501100000E31010000007072696D65636F756E74342E646C6C007072696D65636F756E74000000000020010010000000CD38C83ACC3A00000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
DATA "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
CLOSE #1
END
