十進BASICプログラミングについての質問や研究成果の公開にご利用ください。
メッセージ入力枠は右下をドラッグして拡大できます。 画像，URLは省略可能です。
編集/削除キーを入力しなくてもエラーにはなりませんが，何か適当な半角英数字4～8文字を指定してください。
特に，長文投稿の場合，プレビューで最後の行を確認しても，実際には途中で切れてしまうことがあるので，投稿後の確認が必要です。
Linux版basicとBASファイルの関連付け
- 島村1243
2026/02/09 (Mon) 11:54:02
Lubuntu-24.0でLinux(GTK2)版十進BASICの最新版を利用しています。
作成した自作「xxx.BAS」ファイルと実行ファイル「basic」の関連付けについてお尋ねします。
Windows版「十進BASIC.exe」の場合は、作成した自作「xxx.BAS」ファイルをダブルクリックすると「BASIC.exe」が起動し、「xxx.BAS」ファイルを読み込むだけで実行はしません。
ところが、Linux版十進basicの場合は、「xxx.BAS」をダブルクリックすると、「xxx.BAS」を実行してしまいます。
Windows版と同じように読み込むだけにしたい場合は、どのような起動オプションが必要なのか、ご教示頂けると幸いです。
現在、Lubuntu-24.0において以下の様な処理を行っています。
/home/shima/.local/share/applications/
ディレクトリに
10BASIC.desktop
という名前のファイルを作成し、そのファイルに下記内容を記入しました。
起動オプションとはExec行の末尾「-OR」の事です。
[Desktop Entry]
Comment=Description of Application
Type=Application
Name=十進BASIC
Icon=/home/shima/apps/basic.png
Exec=/home/shima/apps/BASIC81Ja/basic -OR
StartupNotify=false
Categories=Education;
MimeType=plane-txt/x-basic;
なお、上記載のExec行の起動オプション「-OR」を記述しないと、「xxx.BAS」をダブルクリックしたときにbasicが起動して直後終了してしまうのを防止するために記述していますが、意味はわかりません。
タイムアタックゲーム
- しばっち
2026/02/08 (Sun) 08:00:53
タイムアタックゲーム(時間感覚を計るゲームです)
単に10秒、20秒、30秒、40秒と順に計るだけです。
スペースキーを押すと始まります。
10秒経ったと思ったら再度スペースキーを押します。
得点の持ち点は100点です。
実時間との誤差分を得点から差し引いていきます。
次は20秒、その次は30秒、最後に40秒を計ります。
誤差が大きいと得点がどんどん減点されます。
CALL GINIT(800,800)
SET TEXT COLOR 7
SET TEXT BACKGROUND "OPAQUE"
SET TEXT JUSTIFY "CENTER","HALF"
DIM T(4)
FOR I=1 TO 4
READ T(I)
LET SCORE=SCORE+T(I)
NEXT I
DATA 10,20,30,40
FOR I=1 TO 4
SET TEXT HEIGHT 60
PLOT TEXT ,AT 400,50:" SCORE:"&STR$(SCORE)&" "
SET TEXT HEIGHT 40
PLOT TEXT ,AT 400,400:" "&STR$(T(I))&"秒後、再度押してください "
PLOT TEXT ,AT 400,600:"HIT SPACE KEY"
DO
LOOP UNTIL GETKEYSTATE(32)<0
DO
LOOP WHILE GETKEYSTATE(32)<0
PLOT TEXT ,AT 400,400:" 只今、"&STR$(T(I))&"秒を計測中です "
PLOT TEXT ,AT 400,600:"HIT SPACE KEY"
LET TI=TIME
DO
LOOP UNTIL GETKEYSTATE(32)<0
PLOT TEXT ,AT 400,400:" "&STR$(ROUND(TIME-TI,2))&"秒でした "
LET S=ROUND(ABS(TIME-TI),2)
WAIT DELAY 1
LET SCORE=SCORE-S
DO
LOOP WHILE GETKEYSTATE(32)<0
NEXT I
PLOT TEXT ,AT 400,50:"SCORE:"&STR$(SCORE)
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"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB
シューティングゲーム
- しばっち
2026/02/08 (Sun) 07:59:16
インベーダー風のシューティングゲームです。
4,6キーで移動します。
両サイドから敵が出てきます。
スペースキーでビーム発射です。
DECLARE EXTERNAL FUNCTION STICK
RANDOMIZE
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT COLOR 7
SET TEXT HEIGHT 20
SET TEXT BACKGROUND "OPAQUE"
LET NUMMAX=4 ! 敵最大数
DIM F(9,7),E(8,8),X(NUMMAX),Y(NUMMAX),XC(NUMMAX),ENEMY(NUMMAX)
DIM XZ(NUMMAX),YZ(NUMMAX),FL(NUMMAX)
DIM EC(8,8),FC(9,7)
LET XSIZE=600
LET YSIZE=600
CALL GINIT(XSIZE,YSIZE)
LET SC=5
FOR J=1 TO 8
FOR I=1 TO 8
READ E(I,J)
NEXT I
NEXT J
FOR J=1 TO 7
FOR I=1 TO 9
READ F(I,J)
NEXT I
NEXT J
DATA 0,0,0,7,7,0,0,0
DATA 0,0,7,7,7,7,0,0
DATA 0,7,7,7,7,7,7,0
DATA 7,7,0,7,7,0,7,7
DATA 7,7,7,7,7,7,7,7
DATA 0,0,7,0,0,7,0,0
DATA 0,7,0,7,7,0,7,0
DATA 7,0,7,0,0,7,0,7
DATA 0,0,0,0,7,0,0,0,0
DATA 0,0,0,0,7,0,0,0,0
DATA 0,0,0,7,0,7,0,0,0
DATA 0,0,7,0,7,0,7,0,0
DATA 7,0,7,0,7,0,7,0,7
DATA 7,7,7,0,7,0,7,7,7
DATA 7,0,0,7,7,7,0,0,7
LET YY=550 ! 自機初期位置
LET XX=XSIZE/2
LET MISS=3 ! 自機数
DO
LET NUM=INT(RND*NUMMAX+1)
FOR I=1 TO NUM
PLOT TEXT ,AT XSIZE/2,10:"SCORE:"&STR$(SCORE)&" 残機:"&STR$(MISS)
IF ENEMY(I)=0 THEN
LET Y(I)=20+INT(YSIZE/8/SC*RND)*5*SC ! 敵位置
IF RND<.5 THEN
LET X(I)=0
LET XC(I)=10 ! 敵向き
ELSE
LET X(I)=XSIZE-1
LET XC(I)=-10
END IF
LET ENEMY(I)=1
END IF
LET S=STICK ! キー入力
SET DRAW MODE HIDDEN
CALL BOX(XX,YY,XX+9*SC,YY+7*SC,0) ! 自機消去
CALL BOX(X(I),Y(I),X(I)+8*SC,Y(I)+8*SC,0) ! 敵消去
IF FL(I)=1 THEN CALL BOX(XZ(I),YZ(I),XZ(I)+3,YZ(I)+15,0) ! 敵の弾消去
IF S=4 THEN LET XX=XX-15 ! 自機移動
IF XX<0 THEN LET XX=0
IF S=6 THEN LET XX=XX+15
IF XX>XSIZE-1-8*SC THEN LET XX=XSIZE-1-8*SC
LET X(I)=X(I)+XC(I) ! 敵移動
MAT PLOT CELLS,IN XX,YY;XX+8*SC,YY+6*SC:F ! 自機表示
MAT PLOT CELLS,IN X(I),Y(I);X(I)+7*SC,Y(I)+7*SC:E ! 敵表示
IF FL(I)=0 AND RND<.5 THEN ! 敵の弾
LET XZ(I)=X(I)+4*SC
LET YZ(I)=Y(I)+8*SC
LET FL(I)=1
END IF
SET DRAW MODE EXPLICIT
IF FL(I)=1 THEN
LET YZ(I)=YZ(I)+15 ! 敵の弾移動
CALL BOX(XZ(I),YZ(I),XZ(I)+3,YZ(I)+15,4) ! 敵の弾移動
END IF
IF S=10 THEN ! スペースキー
LET XS=XX+4*SC
FOR YS=YY TO 20 STEP -20 ! 自機弾の発射
CALL BOX(XS,YY-20,XS+3,YS,2)
CALL BOX(XS,YY-20,XS+3,YS,0)
IF X(I)<XS AND X(I)+7*SC>XS AND Y(I)<YS AND Y(I)+7*SC>YS THEN ! 敵命中
CALL BOX(X(I),Y(I),X(I)+8*SC,Y(I)+8*SC,0)
LET SCORE=SCORE+10
LET ENEMY(I)=0
END IF
NEXT YS
END IF
IF YZ(I)>580 THEN ! 敵の弾
CALL BOX(XZ(I),YZ(I),XZ(I)+3,YZ(I)+15,0)
LET FL(I)=0
END IF
IF XZ(I)<XX AND XZ(I)+3>XX+8*SC AND YZ(I)+15<YY AND YZ(I)+15>YY+7*SC THEN ! 自機命中
CALL BOX(XX,YY,XX+8*SC,YY+7*SC,2)
WAIT DELAY .1
CALL BOX(XX,YY,XX+8*SC,YY+7*SC,0)
LET MISS=MISS-1
LET FL(I)=0
END IF
IF X(I)>XSIZE-1 OR X(I)<-7*SC THEN LET ENEMY(I)=0 ! 敵リセット
NEXT I
LOOP UNTIL MISS=0 ! 全部やられたら
SET TEXT COLOR 2
SET TEXT HEIGHT 40
PLOT TEXT , AT XSIZE/2,YSIZE/2:"GAME OVER"
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"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB
EXTERNAL SUB BOX(X1,Y1,X2,Y2,C)
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2;X1,Y1
END SUB
EXTERNAL FUNCTION STICK !'キー入力
LET STICK=-1
IF GETKEYSTATE(37)<0 THEN LET STICK=4
IF GETKEYSTATE(38)<0 THEN LET STICK=8
IF GETKEYSTATE(39)<0 THEN LET STICK=6
IF GETKEYSTATE(40)<0 THEN LET STICK=2
FOR I=48 TO 57
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-48
EXIT FUNCTION
END IF
NEXT I
FOR I=96 TO 105
IF GETKEYSTATE(I)<0 THEN
LET STICK=I-96
EXIT FUNCTION
END IF
NEXT I
IF GETKEYSTATE(32)<0 THEN LET STICK=10
END FUNCTION
ASSIGN文で定義される数値関数 - SHIRAISHI Kazuo
2026/02/04 (Wed) 09:58:55
BASIAcc，ParactBASIC，arm64版 BASIC ver.0.9 では，64ビット環境でASSIGN文で定義される数値関数はDLLの出力が64ビットであると仮定するものになっています。
十進BASIC全体にこの原則を拡大します。
それによって，ポインタ値を返すDLLの利用が可能になります。
一方，x86_64, arm64ともに，32bit演算で上位32ビットが0になるので，int型として定義されたDLLを呼び出すと，負数は2^32加算された数として得られることになります。
int型で定義されたDLLを用いるとき，得られた結果に次のint32関数を適用することで，32ビット環境との互換性が保持されます(共通に使用できるコードになる)。
FUNCTION int32(n)
IF n<2^31 THEN LET int32=n ELSE LET int32=n-2^32
END FUNCTION
Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/08/14 (Thu) 10:55:55
Raspberry Pi OS のRaspbianでGPIOを仮想ファイルとして扱うので試してみました。
https://tool-lab.com/raspi-gpio-controlling-command-1/
を参考にしました。
GPIO4にLEDを，GPIO5にスイッチを接続しています。
/sys/class/gpio/exportに4を書き込みとGPIO4が使用可能となるので，
OPEN #1:NAME "/sys/class/gpio/export",ACCESS OUTPUT
PRINT #1:4
CLOSE #1
としてみたのですが，機能しませんでした。
100行のようにechoコマンドを実行することで済ませています。
echoコマンドはbashの内部コマンドなので，echoをEXECUTE文で呼び出すことはできません。
100 EXECUTE "/bin/bash" WITH ("-c", "echo 4 >/sys/class/gpio/export")
110 EXECUTE "/bin/bash" WITH ("-c", "echo 5 >/sys/class/gpio/export")
120 WAIT DELAY 0.1
130 EXECUTE "/bin/bash" WITH ("-c", "echo out >/sys/class/gpio/gpio4/direction")
140 EXECUTE "/bin/bash" WITH ("-c", "echo in >/sys/class/gpio/gpio5/direction")
150 OPEN #4:NAME "/sys/class/gpio/gpio4/value", ACCESS OUTPUT
160 FOR i=1 TO 20
170 PRINT #4:STR$(MOD(i,2))
180 OPEN #5:NAME "/sys/class/gpio/gpio5/value", ACCESS INPUT
190 INPUT #5:s$
200 CLOSE #5
210 PRINT s$
220 WAIT DELAY 0.5
230 NEXT I
240 CLOSE #4
250 EXECUTE "/bin/bash" WITH ("-c", "echo 4 >/sys/class/gpio/unexport")
260 EXECUTE "/bin/bash" WITH ("-c", "echo 5 >/sys/class/gpio/unexport")
270 END
130行，140行は，
OPEN #2:NAME "/sys/class/gpio/gpio4/direction", ACCESS OUTPUT
PRINT #2:"out"
CLOSE #2
OPEN #3:NAME "/sys/class/gpio/gpio5/direction", ACCESS OUTPUT
PRINT #3:"in"
CLOSE #3
のようにしても大丈夫でした。
出力は/sys/class/gpio/gpio4/valueに"0"または"1"を書き込むのですが，それは，150行，170行のように実行可能でした。
入力は，180～200行のように毎度OPEN～CLOSEを実行しないと読み込めませんでした。
Re: Raspberry Pi GPIO Raspberry PI OS Bookworm - SHIRAISHI Kazuo
2025/08/14 (Thu) 11:11:15
Raspberry Pi OS Bookwormだと，GPIOの番号が変わってしまうそうです。
https://xtech.nikkei.com/atcl/nxt/column/18/01109/040700054/?P=2
に従って，
cat /sys/kernel/debug/gpio
を実行して調べてみると，私のRaspberry Piでは，GPIO4,5の番号は，それぞれ，516，517に変更されていました。
次のように書き換えると実行可能でした。
100 EXECUTE "/bin/bash" WITH ("-c", "echo 516 >/sys/class/gpio/export")
110 EXECUTE "/bin/bash" WITH ("-c", "echo 517 >/sys/class/gpio/export")
120 WAIT DELAY 0.1
130 EXECUTE "/bin/bash" WITH ("-c", "echo out >/sys/class/gpio/gpio516/direction")
140 EXECUTE "/bin/bash" WITH ("-c", "echo in >/sys/class/gpio/gpio517/direction")
150 OPEN #4:NAME "/sys/class/gpio/gpio516/value", ACCESS OUTPUT
160 FOR i=1 TO 20
170 PRINT #4:STR$(MOD(i,2))
180 OPEN #5:NAME "/sys/class/gpio/gpio517/value", ACCESS INPUT
190 INPUT #5:s$
200 CLOSE #5
210 PRINT s$
220 WAIT DELAY 0.5
230 NEXT I
240 CLOSE #4
250 EXECUTE "/bin/bash" WITH ("-c", "echo 516 >/sys/class/gpio/unexport")
260 EXECUTE "/bin/bash" WITH ("-c", "echo 517 >/sys/class/gpio/unexport")
270 END
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/08/14 (Thu) 13:23:01
https://pip.raspberrypi.com/categories/685-whitepapers-app-notes/documents/RP-006553-WP/A-history-of-GPIO-usage-on-Raspberry-Pi-devices-and-current-best-practices.pdf
によると，/sys/class/gpio/は廃止予定で，替わりにlibgpiodを使えという。
Intel CPU版で利用可能なDLL呼び出し
https://decimalbasic.web.fc2.com/ExtDLL.htm
をARM64でも実行できるように準備中ですが，とりあえず，
https://qiita.com/ma2shita/items/d745a8f89c673fd74a5e
を参考にpinctrlコマンドでアクセスするプログラムを作ってみました。
100 EXECUTE "/bin/bash" WITH ("-c", "pinctrl set 5 ip pd") !gpio5を入力に変更
110 FOR i=1 TO 20
120 IF MOD(i,2)=1 THEN
130 EXECUTE "/bin/bash" WITH ("-c", "pinctrl set 4 op dh")
140 ELSE
150 EXECUTE "/bin/bash" WITH ("-c", "pinctrl set 4 op dl")
160 END IF
170 EXECUTE "/bin/bash" WITH ("-c", "pinctrl get 5 >gpio5.txt")
180 WAIT DELAY 0.25
190 OPEN #1:NAME "gpio5.txt"
200 LINE INPUT #1:s$
210 PRINT s$
220 !ERASE #1
230 CLOSE #1
240 WAIT DELAY 0.25
250 NEXT i
260 END
pinctrlは独立コマンドなのでEXECUTE文で直接実行可能ですが，データ入力にはコマンドからの返答を取り込む必要があるので，
170行のようにファイル（gpio5.txt）を介してデータを受け取ることにします。そのため，bashを介しての実行になっています。
220行のERASE文は不要だったようです（追記されるのでなく，書き込み時毎度リセットされる）。
受け取ったデータは，次のようになっています。
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | lo // GPIO5 = input
5: ip -- | lo // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | lo // GPIO5 = input
5: ip -- | lo // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
5: ip -- | hi // GPIO5 = input
スイッチの操作でhiとloが切り替わっています。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/08/18 (Mon) 15:16:25
DLL呼び出しが可能になるように拡張しました（Ver.0.7.6.2，および Ver.0.9.2.6）。
Qiitaの記事
https://qiita.com/wancom/items/b041ee7408a87fabf48e
を参考にlibgpiod呼び出しに書き換えてみました。
事前に
sudo apt install libgpiod2 libgpiod-dev libgpiod-doc
を実行して，libgpiodをインストールしておいてください。
100 ! sudo apt install libgpiod2 libgpiod-dev libgpiod-doc
110 ! /usr/share/doc/libgpiod-dev/html
120 OPTION ARITHMETIC NATIVE
130 FUNCTION GPIOD_CHIP_OPEN_LOOKUP(s$)
140 ASSIGN "libgpiod.so","gpiod_chip_open_lookup"
150 END FUNCTION
160 FUNCTION gpiod_chip_get_line(n,t)
170 ASSIGN "libgpiod.so","gpiod_chip_get_line"
180 END FUNCTION
190 SUB gpiod_line_request_output(n,s$,t)
200 ASSIGN "libgpiod.so","gpiod_line_request_output"
210 END SUB
220 SUB gpiod_line_request_input(n,s$)
230 ASSIGN "libgpiod.so","gpiod_line_request_input"
240 END SUB
250 SUB gpiod_line_set_value(gpio, x)
260 ASSIGN "libgpiod.so","gpiod_line_set_value"
270 END SUB
280 FUNCTION gpiod_line_get_value(gpio)
290 ASSIGN "libgpiod.so","gpiod_line_get_value"
300 END FUNCTION
310 SUB ppiod_chip_close(gchip)
320 ASSIGN "libgpiod.so","gpiod_chip_close"
330 END SUB
340 LET GChip=GPIOD_CHIP_OPEN_LOOKUP(STR$(0))
350 ! PRINT GChip
360 LET gpio4 = gpiod_chip_get_line(GChip, 4)
370 ! PRINT gpio4
380 LET gpio5 = gpiod_chip_get_line(GChip, 5)
390 ! PRINT gpio5
400 CALL gpiod_line_request_output(gpio4, "LED", 0)
410 CALL gpiod_line_request_input(gpio5,"Switch")
420 FOR i=1 TO 20
430 CALL gpiod_line_set_value(gpio4, MOD(i,2))
440 WAIT DELAY 0.25
450 PRINT gpiod_line_get_value(gpio5)
460 WAIT DELAY 0.25
470 NEXT i
480 CALL ppiod_chip_close(GChip)
490 END
参考例(Qiitaの記事)では gpiod_chip_open_lookup の引数が""になっていますが，ASSIGN文で定義されるDLLに空文字列を指定するとヌルポインタが渡されるので，
空文字列への(ヌルでない)ポインタを渡すために340行ではchr$(0)を指定します。
"/dev/gpiochip4"のようなデバイス名を指定すべきところだと思いますが，OSがBullseyeだと/devにそれらしきデバイス名が出て来ないのですが，chr$(0)を指定すると動作します。
また，gpiod_chip_open_lookup が返す値はポインタですが，十進BASICでは2進モードでも53ビットの精度しかないので，64ビット環境だと使えない可能性があります。
350行の ! を削除してその値が53ビットの範囲にあることの確認が必要です。
ただし，64ビットのポインタは下位3ビットが0であるのが普通なので，2^56以下であれば可かも知れません。
400行，410行の"LED"，"Switch"は，使い道が不明ですが，適当に付けた名前です。
libgpoidの詳細は，
/usr/share/doc/libgpiod-dev/html/modules.html
にあります。とりあえず
/usr/share/doc/libgpiod-dev/html/group__line__request.html
/usr/share/doc/libgpiod-dev/html/group__line__value.html
あたりを見てください。
上の例は上記文書を読みこなしていない状態で作成したものです。とりあえず動作する参考例にしてください。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/08/31 (Sun) 18:37:35
Raspberry PI OSで動くBASICAcc，ParactBASICでASSIGN文とCALLBACK関数が使えるようにしました。
ParactBASICのテスト用のプログラムを作成しました。
「シグナル」の部分は対応する英単語（Full BASICの機能語）に置き換えてください。そのままだと掲示板の禁止ワードに引っかかって書き込めませんでした。
100 DECLARE STRUCTURE struct1: 1 OF NUMERIC
110 DECLARE STRUCTURE struct2: 1 OF string
120 DECLARE SHARED share1 OF struct1
130 DECLARE SHARED share2 OF struct2
140 !
1000 PARACT part1
1010 DECLARE EXTERNAL FUNCTION GPIOD_CHIP_OPEN_LOOKUP
1020 DECLARE EXTERNAL FUNCTION gpiod_chip_get_line
1030 LET GChip=GPIOD_CHIP_OPEN_LOOKUP(STR$(0))
1040 LET gpio4 = gpiod_chip_get_line(GChip, 4)
1050 CALL gpiod_line_request_output(gpio4, "LED", 0)
1060 PUT TO share1 FROM GChip
1070 PUT TO share2 FROM ""
1080 START part2
1090 シグナル ready
1100 REM
1110 FOR i=1 TO 10
1120 WAIT EVENT go
1130 CALL gpiod_line_set_value(gpio4, MOD(i,2))
1140 シグナル ready
1150 NEXT i
1160 PUT TO share2 FROM "end"
1170 END PARACT
1180 !
2000 PARACT part2
2010 DECLARE EXTERNAL FUNCTION gpiod_chip_get_line
2020 DECLARE EXTERNAL FUNCTION gpiod_line_get_value
2030 GET FROM share1 TO GChip
2040 LET gpio5 = gpiod_chip_get_line(GChip, 5)
2050 CALL gpiod_line_request_input(gpio5,"Switch")
2060 DO
2070 GET FROM share2 TO fin$
2080 IF fin$<>"" THEN EXIT DO
2090 IF gpiod_line_get_value(gpio5)=0 THEN !Switchが押された
2100 WAIT EVENT ready
2110 シグナル go
2120 WAIT DELAY 0.25
2130 END IF
2140 LOOP
2150 CALL gpiod_chip_close(GChip)
2160 END PARACT
2170 !
3000 EXTERNAL FUNCTION GPIOD_CHIP_OPEN_LOOKUP(s$)
3010 ASSIGN "libgpiod.so","gpiod_chip_open_lookup"
3020 END FUNCTION
3030 !
3100 EXTERNAL FUNCTION gpiod_chip_get_line(n,t)
3110 ASSIGN "libgpiod.so","gpiod_chip_get_line"
3120 END FUNCTION
3130 !
3200 EXTERNAL SUB gpiod_line_request_output(n,s$,t)
3210 ASSIGN "libgpiod.so","gpiod_line_request_output"
3220 END SUB
3230 !
3300 EXTERNAL SUB gpiod_line_set_value(gpio, x)
3310 ASSIGN "libgpiod.so","gpiod_line_set_value"
3320 END SUB
3330 !
3400 EXTERNAL SUB gpiod_line_request_input(n,s$)
3410 ASSIGN "libgpiod.so","gpiod_line_request_input"
3420 END SUB
3430 !
3500 EXTERNAL FUNCTION gpiod_line_get_value(gpio)
3510 ASSIGN "libgpiod.so","gpiod_line_get_value"
3520 END FUNCTION
3530 !
3600 EXTERNAL SUB gpiod_chip_close(gchip)
3610 ASSIGN "libgpiod.so","gpiod_chip_close"
3620 END SUB
スイッチを押すごとにLEDのON,OFFを反転し，スイッチを10回押すと終了します。
Full BASICでは，まだ受け取られていないシグナルを重複して発出すると例外状態になります。
それを避けるため，並列単位Part1はシグナルgoを受け取るとシグナルreadyを発行してシグナルgoが発出可能になったことを知らせます。
なお，シグナルの名称は機能語ではありません。任意に名付けることができます。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/09/05 (Fri) 18:07:58
CallBack関数のテストです。
GPIODのgpiod_ctxless_event_monitorは，イベントが発生するとCallBack関数を呼び出します。
CallBack関数の形式は
https://libgpiod-dlang.dpldocs.info/gpiod.gpiod_ctxless_event_handle_cb.html
int function(int uint const(timespec)* void*)
となっているので，
はじめの2個が数値，後の2個が文字列型の引数を取る関数として用意します。（次プログラムの1180行）
ここでは，スイッチを押すごとにLEDのOn,Offを交替さています。
10回押すと終了するようにします。
CallBack関数が1を返すとgpiod_ctxless_event_monitorは終了します。
最初の引数のevtypeがイベントの種類で，スイッチを押したとき2, 戻ったとき3，Time Outのとき１です。
gpiod_ctxless_event_monitorの形式は
https://libgpiod-dlang.dpldocs.info/gpiod.gpiod_ctxless_event_monitor.html
int gpiod_ctxless_event_monitor(const(char)* device, int event_type, uint offset, bool active_low, const(char)* consumer,
const(timespec)* timeout, gpiod_ctxless_event_poll_cb poll_cb, gpiod_ctxless_event_handle_cb event_cb, void* data)
poll_cbはnilでいいのですが，厄介なのがtimeout でtimespec構造体へのポインタの形で用意しないといけません。
正確にはよくわからないのですが，1120行のようにしたら動きました。指定した秒数経過するとtimeoutでCallBackが発生します。
1番はじめの引数deviceでハマりました。結局，
https://note.com/bsoft/n/n66a5cf9c4910
https://qiita.com/jamjam/items/79f6561490d05afcd8aa
に倣って1110行，1130行のようにしています。
BASICAccでCallBack関数に指定できるのは外部手続きのみです。
そのため，モジュールを利用しているのですが，結果として，主プログラムがEND行のみになっています。
100 END
110 !
1000 MODULE GPIO
1010 MODULE OPTION ARITHMETIC NATIVE
1020 SHARE FUNCTION GPIOD_CHIP_OPEN_LOOKUP, gpiod_chip_get_line, gpiod_ctxless_event_monitor
1030 SHARE SUB gpiod_line_request_output, gpiod_line_set_value, gpiod_chip_close
1050 SHARE NUMERIC count,gchip,gpio4
1060 ! GPIO4の初期化
1070 LET GChip=GPIOD_CHIP_OPEN_LOOKUP(CHR$(0))
1080 LET gpio4 = gpiod_chip_get_line(GChip, 4)
1090 CALL gpiod_line_request_output(gpio4, "LED", 0)
1100 ! GPIO5をモニターする
1110 LET ChipName$="gpiochip4"
1120 LET timeout$=DWORD$(2)&DWORD$(0)&DWORD$(0)&DWORD$(0) ! Time out 2秒
1130 LET ret=gpiod_ctxless_event_monitor(chipname$, 3, 5, 1, "callback test", timeout$, 0, callbackadr(4), "")
1140 PRINT ret
1150 ! GPIO4の終了処理
1160 CALL gpiod_chip_close(GChip)
1170 !
1180 EXTERNAL FUNCTION cb(evtype, offset, ts$, data$), callback 4
1190 LET cb=0
1200 PRINT evtype
1210 IF evtype=2 THEN
1220 LET count=count+1
1230 CALL gpiod_line_set_value(gpio4, MOD(count,2))
1240 IF count=10 THEN LET cb=1
1250 ELSEIF evtype=3 then
1260 WAIT DELAY 0.5
1270 END IF
1280 END FUNCTION
1290 !
1300 EXTERNAL FUNCTION GPIOD_CHIP_OPEN_LOOKUP(s$)
1310 ASSIGN "libgpiod.so","gpiod_chip_open_lookup"
1320 END FUNCTION
1330 EXTERNAL FUNCTION gpiod_chip_get_line(n,t)
1340 ASSIGN "libgpiod.so","gpiod_chip_get_line"
1350 END FUNCTION
1360 EXTERNAL SUB gpiod_line_request_output(n,s$,t)
1370 ASSIGN "libgpiod.so","gpiod_line_request_output"
1380 END SUB
1390 EXTERNAL SUB gpiod_line_set_value(gpio, x)
1400 ASSIGN "libgpiod.so","gpiod_line_set_value"
1410 END SUB
1420 EXTERNAL SUB gpiod_chip_close(gchip)
1430 ASSIGN "libgpiod.so","gpiod_chip_close"
1440 END SUB
1450 EXTERNAL FUNCTION gpiod_ctxless_event_monitor(device$, event_type, offset, active_low, consumer$, timeout$, poll_cb, event_cb, data$)
1460 ASSIGN "libgpiod.so","gpiod_ctxless_event_monitor"
1470 END FUNCTION
1480 END MODULE
はじめ，1240 行を IF count=10 THEN LET cb=-1 としていましたが，それは，エラーを伝えるものでした。
そのため，64ビット環境で動かすと，1130行で得られる数が32ビットで-1を表す数になっていました。
64ビットOSのときは，BASICAcc，Decimal BASIC Ver.0.9のいずれでも動作します。
32ビットOSのときは，未確認ですが，BASICAccで動作すると思います。Decimal BASIC Ver.0.9ではCallBack関数が使えません。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/09/06 (Sat) 13:44:05
CallBack利用の改訂版です。
メインの処理を主プログラムに移動させました。
また，GPIOの出力にgpiod_ctxless_set_valueを使ってみることにしました。
https://libgpiod-dlang.dpldocs.info/gpiod.gpiod_ctxless_set_value.html
Raspberry Pi OS (Bookworm) 32bit上のBASICAcc1.2.2.4での動作も確認しています。
100 OPTION ARITHMETIC NATIVE
110 DECLARE EXTERNAL FUNCTION GPIO.gpiod_ctxless_event_monitor
120 LET timeout$=DWORD$(2)&DWORD$(0)&DWORD$(0)&DWORD$(0) ! Time out 2秒
130 LET ret=GPIO.gpiod_ctxless_event_monitor("gpiochip4", 3, 5, 1, "callback test", timeout$, 0, callbackadr(4), "")
140 PRINT ret
150 END
160 !
1000 MODULE GPIO
1010 MODULE OPTION ARITHMETIC NATIVE
1020 PUBLIC FUNCTION gpiod_ctxless_event_monitor
1030 SHARE SUB gpiod_ctxless_set_value
1050 SHARE NUMERIC count
1060 LET count=0
1170 !
1180 EXTERNAL FUNCTION cb(evtype, offset, ts$, data$), callback 4
1190 LET cb=0
1200 PRINT evtype
1210 IF evtype=2 THEN
1220 LET count=count+1
1230 CALL gpiod_ctxless_set_value("gpiochip4", 4, MOD(count,2), 0, "LED", 0, "")
1240 IF count=10 THEN LET cb=1
1250 ELSEIF evtype=3 then
1260 WAIT DELAY 0.5
1270 END IF
1280 END FUNCTION
1290 !
1300 EXTERNAL SUB gpiod_ctxless_set_value(device$,offset, value, active_low, consumer$, cb, data$)
1310 ASSIGN "libgpiod.so","gpiod_ctxless_set_value"
1320 END SUB
1450 EXTERNAL FUNCTION gpiod_ctxless_event_monitor(device$, event_type, offset, active_low, consumer$, timeout$, poll_cb, event_cb, data$)
1460 ASSIGN "libgpiod.so","gpiod_ctxless_event_monitor"
1470 END FUNCTION
1480 END MODULE
スイッチの押し方によっては期待通りに動作しないこともあるので，実用にするには，もう少し手を入れる必要があります。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/09/08 (Mon) 10:26:26
Ver. 0.9.2.6 ARM32ビット版は，ASSIGN文で定義するDLLの引数の個数に4個以下の制限があります。（Ver. 0.9.2.6 ARM64ビット版は10個以下）
(引数の個数の制限は，将来のバージョンで変更になる可能性もあります）
gpiod_ctxless_set_valueは7個の引数が必要ですが，はじめの4個のみを与えて残りはdefault値であることを受け入れてもらえるのかという少し乱暴なテストです。
gpiod_ctxless_get_valueは，引数4個なので問題はありません。
100 DECLARE EXTERNAL FUNCTION gpiod_ctxless_get_value
110 DECLARE EXTERNAL SUB gpiod_ctxless_set_value
120 FOR i=1 TO 10
130 DO WHILE gpiod_ctxless_get_value("gpiochip4", 5, 1, "")=0
140 LOOP
150 CALL gpiod_ctxless_set_value("gpiochip4", 4, mod(i,2), 0)
160 WAIT DELAY 0.5
170 NEXT i
180 END
1300 EXTERNAL SUB gpiod_ctxless_set_value(device$, offset, value, active_low)
1310 ASSIGN "libgpiod.so","gpiod_ctxless_set_value"
1320 END SUB
1400 EXTERNAL FUNCTION gpiod_ctxless_get_value(device$, offset, active_low, cosumer$)
1410 ASSIGN "libgpiod.so","gpiod_ctxless_get_value"
1420 END FUNCTION
スイッチを押すごとにLEDのON,OFFを切り替えます。10回押すと終了します。
Raspberry OS(bookworm)32ビットでの動作は安定しています。
Re: Raspberry Pi GPIO - SHIRAISHI Kazuo
2025/09/08 (Mon) 18:36:56
上掲のプログラムをBASICAccで実行するとAccess violationになります。
7個の引数が可能な環境では，素直に，以下のように記述する必要があります。
100 DECLARE EXTERNAL FUNCTION gpiod_ctxless_get_value
110 DECLARE EXTERNAL SUB gpiod_ctxless_set_value
120 FOR i=1 TO 10
130 DO WHILE gpiod_ctxless_get_value("gpiochip4", 5, 1, "")=0
140 LOOP
150 CALL gpiod_ctxless_set_value("gpiochip4", 4, mod(i,2), 0, "", 0, "")
160 WAIT DELAY 0.5
170 NEXT i
180 END
1300 EXTERNAL SUB gpiod_ctxless_set_value(device$, offset, value, active_low, consumer$, cb, data$)
1310 ASSIGN "libgpiod.so","gpiod_ctxless_set_value"
1320 END SUB
1400 EXTERNAL FUNCTION gpiod_ctxless_get_value(device$, offset, active_low, cosumer$)
1410 ASSIGN "libgpiod.so","gpiod_ctxless_get_value"
1420 END FUNCTION
Raspberry Pi OS (Trixie) - SHIRAISHI Kazuo
2026/01/26 (Mon) 10:30:11
Raspberry Pi OS (Trixie)では，libgpiod3が標準となって，libgpiod2はインストールができないようです。
sudo apt install libgpiod3 libgpiod-dev libgpiod-doc
を実行して /usr/share/doc/libgpiod-dev/html/ を探してもこのライブラリをどう使えばよいかの解説が見当たりません。
ねっちゅう工房 ラズパイ5（Raspberry Pi 5）でLチカ https://nettyukobo.com/raspberrypi5_start_2/
で公開されている「C言語でLED点灯」の移植を試みました。
移植に必要な情報は /usr/share/doc/libgpiod-dev/html/gpiod_8h_source.html にあるgpoid.h から得られます。
バージョンが一致しない可能性がありますが，githubにある https://github.com/brgl/libgpiod/blob/master/include/gpiod.h も同じものです。
移植にあたって留意することはポインタ引数の扱いです。十進BASICではポインタは数値として処理します。
250行，270行，300行，350行にある chip, settings，line_cfg，requestとして得られる値はポインタです。
なので，それを引数に持つ手続きgpiod_line_settings_set_directionなどが持つポインタ型の引数は数値です。
一方で，gpiod_line_config_add_line_settingsが持つポインタ型の引数は，他のポインタを代入するのではなくて，不定個数の整数値の配列の先頭を指すものです。
なので，gpiod_line_config_add_line_settingsが持つポインタ型の引数は文字列で定義します。
以下に示すプログラムは素直に移植しただけです。私はLEDをGPIO4に接続しているので，190行のline_offsetを4にしています。
難解なのは，GPIOチップの名称で，Raspberry Pi OS (Bookworm)ではgpiochip4だったのですが，今度はgpiochip0です。
それは，ターミナルで，gpioinfo を実行すると確認できますが，GPIOチップの名称はどのようにして決まるのでしょうか？
100 REM ねっちゅう工房 ラズパイ5（Raspberry Pi 5）でLチカ
110 REM https://nettyukobo.com/raspberrypi5_start_2/
120 REM C言語でLED点灯
130 ! sudo apt install libgpiod3 libgpiod-dev libgpiod-doc
140 ! /usr/share/doc/libgpiod-dev/html/gpiod_8h_source.html
150 OPTION ARITHMETIC NATIVE
160 DECLARE EXTERNAL FUNCTION gpiod_chip_open, gpiod_line_settings_new, gpiod_line_config_new
170 DECLARE EXTERNAL FUNCTION gpiod_request_config_new, gpiod_chip_request_lines
180 !
190 LET line_offset=4
200 LET GPIOD_LINE_VALUE_INACTIVE = 0
210 LET GPIOD_LINE_VALUE_ACTIVE = 1
220 LET GPIOD_LINE_DIRECTION_INPUT = 2
230 LET GPIOD_LINE_DIRECTION_OUTPUT = 3
240 ! /* --- 1. GPIO チップを開く --- */
250 LET chip=gpiod_chip_open("/dev/gpiochip0")
260 ! /* --- 2. ライン設定を作る --- */
270 LET settings = gpiod_line_settings_new
280 CALL gpiod_line_settings_set_direction(settings, GPIOD_LINE_DIRECTION_OUTPUT)
290 CALL gpiod_line_settings_set_output_value(settings, GPIOD_LINE_VALUE_INACTIVE)
300 LET line_cfg = gpiod_line_config_new
310 CALL gpiod_line_config_add_line_settings(line_cfg, DWORD$(line_offset), 1, settings)
320 ! /* --- 3. ライン要求設定 --- */
330 LET req_cfg = gpiod_request_config_new
340 CALL gpiod_request_config_set_consumer(req_cfg, "blink")
350 LET request = gpiod_chip_request_lines(chip, req_cfg, line_cfg)
360 ! /* --- 4. Lチカループ --- */
370 FOR i=1 TO 10
380 CALL gpiod_line_request_set_value(request, line_offset, GPIOD_LINE_VALUE_ACTIVE)
390 WAIT DELAY 0.25
400 CALL gpiod_line_request_set_value(request, line_offset, GPIOD_LINE_VALUE_INACTIVE)
410 WAIT DELAY 0.25
420 NEXT i
430 ! /* --- 5. 後始末 --- */
440 CALL gpiod_line_request_release(request)
450 CALL gpiod_line_settings_free(settings)
460 CALL gpiod_line_config_free(line_cfg)
470 CALL gpiod_request_config_free(req_cfg)
480 CALL gpiod_chip_close(chip)
490 END
1000 !
1010 EXTERNAL FUNCTION gpiod_chip_open(s$)
1020 ASSIGN "libgpiod.so","gpiod_chip_open"
1030 END FUNCTION
1040 EXTERNAL FUNCTION gpiod_line_settings_new
1050 assign "libgpiod.so","gpiod_line_settings_new"
1060 END FUNCTION
1070 EXTERNAL SUB gpiod_line_settings_set_direction(settings,direction)
1080 ASSIGN "libgpiod.so","gpiod_line_settings_set_direction"
1090 END SUB
1100 EXTERNAL SUB gpiod_line_settings_set_output_value(settings,line_value)
1110 ASSIGN "libgpiod.so","gpiod_line_settings_set_output_value"
1120 END SUB
1130 EXTERNAL FUNCTION gpiod_line_config_new
1140 ASSIGN "libgpiod.so","gpiod_line_config_new"
1150 END FUNCTION
1160 EXTERNAL SUB gpiod_line_config_add_line_settings(config,offsets$,num_offsets,settings)
1170 ASSIGN "libgpiod.so", "gpiod_line_config_add_line_settings"
1180 END SUB
1190 EXTERNAL FUNCTION gpiod_request_config_new
1200 ASSIGN "libgpiod.so", "gpiod_request_config_new"
1210 END FUNCTION
1220 EXTERNAL SUB gpiod_request_config_set_consumer(config,consumer$)
1230 ASSIGN "libgpiod.so","gpiod_request_config_set_consumer"
1240 END SUB
1250 EXTERNAL FUNCTION gpiod_chip_request_lines(chip, req_cfg, line_cfg)
1260 ASSIGN "libgpiod.so","gpiod_chip_request_lines"
1270 END FUNCTION
1280 EXTERNAL SUB gpiod_line_request_set_value(request,offset,value)
1290 ASSIGN "libgpiod.so","gpiod_line_request_set_value"
1300 END SUB
1310 EXTERNAL SUB gpiod_line_request_release(request)
1320 ASSIGN "libgpiod.so","gpiod_line_request_release"
1330 END SUB
1340 EXTERNAL SUB gpiod_line_settings_free(settings)
1350 ASSIGN "libgpiod.so", "gpiod_line_settings_free"
1360 END SUB
1370 EXTERNAL SUB gpiod_line_config_free(line_cfg)
1380 ASSIGN "libgpiod.so","gpiod_line_config_free"
1390 END SUB
1400 EXTERNAL SUB gpiod_request_config_free(req_cfg)
1410 ASSIGN "libgpiod.so","gpiod_request_config_free"
1420 END SUB
1430 EXTERNAL SUB gpiod_chip_close(chip)
1440 ASSIGN "libgpiod.so","gpiod_chip_close"
1450 END SUB
Raspberry Pi (Trixie) GPIO 入力と出力 - SHIRAISHI Kazuo
2026/01/26 (Mon) 20:32:15
GPIO4にLED，GPIO5にスイッチを接続しているので，入力と出力の双方に対応させました。
スイッチを押すごとにLEDの点灯，消灯を反転し，10回押すと終了です。終了するとLEDが点滅します。
GPIOの処理はmoduleにまとめています。
GPIOの初期化はGPIO.init_beginで開始し，GPIO_init_finishで完了します。その間で，ポートごとの入力，出力の別を設定します。
GPIOチップの名称"/dev/gpiochip0"はmodule内で設定していますが，変更が必要であれば,GPIO.init_beginの引数にして，その都度，設定するものにもできます。
最後に，GPIO.closeを実行して終了です。
なお，APIの組み立て方に関するマニュアルを探し出して作ったものではないので，不適切な構成になっている可能性があります。
（正式なドキュメントは，https://libgpiod.readthedocs.io/en/latest/ にあって，個別の説明はありますが，それをどう組み立てて使うかの説明が見当たりません。）
100 OPTION ARITHMETIC NATIVE
110 DECLARE EXTERNAL SUB GPIO.init_begin, GPIO.set_input, GPIO.set_output, GPIO.init_finish
120 DECLARE EXTERNAL FUNCTION GPIO.read
130 DECLARE EXTERNAL SUB GPIO.write, GPIO.close
140 DECLARE NUMERIC gpin, gpout
150 LET gpout = 4
160 LET gpin = 5
170 !
180 CALL GPIO.init_begin
190 CALL GPIO.set_output(gpout)
200 CALL GPIO.set_input(gpin)
210 CALL GPIO.init_finish
220 !
230 DECLARE NUMERIC i
240 FOR i=1 TO 10
250 CALL GPIO.write(gpout, MOD(i,2))
260 DO UNTIL GPIO.read(gpin)=0
270 LOOP
280 WAIT DELAY 0.25
290 NEXT i
300 !
310 FOR i=1 TO 10
320 CALL GPIO.write(gpout, MOD(i,2))
330 WAIT DELAY 0.1
340 NEXT i
350 !
360 CALL GPIO.close
370 END
1000 !
1010 MODULE GPIO
1020 MODULE OPTION ARITHMETIC NATIVE
1030 PUBLIC SUB init_begin, set_input, set_output, init_finish
1040 PUBLIC SUB write, close
1050 PUBLIC FUNCTION read
1060 SHARE NUMERIC chip, request
1070 SHARE FUNCTION gpiod_chip_open, gpiod_line_settings_new, gpiod_line_config_new
1080 SHARE FUNCTION gpiod_request_config_new, gpiod_chip_request_lines, gpiod_line_request_get_value
1090 ! 定数の初期化
1100 SHARE NUMERIC GPIOD_LINE_DIRECTION_INPUT, GPIOD_LINE_DIRECTION_OUTPUT
1110 LET GPIOD_LINE_DIRECTION_INPUT = 2
1120 LET GPIOD_LINE_DIRECTION_OUTPUT = 3
1130 SHARE STRING consumer$
1140 LET consumer$="Decimal BASIC"
1150 !
1159 SHARE NUMERIC line_cfg ! init_beginで初期化され，init_finishでお役御免
1160 EXTERNAL SUB init_begin
1170 LET chip = gpiod_chip_open("/dev/gpiochip0")
1180 LET line_cfg = gpiod_line_config_new
1190 END SUB
1200 !
1210 EXTERNAL SUB set_input(offset)
1220 DECLARE NUMERIC settings
1230 LET settings = gpiod_line_settings_new
1240 CALL gpiod_line_settings_set_direction(settings, GPIOD_LINE_DIRECTION_INPUT)
1250 CALL gpiod_line_config_add_line_settings(line_cfg, DWORD$(offset), 1, settings)
1260 CALL gpiod_line_settings_free(settings)
1270 END SUB
1280 !
1290 EXTERNAL SUB set_output(offset)
1300 DECLARE NUMERIC settings
1310 LET settings = gpiod_line_settings_new
1320 CALL gpiod_line_settings_set_direction(settings, GPIOD_LINE_DIRECTION_OUTPUT)
1330 CALL gpiod_line_settings_set_output_value(settings, 0)
1340 CALL gpiod_line_config_add_line_settings(line_cfg, DWORD$(offset), 1, settings)
1350 CALL gpiod_line_settings_free(settings)
1360 END SUB
1370 !
1380 EXTERNAL SUB Init_finish
1390 DECLARE NUMERIC req_cfg
1400 LET req_cfg = gpiod_request_config_new
1410 CALL gpiod_request_config_set_consumer(req_cfg, consumer$)
1420 LET request = gpiod_chip_request_lines(chip, req_cfg, line_cfg)
1430 CALL gpiod_request_config_free(req_cfg)
1440 CALL gpiod_line_config_free(line_cfg) ! 以降，line_cfgは無効
1450 END SUB
1460 !
1470 EXTERNAL SUB write(offset, n)
1480 CALL gpiod_line_request_set_value(request, offset, n)
1490 END SUB
1500 !
1510 EXTERNAL FUNCTION read(offset)
1520 LET read=gpiod_line_request_get_value(request, offset)
1530 END FUNCTION
1540 !
1550 EXTERNAL SUB CLOSE
1560 CALL gpiod_line_request_release(request)
1570 CALL gpiod_chip_close(chip)
1580 END SUB
1590 !
1600 EXTERNAL FUNCTION gpiod_chip_open(s$)
1610 ASSIGN "libgpiod.so","gpiod_chip_open"
1620 END FUNCTION
1630 EXTERNAL FUNCTION gpiod_line_settings_new
1640 assign "libgpiod.so","gpiod_line_settings_new"
1650 END FUNCTION
1660 EXTERNAL SUB gpiod_line_settings_set_direction(settings,direction)
1670 ASSIGN "libgpiod.so","gpiod_line_settings_set_direction"
1680 END SUB
1690 EXTERNAL SUB gpiod_line_settings_set_output_value(settings,line_value)
1700 ASSIGN "libgpiod.so","gpiod_line_settings_set_output_value"
1710 END SUB
1720 EXTERNAL FUNCTION gpiod_line_config_new
1730 ASSIGN "libgpiod.so","gpiod_line_config_new"
1740 END FUNCTION
1750 EXTERNAL SUB gpiod_line_config_add_line_settings(config,offsets$,num_offsets,settings)
1760 ASSIGN "libgpiod.so", "gpiod_line_config_add_line_settings"
1770 END SUB
1780 EXTERNAL FUNCTION gpiod_request_config_new
1790 ASSIGN "libgpiod.so", "gpiod_request_config_new"
1800 END FUNCTION
1810 EXTERNAL SUB gpiod_request_config_set_consumer(config,consumer$)
1820 ASSIGN "libgpiod.so","gpiod_request_config_set_consumer"
1830 END SUB
1840 EXTERNAL FUNCTION gpiod_chip_request_lines(chip, req_cfg, line_cfg)
1850 ASSIGN "libgpiod.so","gpiod_chip_request_lines"
1860 END FUNCTION
1870 EXTERNAL SUB gpiod_line_request_set_value(request,offset,value)
1880 ASSIGN "libgpiod.so","gpiod_line_request_set_value"
1890 END SUB
1900 EXTERNAL FUNCTION gpiod_line_request_get_value(request, offset)
1910 ASSIGN "libgpiod.so","gpiod_line_request_get_value"
1920 END FUNCTION
1930 EXTERNAL SUB gpiod_line_request_release(request)
1940 ASSIGN "libgpiod.so","gpiod_line_request_release"
1950 END SUB
1960 EXTERNAL SUB gpiod_line_settings_free(settings)
1970 ASSIGN "libgpiod.so", "gpiod_line_settings_free"
1980 END SUB
1990 EXTERNAL SUB gpiod_line_config_free(line_cfg)
2000 ASSIGN "libgpiod.so","gpiod_line_config_free"
2010 END SUB
2020 EXTERNAL SUB gpiod_request_config_free(req_cfg)
2030 ASSIGN "libgpiod.so","gpiod_request_config_free"
2040 END SUB
2050 EXTERNAL SUB gpiod_chip_close(chip)
2060 ASSIGN "libgpiod.so","gpiod_chip_close"
2070 END SUB
2080 END MODULE
Raspberry Pi (Trixie) GPIO 補遺 - SHIRAISHI Kazuo
2026/01/29 (Thu) 09:30:50
プログラム実行中に別のBASICを起動してプログラムを実行すると，後から起動したBASICが異常終了します。
他のプログラムがGPIOポートを使用中に実行しようとするとエラーになるように，1421～1426行を追加しました。
gpioinfoに /dev/gpiochip4 は現れないのですが， /dev/gpiochip4 がシンボリックリンクとして登録されていて，/dev/gpiochip4 を指定しても動作しました。
1130行でGchip$とconsuner$をPUBLICに指定し，default値を，それぞれ，"/dev/gpiochi4"，ログインユーザ名としました。
136行，137行のREMを取り除いて修正すれば，他の値を用いることができます。
なお，環境変数"HOME"は"/home/"で始まる文字列であることを前提としていますが，そうでない環境では1141行の修正が必要です。
100 OPTION ARITHMETIC NATIVE
110 DECLARE EXTERNAL SUB GPIO.init_begin, GPIO.set_input, GPIO.set_output, GPIO.init_finish
120 DECLARE EXTERNAL FUNCTION GPIO.read
130 DECLARE EXTERNAL SUB GPIO.write, GPIO.close
135 DECLARE EXTERNAL STRING GPIO.GChip$, GPIO.consumer$
136 REM LET GPIO.GChip$="/dev/gpiochip0"
137 REM LET GPIO.consumer$="Decimal BASIC"
140 DECLARE NUMERIC gpin, gpout
150 LET gpout = 4
160 LET gpin = 5
170 !
180 CALL GPIO.init_begin
190 CALL GPIO.set_output(gpout)
200 CALL GPIO.set_input(gpin)
210 CALL GPIO.init_finish
220 !
230 DECLARE NUMERIC i
240 FOR i=1 TO 10
250 CALL GPIO.write(gpout, MOD(i,2))
260 DO UNTIL GPIO.read(gpin)=0
270 LOOP
280 WAIT DELAY 0.25
290 NEXT i
300 !
310 FOR i=1 TO 10
320 CALL GPIO.write(gpout, MOD(i,2))
330 WAIT DELAY 0.1
340 NEXT i
350 !
360 CALL GPIO.close
370 END
1000 !
1010 MODULE GPIO
1020 MODULE OPTION ARITHMETIC NATIVE
1030 PUBLIC SUB init_begin, set_input, set_output, init_finish
1040 PUBLIC SUB write, close
1050 PUBLIC FUNCTION read
1060 SHARE NUMERIC chip, request
1070 SHARE FUNCTION gpiod_chip_open, gpiod_line_settings_new, gpiod_line_config_new
1080 SHARE FUNCTION gpiod_request_config_new, gpiod_chip_request_lines, gpiod_line_request_get_value
1090 ! 定数の初期化
1100 SHARE NUMERIC GPIOD_LINE_DIRECTION_INPUT, GPIOD_LINE_DIRECTION_OUTPUT
1110 LET GPIOD_LINE_DIRECTION_INPUT = 2
1120 LET GPIOD_LINE_DIRECTION_OUTPUT = 3
1130 PUBLIC STRING GChip$, consumer$
1135 LET GChip$="/dev/gpiochip4"
1140 ASK EnvironmentVariable("HOME") consumer$
1141 LET consumer$=consumer$(LEN("/home/")+1 : 255)
1150 !
1159 SHARE NUMERIC line_cfg ! init_beginで初期化され，init_finishでお役御免
1160 EXTERNAL SUB init_begin
1170 LET chip = gpiod_chip_open(GChip$)
1180 LET line_cfg = gpiod_line_config_new
1190 END SUB
1200 !
1210 EXTERNAL SUB set_input(offset)
1220 DECLARE NUMERIC settings
1230 LET settings = gpiod_line_settings_new
1240 CALL gpiod_line_settings_set_direction(settings, GPIOD_LINE_DIRECTION_INPUT)
1250 CALL gpiod_line_config_add_line_settings(line_cfg, DWORD$(offset), 1, settings)
1260 CALL gpiod_line_settings_free(settings)
1270 END SUB
1280 !
1290 EXTERNAL SUB set_output(offset)
1300 DECLARE NUMERIC settings
1310 LET settings = gpiod_line_settings_new
1320 CALL gpiod_line_settings_set_direction(settings, GPIOD_LINE_DIRECTION_OUTPUT)
1330 CALL gpiod_line_settings_set_output_value(settings, 0)
1340 CALL gpiod_line_config_add_line_settings(line_cfg, DWORD$(offset), 1, settings)
1350 CALL gpiod_line_settings_free(settings)
1360 END SUB
1370 !
1380 EXTERNAL SUB Init_finish
1390 DECLARE NUMERIC req_cfg
1400 LET req_cfg = gpiod_request_config_new
1410 CALL gpiod_request_config_set_consumer(req_cfg, consumer$)
1420 LET request = gpiod_chip_request_lines(chip, req_cfg, line_cfg)
1421 IF request=0 THEN
1422 PRINT "GPIO Initialization failed"
1423 CALL close
1425 STOP
1426 END IF
1430 CALL gpiod_request_config_free(req_cfg)
1440 CALL gpiod_line_config_free(line_cfg)
1450 END SUB
1460 !
1470 EXTERNAL SUB write(offset, n)
1480 CALL gpiod_line_request_set_value(request, offset, n)
1490 END SUB
1500 !
1510 EXTERNAL FUNCTION read(offset)
1520 LET read=gpiod_line_request_get_value(request, offset)
1530 END FUNCTION
1540 !
1550 EXTERNAL SUB CLOSE
1560 CALL gpiod_line_request_release(request)
1570 CALL gpiod_chip_close(chip)
1580 END SUB
1590 !
1600 EXTERNAL FUNCTION gpiod_chip_open(s$)
1610 ASSIGN "libgpiod.so","gpiod_chip_open"
1620 END FUNCTION
1630 EXTERNAL FUNCTION gpiod_line_settings_new
1640 assign "libgpiod.so","gpiod_line_settings_new"
1650 END FUNCTION
1660 EXTERNAL SUB gpiod_line_settings_set_direction(settings,direction)
1670 ASSIGN "libgpiod.so","gpiod_line_settings_set_direction"
1680 END SUB
1690 EXTERNAL SUB gpiod_line_settings_set_output_value(settings,line_value)
1700 ASSIGN "libgpiod.so","gpiod_line_settings_set_output_value"
1710 END SUB
1720 EXTERNAL FUNCTION gpiod_line_config_new
1730 ASSIGN "libgpiod.so","gpiod_line_config_new"
1740 END FUNCTION
1750 EXTERNAL SUB gpiod_line_config_add_line_settings(config,offsets$,num_offsets,settings)
1760 ASSIGN "libgpiod.so", "gpiod_line_config_add_line_settings"
1770 END SUB
1780 EXTERNAL FUNCTION gpiod_request_config_new
1790 ASSIGN "libgpiod.so", "gpiod_request_config_new"
1800 END FUNCTION
1810 EXTERNAL SUB gpiod_request_config_set_consumer(config,consumer$)
1820 ASSIGN "libgpiod.so","gpiod_request_config_set_consumer"
1830 END SUB
1840 EXTERNAL FUNCTION gpiod_chip_request_lines(chip, req_cfg, line_cfg)
1850 ASSIGN "libgpiod.so","gpiod_chip_request_lines"
1860 END FUNCTION
1870 EXTERNAL SUB gpiod_line_request_set_value(request,offset,value)
1880 ASSIGN "libgpiod.so","gpiod_line_request_set_value"
1890 END SUB
1900 EXTERNAL FUNCTION gpiod_line_request_get_value(request, offset)
1910 ASSIGN "libgpiod.so","gpiod_line_request_get_value"
1920 END FUNCTION
1930 EXTERNAL SUB gpiod_line_request_release(request)
1940 ASSIGN "libgpiod.so","gpiod_line_request_release"
1950 END SUB
1960 EXTERNAL SUB gpiod_line_settings_free(settings)
1970 ASSIGN "libgpiod.so", "gpiod_line_settings_free"
1980 END SUB
1990 EXTERNAL SUB gpiod_line_config_free(line_cfg)
2000 ASSIGN "libgpiod.so","gpiod_line_config_free"
2010 END SUB
2020 EXTERNAL SUB gpiod_request_config_free(req_cfg)
2030 ASSIGN "libgpiod.so","gpiod_request_config_free"
2040 END SUB
2050 EXTERNAL SUB gpiod_chip_close(chip)
2060 ASSIGN "libgpiod.so","gpiod_chip_close"
2070 END SUB
2080 END MODULE
Re: Raspberry Pi LGPIO - SHIRAISHI Kazuo
2026/02/01 (Sun) 09:03:17
libgpiodに代わるものとしてLGPIOをテストしてみました。
インストール方法は
https://pimylifeup.com/raspberry-pi-install-lgpio/
ライブラリの説明は
https://abyz.me.uk/lg/lgpio.html#lgI2cReadByte
にあります。
Ver. 0.9.4.0だと実行はできるのですが，実行後にBASIC本体に障害が発生し，フリーズするか異常終了します。
Ver. 0.9のときは，Ver. 0.9.4.1以降を使用してください。
BASICAccとParactBASICでは問題ありません。
Bookworm 64ビット，Trixie 64ビットでテストしています。
310行の引数 0 はgpiochip0を意味します。gpiochip4だったら 4 を指定してください。
320行以降の引数にある 4，5 は，GPIOの番号です。
100 OPTION ARITHMETIC NATIVE
110 FUNCTION lgGpiochipOpen(gpioDev)
120 ASSIGN "liblgpio.so", "lgGpiochipOpen"
130 END FUNCTION
140 SUB lgGpiochipClose(handle)
150 ASSIGN "liblgpio.so", "lgGpiochipClose"
160 END SUB
170 FUNCTION lgGpioClaimOutput(handle,flags,gpio,level)
180 ASSIGN "liblgpio.so", "lgGpioClaimOutput"
190 END FUNCTION
200 SUB lgGpioWrite(handle,gpio,level)
210 ASSIGN "liblgpio.so", "lgGpioWrite"
220 END SUB
230 FUNCTION lgGpioClaimInput(handle,flags,gpio)
240 ASSIGN "liblgpio.so", "lgGpioClaimInput"
250 END FUNCTION
260 FUNCTION lgGpioRead(hnadle, gpio)
270 ASSIGN "liblgpio.so", "lgGpioRead"
280 END FUNCTION
290 !
300 DECLARE NUMERIC h ! handle
310 LET h=lgGpiochipOpen(0)
320 IF lgGpioClaimOutput(h,0,4,0)=0 AND lgGpioClaimInput(h,0,5)=0 THEN
330 DECLARE NUMERIC i
340 FOR i=1 TO 10
350 CALL lgGpioWrite(h,4,MOD(i,2))
360 DO UNTIL lgGpioRead(h, 5)=0
370 LOOP
380 WAIT DELAY 0.25
390 NEXT i
400 FOR i=1 TO 10
410 CALL lgGpioWrite(h,4,MOD(i,2))
420 WAIT DELAY 0.1
430 NEXT i
440 END if
450 CALL lgGpiochipClose(h)
460 END
Note.
LGPIOでは，関数値が負のとき失敗を意味するが，ASSIGN文ではその値を64ビット整数として評価するので，負数になるべきとき，その値は2^31以上の数になる。
（32ビットの値を出力するとき，64ビットレジスタの上位32ビットは0に固定されているように思われる‥‥‥ただし，すべての場合に成立するか不明）
数独パズル - しばっち
2026/01/25 (Sun) 07:39:09
9*9数独パズル
https://ja.wikipedia.org/wiki/数独
数独は1～9の数字を行、列に重複なくそれぞれ1つずつ
そして、3*3の小ブロックにおいても重複なく1つずつ配置
させていくパズルです。
実行すると下記のような数独問題をファイルに書き出します。
時間がかかる時は、Lazarus64bit版十進BASIC又はBasicAcc、Paract BASICを使用してください。
https://decimalbasic.web.fc2.com/BASICGenJa.htm
https://decimalbasic.web.fc2.com/BASICAccJa.htm
https://decimalbasic.web.fc2.com/BASICAcc2Ja.htm
まず、乱数で適当に穴埋めしていきます。穴埋め回数は要調整です。
その後、解が存在するかバックトラック法で求めています。
解が見つかればそこから乱数で穴を開けていきます。穴開け回数は要調整です。
この時複数解を持たないようにしています。
------------------------------
| 4 2 | 3 7| 5 9 1|
| 8 7 1| 9 5| 3 4|
| 5 3 | 6 1 | 2 8|
------------------------------
| 6 5 7| 9 8| 4 1 3|
| 1 8 | 7 3 6| 5|
| 9 3| 5 4 1| 7 8 6|
------------------------------
| 3 5| 8 7 9| 1 4 2|
| 7 2| 5 3| 6 9|
| 4 8| 1 6 | 5 |
------------------------------
2進モードで実行してください。
RANDOMIZE
PUBLIC NUMERIC BOARD(9,9),ANSWER(9,9),FOUND
LET FOUND=0
DO
MAT BOARD=ZER
LET NN=RND*30+45 ! 要調整
FOR I=1 TO NN
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET N=INT(RND*9+1)
IF BOARD(X,Y)=0 AND CHECK(X,Y,N)=1 THEN ! 適当に穴埋め
LET BOARD(X,Y)=N
END IF
NEXT I
PRINT "解 探索中..."
CALL SOLVE(0)
LOOP UNTIL FOUND=1
PRINT "ファイル書き出し中..."
OPEN #1:NAME "9×9数独問題.txt"
ERASE #1
CALL DISPLAY(#1)
CLOSE #1
!CALL SHOW(BOARD)
!GSAVE "9×9数独問題.png"
OPEN #1:NAME "9×9数独解答.txt"
ERASE #1
MAT BOARD=ANSWER
CALL DISPLAY(#1)
CLOSE #1
!CALL SHOW(BOARD)
!GSAVE "9×9数独解答.png"
END
EXTERNAL SUB CREATPROBLEM
LET NN=INT(RND*50)+30 ! 要調整
FOR I=1 TO NN
LET XX=INT(RND*9+1)
LET YY=INT(RND*9+1)
LET BOARD(XX,YY)=0 ! 適当に穴開け
FOR Y=1 TO 9
FOR X=1 TO 9
IF BOARD(X,Y)=0 THEN
LET C=0
FOR K=1 TO 9
IF CHECK(X,Y,K)=1 THEN LET C=C+1
NEXT K
IF C<>1 THEN LET BOARD(X,Y)=ANSWER(X,Y) ! 解が1つでないなら元に戻す
END IF
NEXT X
NEXT Y
NEXT I
END SUB
EXTERNAL SUB DISPLAY(#1)
PRINT #1:REPEAT$("-",31)
FOR Y=1 TO 9
PRINT #1:"|";
FOR X=1 TO 9
IF BOARD(X,Y)=0 THEN PRINT #1:" "; ELSE PRINT #1:USING$("###",BOARD(X,Y));
IF MOD(X,3)=0 THEN PRINT #1:"|";
NEXT X
PRINT #1
IF MOD(Y,3)=0 THEN PRINT #1:REPEAT$("-",31)
NEXT Y
END SUB
EXTERNAL SUB SHOW(BOARD(,))
LET XSIZE=3
LET YSIZE=3
LET N=XSIZE*YSIZE
SET WINDOW 0,1,1,0
CLEAR
SET TEXT HEIGHT .08
FOR I=1 TO N
IF MOD(I,XSIZE)=0 THEN
SET LINE WIDTH 3
SET LINE COLOR 4
ELSE
SET LINE WIDTH 1
SET LINE COLOR 1
END IF
LET X=I/N
PLOT LINES:X,0;X,1
LET Y=I/N
PLOT LINES:0,Y;1,Y
NEXT I
SET TEXT JUSTIFY "LEFT","TOP"
FOR J=0 TO N-1
FOR I=0 TO N-1
LET X=I/N
LET Y=J/N
IF BOARD(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD(I+1,J+1))
NEXT I
NEXT J
END SUB
EXTERNAL FUNCTION CHECK(X,Y,NUM)
LET CHECK=0
FOR YY=1 TO 9
IF BOARD(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO 9
IF BOARD(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
LET X0=INT((X-1)/3)*3
LET Y0=INT((Y-1)/3)*3
FOR YY=1 TO 3
FOR XX=1 TO 3
IF BOARD(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
LET CHECK=1
END FUNCTION
EXTERNAL SUB SOLVE(N)
IF N=81 THEN
LET FOUND=1
MAT ANSWER=BOARD
CALL CREATPROBLEM
ELSE
LET COL=MOD(N,9)+1
LET ROW=INT(N/9)+1
IF BOARD(COL,ROW)=0 THEN
FOR I=1 TO 9
IF CHECK(COL,ROW,I)=1 THEN
LET BOARD(COL,ROW)=I
CALL SOLVE(N+1)
IF FOUND=1 THEN EXIT SUB
LET BOARD(COL,ROW)=0
END IF
NEXT I
ELSE
CALL SOLVE(N+1)
IF FOUND=1 THEN EXIT SUB
END IF
END IF
END SUB
解答
------------------------------
| 4 2 6| 3 8 7| 5 9 1|
| 8 7 1| 2 9 5| 6 3 4|
| 5 3 9| 6 1 4| 2 7 8|
------------------------------
| 6 5 7| 9 2 8| 4 1 3|
| 1 8 4| 7 3 6| 9 2 5|
| 2 9 3| 5 4 1| 7 8 6|
------------------------------
| 3 6 5| 8 7 9| 1 4 2|
| 7 1 2| 4 5 3| 8 6 9|
| 9 4 8| 1 6 2| 3 5 7|
------------------------------
ファイル書き出し部を下記に置き換えるとhtmlファイルを
書き出します。
PRINT "ファイル書き出し中..."
OPEN #1:NAME "9×9数独問題.html"
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:" <body>"
PRINT #1:" <div align=center>"
PRINT #1:" <h1>問題</h1>"
PRINT #1:" </div>"
PRINT #1:" <table align=center border=";CHR$(34);"3";CHR$(34);">"
FOR Y=1 TO 9 STEP 3
PRINT #1:" <tr>";
FOR X=1 TO 9 STEP 3
PRINT #1:"<td><table border=";CHR$(34);"1";CHR$(34);">";
FOR YY=0 TO 2
PRINT #1:"<tr>";
FOR XX=0 TO 2
IF BOARD(XX+X,YY+Y)=0 THEN PRINT #1:"<td> </td>"; ELSE PRINT #1:"<td>";USING$("###",BOARD(XX+X,YY+Y));"</td>";
NEXT XX
PRINT #1:"</tr>"
NEXT YY
PRINT #1:" </table></td>"
NEXT X
PRINT #1:" </tr>"
NEXT Y
PRINT #1:" </table>"
PRINT #1:" </body>"
PRINT #1:"</html>"
CLOSE #1
OPEN #1:NAME "9×9数独解答.html"
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:" <body>"
PRINT #1:" <div align=center>"
PRINT #1:" <h1>解答</h1>"
PRINT #1:" </div>"
PRINT #1:" <table align=center border=";CHR$(34);"3";CHR$(34);">"
FOR Y=1 TO 9 STEP 3
PRINT #1:" <tr>";
FOR X=1 TO 9 STEP 3
PRINT #1:"<td><table border=";CHR$(34);"1";CHR$(34);">";
FOR YY=0 TO 2
PRINT #1:"<tr>";
FOR XX=0 TO 2
IF BOARD(XX+X,YY+Y)=0 THEN PRINT #1:"<td><font color=#ff0000>";USING$("###",ANSWER(XX+X,YY+Y));"</font></td>"; ELSE PRINT #1:"<td>";USING$("###",ANSWER(XX+X,YY+Y));"</td>";
NEXT XX
PRINT #1:"</tr>"
NEXT YY
PRINT #1:" </table></td>"
NEXT X
PRINT #1:" </tr>"
NEXT Y
PRINT #1:" </table>"
PRINT #1:" </body>"
PRINT #1:"</html>"
CLOSE #1
END
----------------------------------------------------------------------------------
以下はDLL版です。下記URLからダウンロードしてください。VC++2026でコンパイルしました。
x86版とx64版を同梱しています。sudoku.zip
https://18.gigafile.nu/0326-bbcba64ab876afb1aba5835c9c57badc1
ダウンロード期限：2026年3月26日(木)
ダウンロードパスワード：設定していません
下記にあるcソースのみでコンパイルできます。
PUBLIC NUMERIC FOUND
LET FOUND=0
RANDOMIZE
DIM BOARD(9,9)
DO
MAT BOARD=ZER
LET NN=INT(RND*20)+60 ! 要調整
FOR I=1 TO NN
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET N=INT(RND*9+1)
IF BOARD(X,Y)=0 AND CHECK(X,Y,N,BOARD)=1 THEN LET BOARD(X,Y)=N
NEXT I
PRINT "解 探索中..."
CALL SUDOKU(BOARD)
LOOP UNTIL FOUND=1
PRINT "ファイル書き出し中..."
OPEN #1:NAME "9×9数独解答.txt"
ERASE #1
CALL DISPLAY(#1,BOARD)
CLOSE #1
CALL CREATPROBLEM(BOARD)
OPEN #1:NAME "9×9数独問題.txt"
ERASE #1
CALL DISPLAY(#1,BOARD)
CLOSE #1
END
EXTERNAL SUB CREATPROBLEM(BOARD(,))
DIM ANSWER(9,9)
MAT ANSWER=BOARD
LET NN=INT(RND*50)+30 ! 要調整
FOR I=1 TO NN
LET XX=INT(RND*9+1)
LET YY=INT(RND*9+1)
LET BOARD(XX,YY)=0
FOR Y=1 TO 9
FOR X=1 TO 9
IF BOARD(X,Y)=0 THEN
LET C=0
FOR K=1 TO 9
IF CHECK(X,Y,K,BOARD)=1 THEN LET C=C+1
NEXT K
IF C<>1 THEN LET BOARD(X,Y)=ANSWER(X,Y)
END IF
NEXT X
NEXT Y
NEXT I
END SUB
EXTERNAL FUNCTION CHECK(X,Y,NUM,BOARD(,))
LET CHECK=0
FOR YY=1 TO 9
IF BOARD(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO 9
IF BOARD(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
LET X0=INT((X-1)/3)*3
LET Y0=INT((Y-1)/3)*3
FOR YY=1 TO 3
FOR XX=1 TO 3
IF BOARD(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
LET CHECK=1
END FUNCTION
EXTERNAL SUB DISPLAY(#1,BOARD(,))
PRINT #1:REPEAT$("-",31)
FOR Y=1 TO 9
PRINT #1:"|";
FOR X=1 TO 9
IF BOARD(X,Y)=0 THEN PRINT #1:" "; ELSE PRINT #1:USING$("###",BOARD(X,Y));
IF MOD(X,3)=0 THEN PRINT #1:"|";
NEXT X
PRINT #1
IF MOD(Y,3)=0 THEN PRINT #1:REPEAT$("-",31)
NEXT Y
END SUB
EXTERNAL SUB SUDOKU(BOARD(,))
OPTION CHARACTER BYTE
LET A$=REPEAT$(" ",4*81)
FOR Y=0 TO 8
FOR X=0 TO 8
LET A$(4*(9*Y+X)+1:4*(9*Y+X)+4)=DWORD$(BOARD(X+1,Y+1))
NEXT X
NEXT Y
LET FOUND=SOLVE(A$)
IF FOUND=1 THEN
FOR Y=0 TO 8
FOR X=0 TO 8
LET BOARD(X+1,Y+1)=INT32(A$(4*(9*Y+X)+1:4*(9*Y+X)+4))
NEXT X
NEXT Y
END IF
FUNCTION SOLVE(A$)
ASSIGN ".\dll\sudoku9.dll","sudoku"
END FUNCTION
END SUB
EXTERNAL FUNCTION INT32(X$)
OPTION CHARACTER BYTE
LET S=ORD(X$(1:1))+ORD(X$(2:2))*256+ORD(X$(3:3))*256^2+ORD(X$(4:4))*256^3
IF S>2^31 THEN LET S=S-2^32
LET INT32=S
END FUNCTION
------------------------------------------------------------------------------
sudoku9.c
int board[9][9],answer[9][9],found=0;
int check(int x,int y,int n)
{
int xx,yy,x0,y0;
for(yy=0; yy<9; yy++)
if (board[x][yy]==n) return 0;
for(xx=0; xx<9; xx++)
if (board[xx][y]==n) return 0;
x0=x/3;
y0=y/3;
for(yy=0; yy<3; yy++)
for(xx=0; xx<3; xx++)
if (board[x0*3+xx][y0*3+yy]==n) return 0;
return 1;
}
void solve(int n)
{
int x,y,i;
if(n==81) {
found=1;
for (y=0; y<9; y++)
for(x=0; x<9; x++) answer[x][y]=board[x][y];
return;
}
x=n%9;
y=n/9;
if (board[x][y]==0)
{
for(i=1; i<=9; i++)
{
if(check(x,y,i)==1)
{
board[x][y]=i;
solve(n+1);
if (found==1) return;
board[x][y]=0;
}
}
} else {
solve(n+1);
if(found==1) return;
}
return;
}
__declspec(dllexport) int sudoku(int *p)
{
int x,y;
for(y=0; y<9; y++)
for(x=0; x<9; x++) board[x][y]=p[9*y+x];
solve(0);
if (found==1)
for(y=0; y<9; y++)
for(x=0; x<9; x++) p[9*y+x]=answer[x][y];
return found;
}
Re: 数独パズル - しばっち
2026/01/25 (Sun) 07:41:07
実行すると下記のような問題が出力できますがサイズによっては時間を要します。
時間がかかる時は、Lazarus64bit版十進BASIC又はBasicAcc、Paract BASICを使用してください。
4×4サイズ 小ブロック2×2
---------------
| 2| 4|
| 4 | 1 2|
---------------
| 2 1| 4 |
| 3 4| 2 |
---------------
5×5サイズ 小ブロックなし
-----------------
| 2 3 1|
| 2 1 3 |
| 4 5 2|
| 4 2 1 3|
| 1 3 4 5|
-----------------
6×6サイズ 小ブロック3×2
---------------------
| 2 3 1| 6 5|
| 5 6| 1 2|
---------------------
| 1 | 5 2 6|
| 6 5 2| 3 |
---------------------
| 1 4| 6 3|
| 3 6 | 4 1|
---------------------
7×7サイズ 小ブロックなし
-----------------------
| 3 4 5 6 2 7|
| 5 2 4 7 3 1|
| 3 6 7 2 5 4|
| 4 7 3 5 1 2|
| 7 2 3 4 5|
| 2 4 5 1 7 |
| 6 5 2 4 3|
-----------------------
8×8サイズ 小ブロック4×2
---------------------------
| 2 1 3| 5 6 8 7|
| 5 7 8| 3 1 2|
---------------------------
| 5 1 | 7 3 2 8|
| 7 2| 6 4 5|
---------------------------
| 8 7 1| 2 5 3 4|
| 4 2 | 8 7 6|
---------------------------
| 6 8 3 7| 4 2 5 1|
| 1 2 5 4| 8 7 6 3|
---------------------------
10×10サイズ 小ブロック5×2
---------------------------------
| 3 9 4| 6 10 8 5 1|
| 1 10 8 6 5| 9 4 3 7 |
---------------------------------
| 4 3 2 8| 1 7 9 6|
| 7 5 1 9| 4 2 8 3|
---------------------------------
| 3 4 5 2| 7 6 9 |
| 9 1 10 6| 3 2 4 5|
---------------------------------
| 8 2 7| 10 5 4 3 9|
| 10 5 9 3| 7 6 8|
---------------------------------
| 2 6 3 | 8 9 10 7|
| 5 9 8 10| 1 6 2 4|
---------------------------------
11×11サイズ 小ブロックなし
-----------------------------------
| 6 1 5 10 8 4 7 11 3 |
| 7 5 2 9 1 10 3 4 11|
| 3 11 8 2 1 7 5 9 |
| 6 10 9 3 4 5 11 7 2|
| 1 3 9 10 11 8 5 |
| 4 8 11 5 3 10 1 2 6|
| 11 10 1 7 5 9 3 2 4|
| 4 3 8 7 6 9 10 11 5|
| 11 3 4 2 8 5 7 6 1|
| 5 7 6 4 9 10 11 8 3|
| 9 5 7 11 3 4 6 10 8|
-----------------------------------
RANDOMIZE
PUBLIC NUMERIC BOARD(20,20),ANSWER(20,20),FOUND,SIZE,XSIZE,YSIZE
LET FOUND=0
LET XSIZE=3 ! 小ブロックサイズ
LET YSIZE=2
LET SIZE=XSIZE*YSIZE ! 全体のサイズ
DO
MAT BOARD=ZER
LET NN=RND*20+SIZE*SIZE-20 ! 要調整
FOR I=1 TO NN
LET X=INT(RND*SIZE+1)
LET Y=INT(RND*SIZE+1)
LET N=INT(RND*SIZE+1)
IF BOARD(X,Y)=0 AND CHECK(X,Y,N)=1 THEN
LET BOARD(X,Y)=N
END IF
NEXT I
PRINT "解 探索中..."
CALL SOLVE(0)
LOOP UNTIL FOUND=1
PRINT "ファイル書き出し中..."
OPEN #1:NAME STR$(SIZE)&"×"&STR$(SIZE)&"数独問題.txt"
ERASE #1
CALL DISPLAY(#1)
CLOSE #1
OPEN #1:NAME STR$(SIZE)&"×"&STR$(SIZE)&"数独解答.txt"
ERASE #1
MAT BOARD=ANSWER
CALL DISPLAY(#1)
CLOSE #1
END
EXTERNAL SUB CREATPROBLEM
LET NN=RND*20+SIZE*SIZE-20 ! 要調整
FOR I=1 TO NN
LET XX=INT(RND*SIZE+1)
LET YY=INT(RND*SIZE+1)
LET BOARD(XX,YY)=0
FOR Y=1 TO SIZE
FOR X=1 TO SIZE
IF BOARD(X,Y)=0 THEN
LET C=0
FOR K=1 TO SIZE
IF CHECK(X,Y,K)=1 THEN LET C=C+1
NEXT K
IF C<>1 THEN LET BOARD(X,Y)=ANSWER(X,Y)
END IF
NEXT X
NEXT Y
NEXT I
END SUB
EXTERNAL SUB DISPLAY(#1)
IF XSIZE>1 THEN PRINT #1:REPEAT$("-",3*SIZE+SIZE/XSIZE+1) ELSE PRINT #1:REPEAT$("-",3*SIZE+2)
FOR Y=1 TO SIZE
PRINT #1:"|";
FOR X=1 TO SIZE
IF BOARD(X,Y)=0 THEN PRINT #1:" "; ELSE PRINT #1:USING$("###",BOARD(X,Y));
IF XSIZE>1 AND MOD(X,XSIZE)=0 THEN PRINT #1:"|";
NEXT X
IF XSIZE=1 THEN PRINT #1:"|" ELSE PRINT #1
IF XSIZE>1 AND YSIZE>1 AND MOD(Y,YSIZE)=0 THEN PRINT #1:REPEAT$("-",3*SIZE+SIZE/XSIZE+1)
NEXT Y
IF XSIZE=1 OR YSIZE=1 THEN PRINT #1:REPEAT$("-",3*SIZE+2)
END SUB
EXTERNAL FUNCTION CHECK(X,Y,NUM)
LET CHECK=0
FOR YY=1 TO SIZE
IF BOARD(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO SIZE
IF BOARD(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
IF XSIZE>1 AND YSIZE>1 THEN
LET X0=INT((X-1)/XSIZE)*XSIZE
LET Y0=INT((Y-1)/YSIZE)*YSIZE
FOR YY=1 TO YSIZE
FOR XX=1 TO XSIZE
IF BOARD(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
END IF
LET CHECK=1
END FUNCTION
EXTERNAL SUB SOLVE(N)
IF N=SIZE*SIZE THEN
LET FOUND=1
MAT ANSWER=BOARD
CALL CREATPROBLEM
ELSE
LET COL=MOD(N,SIZE)+1
LET ROW=INT(N/SIZE)+1
IF BOARD(COL,ROW)=0 THEN
FOR I=1 TO SIZE
IF CHECK(COL,ROW,I)=1 THEN
LET BOARD(COL,ROW)=I
CALL SOLVE(N+1)
IF FOUND=1 THEN EXIT SUB
LET BOARD(COL,ROW)=0
END IF
NEXT I
ELSE
CALL SOLVE(N+1)
IF FOUND=1 THEN EXIT SUB
END IF
END IF
END SUB
解答
---------------
| 1 2| 3 4|
| 4 3| 1 2|
---------------
| 2 1| 4 3|
| 3 4| 2 1|
---------------
-----------------
| 5 2 3 4 1|
| 2 1 5 3 4|
| 3 4 1 5 2|
| 4 5 2 1 3|
| 1 3 4 2 5|
-----------------
---------------------
| 2 3 1| 4 6 5|
| 5 4 6| 1 3 2|
---------------------
| 4 1 3| 5 2 6|
| 6 5 2| 3 1 4|
---------------------
| 1 2 4| 6 5 3|
| 3 6 5| 2 4 1|
---------------------
-----------------------
| 1 3 4 5 6 2 7|
| 5 2 6 4 7 3 1|
| 3 6 7 2 1 5 4|
| 4 7 3 6 5 1 2|
| 7 1 2 3 4 6 5|
| 2 4 5 1 3 7 6|
| 6 5 1 7 2 4 3|
-----------------------
---------------------------
| 2 1 4 3| 5 6 8 7|
| 5 6 7 8| 3 4 1 2|
---------------------------
| 4 5 1 6| 7 3 2 8|
| 7 3 8 2| 6 1 4 5|
---------------------------
| 8 7 6 1| 2 5 3 4|
| 3 4 2 5| 1 8 7 6|
---------------------------
| 6 8 3 7| 4 2 5 1|
| 1 2 5 4| 8 7 6 3|
---------------------------
---------------------------------
| 7 2 3 9 4| 6 10 8 5 1|
| 1 10 8 6 5| 9 4 3 7 2|
---------------------------------
| 4 3 2 10 8| 5 1 7 9 6|
| 6 7 5 1 9| 4 2 10 8 3|
---------------------------------
| 3 8 4 5 2| 7 6 9 1 10|
| 9 1 10 7 6| 3 8 2 4 5|
---------------------------------
| 8 6 1 2 7| 10 5 4 3 9|
| 10 5 9 4 3| 2 7 1 6 8|
---------------------------------
| 2 4 6 3 1| 8 9 5 10 7|
| 5 9 7 8 10| 1 3 6 2 4|
---------------------------------
-----------------------------------
| 6 1 2 5 10 8 4 7 11 3 9|
| 7 5 8 2 6 9 1 10 3 4 11|
| 3 11 4 8 2 1 7 6 5 9 10|
| 8 6 10 9 3 4 5 11 1 7 2|
| 1 3 9 10 11 6 2 8 4 5 7|
| 4 8 7 11 5 3 10 1 9 2 6|
| 11 10 1 6 7 5 9 3 2 8 4|
| 2 4 3 1 8 7 6 9 10 11 5|
| 10 9 11 3 4 2 8 5 7 6 1|
| 5 7 6 4 9 10 11 2 8 1 3|
| 9 2 5 7 1 11 3 4 6 10 8|
-----------------------------------
Re: 数独パズル - しばっち
2026/01/25 (Sun) 07:42:31
実行すると一部領域が重なった下記のような9*9数独問題を書き出します。
9*9の2つのエリアはそれぞれに通常の数独のルールが適用され、重なった部分は共有します。
時間がかかる時は、Lazarus64bit版十進BASIC又はBasicAcc、Paract BASICを使用してください。
-----------------------------------------
| 2 9| 1 7| 3 6 |*********|
| 7 4 6| 8 9| 5 1 |*********|
| 1| 6 2 5| 4 7 9|*********|
-----------------------------------------
| 8 7 | 2 6 | 1 9 5| 3 7 8|
| 9 5| 1 7 8| 2 4 3| 6 |
| 4 1 2| 5 9 3| 6 8 7| 1 2 |
-----------------------------------------
| 1 6 7| 8 5 2| 9 3 4| 6 |
| 2 3 8| 9 6| 7 5 1| 2 8 3|
| 9 5 | 7 3 1| 8 2 6| 9 5|
-----------------------------------------
|*********| 3 1 7| 6 | 9 5 2|
|*********| 8 9| 5 1 2| 7 3 6|
|*********| 6 2 5| 3 7 | 8 1|
-----------------------------------------
RANDOMIZE
PUBLIC NUMERIC BOARD1(9,9),BOARD2(9,9),ANSWER1(9,9),ANSWER2(9,9),FOUND1,FOUND2
DO
LET FOUND1=0
LET FOUND2=0
MAT BOARD1=ZER
MAT BOARD2=ZER
LET NN=RND*20+60
FOR I=1 TO NN
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET N=INT(RND*9+1)
IF BOARD1(X,Y)=0 AND CHECK1(X,Y,N)=1 THEN
LET BOARD1(X,Y)=N
FOR YY=1 TO 6
FOR XX=1 TO 6
LET BOARD2(XX,YY)=BOARD1(XX+3,YY+3)
NEXT XX
NEXT YY
END IF
NEXT I
PRINT "解 探索中..."
CALL SOLVE1(0)
IF FOUND1=1 THEN
PRINT "FOUND 1"
FOR Y=1 TO 6
FOR X=1 TO 6
LET BOARD2(X,Y)=ANSWER1(X+3,Y+3)
NEXT X
NEXT Y
CALL SOLVE2(0)
END IF
LOOP UNTIL FOUND1=1 AND FOUND2=1
MAT BOARD1=ANSWER1
MAT BOARD2=ANSWER2
CALL CREATPROBLEM
PRINT "ファイル書き出し中..."
OPEN #1:NAME "9×9数独問題.txt"
ERASE #1
CALL DISPLAY(#1)
CLOSE #1
!CALL SHOW(BOARD1,BOARD2)
!GSAVE "9×9数独問題.png"
OPEN #1:NAME "9×9数独解答.txt"
ERASE #1
MAT BOARD1=ANSWER1
MAT BOARD2=ANSWER2
CALL DISPLAY(#1)
CLOSE #1
!CALL SHOW(BOARD1,BOARD2)
!GSAVE "9×9数独解答.png"
END
EXTERNAL SUB CREATPROBLEM
LET NN=INT(RND*50)+30
FOR I=1 TO NN
LET X1=INT(RND*9+1)
LET Y1=INT(RND*9+1)
LET X2=INT(RND*9+1)
LET Y2=INT(RND*9+1)
LET BOARD1(X1,Y1)=0
LET BOARD2(X2,Y2)=0
FOR Y=1 TO 9
FOR X=1 TO 9
IF BOARD1(X,Y)=0 THEN
LET C1=0
FOR K=1 TO 9
IF CHECK1(X,Y,K)=1 THEN LET C1=C1+1
NEXT K
IF C1<>1 THEN LET BOARD1(X,Y)=ANSWER1(X,Y)
END IF
IF BOARD2(X,Y)=0 THEN
LET C2=0
FOR K=1 TO 9
IF CHECK2(X,Y,K)=1 THEN LET C2=C2+1
NEXT K
IF C2<>1 THEN LET BOARD2(X,Y)=ANSWER2(X,Y)
END IF
NEXT X
NEXT Y
NEXT I
END SUB
EXTERNAL SUB DISPLAY(#1)
DIM A$(12,12)
MAT A$=("***")&NUL$
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD1(I,J)>0 THEN LET A$(I,J)=USING$("###",BOARD1(I,J))
NEXT I
NEXT J
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD2(I,J)>0 THEN LET A$(I+3,J+3)=USING$("###",BOARD2(I,J))
NEXT I
NEXT J
PRINT #1:REPEAT$("-",41)
FOR J=1 TO 12
PRINT #1:"|";
FOR I=1 TO 12
PRINT #1:A$(I,J);
IF MOD(I,3)=0 THEN PRINT #1:"|";
NEXT I
PRINT #1
IF MOD(J,3)=0 THEN PRINT #1:REPEAT$("-",41)
NEXT J
END SUB
EXTERNAL SUB SHOW(BOARD1(,),BOARD2(,))
LET XSIZE=3
LET YSIZE=3
LET N=12
SET WINDOW 0,1,1,0
CLEAR
SET TEXT HEIGHT .05
FOR I=1 TO 9
IF MOD(I,XSIZE)=0 THEN
SET LINE WIDTH 3
ELSE
SET LINE WIDTH 1
END IF
LET X=I/N
SET LINE COLOR 1
PLOT LINES:X,0;X,9/N
LET Y=I/N
PLOT LINES:0,Y;9/N,Y
NEXT I
FOR I=0 TO 9
IF MOD(I+3,XSIZE)=0 THEN
SET LINE WIDTH 3
ELSE
SET LINE WIDTH 1
END IF
LET X=(I+3)/N
SET LINE COLOR 4
PLOT LINES:X,3/N;X,1
LET Y=(I+3)/N
PLOT LINES:3/N,Y;1,Y
NEXT I
SET TEXT JUSTIFY "LEFT","TOP"
FOR J=0 TO 8
FOR I=0 TO 8
LET X=I/N
LET Y=J/N
IF BOARD1(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD1(I+1,J+1))
NEXT I
NEXT J
FOR J=0 TO 8
FOR I=0 TO 8
IF I>5 OR J>5 THEN
LET X=(I+3)/N
LET Y=(J+3)/N
IF BOARD2(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD2(I+1,J+1))
END IF
NEXT I
NEXT J
END SUB
EXTERNAL FUNCTION CHECK1(X,Y,NUM)
LET CHECK1=0
FOR YY=1 TO 9
IF BOARD1(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO 9
IF BOARD1(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
FOR XX=1 TO 9
FOR A=1 TO 8
FOR B=A+1 TO 9
IF BOARD1(XX,A)<>0 AND BOARD1(XX,B)<>0 AND BOARD1(XX,A)=BOARD1(XX,B) THEN EXIT FUNCTION
NEXT B
NEXT A
NEXT XX
FOR YY=1 TO 9
FOR A=1 TO 8
FOR B=A+1 TO 9
IF BOARD1(A,YY)<>0 AND BOARD1(B,YY)<>0 AND BOARD1(A,YY)=BOARD1(B,YY) THEN EXIT FUNCTION
NEXT B
NEXT A
NEXT YY
LET X0=INT((X-1)/3)*3
LET Y0=INT((Y-1)/3)*3
FOR YY=1 TO 3
FOR XX=1 TO 3
IF BOARD1(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
LET CHECK1=1
END FUNCTION
EXTERNAL FUNCTION CHECK2(X,Y,NUM)
LET CHECK2=0
FOR YY=1 TO 9
IF BOARD2(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO 9
IF BOARD2(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
FOR XX=1 TO 9
FOR A=1 TO 8
FOR B=A+1 TO 9
IF BOARD2(XX,A)<>0 AND BOARD2(XX,B)<>0 AND BOARD2(XX,A)=BOARD2(XX,B) THEN EXIT FUNCTION
NEXT B
NEXT A
NEXT XX
FOR YY=1 TO 9
FOR A=1 TO 8
FOR B=A+1 TO 9
IF BOARD2(A,YY)<>0 AND BOARD2(B,YY)<>0 AND BOARD2(A,YY)=BOARD2(B,YY) THEN EXIT FUNCTION
NEXT B
NEXT A
NEXT YY
LET X0=INT((X-1)/3)*3
LET Y0=INT((Y-1)/3)*3
FOR YY=1 TO 3
FOR XX=1 TO 3
IF BOARD2(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
LET CHECK2=1
END FUNCTION
EXTERNAL SUB SOLVE1(N)
IF N=81 THEN
LET FOUND1=1
MAT ANSWER1=BOARD1
ELSE
LET COL=MOD(N,9)+1
LET ROW=INT(N/9)+1
IF BOARD1(COL,ROW)=0 THEN
FOR I=1 TO 9
IF CHECK1(COL,ROW,I)=1 THEN
LET BOARD1(COL,ROW)=I
CALL SOLVE1(N+1)
IF FOUND1=1 THEN EXIT SUB
LET BOARD1(COL,ROW)=0
END IF
NEXT I
ELSE
CALL SOLVE1(N+1)
IF FOUND1=1 THEN EXIT SUB
END IF
END IF
END SUB
EXTERNAL SUB SOLVE2(N)
IF N=81 THEN
LET FOUND2=1
MAT ANSWER2=BOARD2
ELSE
LET COL=MOD(N,9)+1
LET ROW=INT(N/9)+1
IF BOARD2(COL,ROW)=0 THEN
FOR I=1 TO 9
IF CHECK2(COL,ROW,I)=1 THEN
LET BOARD2(COL,ROW)=I
CALL SOLVE2(N+1)
IF FOUND2=1 THEN EXIT SUB
LET BOARD2(COL,ROW)=0
END IF
NEXT I
ELSE
CALL SOLVE2(N+1)
IF FOUND2=1 THEN EXIT SUB
END IF
END IF
END SUB
解答
-----------------------------------------
| 5 2 9| 4 1 7| 3 6 8|*********|
| 7 4 6| 3 8 9| 5 1 2|*********|
| 3 8 1| 6 2 5| 4 7 9|*********|
-----------------------------------------
| 8 7 3| 2 6 4| 1 9 5| 3 7 8|
| 6 9 5| 1 7 8| 2 4 3| 5 6 9|
| 4 1 2| 5 9 3| 6 8 7| 1 2 4|
-----------------------------------------
| 1 6 7| 8 5 2| 9 3 4| 6 1 7|
| 2 3 8| 9 4 6| 7 5 1| 2 8 3|
| 9 5 4| 7 3 1| 8 2 6| 4 9 5|
-----------------------------------------
|*********| 3 1 7| 4 6 8| 9 5 2|
|*********| 4 8 9| 5 1 2| 7 3 6|
|*********| 6 2 5| 3 7 9| 8 4 1|
-----------------------------------------
Re: 数独パズル - しばっち
2026/01/25 (Sun) 07:44:42
実行すると9*9の数独を5つ組み合わせた下記のような問題を書き出します。
(左上、右上、真ん中、左下、右下)真ん中は4つ共有域があります。
時間がかかる時は、Lazarus64bit版十進BASIC又はBasicAcc、Paract BASICを使用してください。
-----------------------------------------------------------------------
| 7 2| 6 4 8| 5 |*********| 1 7 | 8 9 5| 4 2 3|
| 8 6| 1 2| 7 4 9|*********| 5 2| 3 4| 7 8 |
| 4 3 1| 7 9 | 8 6|*********| 8 3| 7 2 1| 5 9|
-----------------------------------------------------------------------
| 2 4 3| 8 6| 9 1 7|*********| 5 3 4| 2 1 | 7 8|
| 6 | 9 2 7| 5 4|*********| 2 8| 9 4 | 6 |
| 7 5 | 4 1 | 6 8 2|*********| 6 9 | 5 8 3| 1 4 2|
-----------------------------------------------------------------------
| 4| 8 6 9| 1 7 5| 2 3 6| 8 9| 1 2| 5 6|
| 1 6 5| 7 4| 2 9 | 4 5 7| 3 6 1| 5 8| 2 7|
| 8 7| 2 5 | 4 6 3| 9 1| 7 2 5| 3 9| 8 1 |
-----------------------------------------------------------------------
|*********|*********| 8 4| 7 3| 9 |*********|*********|
|*********|*********| 6 7| 5 9 4| 8 1 3|*********|*********|
|*********|*********| 1 | 6 2 | 5 4 |*********|*********|
-----------------------------------------------------------------------
| 8 | 3 6 | 9 | 7 1 5| 3 | 4 7| 1 5 9|
| 9 1 2| 5 8 4| 7 6| 4 9| 1 5 2| 6 3| 7 |
| 4 6 | 7 | 8 5 1| 3 6 | 7 | 8 1 5| 6 2 |
-----------------------------------------------------------------------
| 6 7 4| 5 8| 1 9 |*********| 3 7| 6 5 4| 2 9 1|
| 1 8| 7 6| 5 2 4|*********| 4 1 9| 7 2 | 5 3 6|
| 5 2 9| 4 1 | 6 8 7|*********| 2 6| 1 3 9| 7 4|
-----------------------------------------------------------------------
| 4 1| 8 9 7| 2 6 5|*********| 8 4 | 5 2| 3 7|
| 2 8 6| 1 4 5| 7 9|*********| 7 5| 3 8 6| 4 1 2|
| 7 9 5| 6 2| 4 1 8|*********| 2 6 3| 4 7 1| 8 5|
-----------------------------------------------------------------------
PUBLIC NUMERIC FOUND
RANDOMIZE
DIM BOARD1(9,9),BOARD2(9,9),BOARD3(9,9),BOARD4(9,9),BOARD5(9,9)
DIM ANSWER1(9,9),ANSWER2(9,9),ANSWER3(9,9),ANSWER4(9,9),ANSWER5(9,9)
PRINT "エリア1 探索中..."
DO ! エリア1 左上
LET FOUND=0
LET P=INT(RND*20)+30
MAT BOARD1=ZER
FOR K=1 TO P
DO
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET NUM=INT(RND*9)+1
LOOP WHILE CHECK(X,Y,NUM,BOARD1)=0
LET BOARD1(X,Y)=NUM
NEXT K
CALL SOLVE(0,BOARD1)
LOOP UNTIL FOUND=1
MAT ANSWER1=BOARD1
PRINT "エリア2 探索中..."
DO ! エリア2 真ん中
LET FOUND=0
LET P=INT(RND*20)+30
MAT BOARD2=ZER
FOR K=1 TO P
DO
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET NUM=INT(RND*9)+1
FOR I=1 TO 3
FOR J=1 TO 3
LET BOARD2(I,J)=BOARD1(I+6,J+6)
NEXT J
NEXT I
LOOP WHILE CHECK(X,Y,NUM,BOARD2)=0
LET BOARD2(X,Y)=NUM
NEXT K
CALL SOLVE(0,BOARD2)
LOOP UNTIL FOUND=1
MAT ANSWER2=BOARD2
PRINT "エリア3 探索中..."
DO ! エリア3 右上
LET FOUND=0
LET P=INT(RND*20)+30
MAT BOARD3=ZER
FOR K=1 TO P
DO
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET NUM=INT(RND*9)+1
FOR J=1 TO 3
FOR I=1 TO 3
LET BOARD3(I,J+6)=BOARD2(I+6,J)
NEXT I
NEXT J
LOOP WHILE CHECK(X,Y,NUM,BOARD3)=0
LET BOARD3(X,Y)=NUM
NEXT K
CALL SOLVE(0,BOARD3)
LOOP UNTIL FOUND=1
MAT ANSWER3=BOARD3
PRINT "エリア4 探索中..."
DO ! エリア4 左下
LET FOUND=0
LET P=INT(RND*20)+30
MAT BOARD4=ZER
FOR K=1 TO P
DO
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET NUM=INT(RND*9)+1
FOR J=1 TO 3
FOR I=1 TO 3
LET BOARD4(I+6,J)=BOARD2(I,J+6)
NEXT I
NEXT J
LOOP WHILE CHECK(X,Y,NUM,BOARD4)=0
LET BOARD4(X,Y)=NUM
NEXT K
CALL SOLVE(0,BOARD4)
LOOP UNTIL FOUND=1
MAT ANSWER4=BOARD4
PRINT "エリア5 探索中..."
DO ! エリア5 右下
LET FOUND=0
LET P=INT(RND*20)+30
MAT BOARD5=ZER
FOR K=1 TO P
DO
LET X=INT(RND*9+1)
LET Y=INT(RND*9+1)
LET NUM=INT(RND*9)+1
FOR J=1 TO 3
FOR I=1 TO 3
LET BOARD5(I,J)=BOARD2(I+6,J+6)
NEXT I
NEXT J
LOOP WHILE CHECK(X,Y,NUM,BOARD5)=0
LET BOARD5(X,Y)=NUM
NEXT K
CALL SOLVE(0,BOARD5)
LOOP UNTIL FOUND=1
MAT ANSWER5=BOARD5
PRINT "問題 作成中..."
CALL CREATPROBLEM(BOARD1,ANSWER1)
CALL CREATPROBLEM(BOARD2,ANSWER2)
CALL CREATPROBLEM(BOARD3,ANSWER3)
CALL CREATPROBLEM(BOARD4,ANSWER4)
CALL CREATPROBLEM(BOARD5,ANSWER5)
PRINT "ファイル書き込み中..."
OPEN #1:NAME "9×9数独拡張問題.txt"
ERASE #1
CALL DISPLAY(BOARD1,BOARD2,BOARD3,BOARD4,BOARD5,#1)
CLOSE #1
OPEN #1:NAME "9×9数独拡張解答.txt"
ERASE #1
CALL DISPLAY(ANSWER1,ANSWER2,ANSWER3,ANSWER4,ANSWER5,#1)
CLOSE #1
PRINT "終了しました"
END
EXTERNAL SUB DISPLAY(BOARD1(,),BOARD2(,),BOARD3(,),BOARD4(,),BOARD5(,),#1)
DIM A$(21,21)
MAT A$="***"&NUL$
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD1(I,J)>0 THEN LET A$(I,J)=USING$("###",BOARD1(I,J)) ELSE LET A$(I,J)=" "
NEXT I
NEXT J
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD2(I,J)>0 THEN LET A$(I+6,J+6)=USING$("###",BOARD2(I,J)) ELSE LET A$(I+6,J+6)=" "
NEXT I
NEXT J
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD3(I,J)>0 THEN LET A$(I+12,J)=USING$("###",BOARD3(I,J)) ELSE LET A$(I+12,J)=" "
NEXT I
NEXT J
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD4(I,J)>0 THEN LET A$(I,J+12)=USING$("###",BOARD4(I,J)) ELSE LET A$(I,J+12)=" "
NEXT I
NEXT J
FOR J=1 TO 9
FOR I=1 TO 9
IF BOARD5(I,J)>0 THEN LET A$(I+12,J+12)=USING$("###",BOARD5(I,J)) ELSE LET A$(I+12,J+12)=" "
NEXT I
NEXT J
PRINT #1:REPEAT$("---",23);"--"
FOR J=1 TO 21
PRINT #1:"|";
FOR I=1 TO 21
PRINT #1:A$(I,J);
IF MOD(I,3)=0 THEN PRINT #1:"|";
NEXT I
PRINT #1
IF MOD(J,3)=0 THEN PRINT #1:REPEAT$("---",23);"--"
NEXT J
END SUB
EXTERNAL SUB SHOW(BOARD1(,),BOARD2(,),BOARD3(,),BOARD4(,),BOARD5(,))
LET N=21
LET XSIZE=3
LET YSIZE=3
SET WINDOW 0,1,1,0
CLEAR
FOR I=0 TO 9
IF MOD(I,XSIZE)=0 THEN
SET LINE WIDTH 3
ELSE
SET LINE WIDTH 1
END IF
SET LINE COLOR 1
LET X=I/N
PLOT LINES:X,0;X,9/N
LET Y=I/N
PLOT LINES:0,Y;9/N,Y
SET LINE COLOR 2
LET X=(I+12)/N
PLOT LINES:X,0;X,9/N
LET Y=I/N
PLOT LINES:12/N,Y;1,Y
SET LINE COLOR 3
LET X=(I+6)/N
PLOT LINES:X,6/N;X,15/N
LET Y=(I+6)/N
PLOT LINES:6/N,Y;15/N,Y
SET LINE COLOR 4
LET X=I/N
PLOT LINES:X,12/N;X,1
LET Y=(I+12)/N
PLOT LINES:0,Y;9/N,Y
SET LINE COLOR 5
LET X=(I+12)/N
PLOT LINES:X,12/N;X,1
LET Y=(I+12)/N
PLOT LINES:12/N,Y;1,Y
NEXT I
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT HEIGHT .03
FOR J=0 TO 8
FOR I=0 TO 8
LET X=I/N
LET Y=J/N
IF BOARD1(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD1(I+1,J+1))
NEXT I
NEXT J
FOR J=0 TO 8
FOR I=0 TO 8
LET X=(I+6)/N
LET Y=(J+6)/N
IF I>2 OR J>2 THEN
IF BOARD2(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD2(I+1,J+1))
END IF
NEXT I
NEXT J
FOR J=0 TO 8
FOR I=0 TO 8
LET X=(I+12)/N
LET Y=J/N
IF I>2 OR J<6 THEN
IF BOARD3(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD3(I+1,J+1))
END IF
NEXT I
NEXT J
FOR J=0 TO 8
FOR I=0 TO 8
LET X=I/N
LET Y=(J+12)/N
IF I<6 OR J>2 THEN
IF BOARD4(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD4(I+1,J+1))
END IF
NEXT I
NEXT J
FOR J=0 TO 8
FOR I=0 TO 8
LET X=(I+12)/N
LET Y=(J+12)/N
IF I>2 OR J>2 THEN
IF BOARD5(I+1,J+1)>0 THEN PLOT TEXT ,AT X,Y:USING$("##",BOARD5(I+1,J+1))
END IF
NEXT I
NEXT J
END SUB
EXTERNAL SUB CREATPROBLEM(BOARD(,),ANSWER(,))
LET P=INT(RND*30)+50
FOR L=1 TO P
LET XX=INT(RND*9)+1
LET YY=INT(RND*9)+1
LET BOARD(XX,YY)=0
FOR Y=1 TO 9
FOR X=1 TO 9
IF BOARD(X,Y)=0 THEN
LET C=0
FOR K=1 TO 9
IF CHECK(X,Y,K,BOARD)=1 THEN LET C=C+1
NEXT K
IF C<>1 THEN LET BOARD(X,Y)=ANSWER(X,Y)
END IF
NEXT X
NEXT Y
NEXT L
END SUB
EXTERNAL FUNCTION CHECK(X,Y,NUM,BOARD(,))
LET CHECK=0
FOR YY=1 TO 9
IF BOARD(X,YY)=NUM THEN EXIT FUNCTION
NEXT YY
FOR XX=1 TO 9
IF BOARD(XX,Y)=NUM THEN EXIT FUNCTION
NEXT XX
LET X0=INT((X-1)/3)*3
LET Y0=INT((Y-1)/3)*3
FOR YY=1 TO 3
FOR XX=1 TO 3
IF BOARD(X0+XX,Y0+YY)=NUM THEN EXIT FUNCTION
NEXT XX
NEXT YY
LET CHECK=1
END FUNCTION
EXTERNAL SUB SOLVE(N,BOARD(,))
IF N=81 THEN
LET FOUND=1
ELSE
LET COL=MOD(N,9)+1
LET ROW=INT(N/9)+1
IF BOARD(COL,ROW)=0 THEN
FOR I=1 TO 9
IF CHECK(COL,ROW,I,BOARD)=1 THEN
LET BOARD(COL,ROW)=I
CALL SOLVE(N+1,BOARD)
IF FOUND=1 THEN EXIT SUB
LET BOARD(COL,ROW)=0
END IF
NEXT I
ELSE
CALL SOLVE(N+1,BOARD)
IF FOUND=1 THEN EXIT SUB
END IF
END IF
END SUB
解答
-----------------------------------------------------------------------
| 9 7 2| 6 4 8| 5 3 1|*********| 1 7 6| 8 9 5| 4 2 3|
| 5 8 6| 1 3 2| 7 4 9|*********| 9 5 2| 6 3 4| 7 8 1|
| 4 3 1| 7 9 5| 8 2 6|*********| 8 4 3| 7 2 1| 6 5 9|
-----------------------------------------------------------------------
| 2 4 3| 5 8 6| 9 1 7|*********| 5 3 4| 2 1 6| 9 7 8|
| 6 1 8| 9 2 7| 3 5 4|*********| 2 1 8| 9 4 7| 3 6 5|
| 7 5 9| 4 1 3| 6 8 2|*********| 6 9 7| 5 8 3| 1 4 2|
-----------------------------------------------------------------------
| 3 2 4| 8 6 9| 1 7 5| 2 3 6| 4 8 9| 1 7 2| 5 3 6|
| 1 6 5| 3 7 4| 2 9 8| 4 5 7| 3 6 1| 4 5 8| 2 9 7|
| 8 9 7| 2 5 1| 4 6 3| 9 8 1| 7 2 5| 3 6 9| 8 1 4|
-----------------------------------------------------------------------
|*********|*********| 5 8 4| 1 7 3| 2 9 6|*********|*********|
|*********|*********| 6 2 7| 5 9 4| 8 1 3|*********|*********|
|*********|*********| 3 1 9| 6 2 8| 5 4 7|*********|*********|
-----------------------------------------------------------------------
| 8 5 7| 3 6 1| 9 4 2| 7 1 5| 6 3 8| 2 4 7| 1 5 9|
| 9 1 2| 5 8 4| 7 3 6| 8 4 9| 1 5 2| 9 6 3| 7 4 8|
| 4 6 3| 7 2 9| 8 5 1| 3 6 2| 9 7 4| 8 1 5| 6 2 3|
-----------------------------------------------------------------------
| 6 7 4| 2 5 8| 1 9 3|*********| 3 8 7| 6 5 4| 2 9 1|
| 1 3 8| 9 7 6| 5 2 4|*********| 4 1 9| 7 2 8| 5 3 6|
| 5 2 9| 4 1 3| 6 8 7|*********| 5 2 6| 1 3 9| 8 7 4|
-----------------------------------------------------------------------
| 3 4 1| 8 9 7| 2 6 5|*********| 8 4 1| 5 9 2| 3 6 7|
| 2 8 6| 1 4 5| 3 7 9|*********| 7 9 5| 3 8 6| 4 1 2|
| 7 9 5| 6 3 2| 4 1 8|*********| 2 6 3| 4 7 1| 9 8 5|
-----------------------------------------------------------------------
BASICでトンデモ理論に挑戦 - 百瀬
2026/01/03 (Sat) 07:13:05
微細構造定数 137.035999...を非フィッティングで導出することに挑戦してみました。
DECLARE EXTERNAL FUNCTION P_full
DECLARE EXTERNAL FUNCTION Expected_Radius
LET d = 3 ! 唯一の入力：空間次元
LET k = 2 * d ! 3次元格子の方向数 (k=6)
LET Nu = 2 ^ k ! 更新チャンネル数 (Nu=64)
LET n = d * d ! ポテンシャル次元 (n=9)
! --- 1ビット識別境界による m* の自動算出 ---
LET threshold = 0.5 ! 1ビット境界（確率 1/2）
LET m_star = 0
FOR m = 1 TO 100
IF P_full(m, k) >= threshold THEN
LET m_star = m ! 累積確率が1/2を超えた最小のm
EXIT FOR
END IF
NEXT m
! --- 定数と補正項の計算 ---
LET K_const = 1 / (2 * (PI ^ 2.5)) ! ユニバーサル幾何定数 K
LET Delta_m = 1 / (12 * m_star ^ 2) ! 幾何学的補正項
! --- 離散期待値と有効残差の算出 ---
LET E_discrete = Expected_Radius(m_star) ! 厳密な離散期待値
LET E_gaussian = (SQR(m_star * PI)) / 2 ! 連続体リファレンス
LET c_free = E_discrete / E_gaussian ! 無次元残差
LET c_eff = c_free * SQR(1 - Delta_m) ! 有効残差
! --- 最終合成 (alpha_inv = alpha0_inv + K * c_eff) ---
LET ln2 = LOG(2)
LET alpha0 = (2 * n + 1)^2 / (8 * PI * Nu^2 * ln2^2) ! 主項 alpha0
LET alpha_inv = (1 / alpha0) + K_const * c_eff ! 最終合成式
! --- 結果表示 ---
PRINT "--- Derived Discrete Parameters ---"
PRINT "Dimension d ="; d
PRINT "Directions k ="; k
PRINT "Update Nu ="; Nu
PRINT "Index m* ="; m_star
PRINT
PRINT "--- Numerical Results ---"
PRINT "alpha0^-1 ="; 1 / alpha0
PRINT "K * c_eff ="; K_const * c_eff
PRINT "Final alpha^-1 ="; alpha_inv
END
! =========================================================
! 外部関数：クーポン・コレクター問題の確率算出
! =========================================================
EXTERNAL FUNCTION P_full(m, k)
LET s = 0
FOR j = 0 TO k
! (-1)^j * nCr(k, j) * ((k-j)/k)^m
LET term = ((-1)^j) * COMB(k, j) * ((k - j) / k) ^ m
LET s = s + term
NEXT j
LET P_full = s
END FUNCTION
! =========================================================
! 外部関数：2Dランダムウォークの厳密期待値 (DP実装)
! =========================================================
EXTERNAL FUNCTION Expected_Radius(m)
! 十進BASICの配列による2次元確率分布の保持
DIM P(-20 TO 20, -20 TO 20)
DIM P_new(-20 TO 20, -20 TO 20)
MAT P = ZER
LET P(0,0) = 1 ! 原点からスタート
FOR step = 1 TO m
MAT P_new = ZER
FOR x = -(step-1) TO (step-1)
FOR y = -(step-1) TO (step-1)
IF P(x,y) > 0 THEN
! 4方向へ等確率 1/4 で遷移
LET P_new(x+1, y) = P_new(x+1, y) + P(x,y) * 0.25
LET P_new(x-1, y) = P_new(x-1, y) + P(x,y) * 0.25
LET P_new(x, y+1) = P_new(x, y+1) + P(x,y) * 0.25
LET P_new(x, y-1) = P_new(x, y-1) + P(x,y) * 0.25
END IF
NEXT y
NEXT x
MAT P = P_new
NEXT step
! 期待値の集計： E = Σ P(x,y) * SQR(x^2 + y^2)
LET sum_r = 0
FOR x = -m TO m
FOR y = -m TO m
IF P(x,y) > 0 THEN
LET sum_r = sum_r + P(x,y) * SQR(x^2 + y^2)
END IF
NEXT y
NEXT x
LET Expected_Radius = sum_r
END FUNCTION
マッチ棒パズル - しばっち
2025/12/28 (Sun) 08:08:24
マッチ棒パズル
https://giga.web.docomo.ne.jp/noutore/aha/261060/
https://noukatsu-shimbun.jp/2025/02/02/23067/
https://healthrent.duskin.jp/column/brain-training/q111.html
実行すると下記のような問題を出力します。
1本だけ動かして数式を完成させます。
マッチは折らず≠は使いません。
7 - 7 = 3
4 - 1 = 6
6 - 9 = 0
4 + 3 = 9
9 - 3 = 9
RANDOMIZE
OPEN #1:NAME "マッチ棒パズル問題.txt"
OPEN #2:NAME "マッチ棒パズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
DO
DO
LET X=INT(RND*10)
LET Y=INT(RND*10)
LET SIGN=(-1)^(INT(RND*2))
LET SUM=X+Y*SIGN ! 解答文
LOOP WHILE SUM<0 OR SUM>9
CALL CHANGE(X,XCODE,XOUT) ! 問題作成
CALL CHANGE(Y,YCODE,YOUT)
CALL CHANGE(SUM,SUMCODE,SUMOUT)
CALL CHANGESIGN(SIGN,SIGNCODE,SIGNOUT)
IF XOUT+SIGNOUT*YOUT<>SUMOUT THEN
IF SUMCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=1 AND YCODE=-1) OR (XCODE=-1 AND YCODE=-1) OR (XCODE=0 AND YCODE=2) OR (XCODE=2 AND YCODE=0) THEN EXIT DO
END IF
IF XCODE=2 AND SIGNCODE=2 THEN
IF (YCODE=-1 AND SUMCODE=1) OR (YCODE=1 AND SUMCODE=-1) OR (YCODE=2 AND SUMCODE=0) OR (YCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=-1 AND SUMCODE=1) OR (XCODE=1 AND SUMCODE=-1) OR (XCODE=2 AND SUMCODE=0) OR (XCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND YCODE=2 THEN
IF (SUMCODE=-1 AND SIGNCODE=1) OR (SUMCODE=1 AND SIGNCODE=-1) OR (SUMCODE=2 AND SIGNCODE=0) OR (SUMCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND SUMCODE=2 THEN
IF (YCODE=-1 AND SIGNCODE=1) OR (YCODE=1 AND SIGNCODE=-1) OR (YCODE=2 AND SIGNCODE=0) OR (YCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SUMCODE=2 THEN
IF (XCODE=-1 AND SIGNCODE=1) OR (XCODE=1 AND SIGNCODE=-1) OR (XCODE=2 AND SIGNCODE=0) OR (XCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
END IF
LOOP
PRINT #2:X;
IF SIGN>0 THEN PRINT #2:"+"; ELSE PRINT #2:"-";
PRINT #2:Y;"=";SUM
PRINT #1:XOUT;
IF SIGNOUT>0 THEN PRINT #1:"+"; ELSE PRINT #1:"-";
PRINT #1:YOUT;"=";SUMOUT
NEXT K
CLOSE #1
CLOSE #2
SUB CHANGE(N,CODE,OUT)
SELECT CASE N
CASE 0
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2 ! 無変更
LET OUT=0
CASE 2
LET CODE=1 ! マッチを持ってくる
LET OUT=8 ! 0を8へ
END SELECT
CASE 1
LET CODE=2 ! 無変更
LET OUT=1
CASE 2
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=2
CASE 2
LET CODE=0 ! 数字内で移動
LET OUT=3 ! 2を3へ
END SELECT
CASE 3
LET Z=INT(RND*3)+1
SELECT CASE Z
CASE 1
LET CODE=2 ! 無変更
LET OUT=3
CASE 2
LET CODE=0
LET OUT=2 ! 3を2へ
CASE 3
LET CODE=0
LET OUT=5 ! 3を5へ
END SELECT
CASE 4
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=4
CASE 2
LET CODE=0
LET OUT=7
END SELECT
CASE 5
LET Z=INT(RND*4)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=5
CASE 2
LET CODE=1
LET OUT=6
CASE 3
LET CODE=0
LET OUT=3
CASE 4
LET CODE=1
LET OUT=9
END SELECT
CASE 6
LET Z=INT(RND*4)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=6
CASE 2
LET CODE=-1 ! マッチを外す
LET OUT=5
CASE 3
LET CODE=1
LET OUT=8
CASE 4
LET CODE=0
LET OUT=9
END SELECT
CASE 7
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=7
CASE 2
LET CODE=0
LET OUT=4
END SELECT
CASE 8
LET Z=INT(RND*3)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=8
CASE 2
LET CODE=-1
LET OUT=9
CASE 3
LET CODE=-1
LET OUT=0
END SELECT
CASE 9
LET Z=INT(RND*4)+1
SELECT CASE Z
CASE 1
LET CODE=2
LET OUT=9
CASE 2
LET CODE=1
LET OUT=8
CASE 3
LET CODE=-1
LET OUT=5
CASE 4
LET CODE=0
LET OUT=6
END SELECT
END SELECT
END SUB
SUB CHANGESIGN(N,CODE,OUT) ! 符号の変更
SELECT CASE N
CASE -1
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2 ! 無変更
LET OUT=-1 ! -
CASE 2
LET CODE=1 ! -から+へ
LET OUT=1 ! +
END SELECT
CASE 1
LET Z=INT(RND*2)+1
SELECT CASE Z
CASE 1
LET CODE=2 ! 無変更
LET OUT=1 ! +
CASE 2
LET CODE=-1 ! +から-へ
LET OUT=-1 ! -
END SELECT
END SELECT
END SUB
END
解答
7 - 4 = 3
7 - 1 = 6
6 - 6 = 0
4 + 5 = 9
8 - 3 = 5
---------------------------------------------------------------------
2桁のマッチ棒パズル
03 + 83 = 85
14 - 00 = 17
97 + 04 = 98
83 - 52 = 30
89 + 06 = 93
RANDOMIZE
OPEN #1:NAME "マッチ棒パズル問題.txt"
OPEN #2:NAME "マッチ棒パズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
DO
DO
LET X1=INT(RND*10)
LET Y1=INT(RND*10)
LET X2=INT(RND*10)
LET Y2=INT(RND*10)
LET SIGN=(-1)^(INT(RND*2))
LET SUM=X1*10+X2+(Y1*10+Y2)*SIGN
LET SUM1=INT(SUM/10)
LET SUM2=MOD(SUM,10)
LOOP WHILE SUM<0 OR SUM>99
IF RND<.5 THEN
IF RND<.5 THEN
CALL CHANGE(X1,XCODE,X1OUT)
LET X2OUT=X2
ELSE
CALL CHANGE(X2,XCODE,X2OUT)
LET X1OUT=X1
END IF
IF RND<.5 THEN
CALL CHANGE(Y1,YCODE,Y1OUT)
LET Y2OUT=Y2
ELSE
CALL CHANGE(Y2,YCODE,Y2OUT)
LET Y1OUT=Y1
END IF
ELSE
IF RND<.5 THEN
CALL CHANGE(X1,XCODE,X1OUT)
CALL CHANGE(X2,YCODE,X2OUT)
LET Y1OUT=Y1
LET Y2OUT=Y2
ELSE
CALL CHANGE(Y1,XCODE,Y1OUT)
CALL CHANGE(Y2,YCODE,Y2OUT)
LET X1OUT=X1
LET X2OUT=X2
END IF
END IF
IF RND<.5 THEN
CALL CHANGE(SUM1,SUMCODE,SUM1OUT)
LET SUM2OUT=SUM2
ELSE
CALL CHANGE(SUM2,SUMCODE,SUM2OUT)
LET SUM1OUT=SUM1
END IF
CALL CHANGESIGN(SIGN,SIGNCODE,SIGNOUT)
IF X1OUT*10+X2OUT+SIGNOUT*(YOUT1*10+YOUT2)<>SUM1OUT*10+SUM2OUT THEN
IF SUMCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=1 AND YCODE=-1) OR (XCODE=-1 AND YCODE=-1) OR (XCODE=0 AND YCODE=2) OR (XCODE=2 AND YCODE=0) THEN EXIT DO
END IF
IF XCODE=2 AND SIGNCODE=2 THEN
IF (YCODE=-1 AND SUMCODE=1) OR (YCODE=1 AND SUMCODE=-1) OR (YCODE=2 AND SUMCODE=0) OR (YCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=-1 AND SUMCODE=1) OR (XCODE=1 AND SUMCODE=-1) OR (XCODE=2 AND SUMCODE=0) OR (XCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND YCODE=2 THEN
IF (SUMCODE=-1 AND SIGNCODE=1) OR (SUMCODE=1 AND SIGNCODE=-1) OR (SUMCODE=2 AND SIGNCODE=0) OR (SUMCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND SUMCODE=2 THEN
IF (YCODE=-1 AND SIGNCODE=1) OR (YCODE=1 AND SIGNCODE=-1) OR (YCODE=2 AND SIGNCODE=0) OR (YCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SUMCODE=2 THEN
IF (XCODE=-1 AND SIGNCODE=1) OR (XCODE=1 AND SIGNCODE=-1) OR (XCODE=2 AND SIGNCODE=0) OR (XCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
END IF
LOOP
PRINT #2:USING$("%%",X1*10+X2);
IF SIGN>0 THEN PRINT #2:" + "; ELSE PRINT #2:" - ";
PRINT #2:USING$("%%",Y1*10+Y2);" = ";USING$("%%",SUM1*10+SUM2)
PRINT #1:USING$("%%",X1OUT*10+X2OUT);
IF SIGNOUT>0 THEN PRINT #1:" + "; ELSE PRINT #1:" - ";
PRINT #1:USING$("%%",Y1OUT*10+Y2OUT);" = ";USING$("%%",SUM1OUT*10+SUM2OUT)
NEXT K
CLOSE #1
CLOSE #2
一部略
SUB CHANGE(N,CODE,OUT)
END SUB
SUB CHANGESIGN(N,CODE,OUT)
END SUB
END
解答
02 + 83 = 85
17 - 00 = 17
94 + 04 = 98
82 - 52 = 30
89 - 06 = 83
---------------------------------------------------------------------
3桁のマッチ棒パズル
575 + 514 = 889
787 + 013 = 500
376 - 416 = 782
950 - 489 = 161
473 - 124 = 249
RANDOMIZE
OPEN #1:NAME "マッチ棒パズル問題.txt"
OPEN #2:NAME "マッチ棒パズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
DO
DO
LET X1=INT(RND*10)
LET Y1=INT(RND*10)
LET X2=INT(RND*10)
LET Y2=INT(RND*10)
LET X3=INT(RND*10)
LET Y3=INT(RND*10)
LET SIGN=(-1)^(INT(RND*2))
LET SUM=X1*100+X2*10+X3+(Y1*100+Y2*10+Y3)*SIGN
LET SUM1=INT(SUM/100) ! 解答文
LET SUM2=MOD(INT(SUM/10),10)
LET SUM3=MOD(SUM,10)
LOOP WHILE SUM<0 OR SUM>999
IF RND<.5 THEN
SELECT CASE INT(RND*3+1)
CASE 1
CALL CHANGE(X1,XCODE,X1OUT)
LET X2OUT=X2
LET X3OUT=X3
CASE 2
CALL CHANGE(X2,XCODE,X2OUT)
LET X1OUT=X1
LET X3OUT=X3
CASE 3
CALL CHANGE(X3,XCODE,X3OUT)
LET X1OUT=X1
LET X2OUT=X2
END SELECT
SELECT CASE INT(RND*3+1)
CASE 1
CALL CHANGE(Y1,YCODE,Y1OUT)
LET Y2OUT=Y2
LET Y3OUT=Y3
CASE 2
CALL CHANGE(Y2,YCODE,Y2OUT)
LET Y1OUT=Y1
LET Y3OUT=Y3
CASE 3
CALL CHANGE(Y3,YCODE,Y3OUT)
LET Y1OUT=Y1
LET Y2OUT=Y2
END SELECT
ELSE
IF RND<.5 THEN
SELECT CASE INT(RND*3+1)
CASE 1
CALL CHANGE(X1,XCODE,X1OUT)
CALL CHANGE(X2,YCODE,X2OUT)
LET X3OUT=X3
LET Y1OUT=Y1
LET Y2OUT=Y2
LET Y3OUT=Y3
CASE 2
CALL CHANGE(X1,XCODE,X1OUT)
CALL CHANGE(X3,YCODE,X3OUT)
LET X2OUT=X2
LET Y1OUT=Y1
LET Y2OUT=Y2
LET Y3OUT=Y3
CASE 3
CALL CHANGE(X2,XCODE,X2OUT)
CALL CHANGE(X3,YCODE,X3OUT)
LET X1OUT=X1
LET Y1OUT=Y1
LET Y2OUT=Y2
LET Y3OUT=Y3
END SELECT
ELSE
SELECT CASE INT(RND*3+1)
CASE 1
CALL CHANGE(Y1,XCODE,Y1OUT)
CALL CHANGE(Y2,YCODE,Y2OUT)
LET Y3OUT=Y3
LET X1OUT=X1
LET X2OUT=X2
LET X3OUT=X3
CASE 2
CALL CHANGE(Y1,XCODE,Y1OUT)
CALL CHANGE(Y3,YCODE,Y3OUT)
LET Y2OUT=Y2
LET X1OUT=X1
LET X2OUT=X2
LET X3OUT=X3
CASE 3
CALL CHANGE(Y2,XCODE,Y2OUT)
CALL CHANGE(Y3,YCODE,Y3OUT)
LET Y1OUT=Y1
LET X1OUT=X1
LET X2OUT=X2
LET X3OUT=X3
END SELECT
END IF
END IF
SELECT CASE INT(RND*3+1)
CASE 1
CALL CHANGE(SUM1,SUMCODE,SUM1OUT)
LET SUM2OUT=SUM2
LET SUM3OUT=SUM3
CASE 2
CALL CHANGE(SUM2,SUMCODE,SUM2OUT)
LET SUM1OUT=SUM1
LET SUM3OUT=SUM3
CASE 3
CALL CHANGE(SUM3,SUMCODE,SUM3OUT)
LET SUM1OUT=SUM1
LET SUM2OUT=SUM2
END SELECT
CALL CHANGESIGN(SIGN,SIGNCODE,SIGNOUT)
IF X1OUT*100+X2OUT*10+X3OUT+SIGNOUT*(Y1OUT*100+Y2OUT*10+Y3OUT)<>SUM1OUT*100+SUM2OUT*10+SUM3OUT THEN
IF SUMCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=1 AND YCODE=-1) OR (XCODE=-1 AND YCODE=-1) OR (XCODE=0 AND YCODE=2) OR (XCODE=2 AND YCODE=0) THEN EXIT DO
END IF
IF XCODE=2 AND SIGNCODE=2 THEN
IF (YCODE=-1 AND SUMCODE=1) OR (YCODE=1 AND SUMCODE=-1) OR (YCODE=2 AND SUMCODE=0) OR (YCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=-1 AND SUMCODE=1) OR (XCODE=1 AND SUMCODE=-1) OR (XCODE=2 AND SUMCODE=0) OR (XCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND YCODE=2 THEN
IF (SUMCODE=-1 AND SIGNCODE=1) OR (SUMCODE=1 AND SIGNCODE=-1) OR (SUMCODE=2 AND SIGNCODE=0) OR (SUMCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND SUMCODE=2 THEN
IF (YCODE=-1 AND SIGNCODE=1) OR (YCODE=1 AND SIGNCODE=-1) OR (YCODE=2 AND SIGNCODE=0) OR (YCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SUMCODE=2 THEN
IF (XCODE=-1 AND SIGNCODE=1) OR (XCODE=1 AND SIGNCODE=-1) OR (XCODE=2 AND SIGNCODE=0) OR (XCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
END IF
LOOP
PRINT #2:USING$("%%%",X1*100+X2*10+X3);
IF SIGN>0 THEN PRINT #2:" + "; ELSE PRINT #2:" - ";
PRINT #2:USING$("%%%",Y1*100+Y2*10+Y3);" = ";USING$("%%%",SUM1*100+SUM2*10+SUM3)
PRINT #1:USING$("%%%",X1OUT*100+X2OUT*10+X3OUT);
IF SIGNOUT>0 THEN PRINT #1:" + "; ELSE PRINT #1:" - ";
PRINT #1:USING$("%%%",Y1OUT*100+Y2OUT*10+Y3OUT);" = ";USING$("%%%",SUM1OUT*100+SUM2OUT*10+SUM3OUT)
NEXT K
CLOSE #1
CLOSE #2
一部略
SUB CHANGE(N,CODE,OUT)
END SUB
SUB CHANGESIGN(N,CODE,OUT)
END SUB
END
解答
575 + 314 = 889
487 + 013 = 500
376 + 416 = 792
650 - 489 = 161
473 - 124 = 349
Re: マッチ棒パズル - しばっち
2025/12/28 (Sun) 08:10:25
テキスト文字ではイメージしにくいので画像で作ってみた。
RANDOMIZE
LET N=10
DIM X(N),Y(N),SUM(N),XOUT(N),YOUT(N),SUMOUT(N),SIGN(N),SIGNOUT(N)
FOR K=1 TO N ! 問題数
DO
DO
LET X(K)=INT(RND*10)
LET Y(K)=INT(RND*10)
LET SIGN(K)=(-1)^(INT(RND*2))
LET SUM(K)=X(K)+Y(K)*SIGN(K) ! 解答文
LOOP WHILE SUM(K)<0 OR SUM(K)>9
CALL CHANGE(X(K),XCODE,XOUT(K)) ! 問題作成
CALL CHANGE(Y(K),YCODE,YOUT(K))
CALL CHANGE(SUM(K),SUMCODE,SUMOUT(K))
CALL CHANGESIGN(SIGN(K),SIGNCODE,SIGNOUT(K))
IF XOUT(K)+SIGNOUT(K)*YOUT(K)<>SUMOUT(K) THEN
IF SUMCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=1 AND YCODE=-1) OR (XCODE=-1 AND YCODE=-1) OR (XCODE=0 AND YCODE=2) OR (XCODE=2 AND YCODE=0) THEN EXIT DO
END IF
IF XCODE=2 AND SIGNCODE=2 THEN
IF (YCODE=-1 AND SUMCODE=1) OR (YCODE=1 AND SUMCODE=-1) OR (YCODE=2 AND SUMCODE=0) OR (YCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=-1 AND SUMCODE=1) OR (XCODE=1 AND SUMCODE=-1) OR (XCODE=2 AND SUMCODE=0) OR (XCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND YCODE=2 THEN
IF (SUMCODE=-1 AND SIGNCODE=1) OR (SUMCODE=1 AND SIGNCODE=-1) OR (SUMCODE=2 AND SIGNCODE=0) OR (SUMCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND SUMCODE=2 THEN
IF (YCODE=-1 AND SIGNCODE=1) OR (YCODE=1 AND SIGNCODE=-1) OR (YCODE=2 AND SIGNCODE=0) OR (YCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SUMCODE=2 THEN
IF (XCODE=-1 AND SIGNCODE=1) OR (XCODE=1 AND SIGNCODE=-1) OR (XCODE=2 AND SIGNCODE=0) OR (XCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
END IF
LOOP
NEXT K
CALL GINIT(300,600)
LET YY=550
LET SC=1 ! 縮小率
FOR K=1 TO N
LET XX=50
IF SIGN(K)>0 THEN LET SIGN$="+" ELSE LET SIGN$="-"
CALL DISPLAY(STR$(X(K))&SIGN$&STR$(Y(K))&"="&STR$(SUM(K)),XX,YY,SC)
LET YY=YY-50*SC
NEXT K
GSAVE "マッチ棒パズル解答.png"
CLEAR
LET YY=550
LET SC=1
FOR K=1 TO N
LET XX=50
IF SIGNOUT(K)>0 THEN LET SIGN$="+" ELSE LET SIGN$="-"
CALL DISPLAY(STR$(XOUT(K))&SIGN$&STR$(YOUT(K))&"="&STR$(SUMOUT(K)),XX,YY,SC)
LET YY=YY-50*SC
NEXT K
GSAVE "マッチ棒パズル問題.png"
一部サブルーチン定義省略
SUB CHANGE(N,CODE,OUT)
END SUB
SUB CHANGESIGN(N,CODE,OUT) ! 符号の変更
END SUB
END
EXTERNAL SUB DISPLAY(N$,X,Y,SC)
SET LINE WIDTH 5
FOR I=1 TO LEN(N$)
SELECT CASE N$(I:I)
CASE "0"
DRAW ZERO WITH SCALE(SC)*SHIFT(X,Y)
CASE "1"
DRAW ONE WITH SCALE(SC)*SHIFT(X,Y)
CASE "2"
DRAW TWO WITH SCALE(SC)*SHIFT(X,Y)
CASE "3"
DRAW THREE WITH SCALE(SC)*SHIFT(X,Y)
CASE "4"
DRAW FOUR WITH SCALE(SC)*SHIFT(X,Y)
CASE "5"
DRAW FIVE WITH SCALE(SC)*SHIFT(X,Y)
CASE "6"
DRAW SIX WITH SCALE(SC)*SHIFT(X,Y)
CASE "7"
DRAW SEVEN WITH SCALE(SC)*SHIFT(X,Y)
CASE "8"
DRAW EIGHT WITH SCALE(SC)*SHIFT(X,Y)
CASE "9"
DRAW NINE WITH SCALE(SC)*SHIFT(X,Y)
CASE "-"
DRAW MINUS WITH SCALE(SC)*SHIFT(X,Y)
CASE "+"
DRAW PLUS WITH SCALE(SC)*SHIFT(X,Y)
CASE "="
DRAW EQUAL WITH SCALE(SC)*SHIFT(X,Y)
END SELECT
LET X=X+30*SC
NEXT I
END SUB
EXTERNAL PICTURE ZERO
!PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE ONE
!PLOT LINES:-10,0;10,0
!PLOT LINES:-10,0;-10,20
!PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
!PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE TWO
PLOT LINES:-10,0;10,0
!PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
!PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE THREE
PLOT LINES:-10,0;10,0
!PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE FOUR
PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
!PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
!PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE FIVE
PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
!PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE SIX
PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
!PLOT LINES:10,20;10,0
PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE SEVEN
!PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
!PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE EIGHT
PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE NINE
PLOT LINES:-10,0;10,0
PLOT LINES:-10,0;-10,20
PLOT LINES:-10,20;10,20
PLOT LINES:10,20;10,0
!PLOT LINES:-10,0;-10,-20
PLOT LINES:-10,-20;10,-20
PLOT LINES:10,-20;10,0
END PICTURE
EXTERNAL PICTURE MINUS
PLOT LINES:-10,0;10,0
END PICTURE
EXTERNAL PICTURE PLUS
PLOT LINES:-10,0;10,0
PLOT LINES:0,10;0,-10
END PICTURE
EXTERNAL PICTURE EQUAL
PLOT LINES:-10,-5;10,-5
PLOT LINES:-10,5;10,5
END PICTURE
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,0,YSIZE-1
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
END SUB
Re: マッチ棒パズル - しばっち
2025/12/28 (Sun) 08:12:26
更にイメージしやすいようにデジカメで撮影したマッチ棒数字画像(640×480)で作ってみました。
(※マッチ棒ではなく綿棒です)
下記からダウンロードしてください。(マッチ棒数字.zip 720KB)
https://15.gigafile.nu/0226-c9ac26967de78c2ff43e05c538d30b76c
ダウンロード期限：2026年2月26日(木)
ダウンロードパスワード:設定していません
RANDOMIZE
LET N=5
LET PATH$=".\マッチ棒数字\"
DIM X(N),Y(N),SUM(N),XOUT(N),YOUT(N),SUMOUT(N),SIGN(N),SIGNOUT(N)
PUBLIC NUMERIC IMAGE0(640,480),IMAGE1(640,480),IMAGE2(640,480),IMAGE3(640,480),IMAGE4(640,480),IMAGE5(640,480),IMAGE6(640,480)
PUBLIC NUMERIC IMAGE7(640,480),IMAGE8(640,480),IMAGE9(640,480),IMAGE10(640,480),IMAGE11(640,480),IMAGE12(640,480)
PUBLIC NUMERIC XSIZE,YSIZE
CALL PICTURELOAD(PATH$&"0.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE0
CALL PICTURELOAD(PATH$&"1.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE1
CALL PICTURELOAD(PATH$&"2.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE2
CALL PICTURELOAD(PATH$&"3.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE3
CALL PICTURELOAD(PATH$&"4.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE4
CALL PICTURELOAD(PATH$&"5.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE5
CALL PICTURELOAD(PATH$&"6.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE6
CALL PICTURELOAD(PATH$&"7.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE7
CALL PICTURELOAD(PATH$&"8.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE8
CALL PICTURELOAD(PATH$&"9.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE9
CALL PICTURELOAD(PATH$&"equal.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE10
CALL PICTURELOAD(PATH$&"plus.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE11
CALL PICTURELOAD(PATH$&"minus.jpg",XSIZE,YSIZE)
ASK PIXEL ARRAY(0,0) IMAGE12
CLEAR
FOR K=1 TO N ! 問題数
DO
DO
LET X(K)=INT(RND*10)
LET Y(K)=INT(RND*10)
LET SIGN(K)=(-1)^(INT(RND*2))
LET SUM(K)=X(K)+Y(K)*SIGN(K) ! 解答文
LOOP WHILE SUM(K)<0 OR SUM(K)>9
CALL CHANGE(X(K),XCODE,XOUT(K)) ! 問題作成
CALL CHANGE(Y(K),YCODE,YOUT(K))
CALL CHANGE(SUM(K),SUMCODE,SUMOUT(K))
CALL CHANGESIGN(SIGN(K),SIGNCODE,SIGNOUT(K))
IF XOUT(K)+SIGNOUT(K)*YOUT(K)<>SUMOUT(K) THEN
IF SUMCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=1 AND YCODE=-1) OR (XCODE=-1 AND YCODE=-1) OR (XCODE=0 AND YCODE=2) OR (XCODE=2 AND YCODE=0) THEN EXIT DO
END IF
IF XCODE=2 AND SIGNCODE=2 THEN
IF (YCODE=-1 AND SUMCODE=1) OR (YCODE=1 AND SUMCODE=-1) OR (YCODE=2 AND SUMCODE=0) OR (YCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SIGNCODE=2 THEN
IF (XCODE=-1 AND SUMCODE=1) OR (XCODE=1 AND SUMCODE=-1) OR (XCODE=2 AND SUMCODE=0) OR (XCODE=0 AND SUMCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND YCODE=2 THEN
IF (SUMCODE=-1 AND SIGNCODE=1) OR (SUMCODE=1 AND SIGNCODE=-1) OR (SUMCODE=2 AND SIGNCODE=0) OR (SUMCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF XCODE=2 AND SUMCODE=2 THEN
IF (YCODE=-1 AND SIGNCODE=1) OR (YCODE=1 AND SIGNCODE=-1) OR (YCODE=2 AND SIGNCODE=0) OR (YCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
IF YCODE=2 AND SUMCODE=2 THEN
IF (XCODE=-1 AND SIGNCODE=1) OR (XCODE=1 AND SIGNCODE=-1) OR (XCODE=2 AND SIGNCODE=0) OR (XCODE=0 AND SIGNCODE=2) THEN EXIT DO
END IF
END IF
LOOP
NEXT K
LET SC=1/4 !縮小率
CALL GINIT(XSIZE*SC*N,YSIZE*SC*N)
LET YY=0
FOR K=1 TO N
LET XX=0
IF SIGN(K)>0 THEN LET SIGN$="+" ELSE LET SIGN$="-"
CALL DISPLAY(STR$(X(K))&SIGN$&STR$(Y(K))&"="&STR$(SUM(K)),XX,YY,SC)
LET YY=YY+YSIZE*SC
NEXT K
GSAVE "マッチ棒数字棒パズル解答.png"
CLEAR
LET YY=0
LET SC=1/4
FOR K=1 TO N
LET XX=0
IF SIGNOUT(K)>0 THEN LET SIGN$="+" ELSE LET SIGN$="-"
CALL DISPLAY(STR$(XOUT(K))&SIGN$&STR$(YOUT(K))&"="&STR$(SUMOUT(K)),XX,YY,SC)
LET YY=YY+YSIZE*SC
NEXT K
GSAVE "マッチ棒数字棒パズル問題.png"
一部サブルーチン定義省略
SUB CHANGE(N,CODE,OUT)
END SUB
SUB CHANGESIGN(N,CODE,OUT) ! 符号の変更
END SUB
END
EXTERNAL SUB DISPLAY(N$,X,Y,SC)
FOR I=1 TO LEN(N$)
SELECT CASE N$(I:I)
CASE "0"
DRAW ZERO WITH SCALE(SC)*SHIFT(X,Y)
CASE "1"
DRAW ONE WITH SCALE(SC)*SHIFT(X,Y)
CASE "2"
DRAW TWO WITH SCALE(SC)*SHIFT(X,Y)
CASE "3"
DRAW THREE WITH SCALE(SC)*SHIFT(X,Y)
CASE "4"
DRAW FOUR WITH SCALE(SC)*SHIFT(X,Y)
CASE "5"
DRAW FIVE WITH SCALE(SC)*SHIFT(X,Y)
CASE "6"
DRAW SIX WITH SCALE(SC)*SHIFT(X,Y)
CASE "7"
DRAW SEVEN WITH SCALE(SC)*SHIFT(X,Y)
CASE "8"
DRAW EIGHT WITH SCALE(SC)*SHIFT(X,Y)
CASE "9"
DRAW NINE WITH SCALE(SC)*SHIFT(X,Y)
CASE "-"
DRAW MINUS WITH SCALE(SC)*SHIFT(X,Y)
CASE "+"
DRAW PLUS WITH SCALE(SC)*SHIFT(X,Y)
CASE "="
DRAW EQUAL WITH SCALE(SC)*SHIFT(X,Y)
END SELECT
LET X=X+XSIZE*SC
NEXT I
END SUB
EXTERNAL PICTURE ZERO
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE0
END PICTURE
EXTERNAL PICTURE ONE
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE1
END PICTURE
EXTERNAL PICTURE TWO
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE2
END PICTURE
EXTERNAL PICTURE THREE
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE3
END PICTURE
EXTERNAL PICTURE FOUR
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE4
END PICTURE
EXTERNAL PICTURE FIVE
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE5
END PICTURE
EXTERNAL PICTURE SIX
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE6
END PICTURE
EXTERNAL PICTURE SEVEN
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE7
END PICTURE
EXTERNAL PICTURE EIGHT
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE8
END PICTURE
EXTERNAL PICTURE NINE
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE9
END PICTURE
EXTERNAL PICTURE EQUAL
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE10
END PICTURE
EXTERNAL PICTURE PLUS
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE11
END PICTURE
EXTERNAL PICTURE MINUS
MAT PLOT CELLS, IN 0,0;XSIZE-1,YSIZE-1:IMAGE12
END PICTURE
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 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
数値計算による行列計算法 - 下手の横好き
2025/12/11 (Thu) 00:26:56
最小二乗法による測量網平均についての本が欲しくて探してます。確率統計の基礎もそうですが。行列による偏微分方程式の解法は理解に苦しいんでます。
ぜひ、行列計算方法、確率・統計、の数値計算方法も探してますが、こういう順番で読めば、こんな本が参考になるよ行ったものをご推薦していただけませんか。
Re: 数値計算による行列計算法 - SHIRAISHI Kazuo
2025/12/11 (Thu) 07:41:39
Copilotに尋ねてみました。
測量網平均 測量では複数の観測点や基準点を結ぶ「網 (network)」を構築し、その座標や位置関係を平均化して最も整合的な値を求める。
→ このとき最小二乗法を使うことで、観測誤差を均等に分散させ、全体の網を最も合理的に調整できる。
測量網平均を最小二乗法で解くには 行列計算 が必須。
観測方程式を行列形式で表す
正規方程式を導出して解く
偏微分を用いて誤差の影響を最小化する
ということのようです。どなたか，アドバイスいただけないでしょうか。
追記
おそらく，「偏微分方程式の解法」ではなくて，「偏微分を利用して求まった方程式を解く」ことだと思われます。
Re: 数値計算による行列計算法 - SHIRAISHI Kazuo
2025/12/11 (Thu) 09:10:08
おそらく，人工知能の機械学習で使われる数学的手法と類似するもののように思います。
だとすると，一般的な入門書としては，
西内啓著「統計学が最強の学問である[数学編]」，ダイアモンド社
がよさそうです。ただし，具体的な計算方法については別の書物が必要です。
Re: 数値計算による行列計算法 - しばっち
2025/12/14 (Sun) 12:59:33
Microsoft copilotに訊いてみた。
JIS FULL BASICによる測量網平均法（最小二乗法）サンプル
測量網平均（ネットワーク調整）は、観測方程式を線形化し、正規方程式を解くことで未知点の座標を推定します。下のサンプルは、既知点A,Bから未知点Pの座標
(X,Y) を、距離観測 r1,r2 を用いて最小二乗で推定する最小構成の例です。最小二乗法は、残差二乗和を最小化する推定で、加重（分散の逆数）を用いると異なる精度の観測を統合できます。
測量網平均では、行列形式で観測モデルを定式化し、正規方程式を解くのが標準的手順ですnishishu.net+1。
問題設定と線形化の概要
既知点: A=(XA,YA), B=(XB,YB)
未知点: P=(X,Y)
観測: 距離 r1=|P−A|, r2=|P−B|
重み: w1=1/σ1^2, w2=1/σ2^2（距離観測の標準偏差σ）
線形化: 近似値(X0,Y0) 周りで r ≈ r_calc + ∂r/∂X·dX + ∂r/∂Y·dY ここで ∂r/∂X = (X−Xk)/r_calc, ∂r/∂Y = (Y−Yk)/r_calc
この2本の観測方程式から設計行列 A（2×2）、観測ベクトル l（2×1）を作り、正規方程式
(AtWA)d=AtW v を反復で解いて (X,Y) を更新します。
フロー概要
初期値設定: 既知点の幾何から適当な初期座標を与える
反復計算: 設計行列の生成→正規方程式の解（2×2）→更新→収束判定
出力: 推定座標、残差、誤差指標（任意）
' JIS FULL BASIC (ISO Full BASIC) 互換を想定した記述
' 2距離観測による未知点P=(X,Y)の最小二乗推定（A,Bは既知）
'---- 入力パラメータ ----
LET XA = 1000.0
LET YA = 1000.0
LET XB = 1200.0
LET YB = 900.0
LET R1_OBS = 223.6068 ' 観測距離 |P-A| の例
LET R2_OBS = 223.6068 ' 観測距離 |P-B| の例
LET SIGMA1 = 0.01 ' 距離観測1の標準偏差
LET SIGMA2 = 0.01 ' 距離観測2の標準偏差
'---- 初期値（適当な近似）----
LET X = 1100.0
LET Y = 950.0
'---- 反復条件 ----
LET MAXITER = 20
LET TOL = 1E-8
'---- 重み ----
LET W1 = 1.0 / (SIGMA1 * SIGMA1)
LET W2 = 1.0 / (SIGMA2 * SIGMA2)
'---- 反復開始 ----
FOR ITER = 1 TO MAXITER
' 計算距離
LET DXA = X - XA
LET DYA = Y - YA
LET DXB = X - XB
LET DYB = Y - YB
LET R1_CALC = SQR(DXA*DXA + DYA*DYA)
LET R2_CALC = SQR(DXB*DXB + DYB*DYB)
' 偏微分（設計行列A）
IF R1_CALC = 0.0 THEN
PRINT "R1_CALC=0: 幾何が不正"; : STOP
END IF
IF R2_CALC = 0.0 THEN
PRINT "R2_CALC=0: 幾何が不正"; : STOP
END IF
LET A11 = DXA / R1_CALC
LET A12 = DYA / R1_CALC
LET A21 = DXB / R2_CALC
LET A22 = DYB / R2_CALC
' 観測方程式の定数項 v = (L_obs - L_calc)
LET V1 = R1_OBS - R1_CALC
LET V2 = R2_OBS - R2_CALC
' 正規方程式 N = A^T W A, U = A^T W v
' W は対角（W1, W2）
LET N11 = W1*A11*A11 + W2*A21*A21
LET N12 = W1*A11*A12 + W2*A21*A22
LET N22 = W1*A12*A12 + W2*A22*A22
LET U1 = W1*A11*V1 + W2*A21*V2
LET U2 = W1*A12*V1 + W2*A22*V2
' 2x2連立の解 d = N^{-1} U
LET DET = N11*N22 - N12*N12
IF ABS(DET) < 1E-20 THEN
PRINT "特異行列（幾何が弱い/重みが不適）"; : STOP
END IF
LET dX = ( U1*N22 - U2*N12 ) / DET
LET dY = ( N11*U2 - N12*U1 ) / DET
' 更新
LET X = X + dX
LET Y = Y + dY
' 収束判定
IF ABS(dX) < TOL AND ABS(dY) < TOL THEN
EXIT FOR
END IF
NEXT ITER
' 最終残差
LET DXA = X - XA
LET DYA = Y - YA
LET DXB = X - XB
LET DYB = Y - YB
LET R1_CALC = SQR(DXA*DXA + DYA*DYA)
LET R2_CALC = SQR(DXB*DXB + DYB*DYB)
LET V1 = R1_OBS - R1_CALC
LET V2 = R2_OBS - R2_CALC
' 誤差指標（加重残差平方和）
LET CHI2 = W1*V1*V1 + W2*V2*V2
PRINT "推定座標 P = ("; X; ","; Y; ")"
PRINT "残差 v1="; V1; " v2="; V2
PRINT "加重残差平方和 χ^2="; CHI2
PRINT "反復回数="; ITER
END
拡張のヒント
角度・方位の導入: 角観測なら r と同様に線形化し、偏微分を設計行列に追加します（行数が増えるだけ）。
複数未知点・網: 未知座標をベクトル化し、Aを m×n（m観測、n未知）として正規方程式を作ります。JIS FULL BASICでの一般行列解法は、2×2ブロック分割やガウス消去を自前実装します。
加重の設計: 観測毎の分散に基づく重み行列Wを用いると、異なる精度の測定を整合的に統合できます。
検定と品質管理: 残差解析、カイ二乗、標準偏差推定などで観測の整合性を評価します。
参考の考え方
最小二乗法は、余剰観測や誤差を含む測定から一意の推定値を得るための基本手法で、行列による観測モデル化と正規方程式の解法が核になります。
異なる誤差の計測値を統合する際は、分散の逆数による加重平均が最尤推定と一致し、測量網平均でも同じ原理を用います
測量分野では、行列による導出と網平均への応用が体系的に整理されています
ネット検索すると下記のような本が出てきた。
https://www.amazon.co.jp/最小二乗法と測量網平均の基礎-田島-稔/dp/4885953103
但し、私はこの本の中身について一切存じませんのであしからず。
ただ検索して出てきただけです。
Re: Re: 数値計算による行列計算法 - 下手の横好き
2025/12/14 (Sun) 15:09:49
しばっち さんへ
ありがとうございました
Re: Re: 数値計算による行列計算法 - 下手の横好き
2025/12/14 (Sun) 15:39:37
観測方程式
と
正規方程式
について簡単に説明していただけないでしょうか?
お願いします
十進BASIC Ver.7.8.8.7，Ver. 8.1.5.3，Ver.0.9.3.3 変更点 - SHIRAISHI Kazuo
2025/11/26 (Wed) 11:58:08
十進BASIC Ver.7.8.8.7，Ver. 8.1.5.3，Ver.0.9.3.3 でデバッグ機能を強化しました。
実行メニューでステップ実行を選ぶと，カーソルがある行にブレークポイントが設定されます。
また，デバッグウィンドウで，ステップ(Local)を選ぶと，プログラム単位内のみステップ実行します。
一部バージョンのLinuxでのデバッグウィンドウの不具合 - SHIRAISHI Kazuo
2025/11/29 (Sat) 10:15:23
Ubuntu 25.10 などでは，デバッグウィンドウの最大化・最小化ができてしまいます。
最小化した後，中断アイコンをクリックすると，「中断します.お待ちください.」と表示されます。
そのとき，最小化したデバッグウィンドウのアイコンを探し出して再表示しないと，永遠に待たされます。
Ubuntuでは，画面左端のアプリケーションアイコンの中に隠れていますが，OSによって最小化アイコンの隠れ方は色々です。
Linux版をお使いの方は，あらかじめデバッグウィンドウの挙動を確認しておいてください。
Re: 一部バージョンのLinuxでのデバッグウィンドウの不具合 - SHIRAISHI Kazuo
2025/11/30 (Sun) 08:24:14
Ver. 8.1.3.5での修正が無効化されていたのが原因でした。
修正します。Ver.8.1.5.4，Ver.0.9.3.4 になります。
ただし，完全ではありません。Linuxによっては，不具合が残ります。
Re: 一部バージョンのLinuxでのデバッグウィンドウの不具合 - SHIRAISHI Kazuo
2025/12/01 (Mon) 09:49:30
画像はVer.8.1.5.4 GTK2版のDebian12での実行結果です。
右上隅のボーダーアイコンが×のみで，正常です。
なお，環境によって，右画像のように「ステップ(Local)」の右側が切れてしまうことがあります。
Re:一部バージョンのLinuxでのデバッグウィンドウの不具合 - SHIRAISHI Kazuo
2025/12/01 (Mon) 09:58:32
画像は，Ver.8.1.5.4 GTK2版のUbuntu24.04での実行結果です。
ボーダーアイコンが３つ表示されています。□や_をクリックしたとき一瞬反応しますが，元に戻ります。
Ver. 8.1.5.4では最大化・最小化の動作を抑制していますが，ChromebookのLinuxのようにそれをすり抜けて最大化・最小化ができてしまうかも知れません。
そのようなLinuxに遭遇した方は報告をお願いします。
なお，最小化したデバッグ・ウィンドウ アイコンが，上端，下端，左端，右端のどこかに隠れているはずなので，どこにあったかの報告もあると有益です。
world clock - gnuutera2012文句うさぴょん URL
2025/11/05 (Wed) 01:10:24
! 世界の主な都市における時差
! DATA コード,時差,都市名
DIM A$(100),B$(100),C$(100)
DATA "UTC"," 0","<協定世界時>"
DATA "LON"," 0","ロンドン"
DATA "PAR","+1","パリ"
DATA "ATH","+2","アテネ"
DATA "JED","+3","ジェッダ"
DATA "THR","+3.5","テヘラン"
DATA "DXB","+4","ドバイ"
DATA "KBL","+4.5","カブール"
DATA "KHI","+5","カラチ"
DATA "DEL","+5.5","デリー"
DATA "DAC","+6","ダッカ"
DATA "RGN","+6.5","ヤンゴン"
DATA "BKK","+7","バンコク"
DATA "HKG","+8","香港"
DATA "TYO","+9","東京"
DATA "ADL","+9.5","アデレード"
DATA "SYD","+10","シドニー"
DATA "NOU","+11","ヌーメア"
DATA "WLG","+12","ウェリントン"
DATA "PPG","-11","パゴパゴ"
DATA "HNL","-10","ホノルル"
DATA "ANC","-9","アンカレジ"
DATA "LAX","-8","ロサンゼルス"
DATA "DEN","-7","デンバー"
DATA "CHI","-6","シカゴ"
DATA "NYC","-5","ニューヨーク"
DATA "SCL","-4","サンティアゴ"
DATA "RIO","-3","リオデジャネイロ"
DATA "FEN","-2","フェルナンド・デ・ノローニャ"
DATA "RAI","-1","プライア"
LET LENGTHA=0
LET LENGTHB=0
LET LENGTHC=0
FOR I=1 TO 100
READ IF MISSING THEN EXIT FOR : A$(I),B$(I),C$(I)
IF BLEN(A$(I))>LENGTHA THEN LET LENGTHA=BLEN(A$(I))
IF BLEN(B$(I))>LENGTHB THEN LET LENGTHB=BLEN(B$(I))
IF BLEN(C$(I))>LENGTHC THEN LET LENGTHC=BLEN(C$(I))
NEXT I
LET NUM=I-1
PRINT "┏"&REPEAT$("━",(LENGTHA)/2)&"┳"&REPEAT$("━",(LENGTHB)/2)&"┳"&REPEAT$("━",(LENGTHC)/2)&"┓"
FOR I=1 TO NUM
PRINT "┃"&A$(I)&" "&REPEAT$(" ",LENGTHA-BLEN(A$(I)))&"┃"&B$(I)&REPEAT$(" ",LENGTHB-BLEN(B$(I)))&"┃"&C$(I)&REPEAT$(" ",LENGTHC-BLEN(C$(I)))&"┃"
IF I<>NUM THEN PRINT "┣"&REPEAT$("━",(LENGTHA)/2)&"╋"&REPEAT$("━",(LENGTHB)/2)&"╋"&REPEAT$("━",(LENGTHC)/2)&"┫"
NEXT I
PRINT "┗"&REPEAT$("━",(LENGTHA)/2)&"┻"&REPEAT$("━",(LENGTHB)/2)&"┻"&REPEAT$("━",(LENGTHC)/2)&"┛"
!アナログ時計
SET TEXT JUSTIFY "center","half" !文字表示の書式
DEF t2agl(p,q)=PI/2-2*PI*p/q !Ｙ軸から時計まわり
DO
SET DRAW mode hidden !ちらつき防止（開始）
CLEAR
! 【UTC】【LON】【LIS】
LET deltaHofAtoT=-9 ! 【UTC】【LON】【LIS】は【TYO】-9
SET VIEWPORT 0,1/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "UTC,LON" ! 【UTC】【LON】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "LIS" ! 【LIS】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【MAD】【PAR】【ROM】【BER】【STO】
LET deltaHofAtoT=-8 ! 【MAD】【PAR】【ROM】【BER】【STO】は【TYO】-8
SET VIEWPORT 1/6,2/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "MAD,PAR" ! 【MAD】【PAR】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "ROM,BER" ! 【ROM】【BER】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.9: "STO" ! 【STO】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【ATH】【CAI】【JRS】
LET deltaHofAtoT=-7 ! 【ATH】【CAI】【JRS】は【TYO】-7
SET VIEWPORT 2/6,3/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "ATH,CAI" ! 【ATH】【CAI】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "JRS" ! 【JRS】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【JED】【MOW】
LET deltaHofAtoT=-6 ! 【JED】【MOW】は【TYO】-6
SET VIEWPORT 3/6,4/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "JED,MOW" ! 【JED】【MOW】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【THR】
LET deltaHofAtoT=-5.5 ! 【THR】は【TYO】-5.5
SET VIEWPORT 4/6,5/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "THR" ! 【THR】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【DXB】
LET deltaHofAtoT=-5 ! 【DXB】は【TYO】-5
SET VIEWPORT 5/6,6/6,0,1/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "DXB" ! 【DXB】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【KBL】
LET deltaHofAtoT=-4.5 ! 【KBL】は【TYO】-4.5
SET VIEWPORT 0/6,1/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "KBL" ! 【KBL】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【KHI】
LET deltaHofAtoT=-4 ! 【KHI】は【TYO】-4
SET VIEWPORT 1/6,2/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "KHI" ! 【KHI】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【DEL】
LET deltaHofAtoT=-3.5 ! 【DEL】は【TYO】-3.5
SET VIEWPORT 2/6,3/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "DEL" ! 【DEL】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【KTM】
LET deltaHofAtoT=-3.25 ! 【KTM】は【TYO】-3.1
SET VIEWPORT 3/6,4/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "KTM" ! 【KTM】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【DAC】
LET deltaHofAtoT=-3 ! 【DAC】は【TYO】-3
SET VIEWPORT 4/6,5/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "DAC" ! 【DAC】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【RGN】
LET deltaHofAtoT=-2.5 ! 【RGN】は【TYO】-2.5
SET VIEWPORT 5/6,6/6,1/6,2/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "RGN" ! 【RGN】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【BKK】
LET deltaHofAtoT=-2 ! 【BKK】は【TYO】-2
SET VIEWPORT 0/6,1/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "BKK" ! 【BKK】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【HKG】【TPE】【BJS】【SIN】
LET deltaHofAtoT=-1 ! 【HKG】【TPE】【BJS】【SIN】は【TYO】-1
SET VIEWPORT 1/6,2/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "HKG,TPE" ! 【HKG】【TPE】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "BJS,SIN" ! 【BJS】【SIN】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【TYO】【SEL】
LET deltaHofAtoT=0 ! 【TYO】【SEL】は【TYO】-0
SET VIEWPORT 2/6,3/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "TYO,SEL" ! 【TYO】【SEL】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【ADL】
LET deltaHofAtoT=0.5 ! 【ADL】は【TYO】+0.5
SET VIEWPORT 3/6,4/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "ADL" ! 【ADL】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【SYD】【GUM】
LET deltaHofAtoT=1 ! 【SYD】【GUM】は【TYO】+1
SET VIEWPORT 4/6,5/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "SYD,GUM" ! 【SYD】【GUM】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【NOU】
LET deltaHofAtoT=2 ! 【NOU】は【TYO】+2
SET VIEWPORT 5/6,6/6,2/6,3/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "NOU" ! 【NOU】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【WLG】
LET deltaHofAtoT=3 ! 【WLG】は【TYO】+3
SET VIEWPORT 0/6,1/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "WLG" ! 【WLG】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【PPG】
LET deltaHofAtoT=-20 ! 【PPG】は【TYO】-20
SET VIEWPORT 1/6,2/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "PPG" ! 【PPG】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【HNL】
LET deltaHofAtoT=-19 ! 【HNL】は【TYO】-19
SET VIEWPORT 2/6,3/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "HNL" ! 【HNL】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【ANC】
LET deltaHofAtoT=-18 ! 【ANC】は【TYO】-18
SET VIEWPORT 3/6,4/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "ANC" ! 【ANC】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【LAX】【YVR】
LET deltaHofAtoT=-17 ! 【LAX】【YVR】は【TYO】-17
SET VIEWPORT 4/6,5/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "LAX,YVR" ! 【LAX】【YVR】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【DEN】【YEA】
LET deltaHofAtoT=-16 ! 【DEN】【YEA】は【TYO】-16
SET VIEWPORT 5/6,6/6,3/6,4/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "DEN,YEA" ! 【DEN】【YEA】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【CHI】【YWG】【MEX】
LET deltaHofAtoT=-15 ! 【CHI】【YWG】【MEX】は【TYO】-15
SET VIEWPORT 0/6,1/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
Re: 無題 - gnuutera2012文句うさぴょん URL
2025/11/05 (Wed) 01:22:38
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "CHI,YWG" ! 【CHI】【YWG】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "MEX" ! 【MEX】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【NYC】【YTO】【MIA】
LET deltaHofAtoT=-14 ! 【NYC】【YTO】【MIA】は【TYO】-14
SET VIEWPORT 1/6,2/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "NYC,YTO" ! 【NYC】【YTO】
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.6: "MIA" ! 【MIA】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【SCL】【YHZ】
LET deltaHofAtoT=-13 ! 【SCL】【YHZ】は【TYO】-13
SET VIEWPORT 2/6,3/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "SCL,YHZ" ! 【SCL】【YHZ】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【YYT】
LET deltaHofAtoT=-12.5 ! 【YYT】は【TYO】-13
SET VIEWPORT 3/6,4/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "YYT" ! 【YYT】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【RIO】
LET deltaHofAtoT=-12 ! 【RIO】は【TYO】-12
SET VIEWPORT 4/6,5/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "RIO" ! 【RIO】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【FEN】
LET deltaHofAtoT=-11 ! 【FEN】は【TYO】-11
SET VIEWPORT 5/6,6/6,4/6,5/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "FEN" ! 【FEN】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
! 【RAI】
LET deltaHofAtoT=-10 ! 【RAI】は【TYO】-10
SET VIEWPORT 0/6,1/6,5/6,6/6
SET WINDOW -1.2,1.2,-1.2,1.2 !表示領域
LET t=TIME+deltaHofAtoT*3600 !次の三行削除
! 【作業中ここから】
IF t>=24*60^2 THEN LET h=INT((t-24*60^2)/3600)
IF t>=24*60^2 THEN LET m=INT(((t-24*60^2)-h*3600)/60)
IF t>=24*60^2 THEN LET s=(t-24*60^2)-h*3600-m*60
IF t>=24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)+1)
IF t>=0 AND t<24*60^2 THEN LET h=INT(t/3600)
IF t>=0 AND t<24*60^2 THEN LET m=INT((t-h*3600)/60)
IF t>=0 AND t<24*60^2 THEN LET s=t-h*3600-m*60
IF t>=0 AND t<24*60^2 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100))
IF t<0 THEN LET h=INT((t+24*60^2)/3600)
IF t<0 THEN LET m=INT(((t+24*60^2)-h*3600)/60)
IF t<0 THEN LET s=(t+24*60^2)-h*3600-m*60
IF t<0 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.2: STR$(MOD(INT(VAL(DATE$)/100),100))&"/"&STR$(MOD(VAL(DATE$),100)-1)
! 【作業中ここまで】
FOR i=1 TO 12 !文字盤
LET th=t2agl(i,12) !Ｙ軸から時計まわり
PLOT TEXT ,AT COS(th),SIN(th): STR$(i) !円周上
NEXT i
PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-0.3: "RAI" ! 【RAI】
! 【作業中ここから】
IF h<10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":"&"0"&STR$(m)
IF h<10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: "0"&STR$(h)&":" &STR$(m)
IF h>=10 AND m<10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":"&"0"&STR$(m)
IF h>=10 AND m>=10 THEN PLOT TEXT ,AT COS(t2agl(12,12)),SIN(t2agl(12,12))-1.5: STR$(h)&":" &STR$(m)
! 【作業中ここまで】
SET LINE width 8
LET th=t2agl(h + m/60,12) !長針
PLOT LINES: 0,0; 0.6*COS(th),0.6*SIN(th)
SET LINE width 4
LET th=t2agl(m,60) !短針
PLOT LINES: 0,0; 0.8*COS(th),0.8*SIN(th)
SET LINE width 1
LET th=t2agl(s,60) !秒針
PLOT LINES: 0,0; 0.9*COS(th),0.9*SIN(th)
SET DRAW mode explicit !ちらつき防止（終了）
LOOP
END
Re: world clock - しばっち
2025/11/09 (Sun) 07:58:20
私も作ってみました。
マウスでクリックして選択してください。
https://www.takahashishoten.co.jp/wp/wp-content/uploads/2023/07/time_difference-2.pdf?srsltid=AfmBOorHvxu7LJ1Q62OXyAa5Z0d6859cW_iqMZ1aVOkoeinCvA5XZn7w
https://www.grand-seiko.com/instructions/html/GS_9R_ja/AGFISYnhamlwbp
https://www.japandix.jp/topics/time_difference/001/
https://www.jetro.go.jp/ext_images/members/memberservice/briefing/202404_bri_time_difference.pdf
https://citizen.jp/support-jp/manual/pdf/time%20dif.pdf
LET XSIZE=1000
LET YSIZE=800
CALL GINIT(XSIZE,YSIZE)
DIM TIMEDIFF(24),CITY$(24),PX(24),PY(24)
FOR I=1 TO 24
READ TIMEDIFF(I),CITY$(I)
NEXT I
DATA 0,"東京"
DATA -1,"北京"
DATA -2,"バンコク"
DATA -3,"ダッカ"
DATA -4,"カラチ"
DATA -5,"ドバイ"
DATA -6,"ジッタ"
DATA -7,"カイロ"
DATA -8,"パリ"
DATA -9,"ロンドン"
DATA -10,"アゾレス諸島"
DATA -11,"フェルナンド・デ・ノローニャ"
DATA -12,"リオデジャネイロ"
DATA -13,"サントドミンゴ"
DATA -14,"ニューヨーク"
DATA -15,"シカゴ"
DATA -16,"デンバー"
DATA -17,"ロサンゼルス"
DATA -18,"アンカレッジ"
DATA -19,"ホノルル"
DATA -20,"ミッドウェー島"
DATA 3,"ウェリントン"
DATA 2,"ヌーメア"
DATA 1,"シドニー"
LET P=1
DO
SET DRAW MODE HIDDEN
CLEAR
CALL DISPLAY
LET T$=TIME$
LET D$=DATE$
LET YEAR=VAL(D$(1:4))
LET MONTH=VAL(D$(5:6))
LET DAY=VAL(D$(7:8))
LET HOUR=VAL(T$(1:2))+TIMEDIFF(P)
LET SS=0
IF FP(HOUR)>0 THEN
LET SS=60*FP(HOUR)
LET HOUR=INT(HOUR)
END IF
LET MINUTE=VAL(T$(4:5))+SS
IF MINUTE>59 THEN
LET MINUTE=MOD(MINUTE,60)
LET HOUR=HOUR+1
END IF
LET SECOND=VAL(T$(7:8))
IF HOUR<0 THEN ! 前日の計算
LET HOUR=HOUR+24
LET DAY=DAY-1
IF DAY<1 THEN
LET MONTH=MONTH-1
IF MONTH<1 THEN
LET MONTH=12
LET YEAR=YEAR-1
END IF
IF ISDATE(YEAR,MONTH,28)=1 THEN LET DAY=28
IF ISDATE(YEAR,MONTH,29)=1 THEN LET DAY=29
IF ISDATE(YEAR,MONTH,30)=1 THEN LET DAY=30
IF ISDATE(YEAR,MONTH,31)=1 THEN LET DAY=31
END IF
END IF
IF HOUR>23 THEN ! 翌日の計算
LET HOUR=HOUR-24
LET DAY=DAY+1
IF ISDATE(YEAR,MONTH,DAY)=0 THEN
LET DAY=1
LET MONTH=MONTH+1
IF MONTH>12 THEN
LET MONTH=1
LET YEAR=YEAR+1
END IF
END IF
END IF
SET TEXT JUSTIFY "CENTER","HALF"
SET TEXT HEIGHT 50
PLOT TEXT ,AT XSIZE/2,YSIZE/2+50:CITY$(P)
PLOT TEXT ,AT XSIZE/2,YSIZE/3*2:USING$("%%%%",YEAR)&"/"&USING$("%%",MONTH)&"/"&USING$("%%",DAY)&"("&WEEK$(YEAR,MONTH,DAY)&")"
SET TEXT HEIGHT 80
PLOT TEXT ,AT XSIZE/2,YSIZE*5/6:USING$("%%",HOUR)&":"&USING$("%%",MINUTE)&":"&USING$("%%",SECOND)
SET DRAW MODE EXPLICIT
DO
MOUSE POLL MX,MY,left,right
LET X=INT(MX/(XSIZE/6))
LET Y=INT(MY/(YSIZE/8))
LET PP=X+1+Y*6
IF PP>=1 AND PP<=24 AND PP<>P THEN
SET TEXT COLOR 4
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT HEIGHT YSIZE/32
PLOT TEXT ,AT PX(PP),PY(PP):CITY$(PP)(1:5)
PLOT TEXT ,AT PX(PP),PY(PP)+YSIZE/32:CITY$(PP)(6:10)
PLOT TEXT ,AT PX(PP),PY(PP)+YSIZE/16:CITY$(PP)(11:15)
END IF
IF LEFT=1 OR RIGHT=1 THEN
IF PP>=1 AND PP<=24 THEN LET P=PP
EXIT DO
END IF
LOOP WHILE T$=TIME$
LOOP
SUB DISPLAY
SET LINE COLOR 7
SET TEXT COLOR 7
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT HEIGHT YSIZE/32
FOR Y=0 TO YSIZE/2 STEP YSIZE/8
PLOT LINES:0,Y;XSIZE,Y
NEXT Y
FOR X=0 TO XSIZE STEP XSIZE/6
PLOT LINES:X,0;X,YSIZE/2
NEXT X
LET N=0
FOR Y=0 TO YSIZE/2-10 STEP YSIZE/8
FOR X=0 TO XSIZE-10 STEP XSIZE/6
LET N=N+1
PLOT TEXT , AT X,Y:CITY$(N)(1:5)
PLOT TEXT , AT X,Y+YSIZE/32:CITY$(N)(6:10)
PLOT TEXT , AT X,Y+YSIZE/16:CITY$(N)(11:15)
LET PX(N)=X
LET PY(N)=Y
NEXT X
NEXT Y
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"
FOR I=0 TO 7
SET COLOR MIX(I) BITAND(I,2)/2,BITAND(I,4)/4,BITAND(I,1)
NEXT I
CLEAR
END SUB
EXTERNAL FUNCTION ISDATE(Y,M,D) ! 存在する日か 2100/2/29は存在しない(うるう年ではない)
LET ISDATE=0
SELECT CASE M
CASE 1
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 2
IF D=29 THEN
IF MOD(Y,400)=0 OR(MOD(Y,100)<>0 AND MOD(Y,4)=0) THEN LET ISDATE=1
END IF
IF D>=1 AND D<=28 THEN LET ISDATE=1
CASE 3
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 4
IF D>=1 AND D<=30 THEN LET ISDATE=1
CASE 5
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 6
IF D>=1 AND D<=30 THEN LET ISDATE=1
CASE 7
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 8
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 9
IF D>=1 AND D<=30 THEN LET ISDATE=1
CASE 10
IF D>=1 AND D<=31 THEN LET ISDATE=1
CASE 11
IF D>=1 AND D<=30 THEN LET ISDATE=1
CASE 12
IF D>=1 AND D<=31 THEN LET ISDATE=1
END SELECT
END FUNCTION
EXTERNAL FUNCTION WEEK$(Y,M,D) ! ZELLERの公式
IF M<3 THEN
LET Y=Y-1
LET M=M+12
END IF
LET ZELLER=MOD(Y+INT(Y/4)-INT(Y/100)+INT(Y/400)+INT((13*M+8)/5)+D,7)
LET WEEK$=MID$("日月火水木金土",ZELLER+1,1)
END FUNCTION
Re: Re: world clock - gnuutera2012文句うさぴょん URL
2025/11/30 (Sun) 23:35:28
返信ありがとうございます。
私のは月を跨ぐときにエラーになるので、各月のチェックが甘かったようです。早速、デバッグやらないといけないです。対策として、修正ユリウス歴を導入しようと思います。
https://x.com/gnuutera2012/status/1988256096100757519?t=N2njHZu94umQ0q0JRTp9nA&s=19
分割文字パズル - しばっち
2025/11/23 (Sun) 07:38:01
分割文字パズル
nx*nyに分割した漢字を当てるパズルです。
RANDOMIZE
LET XSIZE=300 ! 画像サイズ
LET YSIZE=300
LET NX=3 ! 横分割数
LET NY=3 ! 縦分割数
DIM M(XSIZE/NX,YSIZE/NY),IMG(NX,NY,XSIZE/NX,YSIZE/NY),R(NX*NY)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET DRAW MODE HIDDEN
SET TEXT HEIGHT MIN(XSIZE,YSIZE)*.8 ! 文字サイズ
SET TEXT JUSTIFY "CENTER","HALF"
DO
WHEN EXCEPTION IN
LET CODE=INT(RND*(ORD("腕")-ORD("亜")+1))+ORD("亜") ! 漢字 出力範囲
LET A$=CHR$(CODE)
EXIT DO
USE
END WHEN
LOOP
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$
SET COLOR MODE "NATIVE"
FOR J=0 TO NY-1
FOR I=0 TO NX-1
ASK PIXEL ARRAY (I*XSIZE/NX+1,J*YSIZE/NY+1) M
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET IMG(I+1,J+1,X,Y)=M(X,Y)
NEXT X
NEXT Y
NEXT I
NEXT J
CLEAR
FOR I=1 TO NX*NY
LET R(I)=I-1
NEXT I
FOR I=1 TO NX*NY
SWAP R(I),R(INT(RND*NX*NY+1))
NEXT I
FOR I=1 TO NX*NY
LET XS=MOD(R(I),NX)
LET YS=INT(R(I)/NX)
LET XX=MOD(I-1,NX)
LET YY=INT((I-1)/NX)
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET M(X,Y)=IMG(XS+1,YS+1,X,Y)
NEXT X
NEXT Y
MAT PLOT CELLS, IN XX*XSIZE/NX+1,YY*YSIZE/NY+1;(XX+1)*XSIZE/NX,(YY+1)*YSIZE/NY:M
NEXT I
FOR I=1 TO NX-1
PLOT LINES:XSIZE/NX*I,0;XSIZE/NX*I,YSIZE
NEXT I
FOR I=1 TO NY-1
PLOT LINES:0,YSIZE/NY*I;XSIZE,YSIZE/NY*I
NEXT I
SET DRAW MODE EXPLICIT
INPUT PROMPT "この文字は何ですか?":C$
IF C$=A$ THEN
PRINT "正解です"
ELSE
PRINT "間違いです"
PRINT "正解は「";A$;"」です"
END IF
CLEAR
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$
END
サンプル画像の正解文字は「該」です
Re: 分割文字パズル - しばっち
2025/11/23 (Sun) 07:40:10
https://news.mynavi.jp/article/20240305-2862130/
https://www.waraerujd.com/二字熟語
二字熟語でやってみた。
RANDOMIZE
LET YSIZE=300
LET XSIZE=YSIZE*2
LET NY=2
LET NX=NY*2
DIM M(XSIZE/NX,YSIZE/NY),IMG(NX,NY,XSIZE/NX,YSIZE/NY),R(NX*NY)
DIM A$(1000)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET DRAW MODE HIDDEN
SET TEXT HEIGHT MIN(XSIZE,YSIZE)*.8
SET TEXT JUSTIFY "CENTER","HALF"
DO
LET N=N+1
READ IF MISSING THEN EXIT DO:A$(N)
LOOP
LET C=INT(RND*N+1)
SET COLOR MODE "NATIVE"
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$(C)
FOR J=0 TO NY-1
FOR I=0 TO NX-1
ASK PIXEL ARRAY (I*XSIZE/NX+1,J*YSIZE/NY+1) M
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET IMG(I+1,J+1,X,Y)=M(X,Y)
NEXT X
NEXT Y
NEXT I
NEXT J
CLEAR
FOR I=1 TO NX*NY
LET R(I)=I-1
NEXT I
FOR I=1 TO NX*NY
SWAP R(I),R(INT(RND*NX*NY+1))
NEXT I
FOR I=1 TO NX*NY
LET X1=MOD(R(I),NX)
LET Y1=INT(R(I)/NX)
LET XX=MOD(I-1,NX)
LET YY=INT((I-1)/NX)
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET M(X,Y)=IMG(X1+1,Y1+1,X,Y)
NEXT X
NEXT Y
MAT PLOT CELLS, IN XX*XSIZE/NX+1,YY*YSIZE/NY+1;(XX+1)*XSIZE/NX,(YY+1)*YSIZE/NY:M
NEXT I
FOR I=1 TO NX-1
PLOT LINES:XSIZE/NX*I,0;XSIZE/NX*I,YSIZE
NEXT I
FOR I=1 TO NY-1
PLOT LINES:0,YSIZE/NY*I;XSIZE,YSIZE/NY*I
NEXT I
SET DRAW MODE EXPLICIT
INPUT PROMPT "この熟語は何ですか?":C$
IF C$(1:2)=A$(C) THEN
PRINT "正解です"
ELSE
PRINT "間違いです"
PRINT "正解は「";A$(C);"」です"
END IF
CLEAR
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$(C)
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 "拳固","健康","健在","原罪","謙遜","検討","健闘","剣道","圏内","公害"
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 "南蛮","肉食","肉薄","日記","人魚","任侠","人形","忍者","忍耐","涅槃"
DATA "年貢","念仏","念力","悩殺","暖簾","馬鹿","破格","破局","博識","麦秋"
DATA "白書","白状","爆勝","爆睡","白眉","罰金","発酵","抜擢","番犬","番台"
DATA "番茶","番長","半裸","彼岸","秘境","卑下","比肩","非行","秘術","秘書"
DATA "秘伝","微妙","病気","標語","比例","悲恋","不安","風刺","風水","風船"
DATA "風俗","風流","風鈴","不覚","不遇","複雑","復職","富豪","無骨","無精"
DATA "侮辱","不正","風情","仏教","仏国","払拭","仏像","仏壇","仏滅","腐敗"
DATA "不毛","風流","不倫","不惑","分煙","文系","文体","分別","文楽","陛下"
DATA "兵器","米国","平和","別荘","反吐","返済","返事","便所","変身","鞭撻"
DATA "便利","忙殺","謀殺","坊主","包丁","亡父","亡命","墨守","木鐸","保険"
DATA "菩薩","奔走","煩悩","本場","本番","本命","毎度","摩擦","満悦","慢心"
DATA "味覚","微塵","未知","未明","妙案","冥利","未練","無我","無垢","矛盾"
DATA "無常","無茶","夢中","無念","迷宮","名犬","瞑想","名答","冥福","盟友"
DATA "迷惑","面子","妄言","猛虎","猛獣","猛省","妄想","耄碌","木魚","黙殺"
DATA "黙祷","黙認","喪主","文句","野球","野合","屋台","野党","飲茶","幽霊"
DATA "妖艶","養生","養殖","洋食","夭逝","幼稚","要約","余技","余興","預金"
DATA "余慶","予言","予算","余談","余地","予知","余命","雷神","落雁","落札"
DATA "楽勝","裸族","理屈","理系","利子","利息","流行","良心","料理","旅館"
DATA "緑茶","臨終","類書","留守","霊界","霊感","礼儀","歴注","劣化","連休"
DATA "連中","漏洩","廊下","老害","老後","籠城","老人","老衰","狼藉","蝋燭"
DATA "労働","狼狽","朗報","六曜","露骨","露地","路地","論客","論破","論理"
DATA "猥談","賄賂","和牛","和食","和風","雲呑"
END
サンプル画像の正解は「返事」です
Re: 分割文字パズル - しばっち
2025/11/23 (Sun) 07:41:22
3字熟語のパズルです。
https://sanji-jukugo.com/index/page/15/
https://記事作成代行.jp/idiom-three-words/
RANDOMIZE
LET YSIZE=300
LET XSIZE=YSIZE*3
LET NY=2
LET NX=NY*3
DIM M(XSIZE/NX,YSIZE/NY),IMG(NX,NY,XSIZE/NX,YSIZE/NY),R(NX*NY)
DIM A$(1000)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET DRAW MODE HIDDEN
SET TEXT HEIGHT MIN(XSIZE,YSIZE)*.8
SET TEXT JUSTIFY "CENTER","HALF"
DO
LET N=N+1
READ IF MISSING THEN EXIT DO:A$(N)
LOOP
LET C=INT(RND*N+1)
SET COLOR MODE "NATIVE"
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$(C)
FOR J=0 TO NY-1
FOR I=0 TO NX-1
ASK PIXEL ARRAY (I*XSIZE/NX+1,J*YSIZE/NY+1) M
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET IMG(I+1,J+1,X,Y)=M(X,Y)
NEXT X
NEXT Y
NEXT I
NEXT J
CLEAR
FOR I=1 TO NX*NY
LET R(I)=I-1
NEXT I
FOR I=1 TO NX*NY
SWAP R(I),R(INT(RND*NX*NY+1))
NEXT I
FOR I=1 TO NX*NY
LET X1=MOD(R(I),NX)
LET Y1=INT(R(I)/NX)
LET XX=MOD(I-1,NX)
LET YY=INT((I-1)/NX)
FOR Y=1 TO YSIZE/NY
FOR X=1 TO XSIZE/NX
LET M(X,Y)=IMG(X1+1,Y1+1,X,Y)
NEXT X
NEXT Y
MAT PLOT CELLS, IN XX*XSIZE/NX+1,YY*YSIZE/NY+1;(XX+1)*XSIZE/NX,(YY+1)*YSIZE/NY:M
NEXT I
FOR I=1 TO NX-1
PLOT LINES:XSIZE/NX*I,0;XSIZE/NX*I,YSIZE
NEXT I
FOR I=1 TO NY-1
PLOT LINES:0,YSIZE/NY*I;XSIZE,YSIZE/NY*I
NEXT I
SET DRAW MODE EXPLICIT
INPUT PROMPT "この熟語は何ですか?":C$
IF C$(1:3)=A$(C) THEN
PRINT "正解です"
ELSE
PRINT "間違いです"
PRINT "正解は「";A$(C);"」です"
END IF
CLEAR
PLOT TEXT ,AT XSIZE/2,YSIZE/2:A$(C)
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 "大大的","大団円","駄洒落","断末魔","知情意","地動説","千鳥足","致命傷","茶番劇","長期戦"
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 "月天心","川逍遥","水蜜桃","天邪鬼","有頂天","閻魔帳","八百万","天狗風","一張羅","太平楽"
DATA "能天気","安本丹","頓珍漢","守銭奴","素寒貧","棚牡丹","猪口才","不可逆","不条理","不文律"
DATA "不退転","未曾有","無尽蔵","檜舞台","審美眼","寂寥感","老婆心","試金石","大御所","御題目"
DATA "居丈高"
END
数式の微分（導関数） - SHIRAISHI Kazuo
2025/11/11 (Tue) 18:35:14
ニュートン法で方程式の解の近似値を計算するとき導関数が必要になりますが，その場合に用いることを想定して導関数を計算するプログラムを作ってみました。
200行～430行はテストデータです。
100 REM Differentiator.Derivative$(expr$,dvar$)は，数式expr$を変数dvar$で微分して得られる導関数。
110 REM 関数は，SIN，COS，TAN, LOG, EXP, SQR, ATN, ASIN, ACOS のみ
120 REM 数値式の文法はほぼFull BASICに準ずるが，関数名に続く括弧は空白を入れずに書く。
130 REM 英字の小文字と大文字を同一視する。
140 REM 変数名はギリシャ文字の小文字α,…,ω も可。
150 REM 微分変数以外の変数(文字定数)を含んでよいが，配列(添字付き変数)は不可。
160 REM
170 DECLARE EXTERNAL FUNCTION Differentiator.Derivative$
180 DECLARE STRING s$,t$
190 !
200 DATA "x^3-a*x^2+b*x+c","x"
210 DATA "x^2+3*x*y-2*y^2", "x"
220 DATA "x^2+3*x*y-2*y^2", "y"
230 DATA "(x+1)*(x+2)*(x+3)","x"
240 DATA "x/x^2/x^3","x"
250 DATA "2*x/(3*x)/(4*x)*(5*x)","x"
260 DATA "EXP(-2*(x-k)^2)","x"
270 DATA "exp(-2*x^2-8*x)","x"
280 DATA "sqr(-2*x)","x"
290 DATA "SQR(2*X^2)","x"
300 DATA "SIN(-2*x^2-3*x+1)","x"
310 DATA "COS(-3*x^3-2*x)","x"
320 DATA "sin(a1*x^3+a2*x^2+a3*x+a4)","x"
330 DATA "exp(-2*sin(x^2+1))","x"
340 DATA "TAN(x)*COS(x)","x"
350 DATA "EXP(a*x+b)","x"
360 DATA "cos(α*x+β)","x"
370 DATA "x^(n+1)","x"
380 DATA "x^x","x"
390 DATA "x^(x^2)","x"
400 DATA "x^(x*x)","x"
410 DATA "(x^x)^x","x"
420 DATA "x^x^x","x"
430 DATA "EXP(x*LOG(x))","x"
440 !
450 DO
460 READ IF MISSING THEN EXIT DO:s$,t$
470 PRINT s$,"を";t$;"で微分"
480 PRINT Derivative$(s$,t$)
490 PRINT
500 LOOP
510 END
520 !
1000 MODULE Differentiator
1010 MODULE option character kanji
1020 PUBLIC FUNCTION Derivative$
1030 SHARE STRING s$
1040 SHARE STRING DiffVar$
1050 SHARE NUMERIC i
1060 SHARE SUB skip
1070 SHARE SUB expression,term,factor,primary,numeric
1080 SHARE FUNCTION prod$,add$,sbt$,div$,Paren$,UnParen$
1090 !
1100 EXTERNAL FUNCTION Derivative$(expr$,dvar$)
1110 REM expr$の数式をdvar$で微分する
1120 DECLARE STRING exp$,dev$
1130 LET diffvar$=dvar$
1140 LET s$=expr$
1150 LET i=1
1160 CALL skip
1170 CALL expression(exp$,dev$)
1180 IF i<LEN(s$) THEN PRINT i,"Syntax error"
1190 let Derivative$=dev$
1200 end function
1210 !
1220 EXTERNAL SUB skip ! 空白を読み飛ばす
1230 DO WHILE s$(i:i)=" "
1240 LET i=i+1
1250 LOOP
1260 END SUB
1270 !
1280 EXTERNAL FUNCTION add$(s$,t$)
1290 IF s$="0" THEN
1300 LET add$=t$
1310 ELSEIF t$="0" THEN
1320 LET add$=s$
1330 ELSE
1340 LET add$=s$ & "+" & t$
1350 END IF
1360 END FUNCTION
1370 !
1380 EXTERNAL FUNCTION sbt$(s$,t$)
1390 IF s$=t$ THEN
1400 LET sbt$="0"
1410 ELSEIF s$="" AND t$="0" THEN
1420 LET sbt$="0"
1430 ELSEIF s$="0" THEN
1440 LET sbt$="(-" & t$ &")"
1450 ELSEIF t$="0" THEN
1460 LET sbt$=s$
1470 ELSE
1480 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1490 LET sbt$=s$ & "-" & t$
1500 END IF
1510 END FUNCTION
1520 !
1530 EXTERNAL FUNCTION prod$(s$,t$)
1540 IF UnParen$(s$)="1" THEN
1550 LET prod$=t$
1560 ELSEIF UnParen$(t$)="1" THEN
1570 LET prod$=s$
1580 ELSEIF s$="0" OR t$="0" THEN
1590 LET prod$="0"
1600 ELSE
1610 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1620 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1630 LET prod$=s$ & "*" & t$
1640 END IF
1650 END FUNCTION
1660 !
1670 EXTERNAL FUNCTION div$(s$,t$)
1680 IF s$=t$ THEN
1690 LET div$="1"
1700 ELSEIF s$="1" THEN
1710 LET div$="1/" & t$
1720 ELSEIF t$="1" THEN
1730 LET div$=s$
1740 ELSEIF s$="0" THEN
1750 LET div$="0"
1760 ELSE
1770 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1780 IF POS(t$,"+")>0 OR POS(t$,"-")>0 OR POS(t$,"*")>0 OR POS(t$,"/")>0THEN LET t$=Paren$(t$)
1790 LET div$=s$ & "/" & t$
1800 END IF
1810 END FUNCTION
1820 !
1830 EXTERNAL SUB expression(exp$,dev$) !加減式
1840 DECLARE NUMERIC i0
1850 DECLARE STRING op$,e1$,d1$,e2$,d2$
1860 IF s$(i:i)="+" OR s$(i:i)="-" THEN
1870 LET exp$=""
1880 LET dev$=""
1890 ELSE
1900 CALL term(exp$,dev$)
1910 END IF
1920 DO WHILE s$(i:i)="+" OR s$(i:i)="-"
1930 LET op$=s$(i:i)
1940 LET i=i+1
1950 CALL skip
1960 LET e1$=exp$
1970 LET d1$=dev$
1980 CALL term(e2$,d2$)
1990 LET exp$=e1$ & op$ & e2$
2000 SELECT CASE op$
2010 CASE "+"
2020 LET dev$=add$(d1$,d2$)
2030 CASE "-"
2040 LET dev$=sbt$(d1$,d2$)
2050 END SELECT
2060 LOOP
2070 CALL skip
2080 END SUB
2090 !
2100 EXTERNAL SUB term(exp$,dev$) !項(乗除)
2110 DECLARE NUMERIC i0
2120 DECLARE STRING op$,e1$,d1$,e2$,d2$
2130 CALL factor(exp$,dev$)
2140 DO WHILE s$(i:i)="*" OR s$(i:i)="/"
2150 LET op$=s$(i:i)
2160 LET i=i+1
2170 CALL skip
2180 LET e1$=exp$
2190 LET d1$=dev$
2200 CALL factor(e2$,d2$)
2210 LET exp$=e1$ & op$ & e2$
2220 SELECT CASE op$
2230 CASE "*"
2240 LET dev$=add$(prod$(d1$,e2$),prod$(e1$,d2$))
2250 CASE "/"
2260 LET dev$=div$(Paren$(sbt$(prod$(d1$,e2$),prod$(e1$,d2$))), Paren$(e2$) & "^2")
2270 END SELECT
2280 LOOP
2290 CALL skip
2300 END SUB
2310 !
2320 EXTERNAL SUB factor(exp$,dev$) !因子(冪乗)
2330 DECLARE NUMERIC i0,n
2340 DECLARE STRING e1$,d1$,e2$,d2$
2350 CALL primary(exp$,dev$)
2360 DO WHILE s$(i:i)="^"
2370 LET i=i+1
2380 CALL skip
2390 LET e1$=exp$
2400 LET d1$=dev$
2410 CALL primary(e2$,d2$)
2420 LET exp$=e1$ & "^" & e2$
2430 ! 2440行～2600行で，e1$,e2$,exp$は因子(factor)
2440 IF UnParen$(d2$)="0" THEN
2450 WHEN EXCEPTION IN
2460 LET n=VAL(e2$)-1
2470 IF n=1 THEN
2480 LET dev$=prod$(prod$(e2$,e1$) ,d1$)
2490 ELSEIF n>0 THEN
2500 LET dev$=prod$(prod$(e2$, e1$ & "^" & STR$(n)) ,d1$)
2510 ELSE
2520 LET dev$=prod$(prod$(e2$, e1$ & "^(" & STR$(n) & ")"),d1$)
2530 END IF
2540 USE
2550 LET dev$=prod$(e2$ & "*" & e1$ & "^(" & e2$ & "-1)",d1$)
2560 END WHEN
2570 ELSE
2580 LET dev$=prod$(exp$ , add$( prod$(d2$, "LOG(" & e1$ & ")"), prod$(div$(e2$,e1$),d1$)))
2590 END IF
2600 LOOP
2610 CALL skip
2620 END SUB
2630 !
2640 EXTERNAL SUB primary(exp$,dev$)
2650 DECLARE NUMERIC i0
2660 DECLARE STRING op$,e1$,d1$,e2$,d2$
2670 LET i0=i
2680 IF s$(i:i)="(" THEN
2690 LET i=i+1
2700 CALL SKIP
2710 CALL expression(e1$,d1$)
2720 LET exp$="(" & e1$ & ")"
2730 LET dev$="(" & d1$ & ")"
2740 ELSEIF UCASE$(s$(i:i+3))="SIN(" THEN
2750 LET i=i+4
2760 CALL SKIP
2770 CALL expression(e1$,d1$)
2780 LET exp$="SIN(" & e1$ & ")"
2790 LET dev$=prod$(d1$,"COS(" & e1$ & ")")
2800 ELSEIF UCASE$(s$(i:i+3))="COS(" THEN
2810 LET i=i+4
2820 CALL SKIP
2830 CALL expression(e1$,d1$)
2840 LET exp$="COS(" & e1$ & ")"
2850 LET dev$=prod$(d1$,"(-SIN(" & e1$ & "))")
2860 ELSEIF UCASE$(s$(i:i+3))="TAN(" THEN
2870 LET i=i+4
2880 CALL SKIP
2890 CALL expression(e1$,d1$)
2900 LET exp$="TAN(" & e1$ & ")"
2910 LET dev$=prod$( d1$, "SEC(" & e1$ & ")^2")
2920 ELSEIF UCASE$(s$(i:i+3))="LOG(" THEN
2930 LET i=i+4
2940 CALL SKIP
2950 CALL expression(e1$,d1$)
2960 LET exp$="LOG(" & e1$ & ")"
2970 LET dev$="(" & d1$ & ")/(" & e1$ & ")"
2980 ELSEIF UCASE$(s$(i:i+3))="EXP(" THEN
2990 LET i=i+4
3000 CALL SKIP
3010 CALL expression(e1$,d1$)
3020 LET exp$="EXP(" & e1$ & ")"
3030 LET dev$=prod$( d1$ ,"EXP(" & e1$ & ")")
3040 ELSEIF UCASE$(s$(i:i+3))="SQR(" THEN
3050 LET i=i+4
3060 CALL SKIP
3070 CALL expression(e1$,d1$)
3080 LET exp$="SQR(" & e1$ & ")"
3090 LET dev$=div$(d1$,"(2*SQR(" & e1$ & "))")
3100 ELSEIF UCASE$(s$(i:i+3))="ATN(" THEN
3110 LET i=i+4
3120 CALL SKIP
3130 CALL expression(e1$,d1$)
3140 LET exp$="ATN(" & e1$ & ")"
3150 LET dev$="(" & d1$ & ")/(1+(" & e1$ & ")^2)"
3160 ELSEIF UCASE$(s$(i:i+4))="ASIN(" THEN
3170 LET i=i+5
3180 CALL SKIP
3190 CALL expression(e1$,d1$)
3200 LET exp$="ASIN(" & e1$ & ")"
3210 LET dev$="(" & d1$ & ")/SQR(1-(" & e1$ & ")^2)"
3220 ELSEIF UCASE$(s$(i:i+4))="ACOS(" THEN
3230 LET i=i+5
3240 CALL SKIP
3250 CALL expression(e1$,d1$)
3260 LET exp$="ACOS(" & e1$ & ")"
3270 LET dev$="(-(" & d1$ & "))/SQR(1-(" & e1$ & ")^2)"
3280 END IF
3290 IF i>i0 THEN
3300 IF s$(i:i)=")" THEN
3310 LET i=i+1
3320 CALL skip
3330 ELSE
3340 PRINT i, ") expected"
3350 STOP
3360 END IF
3370 ELSE
3380 IF s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="." THEN
3390 CALL NUMERIC(exp$,dev$)
3400 ELSEIF s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="α" AND s$(i:i)<="ω" THEN
3410 CALL identif(exp$,dev$)
3420 ELSE
3430 END IF
3440 END IF
3450 END SUB
3460 !
3470 EXTERNAL SUB numeric(exp$,dev$)
3480 DECLARE NUMERIC i0
3490 LET i0=i
3500 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="."
3510 LET i=i+1
3520 LOOP
3530 IF UCASE$(s$(i:i))="E" THEN
3540 LET i=i+1
3550 IF s$(i:i)="+" OR s$(i:i)="-" THEN LET i=i+1
3560 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
3570 LET i=i+1
3580 LOOP
3590 END IF
3600 LET exp$=s$(i0:i-1)
3610 LET dev$="0"
3620 CALL skip
3630 END SUB
3640 !
3650 EXTERNAL SUB identif(exp$,dev$)
3660 DECLARE NUMERIC i0
3670 LET i0=i
3680 DO WHILE s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)>="α" AND s$(i:i)<="ω"
3690 LET i=i+1
3700 LOOP
3710 LET exp$=s$(i0:i-1)
3720 IF UCASE$(exp$)=UCASE$(DiffVar$) THEN LET dev$="1" ELSE LET dev$="0"
3730 CALL skip
3740 END SUB
3750 !
3760 EXTERNAL FUNCTION Paren$(s$)
3770 LET Paren$="(" & s$ & ")"
3780 END FUNCTION
3790 !
3800 EXTERNAL FUNCTION UnParen$(s$)
3810 ! 両端から括弧を外す。両端が対応する括弧である場合にのみ適用する。
3820 IF s$(1:1)="(" AND s$(LEN(s$):LEN(s$))=")" THEN
3830 LET UnParen$=UnParen$(s$(2:LEN(s$)-1))
3840 ELSE
3850 LET UnParen$=s$
3860 END IF
3870 END FUNCTION
3880 END MODULE
Re: 数式の微分（導関数） - SHIRAISHI Kazuo
2025/11/11 (Tue) 18:53:56
2320行の外部副プログラムfactor(exp$,dev$)を実行すると，因数をexp$に，その導関数をdev$に代入します。
2100行の外部副プログラムtermは，項(乗除算)をexp$に代入し，その導関数をdev$に代入します。
項が乗算のとき，y=u*vの導関数は，y'=u'*v+u*v'です。
なので，積u*vの導関数を求めるためには，u,vとその導関数u',v'を求めてu'*v+u*v'を作ればよいことになります。
それを実行しているのが2240行です。
factorを実行して求めたe1$とe2$は因数ですが，その導関数のd1$とd2$は因数の形をしているとは限りません。
積u'*vを作るときにu'を括弧で括ることが不可欠です。
一方で，u'が0であるとき，u'*vは不要になります。
そのために，積を作る関数prod$を定義しています。
1610行の POS(s$,"+")>0 OR POS(s$,"-")>0 は過剰ですが，最適化しようとするとかなり面倒なことになります。
Re: 数式の微分（導関数） - SHIRAISHI Kazuo
2025/11/11 (Tue) 19:00:57
副プログラムfactorは，因数，すなわち，u^vの形の式を対象にします。
factorでの処理は複雑です。
y=u^vの導関数は，
y'=y*(v'*LOG(u)+u'*v/u)
ですが，これはu>0の場合に限定されます。
vが変数を含まなければ，
y=u^nに対して
y'=n*u^(n-1)*u'
です。
v，すなわち，e2$が変数を含むかどうかは，その導関数d2$を見ればわかります。
vが変数を含まないときの導関数を2550行で，vが変数を含むときの導関数を2580行で求めています。
Re: 数式の微分（導関数） - SHIRAISHI Kazuo
2025/11/11 (Tue) 20:51:29
変数としてギリシャ文字の小文字も使えるようにしています。多バイト文字を1文字として扱うために，MODULE Differentiator で
MODULE option character kanji
を宣言しています。Ver.8 やVer.0.9では
OPTION CHARACTER MULTIBYTE
を書くことになっていますが，互換性保持のため
option character kanji
と書くこともできるようになっています。
呼び出し側のプログラム単位では，文字を単位とする処理をしないので
option character kanji
を書く必要はありません。
Re: 数式の微分（導関数） - SHIRAISHI Kazuo
2025/11/12 (Wed) 10:45:41
Paren$を修正して無駄な括弧を付加しないようにしました。
100 REM Differentiator.Derivative$(expr$,dvar$)は，数式expr$を変数dvar$で微分して得られる導関数。
110 REM 関数は，SIN，COS，TAN, LOG, EXP, SQR, ATN, ASIN, ACOS のみ
120 REM 数値式の文法はほぼFull BASICに準ずるが，関数名に続く括弧は空白を入れずに書く。
130 REM 英字の小文字と大文字を同一視する。
140 REM 変数名はギリシャ文字の小文字α,…,ω も可。
150 REM 微分変数以外の変数(文字定数)を含んでよいが，配列(添字付き変数)は不可。
160 REM
170 DECLARE EXTERNAL FUNCTION Differentiator.Derivative$
180 DECLARE STRING s$,t$
190 !
200 DATA "x^3-a*x^2+b*x+c","x"
210 DATA "x^2+3*x*y-2*y^2", "x"
220 DATA "x^2+3*x*y-2*y^2", "y"
230 DATA "(x+1)*(x+2)*(x+3)","x"
240 DATA "x/x^2/x^3","x"
250 DATA "2*x/(3*x)/(4*x)*(5*x)","x"
260 DATA "EXP(-2*(x-k)^2)","x"
270 DATA "exp(-2*x^2-8*x)","x"
280 DATA "sqr(-2*x)","x"
290 DATA "SQR(2*X^2)","x"
300 DATA "SIN(-2*x^2-3*x+1)","x"
310 DATA "COS(-3*x^3-2*x)","x"
320 DATA "sin(a1*x^3+a2*x^2+a3*x+a4)","x"
330 DATA "exp(-2*sin(x^2+1))","x"
340 DATA "TAN(x)*COS(x)","x"
350 DATA "ATN(SIN(x))","x"
360 DATA "ASIN(x/180*PI)","x"
370 DATA "x^(n+1)","x"
380 DATA "x^x","x"
390 DATA "x^(x^2)","x"
400 DATA "x^(x*x)","x"
410 DATA "(x^x)^x","x"
420 DATA "x^x^x","x"
430 DATA "EXP(x*LOG(x))","x"
440 !
450 DO
460 READ IF MISSING THEN EXIT DO:s$,t$
470 PRINT s$,"を";t$;"で微分"
480 PRINT Derivative$(s$,t$)
490 PRINT
500 LOOP
510 END
520 !
1000 MODULE Differentiator
1010 MODULE OPTION CHARACTER kanji
1020 PUBLIC FUNCTION Derivative$
1030 SHARE STRING s$
1040 SHARE STRING DiffVar$
1050 SHARE NUMERIC i
1060 SHARE SUB skip
1070 SHARE SUB expression,term,factor,primary,numeric
1080 SHARE FUNCTION prod$,add$,sbt$,div$,Paren$,UnParen$
1090 !
1100 EXTERNAL FUNCTION Derivative$(expr$,dvar$)
1110 REM expr$の数式をdvar$で微分する
1120 DECLARE STRING exp$,dev$
1130 LET diffvar$=dvar$
1140 LET s$=expr$
1150 LET i=1
1160 CALL skip
1170 CALL expression(exp$,dev$)
1180 IF i<LEN(s$) THEN PRINT i,"Syntax error"
1190 let Derivative$=dev$
1200 end function
1210 !
1220 EXTERNAL SUB skip ! 空白を読み飛ばす
1230 DO WHILE s$(i:i)=" "
1240 LET i=i+1
1250 LOOP
1260 END SUB
1270 !
1280 EXTERNAL FUNCTION add$(s$,t$)
1290 IF s$="0" THEN
1300 LET add$=t$
1310 ELSEIF t$="0" THEN
1320 LET add$=s$
1330 ELSE
1340 LET add$=s$ & "+" & t$
1350 END IF
1360 END FUNCTION
1370 !
1380 EXTERNAL FUNCTION sbt$(s$,t$)
1390 IF s$=t$ THEN
1400 LET sbt$="0"
1410 ELSEIF s$="" AND t$="0" THEN
1420 LET sbt$="0"
1430 ELSEIF s$="0" THEN
1440 LET sbt$="(-" & t$ &")"
1450 ELSEIF t$="0" THEN
1460 LET sbt$=s$
1470 ELSE
1480 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1490 LET sbt$=s$ & "-" & t$
1500 END IF
1510 END FUNCTION
1520 !
1530 EXTERNAL FUNCTION prod$(s$,t$)
1540 IF s$="1" THEN
1550 LET prod$=t$
1560 ELSEIF t$="1" THEN
1570 LET prod$=s$
1580 ELSEIF s$="0" OR t$="0" THEN
1590 LET prod$="0"
1600 ELSE
1610 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1620 IF POS(t$,"+")>0 OR POS(t$,"-")>0 THEN LET t$=Paren$(t$)
1630 LET prod$=s$ & "*" & t$
1640 END IF
1650 END FUNCTION
1660 !
1670 EXTERNAL FUNCTION div$(s$,t$)
1680 IF s$=t$ THEN
1690 LET div$="1"
1700 ELSEIF t$="1" THEN
1710 LET div$=s$
1720 ELSEIF s$="0" THEN
1730 LET div$="0"
1740 ELSE
1750 IF POS(s$,"+")>0 OR POS(s$,"-")>0 THEN LET s$=Paren$(s$)
1760 IF POS(t$,"+")>0 OR POS(t$,"-")>0 OR POS(t$,"*")>0 OR POS(t$,"/")>0THEN LET t$=Paren$(t$)
1770 LET div$=s$ & "/" & t$
1780 END IF
1790 END FUNCTION
1800 !
1810 EXTERNAL SUB expression(exp$,dev$) !加減式
1820 DECLARE NUMERIC i0
1830 DECLARE STRING op$,e1$,d1$,e2$,d2$
1840 IF s$(i:i)="+" OR s$(i:i)="-" THEN
1850 LET exp$=""
1860 LET dev$=""
1870 ELSE
1880 CALL term(exp$,dev$)
1890 END IF
1900 DO WHILE s$(i:i)="+" OR s$(i:i)="-"
1910 LET op$=s$(i:i)
1920 LET i=i+1
1930 CALL skip
1940 LET e1$=exp$
1950 LET d1$=dev$
1960 CALL term(e2$,d2$)
1970 LET exp$=e1$ & op$ & e2$
1980 SELECT CASE op$
1990 CASE "+"
2000 LET dev$=add$(d1$,d2$)
2010 CASE "-"
2020 LET dev$=sbt$(d1$,d2$)
2030 END SELECT
2040 LOOP
2050 CALL skip
2060 END SUB
2070 !
2080 EXTERNAL SUB term(exp$,dev$) !項(乗除)
2090 DECLARE NUMERIC i0
2100 DECLARE STRING op$,e1$,d1$,e2$,d2$
2110 CALL factor(exp$,dev$)
2120 DO WHILE s$(i:i)="*" OR s$(i:i)="/"
2130 LET op$=s$(i:i)
2140 LET i=i+1
2150 CALL skip
2160 LET e1$=exp$
2170 LET d1$=dev$
2180 CALL factor(e2$,d2$)
2190 LET exp$=e1$ & op$ & e2$
2200 SELECT CASE op$
2210 CASE "*"
2220 LET dev$=add$(prod$(d1$,e2$),prod$(e1$,d2$))
2230 CASE "/"
2240 LET dev$=div$(Paren$(sbt$(prod$(d1$,e2$),prod$(e1$,d2$))), Paren$(e2$) & "^2")
2250 END SELECT
2260 LOOP
2270 CALL skip
2280 END SUB
2290 !
2300 EXTERNAL SUB factor(exp$,dev$) !因子(冪乗)
2310 DECLARE NUMERIC i0,n
2320 DECLARE STRING e1$,d1$,e2$,d2$
2330 CALL primary(exp$,dev$)
2340 DO WHILE s$(i:i)="^"
2350 LET i=i+1
2360 CALL skip
2370 LET e1$=exp$
2380 LET d1$=dev$
2390 CALL primary(e2$,d2$)
2400 LET exp$=e1$ & "^" & e2$
2410 ! 2420行～2580行で，e1$,e2$,exp$は因子(factor)
2420 IF d2$="0" THEN
2430 WHEN EXCEPTION IN
2440 LET n=VAL(e2$)-1
2450 IF n=1 THEN
2460 LET dev$=prod$(prod$(e2$,e1$) ,d1$)
2470 ELSEIF n>0 THEN
2480 LET dev$=prod$(prod$(e2$, e1$ & "^" & STR$(n)) ,d1$)
2490 ELSE
2500 LET dev$=prod$(prod$(e2$, e1$ & "^(" & STR$(n) & ")"),d1$)
2510 END IF
2520 USE
2530 LET dev$=prod$(e2$ & "*" & e1$ & "^(" & e2$ & "-1)",d1$)
2540 END WHEN
2550 ELSE
2560 LET dev$=prod$(exp$ , add$( prod$(d2$, "LOG(" & e1$ & ")"), prod$(div$(e2$,e1$),d1$)))
2570 END IF
2580 LOOP
2590 CALL skip
2600 END SUB
2610 !
2620 EXTERNAL SUB primary(exp$,dev$)
2630 DECLARE NUMERIC i0
2640 DECLARE STRING op$,e1$,d1$,e2$,d2$
2650 LET i0=i
2660 IF s$(i:i)="(" THEN
2670 LET i=i+1
2680 CALL SKIP
2690 CALL expression(e1$,d1$)
2700 LET exp$="(" & e1$ & ")"
2710 !LET dev$="(" & d1$ & ")"
2720 LET dev$=Paren$(d1$)
2730 ELSEIF UCASE$(s$(i:i+3))="SIN(" THEN
2740 LET i=i+4
2750 CALL SKIP
2760 CALL expression(e1$,d1$)
2770 LET exp$="SIN(" & e1$ & ")"
2780 LET dev$=prod$(d1$,"COS(" & e1$ & ")")
2790 ELSEIF UCASE$(s$(i:i+3))="COS(" THEN
2800 LET i=i+4
2810 CALL SKIP
2820 CALL expression(e1$,d1$)
2830 LET exp$="COS(" & e1$ & ")"
2840 LET dev$=prod$(d1$,"(-SIN(" & e1$ & "))")
2850 ELSEIF UCASE$(s$(i:i+3))="TAN(" THEN
2860 LET i=i+4
2870 CALL SKIP
2880 CALL expression(e1$,d1$)
2890 LET exp$="TAN(" & e1$ & ")"
2900 LET dev$=prod$( d1$, "SEC(" & e1$ & ")^2")
2910 ELSEIF UCASE$(s$(i:i+3))="LOG(" THEN
2920 LET i=i+4
2930 CALL SKIP
2940 CALL expression(e1$,d1$)
2950 LET exp$="LOG(" & e1$ & ")"
2960 LET dev$=Div$(Paren$(d1$),Paren$(e1$))
2970 ELSEIF UCASE$(s$(i:i+3))="EXP(" THEN
2980 LET i=i+4
2990 CALL SKIP
3000 CALL expression(e1$,d1$)
3010 LET exp$="EXP(" & e1$ & ")"
3020 LET dev$=prod$( d1$ ,"EXP(" & e1$ & ")")
3030 ELSEIF UCASE$(s$(i:i+3))="SQR(" THEN
3040 LET i=i+4
3050 CALL SKIP
3060 CALL expression(e1$,d1$)
3070 LET exp$="SQR(" & e1$ & ")"
3080 LET dev$=div$(d1$,"(2*SQR(" & e1$ & "))")
3090 ELSEIF UCASE$(s$(i:i+3))="ATN(" THEN
3100 LET i=i+4
3110 CALL SKIP
3120 CALL expression(e1$,d1$)
3130 LET exp$="ATN(" & e1$ & ")"
3140 LET dev$=div$(Paren$(d1$), "(1+" & Paren$(e1$) & "^2)")
3150 ELSEIF UCASE$(s$(i:i+4))="ASIN(" THEN
3160 LET i=i+5
3170 CALL SKIP
3180 CALL expression(e1$,d1$)
3190 LET exp$="ASIN(" & e1$ & ")"
3200 LET dev$=Paren$(d1$) & "/SQR(1-(" & e1$ & ")^2)"
3210 ELSEIF UCASE$(s$(i:i+4))="ACOS(" THEN
3220 LET i=i+5
3230 CALL SKIP
3240 CALL expression(e1$,d1$)
3250 LET exp$="ACOS(" & e1$ & ")"
3260 LET dev$="(-" & Paren$(d1$) & ")/SQR(1-(" & e1$ & ")^2)"
3270 END IF
3280 IF i>i0 THEN
3290 IF s$(i:i)=")" THEN
3300 LET i=i+1
3310 CALL skip
3320 ELSE
3330 PRINT i, ") expected"
3340 STOP
3350 END IF
3360 ELSE
3370 IF s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="." THEN
3380 CALL NUMERIC(exp$,dev$)
3390 ELSEIF s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="α" AND s$(i:i)<="ω" THEN
3400 CALL identif(exp$,dev$)
3410 ELSE
3420 END IF
3430 END IF
3440 END SUB
3450 !
3460 EXTERNAL SUB numeric(exp$,dev$)
3470 DECLARE NUMERIC i0
3480 LET i0=i
3490 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="."
3500 LET i=i+1
3510 LOOP
3520 IF UCASE$(s$(i:i))="E" THEN
3530 LET i=i+1
3540 IF s$(i:i)="+" OR s$(i:i)="-" THEN LET i=i+1
3550 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
3560 LET i=i+1
3570 LOOP
3580 END IF
3590 LET exp$=s$(i0:i-1)
3600 LET dev$="0"
3610 CALL skip
3620 END SUB
3630 !
3640 EXTERNAL SUB identif(exp$,dev$)
3650 DECLARE NUMERIC i0
3660 LET i0=i
3670 DO WHILE s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)>="α" AND s$(i:i)<="ω"
3680 LET i=i+1
3690 LOOP
3700 LET exp$=s$(i0:i-1)
3710 IF UCASE$(exp$)=UCASE$(DiffVar$) THEN LET dev$="1" ELSE LET dev$="0"
3720 CALL skip
3730 END SUB
3740 !
3750 EXTERNAL FUNCTION Paren$(s$)
3760 DECLARE NUMERIC i
3770 SUB EndParen
3780 let i=i+1
3790 DO UNTIL s$(i:i)=")"
3800 LET i=i+1
3810 IF s$(i:i)="(" THEN CALL EndParen
3820 LOOP
3830 END SUB
3840 LET i=1
3850 DO WHILE s$(i:i)=" "
3860 LET i=i+1
3870 LOOP
3880 IF s$(i:i)="(" THEN
3890 CALL EndParen
3900 ELSEIF s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="." THEN
3910 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)="."
3920 LET i=i+1
3930 LOOP
3940 IF UCASE$(s$(i:i))="E" THEN
3950 LET i=i+1
3960 IF s$(i:i)="+" OR s$(i:i)="-" THEN LET i=i+1
3970 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
3980 LET i=i+1
3990 LOOP
4000 END IF
4010 ELSEIF s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="α" AND s$(i:i)<="ω" THEN
4020 DO WHILE s$(i:i)>="a" AND s$(i:i)<="z" OR s$(i:i)>="A" AND s$(i:i)<="Z" OR s$(i:i)>="0" AND s$(i:i)<="9" OR s$(i:i)>="α" AND s$(i:i)<="ω"
4030 LET i=i+1
4040 LOOP
4050 IF s$(i:i)="(" THEN CALL EndParen
4060 END IF
4070 DO WHILE s$(i:i)=" "
4080 LET i=i+1
4090 LOOP
4100 IF i<LEN(s$) THEN
4110 LET Paren$="(" & s$ & ")"
4120 ELSE
4130 LET Paren$=s$
4140 END IF
4150 END FUNCTION
4250 END MODULE
行列の固有多項式 - SHIRAISHI Kazuo
2025/11/13 (Thu) 14:23:22
外部関数 EigenPolynom$(A(,),v$) は，正方行列Aの固有多項式を求めます。未知数をv$で指定。
固有方程式をニュートン法で解きたいとき，導関数を前掲プログラムで求めるのに利用できます。
（ただし，多くの場合，固有値・固有ベクトルを求めるのにこの方法が適するとはいえません。）
100 DECLARE EXTERNAL FUNCTION EigenPolynom$
110 DIM A(3,3)
120 DATA 4,5,6
130 DATA 1,2,3
140 DATA 7,8,6
150 MAT READ A
160 print EigenPolynom$(A,"λ")
170 END
180 !
1000 EXTERNAL FUNCTION EigenPolynom$(A(,),v$)
1010 DECLARE EXTERNAL FUNCTION determinant$
1020 DECLARE NUMERIC n,i,j
1030 LET n=UBOUND(A,1)
1040 DIM a$(n,n)
1050 FOR i=1 TO n
1060 FOR j=1 TO n
1070 LET a$(i,j)=STR$(a(i,j))
1080 if A(i,j)<0 then let a$(i,j)="(" & a$(i,j) & ")"
1090 IF i=j THEN LET a$(i,j) = "(" & a$(i,j) & "-" & v$ &")"
1100 NEXT j
1110 NEXT i
1120 MAT PRINT a$
1130 LET EigenPolynom$=determinant$(a$)
1140 END FUNCTION
1150 !
1160 EXTERNAL FUNCTION determinant$(A$(,))
1170 DECLARE EXTERNAL SUB submatrix
1180 DECLARE NUMERIC h,n
1190 DECLARE STRING s$
1200 FUNCTION sign$(i,j)
1210 IF MOD(i+j,2)=0 THEN
1220 LET sign$="+"
1230 ELSE
1240 LET sign$="-"
1250 END IF
1260 END FUNCTION
1270 LET h=UBOUND(A$,1)
1280 DIM B$(h-1,h-1)
1290 IF h=1 THEN
1300 LET determinant$=A$(1,1)
1310 ELSE
1320 FOR n=1 TO h
1330 CALL submatrix(A$,1,n,B$)
1340 LET s$=s$ &" " & sign$(1,n) & a$(1,n)& "*" & "(" & determinant$(B$) &")"
1350 NEXT n
1360 LET determinant$=s$
1370 END IF
1380 END FUNCTION
1390 !
1400 EXTERNAL SUB submatrix(A$(,), m,n, B$(,))
1410 ! A$のm行n列を除去した小行列
1420 DECLARE NUMERIC h,i,j,i0,j0
1430 LET h=UBOUND(A$,1)
1440 MAT B$=NUL$(h-1,h-1)
1450 FOR i=1 TO h
1460 FOR j=1 TO h
1470 IF i<=m THEN LET i0=i ELSE LET i0=i-1
1480 IF j<=n THEN LET j0=j ELSE LET j0=j-1
1490 IF i0<h AND j0<h THEN LET B$(i0,j0)=A$(i,j)
1500 NEXT j
1510 NEXT i
1520 END SUB
Ver. 8.1 , Ver.0.9 置換ダイアログ バグ - SHIRAISHI Kazuo
2025/10/23 (Thu) 08:17:43
Ver.8.1とVer.0.9の置換ダイアログで，1個の単語に対し置換を終えた後，ダイアログを閉じずに続けて新たな単語の置換を行なうと，十進BASICがフリーズします。
対策版を準備中ですが，それまでは，置換作業の終了後は，一旦，ダイアログを閉じてください。
Re: Ver. 8.1 , Ver.0.9 置換ダイアログ バグ - SHIRAISHI Kazuo
2025/10/27 (Mon) 10:02:38
Ver.8.1.5.1とVer.0.9.3.1で修正しました。ダイアログが自動で閉じます。
Re: Ver. 8.1 , Ver.0.9 置換ダイアログ バグ - SHIRAISHI Kazuo
2025/11/06 (Thu) 07:18:08
Ver.8.1.5.1とVer.0.9.3.1での修正が不完全でした。
BASICAcc，ParactBASICを含め，Lazarusで作成したすべてのバージョンで，問題が発生します。
対策を検討中です。
対策が完了するまでは，置換を行うとき，念のため，一旦プログラムを保存してください。
Re: Ver. 8.1 , Ver.0.9 置換ダイアログ バグ - SHIRAISHI Kazuo
2025/11/08 (Sat) 16:08:05
Ver.8.1.5.2とVer.0.9.3.2で修正しました。
古いファイルが使えない - ももてつ
2025/11/03 (Mon) 14:30:02
10年ぐらい前に作成した十進BASICのファイルを久しぶりに
実行しようと、今のPCに最新版をインストールし、開いてみた。一つだけ実行可能だったが、他のプログラムは開いても、新規ファイルのようにプログラムが表示されず、もちろん実行もかなわず。古いバージョンとは互換性がないんでしょうか。
Re: 古いファイルが使えない - SHIRAISHI Kazuo
2025/11/03 (Mon) 15:07:01
プログラムファイルは以前から単純なテキストファイルです。
Windowsのメモ帳で開いたらどう表示されますか？
なお，日本語を含むときは，文字コードの違いに注意してください。
Ver.7はShift-JISですが，Ver.8はUTF-8（Windows版は，設定を変えればShift-JISも可）です。
なお，そのさらに昔（20年くらい前）のLinux版だとEUC-JPだったかもしれません。
異なる文字探しパズル - しばっち
2025/11/02 (Sun) 08:17:12
実行すると下記のようなファイルを書き出します。
この中には異なる文字が含まれています。
("階"及び"柴"がそれぞれに含まれています)
https://machigai-sagashi.com/all_list/
https://news.mynavi.jp/article/20241121-3054324/
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1299402027
https://kyozaisupport.com/niteirukanji0201/
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕階偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕階偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕階偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕偕
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫柴紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫柴紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫紫
RANDOMIZE
LET ROW=20 ! 行
LET COL=20 ! 列
DIM M$(COL,ROW),A$(650),B$(650)
DIM T$(COL,ROW)
DO
LET N=N+1
READ IF MISSING THEN EXIT DO:A$(N),B$(N)
LOOP
OPEN #1:NAME "文字探し問題.txt"
OPEN #2:NAME "文字探し答え.txt"
ERASE #1
ERASE #2
FOR K=1 TO 5 ! 問題数
LET L=INT(RND*(N-1)+1)
IF RND<.5 THEN SWAP A$(L),B$(L)
MAT M$=(A$(L))& NUL$
MAT T$=M$
LET P=INT(RND*3+1) ! 異なる文字数
FOR I=1 TO P
LET X=INT(RND*COL+1)
LET Y=INT(RND*ROW+1)
LET M$(X,Y)=B$(L)
LET T$(X,Y)=" "
NEXT I
FOR Y=1 TO ROW
FOR X=1 TO COL
PRINT #1:M$(X,Y);
NEXT X
PRINT #1
NEXT Y
PRINT #1
FOR Y=1 TO ROW
FOR X=1 TO COL
PRINT #2 : T$(X,Y);
NEXT X
PRINT #2
NEXT Y
PRINT #2
NEXT K
CLOSE #1
CLOSE #2
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 "津","律"
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 "水","氷"
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 "連","錬"
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 "賃","貨"
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 "紛","粉"
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 "村","林"
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 "快","怏"
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 "堅","竪"
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 "回","同"
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 "遂","逐"
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 "五","伍"
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 "胃","冑"
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 "検","倹"
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 "酒","洒"
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 "敞","敝"
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 "旅","族"
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 "回","同"
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 "紀","記"
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 "叉","又"
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 "賭","堵"
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 "把","杷"
DATA "鰆","椿"
DATA "鯨","涼"
DATA "鯉","理"
DATA "鯛","調"
DATA "植","値"
DATA "梅","海"
DATA "柏","拍"
DATA "柿","肺"
DATA "桐","銅"
DATA "橙","澄"
DATA "杷","肥"
DATA "桧","絵"
DATA "杜","仕"
DATA "梧","語"
END
---------------------------------------------------------------------
下記ではhtmlファイルを書き出します。
上記からDATA文をコピペしてください。
RANDOMIZE
LET ROW=20
LET COL=20
DIM M$(COL,ROW),A$(650),B$(650)
DO
LET N=N+1
READ IF MISSING THEN EXIT DO:A$(N),B$(N)
LOOP
OPEN #1:NAME "文字探し問題.html"
OPEN #2:NAME "文字探し答え.html"
ERASE #1
ERASE #2
PRINT #1:"<!DOCTYPE html>"
PRINT #1:" <html>"
PRINT #1:" <body>"
PRINT #1:" <div align=center>"
PRINT #1:" <h1>問題</h1>"
PRINT #1:" </div>"
PRINT #2:"<!DOCTYPE html>"
PRINT #2:" <html>"
PRINT #2:" <body>"
PRINT #2:" <div align=center>"
PRINT #2:" <h1>解答</h1>"
PRINT #2:" </div>"
FOR K=1 TO 5
PRINT #1:" <table align=center>"
PRINT #2:" <table align=center>"
LET L=INT(RND*(N-1)+1)
IF RND<.5 THEN SWAP A$(L),B$(L)
MAT M$=(A$(L))& NUL$
LET P=INT(RND*3+1)
FOR I=1 TO P
LET X=INT(RND*COL+1)
LET Y=INT(RND*ROW+1)
LET M$(X,Y)=B$(L)
NEXT I
FOR Y=1 TO ROW
PRINT #1:"<tr>"
FOR X=1 TO COL
PRINT #1:"<td>";M$(X,Y);"</td>";
NEXT X
PRINT #1
PRINT #1:"</tr>"
NEXT Y
FOR Y=1 TO ROW
PRINT #2:"<tr>"
FOR X=1 TO COL
IF M$(X,Y)=B$(L) THEN
PRINT #2:"<td><font color=#ff0000>";M$(X,Y);"</font></td>"
ELSE
PRINT #2:"<td>";M$(X,Y);"</td>";
END IF
NEXT X
PRINT #2
PRINT #2:"</tr>"
NEXT Y
PRINT #1:" </table>"
PRINT #1:"<br>"
PRINT #2:" </table>"
PRINT #2:"<br>"
NEXT K
PRINT #1:" </body>"
PRINT #1:" </html>"
PRINT #2:" </body>"
PRINT #2:" </html>"
CLOSE #1
CLOSE #2
DATA "浦","捕"
DATA "輸","愉"
DATA "輪","輸"
DATA "快","決"
END
Re: 異なる文字探しパズル - しばっち
2025/11/02 (Sun) 08:19:18
ゲーム風にしてみました。
異なる文字を見つけたらマウスでその文字をクリックしてください。全部見つけると終了します。
「G」キーで答えを表示します。
上記からDATA文をコピペしてください。
RANDOMIZE
LET ROW=20
LET COL=20
DIM A$(650),B$(650),M$(COL,ROW)
DO
LET N=N+1
READ IF MISSING THEN EXIT DO:A$(N),B$(N)
LOOP
CALL GINIT(600,600)
LET H=MIN(600/ROW,600/COL)
SET TEXT JUSTIFY "LEFT","TOP"
SET TEXT COLOR 7
SET TEXT HEIGHT H*.8
LET L=INT(RND*(N-1)+1)
IF RND<.5 THEN SWAP A$(L),B$(L)
MAT M$=(A$(L))& NUL$
LET P=INT(RND*4+1)
FOR I=1 TO P
LET X=INT(RND*COL+1)
LET Y=INT(RND*ROW+1)
LET M$(X,Y)=B$(L)
NEXT I
FOR Y=1 TO ROW
FOR X=1 TO COL
PLOT TEXT ,AT (X-1)*H,(Y-1)*H:M$(X,Y)
NEXT X
NEXT Y
LET T=TIME
DO
DO
MOUSE POLL XX,YY,LEFT,RIGHT
IF GETKEYSTATE(ORD("G"))<0 OR GETKEYSTATE(ORD("g"))<0 THEN
SET TEXT COLOR 4
FOR Y=1 TO ROW
FOR X=1 TO COL
IF M$(X,Y)=B$(L) THEN
PLOT TEXT ,AT (X-1)*H,(Y-1)*H:M$(X,Y)
END IF
NEXT X
NEXT Y
STOP
END IF
LOOP UNTIL RIGHT=1 OR LEFT=1
DO
MOUSE POLL XX,YY,LEFT,RIGHT
LOOP WHILE RIGHT=1 OR LEFT=1
LET X=INT(XX/H)+1
LET Y=INT(YY/H)+1
IF M$(X,Y)=B$(L) THEN
SET TEXT COLOR 0
PLOT TEXT ,AT (X-1)*H,(Y-1)*H:M$(X,Y)
LET C=C+1
LET M$(X,Y)=""
ELSE
SET TEXT COLOR 2
PLOT TEXT ,AT (X-1)*H,(Y-1)*H:M$(X,Y)
END IF
LOOP UNTIL C=P
PRINT TIME-T;"秒"
DATA "浦","捕"
DATA "輸","愉"
DATA "輪","輸"
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
CLEAR
END SUB
ペントミノパズル - しばっち
2025/10/13 (Mon) 08:24:36
ペントミノ
https://ja.wikipedia.org/wiki/ペントミノ
実行すると下記のような問題を出力します。
0 0 0 4 1 3 2
0□□□□□□□
0□□□□□□□
1□□□□□□□
2□□□□□□□
3□□□□□□□
3□□□□□□□
1□□□□□□□
0 0 0 3 5 2 0
0□□□□□□□
0□□□□□□□
1□□□□□□□
3□□□□□□□
2□□□□□□□
2□□□□□□□
2□□□□□□□
0 0 0 3 2 3 2
0□□□□□□□
1□□□□□□□
3□□□□□□□
3□□□□□□□
2□□□□□□□
1□□□□□□□
0□□□□□□□
縦横にある数だけコマ(ペントミノ)の形にマスを埋めていくパズルです。
コマは12種類(DATA文参照)あります。２種類以上(同種含む)のコマを
使用しています。
RANDOMIZE
LET SIZE=7
READ NSIZE,NMAX
DIM MASU(SIZE,SIZE),KOMA(NMAX,NSIZE,NSIZE),KOMA2(NSIZE,NSIZE)
FOR P=1 TO NMAX
FOR L=1 TO NSIZE
READ S$
FOR M=1 TO NSIZE
IF S$(M:M)="*" THEN LET KOMA(P,L,M)=P
NEXT M
NEXT L
NEXT P
OPEN #1:NAME "ペントミノパズル問題.txt"
OPEN #2:NAME "ペントミノパズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
LET NUM=0
MAT MASU=ZER
DO
FOR Q=1 TO 30 ! 試行回数
LET COL=INT(RND*SIZE+1)
LET ROW=INT(RND*SIZE+1)
LET P=INT(RND*NMAX+1) ! コマの種類
! LET ROT=INT(RND*8)
CALL ROTATE(ROT,P) ! 回転
IF CHECK(ROW,COL)=1 THEN
CALL PUT(ROW,COL)
LET NUM=NUM+1
END IF
NEXT Q
LOOP UNTIL NUM>=2 ! コマ2種類以上なら
PRINT #1:" ";
FOR M=1 TO SIZE
LET S=0
FOR L=1 TO SIZE
IF MASU(L,M)<>0 THEN LET S=S+1
NEXT L
PRINT #1,USING "##":S;
NEXT M
PRINT #1
FOR L=1 TO SIZE
LET S=0
FOR M=1 TO SIZE
IF MASU(L,M)<>0 THEN LET S=S+1
NEXT M
PRINT #1,USING "##":S;
PRINT #1:REPEAT$("□",SIZE)
NEXT L
PRINT #1
FOR L=1 TO SIZE
FOR M=1 TO SIZE
SELECT CASE MASU(L,M)
CASE 0
PRINT #2:"□";
CASE 1,7
PRINT #2:"■";
CASE 2,8
PRINT #2:"◆";
CASE 3,9
PRINT #2:"●";
CASE 4,10
PRINT #2:"▲";
CASE 5,11
PRINT #2:"▼";
CASE 6,12
PRINT #2:"★";
END SELECT
NEXT M
PRINT #2
NEXT L
PRINT #2
NEXT K
CLOSE #1
CLOSE #2
FUNCTION CHECK(ROW,COL)
LET C=0
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
IF ROW+L<=SIZE AND COL+M<=SIZE THEN
IF MASU(ROW+L,COL+M)=0 AND KOMA2(L,M)<>0 THEN
LET C=C+1
END IF
END IF
NEXT M
NEXT L
IF C=NSIZE THEN LET CHECK=1 ELSE LET CHECK=0
END FUNCTION
SUB PUT(ROW,COL)
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
IF KOMA2(L,M)<>0 THEN LET MASU(ROW+L,COL+M)=KOMA2(L,M)
NEXT M
NEXT L
END SUB
SUB ROTATE(ROT,P)
SELECT CASE ROT
CASE 0
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,M)=KOMA(P,L,M)
NEXT M
NEXT L
CASE 1 ! 右回転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,NSIZE-M+1)=KOMA(P,M,L)
NEXT M
NEXT L
CASE 2 ! 左回転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(NSIZE-L+1,M)=KOMA(P,M,L)
NEXT M
NEXT L
CASE 3 ! 180度回転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,M)=KOMA(P,NSIZE-L+1,NSIZE-M+1)
NEXT M
NEXT L
CASE 4 ! 左右反転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,M)=KOMA(P,L,NSIZE-M+1)
NEXT M
NEXT L
CASE 5 ! 上下反転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,M)=KOMA(P,NSIZE-L+1,M)
NEXT M
NEXT L
CASE 6 ! 左右反転左回転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(L,NSIZE-M+1)=KOMA(P,NSIZE-M+1,L)
NEXT M
NEXT L
CASE 7 ! 左右反転右回転
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
LET KOMA2(NSIZE-L+1,M)=KOMA(P,NSIZE-M+1,L)
NEXT M
NEXT L
END SELECT
END SUB
!DATA 3,2 ! トロミノ(点3つ)
!DATA " * " ! I
!DATA " * "
!DATA " * "
!
!DATA " * " ! L
!DATA " **"
!DATA " "
!DATA 4,5 ! テトロミノ(点4つ)
!DATA " * " ! I
!DATA " * "
!DATA " * "
!DATA " * "
!
!DATA " * " ! L
!DATA " * "
!DATA " ** "
!DATA " "
!
!DATA " ** " ! O
!DATA " ** "
!DATA " "
!DATA " "
!
!DATA " " ! T
!DATA "*** "
!DATA " * "
!DATA " "
!
!DATA "** " ! Z
!DATA " ** "
!DATA " "
!DATA " "
DATA 5,12 ! ペントミノ(点5つ)
DATA " " ! X
DATA " * "
DATA " *** "
DATA " * "
DATA " "
!
DATA " " ! F
DATA " ** "
DATA " ** "
DATA " * "
DATA " "
!
DATA " * " ! L
DATA " * "
DATA " * "
DATA " ** "
DATA " "
!
DATA " " ! W
DATA " * "
DATA " ** "
DATA " ** "
DATA " "
!
DATA " " ! Z
DATA " ** "
DATA " * "
DATA " ** "
DATA " "
!
DATA " * " ! I
DATA " * "
DATA " * "
DATA " * "
DATA " * "
!
DATA " * " ! N
DATA " ** "
DATA " * "
DATA " * "
DATA " "
!
DATA " " ! P
DATA " ** "
DATA " ** "
DATA " * "
DATA " "
!
DATA " " ! T
DATA " *** "
DATA " * "
DATA " * "
DATA " "
!
DATA " * " ! Y
DATA " ** "
DATA " * "
DATA " * "
DATA " "
!
DATA " " ! U
DATA " * * "
DATA " *** "
DATA " "
DATA " "
!
DATA " " ! V
DATA " * "
DATA " * "
DATA " *** "
DATA " "
END
解答
□□□□□□□
□□□□□□□
□□□●□□□
□□□●□□■
□□□●□■■
□□□●●■□
□□□□□■□
□□□□□□□
□□□□□□□
□□□□■□□
□□□■■■□
□□□▲■□□
□□□▲▲□□
□□□□▲▲□
□□□□□□□
□□□□□□■
□□□□■■■
□□□■■■□
□□□■□■□
□□□■□□□
□□□□□□□
Re: ペントミノパズル - しばっち
2025/10/13 (Mon) 08:26:34
https://ja.wikipedia.org/wiki/ヘキソミノ
コマの種類が35個になったヘキソミノです。
RANDOMIZE
LET SIZE=8
READ NSIZE,NMAX
DIM MASU(SIZE,SIZE),KOMA(NMAX,NSIZE,NSIZE)
FOR P=1 TO NMAX
FOR L=1 TO NSIZE
READ S$
FOR M=1 TO NSIZE
IF S$(M:M)="*" THEN LET KOMA(P,L,M)=P
NEXT M
NEXT L
NEXT P
OPEN #1:NAME "ヘキソミノパズル問題.txt"
OPEN #2:NAME "ヘキソミノパズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
LET NUM=0
MAT MASU=ZER
DO
FOR Q=1 TO 30 ! 試行回数
LET COL=INT(RND*SIZE+1)
LET ROW=INT(RND*SIZE+1)
LET P=INT(RND*NMAX+1)
IF CHECK(ROW,COL,P)=1 THEN
CALL PUT(ROW,COL,P)
LET NUM=NUM+1
END IF
NEXT Q
LOOP UNTIL NUM>=2 ! コマ2種類以上なら
PRINT #1:" ";
FOR M=1 TO SIZE
LET S=0
FOR L=1 TO SIZE
IF MASU(L,M)<>0 THEN LET S=S+1
NEXT L
PRINT #1,USING "##":S;
NEXT M
PRINT #1
FOR L=1 TO SIZE
LET S=0
FOR M=1 TO SIZE
IF MASU(L,M)<>0 THEN LET S=S+1
NEXT M
PRINT #1,USING "##":S;
PRINT #1:REPEAT$("□",SIZE)
NEXT L
PRINT #1
FOR L=1 TO SIZE
FOR M=1 TO SIZE
SELECT CASE MASU(L,M)
CASE 0
PRINT #2:"□";
CASE 1,7,13,19,25,31
PRINT #2:"■";
CASE 2,8,14,20,26,32
PRINT #2:"◆";
CASE 3,9,15,21,27,33
PRINT #2:"●";
CASE 4,10,16,22,28,34
PRINT #2:"▲";
CASE 5,11,17,23,29,35
PRINT #2:"▼";
CASE 6,12,18,24,30
PRINT #2:"★";
END SELECT
NEXT M
PRINT #2
NEXT L
PRINT #2
NEXT K
CLOSE #1
CLOSE #2
FUNCTION CHECK(ROW,COL,P)
LET C=0
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
IF ROW+L<=SIZE AND COL+M<=SIZE THEN
IF MASU(ROW+L,COL+M)=0 AND KOMA(P,L,M)<>0 THEN
LET C=C+1
END IF
END IF
NEXT M
NEXT L
IF C=NSIZE THEN LET CHECK=1 ELSE LET CHECK=0
END FUNCTION
SUB PUT(ROW,COL,P)
FOR L=1 TO NSIZE
FOR M=1 TO NSIZE
IF KOMA(P,L,M)<>0 THEN LET MASU(ROW+L,COL+M)=KOMA(P,L,M)
NEXT M
NEXT L
END SUB
DATA 6,35 ! ヘキソミノ(点6つ)
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 " ** "
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 " "
!
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 " **** "
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 " "
!
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 " *** "
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 " "
!
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 " ** "
DATA " ** "
DATA " "
DATA " "
!
DATA " "
DATA " * "
DATA " *** "
DATA " * * "
DATA " "
DATA " "
!
DATA " "
DATA " * "
DATA " *** "
DATA " * * "
DATA " "
DATA " "
!
DATA " "
DATA " ** "
DATA " ** "
DATA " ** "
DATA " "
DATA " "
END
拡張されたMAT文 - nagram
2025/10/05 (Sun) 20:50:43
Ver.7.8.7.4 で行列計算ができるようになり、一時的に結果を入れておく配列も不要になりコードがすっきりします。活用させてもらいます。
●気になることが一つあります。
既存のMAT文では、右辺の結果が1次元の場合は行ベクトルでも列ベクトルでも1次元の配列に代入します。
ところが拡張したMAT文では、行列計算の結果が行ベクトルの場合は1次元の配列に、列ベクトルの場合は2次元の配列に代入します。
結果が列ベクトルの場合、右辺が [配列*配列] か [行列計算式] かで代入する配列を1次元にするか2次元にするか決めなければいけません。
これは利用者にとってはわかりづらいことです。
DIM A(3,3),B(3,3),C1(3), P(3,1),Q(1,3), X1(3),Y1(3)
MAT READ A,B,C1
DATA 1,-3,2 , 0,-1,4 , 3,2,0
DATA 2,1,0 , -3,4,1 , 1,0,-2
DATA 3,2,-1
MAT X1=A*C1 ! 既存の配列計算 (C1を列ベクトルと解釈)
MAT PRINT X1; ! 数学的には X1 は列ベクトル
MAT Y1=C1*A ! 既存の配列計算 (C1を行ベクトルと解釈)
MAT PRINT Y1; ! 数学的には Y1 は行ベクトル
! MAT X1=(A+B)*C1 ! 翻訳時エラー
MAT P=(A+B)*C1 ! 行列計算 (結果は3行×1列の2次元配列)
MAT PRINT P
! MAT P=A*C1 ! 翻訳時エラー
MAT Y1=C1*(A+B) ! エラーにはならない (結果は1次元配列)
MAT PRINT Y1;
! MAT Q=C1*(A+B) ! 翻訳時エラー
END
●提案ですが、既存のMAT文は規格のままにして、行列計算には例えば MATRIX など別の命令文を導入してはどうでしょうか。
そして行列計算の結果を代入する配列を2次元に限定すればわかりやすいと思うのですが、いかがでしょうか。
これに従えば、上記の行列計算は次のようになります。
MAT X1=A*C1
MAT Y1=C1*A
MATRIX P=A*C1
MATRIX Q=C1*A
MATRIX P=(A+B)*C1
MATRIX Q=C1*(A+B)
MAT Y1=C1*(A+B) はエラーとする(現行ではOK)
MATRIX Y1=C1*(A+B) はエラーとする
1次元+1次元 の演算結果も MATRIX文では2次元とします
MAT Y1=C1+X1 結果は 1次元
MATRIX Q=C1+X1 結果を 1行×3列の2次元として代入
●もう一つ質問があります。
MAT M=TRN([行列計算式]) と MAT TRN(M)=[行列計算式] は同じ結果になると思うのですが、
[行列計算式]が1次元の場合は異なる結果になります。
異なる結果になるよう設定した意図を教えていただければありがたいです。
MAT P=TRN(X1+Y1)
PRINT "(";SIZE(P,1);",";SIZE(P,2);") … Pのサイズ"
MAT PRINT P
MAT TRN(P)=X1+Y1
PRINT "(";SIZE(P,1);",";SIZE(P,2);") … Pのサイズ"
MAT PRINT P;
END
Re: 拡張されたMAT文 - SHIRAISHI Kazuo
2025/10/06 (Mon) 08:06:02
一次元配列にTRNを適用できるように拡張しています。ただし，TRNを取った結果は2次元で，そのTRNも2次元になります。
行列と縦ベクトルの積は，
10 DIM a(3,3), x(3) ,y(3)
20 MAT y=a*x
30 MAT TRN(y)=a*TRN(x)
40 MAT y=TRN(a*TRN(x))
50 END
Full BASIC規格は20行ですが，
30行のように書けることを目的に左辺にTRNを書く文法を追加しています。
40行のように書けるためには，文法的に縦ベクトルを判別することが必要で，将来構想の段階(進行中)です。
Re: 拡張されたMAT文 - nagram
2025/10/06 (Mon) 20:42:07
早々の回答、ありがとうございます。
JIS規格の難点の一つは、1次元配列が横ベクトルとしても縦ベクトルとしても利用できることだと思います。
構想進行中とのことですので、期待してます。
Re: 拡張されたMAT文 - SHIRAISHI Kazuo
2025/10/07 (Tue) 13:13:02
第2掲示板（過去ログ）人の色覚の数理
https://decimalbasic.ninja-web.net/bbs2/ColorVision.html
[3]の処理をするプログラムが次のようにL,M,Sやr,g,bなどの意味のある変数名のもとで作成できるようになります。
100 LET fn$="E:\Users\*********\Downloads\linss2_10e_fine.csv"
110 DATA 5.89749E-03, 3.65317E-04, 0 ! 700 nm (Red)
120 DATA 9.24341E-01, 9.93742E-01, 2.85277E-03 ! 546.1nm (Green)
130 DATA 3.51131E-02, 5.39344E-02, 9.19756E-01 ! 435.8nm (Blue)
140 DIM A(3,3)
150 MAT READ A
160 SET WINDOW 390,830,-25,100
170 DRAW grid(50,10)
180 SET POINT STYLE 1
190 OPEN #1: NAME fn$, ACCESS INPUT, RECTYPE CSV
200 DO
210 READ #1,IF MISSING THEN EXIT DO: w,L,M,S
220 MAT [r,g,b]=[L,M,S]*INV(A)
230 PRINT w,r,g,b
240 SET POINT COLOR "RED"
250 PLOT POINTS:w,r
260 SET POINT COLOR "GREEN"
270 PLOT POINTS:w,g
280 SET POINT COLOR "BLUE"
290 PLOT points:w,b
300 LOOP
310 CLOSE #1
320 END
ここで用いているデータlinss2_10e_fine.csvは
Colour & Vision Research laboratory http://cvrl.ioo.ucl.ac.uk/index.htm
からダウンロードできます。詳細は上掲掲示板過去ログを参照してください。
CLEAR文が実行されてない - しばっち
2025/10/05 (Sun) 07:21:54
WINDOW版十進BASIC7873にて毎回クリアされて
ライン(単色のみ)が描かれるはずですが、途中描画でクリアされず(複数色表示される)上書きされている。
最後に本来描かれるはずの(最終結果は正しい)画像が表示されるため
WAIT文がないと速すぎてわからない(気付かない)
FOR J=1 TO 5
CLEAR
SET LINE COLOR J
FOR I=1 TO 100
PLOT LINES:RND,RND;
NEXT I
WAIT DELAY 1
NEXT J
END
Re: CLEAR文が実行されてない - SHIRAISHI Kazuo
2025/10/05 (Sun) 08:43:53
ご報告ありがとうございました。
修正します(というか，元に戻します)。
Ver. 0.9 のバグ（修正済み） - SHIRAISHI Kazuo
2025/09/30 (Tue) 13:53:52
Ver. 0.9（～0.9.2.8）に実行スレッド上で実行しなければならない命令を計算スレッド上で実行するバグを発見しました。
実行中のプログラムを突発的に突然終了させてしまう不具合の原因になります。
修正版をver.0.9.3.0としてアップロードしました。
https://decimalbasic.web.fc2.com/BASICGenJa.htm
なお，Ver. 0.9.3.0では，MAT文に行列の計算式が書けるようにしました。
数独 - 永野護
2025/09/23 (Tue) 13:39:14
しばっち様、ありがとうございました。私が提示したpythonコードはcopilotかchatgptで作ったものですが、私には移植できなかったのでお頼みしました。ご多忙の中、ご協力いただきましたことに深く感謝します。
数独 - 永野護
2025/09/20 (Sat) 18:04:28
下記は数独を解くpythonコードです。十進basicに移植したらどうなるでしょうか。
# 数独全解探索プログラム (バックトラック法)
# --- 問題データ（0は空白） ---
board = [
[5,3,0,0,7,0,0,0,0],
[6,0,0,1,9,5,0,0,0],
[0,9,8,0,0,0,0,6,0],
[8,0,0,0,6,0,0,0,3],
[4,0,0,8,0,3,0,0,1],
[0,0,0,0,2,0,0,0,6],
[0,6,0,0,0,0,2,8,0],
[0,0,0,0,1,9,0,0,0],
[0,0,0,0,8,0,0,0,0]
]
solution_count = 0
def print_board(b):
"""盤面を表示"""
for r in range(9):
for c in range(9):
print(b[r][c], end=" ")
print()
print()
def is_valid(b, r, c, num):
"""(r,c) に num を置けるか判定"""
# 行チェック
# if num in b[r]:
for i in range(9):
if b[r][i]==num:
return False
# 列チェック
for i in range(9):
if b[i][c] == num:
return False
# 3x3 ブロックチェック
r0 = (r // 3) * 3
c0 = (c // 3) * 3
for i in range(3):
for j in range(3):
if b[r0+i][c0+j] == num:
return False
return True
def solve(b):
"""バックトラックで全解探索"""
global solution_count
for r in range(9):
for c in range(9):
if b[r][c] == 0:
for num in range(1, 10):
if is_valid(b, r, c, num):
b[r][c] = num
solve(b)
b[r][c] = 0
return # このマスが埋まらなければ戻る
# 空マスがない = 解を発見
solution_count += 1
print(f"---- 解 {solution_count} ----")
print_board(b)
# --- 実行 ---
solve(board)
print("総解数 =", solution_count)
Re: 数独 - SHIRAISHI Kazuo
2025/09/22 (Mon) 12:46:06
問題データの記述はDATA文，配列への読み込みはMAT READ，
大域変数solution_countはモジュールのPUBLIC変数に，
True, Falseは数値の1，0か，文字列の"Y',"N"で代用する，
といったところでしょうか。
Re: 数独 - しばっち
2025/09/23 (Tue) 07:53:02
pythonプログラムから十進basicへの移植を人工知能AI(copilot)に頼んでみた。
一部若干の修正が必要でしたが、ほぼ完ぺきに移植できていました。
移植とは2つの言語理解を必要とする高度な作業ですが
どうやらAIでも行えるようです。
これからはAIを活用していくことで言語習得の手助けとなりそうです。
PUBLIC NUMERIC SOLUTION_COUNT
!' --- 問題データ（0は空白） ---
DIM board(1 TO 9, 1 TO 9)
DATA 5,3,0,0,7,0,0,0,0
DATA 6,0,0,1,9,5,0,0,0
DATA 0,9,8,0,0,0,0,6,0
DATA 8,0,0,0,6,0,0,0,3
DATA 4,0,0,8,0,3,0,0,1
DATA 0,0,0,0,2,0,0,0,6
DATA 0,6,0,0,0,0,2,8,0
DATA 0,0,0,0,1,9,0,0,0
DATA 0,0,0,0,8,0,0,0,0
FOR i = 1 TO 9
FOR j = 1 TO 9
READ board(i,j)
NEXT j
NEXT i
LET solution_count = 0
!' --- 実行 ---
CALL solve(board)
PRINT "総解数 ="; solution_count
END
!' --- 盤面表示 ---
EXTERNAL SUB print_board(b(,))
FOR r = 1 TO 9
FOR c = 1 TO 9
PRINT b(r,c);
NEXT c
PRINT
NEXT r
PRINT
END SUB
!' --- (r,c) に num を置けるか判定 ---
EXTERNAL FUNCTION is_valid(b(,), r, c, num)
!' 行チェック
FOR i = 1 TO 9
IF b(r,i) = num THEN
LET is_valid = 0
EXIT FUNCTION
END IF
NEXT i
!' 列チェック
FOR i = 1 TO 9
IF b(i,c) = num THEN
LET is_valid = 0
EXIT FUNCTION
END IF
NEXT i
!' 3x3 ブロックチェック
LET r0 = INT((r - 1) / 3) * 3 + 1
LET c0 = INT((c - 1) / 3) * 3 + 1
FOR i = 0 TO 2
FOR j = 0 TO 2
IF b(r0 + i, c0 + j) = num THEN
LET is_valid = 0
EXIT FUNCTION
END IF
NEXT j
NEXT i
LET is_valid = 1
END FUNCTION
!' --- バックトラックで全解探索 ---
EXTERNAL SUB solve(b(,))
FOR r = 1 TO 9
FOR c = 1 TO 9
IF b(r,c) = 0 THEN
FOR num = 1 TO 9
IF is_valid(b, r, c, num)=1 THEN
LET b(r,c) = num
CALL solve(b)
LET b(r,c) = 0
END IF
NEXT num
EXIT SUB
END IF
NEXT c
NEXT r
!' 空マスがない = 解を発見
LET solution_count = solution_count + 1
PRINT "---- 解"; solution_count; " ----"
CALL print_board(b)
END SUB
実行結果
---- 解 1 ----
5 3 1 6 7 8 4 9 2
6 2 4 1 9 5 3 7 8
7 9 8 3 4 2 1 6 5
8 1 2 9 6 4 7 5 3
4 7 6 8 5 3 9 2 1
3 5 9 7 2 1 8 4 6
1 6 5 4 3 7 2 8 9
2 8 7 5 1 9 6 3 4
9 4 3 2 8 6 5 1 7
---- 解 2 ----
5 3 1 6 7 8 4 9 2
6 2 4 1 9 5 3 7 8
7 9 8 3 4 2 1 6 5
8 1 2 9 6 4 7 5 3
4 7 6 8 5 3 9 2 1
9 5 3 7 2 1 8 4 6
1 6 5 4 3 7 2 8 9
2 8 7 5 1 9 6 3 4
3 4 9 2 8 6 5 1 7
---- 解 3 ----
5 3 1 6 7 8 4 9 2
6 2 4 1 9 5 3 7 8
7 9 8 3 4 2 1 6 5
8 1 2 9 6 4 7 5 3
4 7 6 8 5 3 9 2 1
9 5 3 7 2 1 8 4 6
1 6 9 5 3 7 2 8 4
2 8 5 4 1 9 6 3 7
3 4 7 2 8 6 5 1 9
中略
---- 解 130 ----
5 3 4 6 7 8 9 1 2
6 7 2 1 9 5 3 4 8
1 9 8 4 3 2 5 6 7
8 5 9 7 6 1 4 2 3
4 2 6 8 5 3 7 9 1
7 1 3 9 2 4 8 5 6
3 6 1 5 4 7 2 8 9
2 8 5 3 1 9 6 7 4
9 4 7 2 8 6 1 3 5
---- 解 131 ----
5 3 4 6 7 8 9 1 2
6 7 2 1 9 5 3 4 8
1 9 8 4 3 2 5 6 7
8 5 9 7 6 1 4 2 3
4 2 6 8 5 3 7 9 1
7 1 3 9 2 4 8 5 6
9 6 1 3 4 7 2 8 5
2 8 7 5 1 9 6 3 4
3 4 5 2 8 6 1 7 9
---- 解 132 ----
5 3 4 6 7 8 9 1 2
6 7 2 1 9 5 3 4 8
1 9 8 4 3 2 5 6 7
8 5 9 7 6 1 4 2 3
4 2 6 8 5 3 7 9 1
7 1 3 9 2 4 8 5 6
9 6 1 3 4 7 2 8 5
3 8 5 2 1 9 6 7 4
2 4 7 5 8 6 1 3 9
総解数 = 132
無題 - 永野護
2025/09/22 (Mon) 23:31:21
有難うございました。
数式パズル - しばっち
2025/09/14 (Sun) 07:33:53
数式パズル
実行すると下記のような問題をファイルに出力します。
数字の間にプラス(+)かマイナス(-)を入れて
数式を完成させるパズルです。
※テキストエディタで開くか印刷してから利用してください。
問題
8 6 8 9 = 1
6 6 9 7 = 10
1 4 8 6 = 7
4 9 2 8 = 1
3 6 5 8 = 12
RANDOMIZE
LET N=4 ! 項数
DIM NUM(N),SIGN(N)
OPEN #1:NAME "数式パズル問題.txt"
OPEN #2:NAME "数式パズル解答.txt"
ERASE #1
ERASE #2
FOR J=1 TO 20 ! 問題数
DO
LET SUM=0
FOR I=1 TO N
LET NUM(I)=INT(RND*9+1)
IF I=1 THEN
LET SIGN(1)=1 ! 先頭はプラス
ELSE
LET SIGN(I)=(-1)^INT(2*RND)
END IF
LET SUM=SUM+NUM(I)*SIGN(I)
NEXT I
LOOP WHILE SUM<0 OR SUM>20 ! 0～20迄の範囲
FOR I=1 TO N
PRINT #1:NUM(I);
NEXT I
PRINT #1:"=";SUM
FOR I=1 TO N
LET S=SIGN(I)
IF I>1 THEN
IF S>0 THEN PRINT #2:"+"; ELSE PRINT #2:"-";
END IF
PRINT #2:NUM(I);
NEXT I
PRINT #2:"=";SUM
NEXT J
CLOSE #1
CLOSE #2
END
解答
8 - 6 + 8 - 9 = 1
6 + 6 - 9 + 7 = 10
1 + 4 + 8 - 6 = 7
4 - 9 - 2 + 8 = 1
3 + 6 - 5 + 8 = 12
------------------------------------------------------------------------------
DLLによるパーサー(数式解析器)を利用して
足し算と引き算に掛け算と割り算にかっこも使用した
問題をファイルに出力します。
プログラムが手抜きなので表記のおかしなところもありますが
難易度は格段に上がるかと思います。
更に(%)剰余、(^)ペキ乗、(&)and演算、(|)or演算も追加できます。
問題
7 6 7 1 = 1
10 6 10 5 = 15
9 4 2 10 = 1
4 5 4 4 = 1
9 1 5 2 = 9
2 6 6 8 = 1
2 5 5 2 = 2
1 1 3 3 = 13
4 7 5 4 = 0
1 3 7 9 = 1
VC++2022でコンパイルしました。
下記からダウンロードしてください。parser.zip
https://106.gigafile.nu/1113-b721e75329147bc93b924352188c2f121
ダウンロード期限：2025年11月13日(木)
ダウンロードパス:設定していません
ヘッダーライブラリーです。(インクルードするだけで使えます)
下記からダウンロードしてこの下にあるcppソースからコンパイルできます。
https://www.partow.net/programming/exprtk/index.html#downloads
https://github.com/ArashPartow/exprtk/tree/master
RANDOMIZE
LET N=4
DIM TERM$(N),NUM$(N),K$(N),KK$(N)
LET A$="+-*/"
! A$="+-*/%^&|"
OPEN #1:NAME "数式パズル問題.txt"
OPEN #2:NAME "数式パズル解答.txt"
ERASE #1
ERASE #2
FOR J=1 TO 50
DO
DO
IF RND<.5 THEN
MAT KK$=NUL$
DO
MAT K$=NUL$
LET P1=INT(RND*N+1)
LET K$(P1)="("
LET P2=INT(RND*N+1)
LOOP WHILE P1>=P2
LET KK$(P2)=")"
END IF
LET ER=0
FOR I=1 TO N
LET P=INT(RND*LEN(A$)+1)
LET TERM$(I)=A$(P:P)
IF TERM$(I)="^" AND ER=0 THEN LET ER=1
LET NUM$(I)=STR$(INT(10*RND+1))
NEXT I
LOOP UNTIL ER=0
LET FORMULA$=""
LET F$=""
FOR I=1 TO N-1
LET FORMULA$=FORMULA$&K$(I)&NUM$(I)&KK$(I)&TERM$(I)
LET F$=F$&NUM$(I)&" "
NEXT I
LET FORMULA$=FORMULA$&NUM$(N)
LET F$=F$&NUM$(I)
CALL PARSER(FORMULA$,ANS,ERR)
LOOP UNTIL ERR=0 AND ANS>=0 AND ANS<=100 AND FP(ANS)=0
PRINT #2:FORMULA$;" =";ANS
PRINT #1:F$;" =";ANS
NEXT J
CLOSE #1
CLOSE #2
END
EXTERNAL SUB PARSER(X$,ANS,ERR)
OPTION CHARACTER BYTE
LET ERR$=REPEAT$(" ",4)
IF X$="" THEN
LET ERR=1
LET ANS=0
EXIT SUB
END IF
LET ANS=PARSER16(LCASE$(X$),ERR$)
LET ERR=INT32(ERR$)
FUNCTION PARSER16(X$,ERR$)
ASSIGN ".\DLL\parser-exprtk.dll","parser16",FPU
END FUNCTION
END SUB
EXTERNAL FUNCTION INT32(S$)
OPTION CHARACTER BYTE
FOR I=1 TO 4
LET N=N+256^(I-1)*ORD(S$(I:I))
NEXT I
LET INT32=MOD(N+2^31,2^32)-2^31
END FUNCTION
------------------------------------------------------------------------------
parser-exprtk.cpp
#include <cstdio>
#include <cmath>
#include <string>
#include <exprtk.hpp>
using namespace std;
extern "C" __declspec(dllexport) double parser16(char *input,int *err)
{
typedef exprtk::symbol_table<double> symbol_table_t;
typedef exprtk::expression<double> expression_t;
typedef exprtk::parser<double> parser_t;
double y;
string expression_string = input;
symbol_table_t symbol_table;
symbol_table.add_constants();
expression_t expression;
expression.register_symbol_table(symbol_table);
parser_t parser;
try {
if (parser.compile(expression_string,expression)) {
y = expression.value();
*err=0;
return y;
}
*err=1;
return 0;
} catch(...) {
*err=1;
return 0.0;
}
}
解答
7&6*7-1 = 1
10%(6*10)+5 = 15
9|(4-2)&10 = 1
4*(5|4)|4 = 1
9^(1%5)^2 = 9
(2|6)*6|8 = 1
2^(5|5)^2 = 2
1+(1+3)*3 = 13
4%(7&5)&4 = 0
1+(3+7)&9 = 1
------------------------------------------------------------------------------
数式解析にSAMPLEフォルダ内のINTERPRE.basを使用してみました。
DECLARE EXTERNAL FUNCTION interpreter.expression ! 数値式を評価する関数
DECLARE EXTERNAL STRING interpreter.s$ ! 入力行
DECLARE EXTERNAL NUMERIC interpreter.i ! 入力行の文字位置
DECLARE EXTERNAL NUMERIC interpreter.ERR
DECLARE EXTERNAL SUB interpreter.skip ! 空白文字を読み飛ばす副プログラム
RANDOMIZE
LET N=4
DIM TERM$(N),NUM$(N),K$(N),KK$(N)
LET A$="+-*/"
! A$="+-*/%\^&|<>@"
OPEN #1:NAME "算数パズル問題.txt"
OPEN #2:NAME "算数パズル解答.txt"
ERASE #1
ERASE #2
FOR J=1 TO 50
DO
DO
MAT KK$=NUL$
IF RND<.5 THEN
DO
MAT K$=NUL$
LET P1=INT(RND*N+1)
LET K$(P1)="("
LET P2=INT(RND*N+1)
LOOP WHILE P1>=P2
LET KK$(P2)=")"
END IF
LET ER=0
FOR I=1 TO N
LET P=INT(RND*LEN(A$)+1)
LET TERM$(I)=A$(P:P)
IF TERM$(I)="^" AND ER=0 THEN LET ER=1
LET NUM$(I)=STR$(INT(10*RND+1))
NEXT I
LOOP UNTIL ER=0
LET S$=""
LET F$=""
FOR I=1 TO N-1
LET S$=S$&K$(I)&NUM$(I)&KK$(I)&TERM$(I)
LET F$=F$&NUM$(I)&" "
NEXT I
IF KK$(N)<>"" THEN
LET S$=S$&NUM$(N)&KK$(N)
LET F$=F$&NUM$(N)&KK$(N)
ELSE
LET S$=S$&NUM$(N)
LET F$=F$&NUM$(N)
END IF
LET I=1
LET ERR=0
CALL SKIP
LET ANS=EXPRESSION
LOOP UNTIL ERR=0 AND ANS>=0 AND ANS<=100 AND FP(ANS)=0
PRINT #2:S$;" =";ANS
PRINT #1:F$;" =";ANS
NEXT J
CLOSE #1
CLOSE #2
END
1200 MODULE interpreter
1210 PUBLIC STRING s$
1220 PUBLIC NUMERIC i,ERR
1230 PUBLIC FUNCTION expression
1240 PUBLIC SUB skip
1250 SHARE FUNCTION term,factor,primary,numeric
1260 !
1270 EXTERNAL SUB skip
1280 DO WHILE s$(i:i)=" "
1290 LET i=i+1
1300 LOOP
1310 END SUB
1320 !
1330 EXTERNAL FUNCTION expression
1340 DECLARE NUMERIC n
1350 DECLARE STRING op$
1360 SELECT CASE s$(i:i)
1370 CASE "-"
1380 LET i=i+1
1390 CALL skip
1400 LET n=-term
1410 CASE "+"
1420 LET i=i+1
1430 CALL skip
1440 LET n=term
1450 CASE ELSE
1460 LET n=term
1470 END SELECT
1480 DO WHILE s$(i:i)="+" OR s$(i:i)="-" OR S$(I:I)=">" OR S$(I:I)="<"
1490 LET op$=s$(i:i)
1500 LET i=i+1
1510 CALL skip
1520 IF op$="+" THEN LET n=n+term
IF OP$="-" THEN LET n=n-term
IF OP$="<" THEN LET N=MIN(N,TERM)
IF OP$=">" THEN LET N=MAX(N,TERM)
1530 LOOP
IF ERR=1 THEN EXIT FUNCTION
1540 LET expression =n
1550 CALL skip
1560 END FUNCTION
1570 !
1580 EXTERNAL FUNCTION term
1590 DECLARE NUMERIC n
1600 DECLARE STRING op$
1610 LET n=factor
1620 DO WHILE s$(i:i)="*" OR s$(i:i)="/" OR S$(I:I)="%" OR S$(I:I)="\" OR S$(I:I)="@"
1630 LET op$=s$(i:i)
1640 LET i=i+1
1650 CALL skip
1660 IF op$="*" THEN LET n=n*factor
IF OP$="/" THEN
LET M=FACTOR
IF M=0 THEN
LET ERR=1
EXIT FUNCTION
ELSE
LET n=n/M
END IF
END IF
IF OP$="%" THEN
LET M=FACTOR
IF M=0 THEN
LET ERR=1
EXIT FUNCTION
ELSE
LET N=MOD(N,M)
END IF
END IF
IF OP$="\" THEN
LET M=FACTOR
IF M=0 THEN
LET ERR=1
EXIT FUNCTION
ELSE
LET N=IP(N/M)
END IF
END IF
IF OP$="@" THEN LET N=(N+FACTOR)/2
1670 LOOP
1680 LET term=n
1690 END FUNCTION
1700 !
1710 EXTERNAL FUNCTION factor
1720 DECLARE NUMERIC n
1730 LET n=primary
1740 DO WHILE s$(i:i)="^" OR S$(I:I)="&" OR S$(I:I)="|" OR S$(I:I)="~"
1750 LET i=i+1
1760 CALL skip
IF OP$="^" THEN LET n=n^primary
IF OP$="&" THEN LET N=BITAND(N,PRIMARY)
IF OP$="|" THEN LET N=BITOR(N,PRIMARY)
IF OP$="~" THEN LET N=BITXOR(N,PRIMARY)
1780 LOOP
1790 LET factor=n
1800 END FUNCTION
1810 !
1820 EXTERNAL FUNCTION primary
1830 IF s$(i:i)>="0" AND s$(i:i)<="9" THEN
1840 LET primary=NUMERIC
1850 ELSEIF s$(i:i+1)="PI" THEN
1860 LET i=i+2
1870 CALL SKIP
1880 LET primary=PI
1890 ELSE
1900 IF s$(i:i)="(" THEN
1910 LET i=i+1
1920 CALL SKIP
1930 LET primary=expression
1940 ELSEIF s$(i:i+3)="SIN(" THEN
1950 LET i=i+4
1960 CALL SKIP
1970 LET Primary=SIN(expression)
1980 ELSEIF s$(i:i+3)="COS(" THEN
1990 LET i=i+4
2000 CALL SKIP
2010 LET Primary=COS(expression)
2020 ELSEIF s$(i:i+3)="TAN(" THEN
2030 LET i=i+4
2040 CALL SKIP
2050 LET Primary=TAN(expression)
2060 ELSEIF s$(i:i+3)="LOG(" THEN
2070 LET i=i+4
2080 CALL SKIP
2090 LET Primary=LOG(expression)
2100 ELSEIF s$(i:i+3)="EXP(" THEN
2110 LET i=i+4
2120 CALL SKIP
2130 LET Primary=EXP(expression)
2140 ELSEIF s$(i:i+3)="SQR(" THEN
2150 LET i=i+4
2160 CALL SKIP
2170 LET Primary=SQR(expression)
2180 ELSEIF s$(i:i+3)="INT(" THEN
2190 LET i=i+4
2200 CALL SKIP
2210 LET Primary=INT(expression)
2220 ELSEIF s$(i:i+3)="ABS(" THEN
2230 LET i=i+4
2240 CALL SKIP
2250 LET Primary=ABS(expression)
2260 ELSE
2270 LET ERR=1
2280 EXIT FUNCTION
2290 END IF
2300 IF s$(i:i)=")" THEN
2310 LET i=i+1
2320 CALL skip
2330 ELSE
2340 LET ERR=1
2350 EXIT FUNCTION
2360 END IF
2370 END IF
2380 END FUNCTION
2390 !
2400 EXTERNAL FUNCTION numeric
2410 DECLARE NUMERIC i0
2420 CALL skip
2430 LET i0=i
2440 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
2450 LET i=i+1
2460 LOOP
2470 IF s$(i:i)="." THEN LET i=i+1
2480 DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
2490 LET i=i+1
2500 LOOP
2510 LET numeric=VAL(s$(i0:i-1))
2520 CALL skip
2530 END FUNCTION
2540 !
2550 END MODULE
Re: 数式パズル - しばっち
2025/09/14 (Sun) 07:35:27
実行すると下記のような問題を出力します。
〇に1か2を入れて足し算を完成させるパズルです。
https://warabe.or.jp/airwarabe4/?gad_source=1&gclid=EAIaIQobChMIlcyvz7z5igMVYtcWBR2LOSM2EAMYASAAEgIW2fD_BwE
但し、乱数使用の為場合によって
〇+〇+1+2
〇+〇+2+1
と
〇+〇+2+1
〇+〇+1+2
のような入れ替わりで解が複数存在する場合があります。
〇+〇+〇+〇= 8
+ + + +
〇+〇+〇+〇= 6
+ + + +
〇+〇+〇+〇= 6
+ + + +
〇+〇+〇+〇= 6
= = = =
7 6 8 5
〇+〇+〇+〇= 6
+ + + +
〇+〇+〇+〇= 7
+ + + +
〇+〇+〇+〇= 5
+ + + +
〇+〇+〇+〇= 5
= = = =
6 7 5 5
〇+〇+〇+〇= 5
+ + + +
〇+〇+〇+〇= 8
+ + + +
〇+〇+〇+〇= 6
+ + + +
〇+〇+〇+〇= 5
= = = =
5 5 8 6
RANDOMIZE
LET N=4 ! 項数
DIM M(N,N),B(N),C(N)
DIM NUM(2)
MAT READ NUM
DATA 1,2 ! 使用する数値(1,2以外も指定できる。個数を3つ以上にもできます)
OPEN #1:NAME "丸数字足し算問題.txt"
OPEN #2:NAME "丸数字足し算解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
MAT B=ZER
MAT C=ZER
FOR I=1 TO N
FOR J=1 TO N
LET M(I,J)=NUM(INT(RND*UBOUND(NUM,1)+1))
NEXT J
NEXT I
FOR J=1 TO N
FOR I=1 TO N
LET B(I)=B(I)+M(J,I)
NEXT I
NEXT J
FOR J=1 TO N
FOR I=1 TO N
LET C(J)=C(J)+M(J,I)
NEXT I
NEXT J
FOR J=1 TO N
FOR I=1 TO N-1
PRINT #1:"〇+";
NEXT I
PRINT #1:"〇=";B(J)
IF J<N THEN PRINT #1:" ";REPEAT$("+ ",N)
NEXT J
FOR J=1 TO N
FOR I=1 TO N-1
PRINT #2:M(I,J);"+";
NEXT I
PRINT #2:M(N,J);"=";B(J)
IF J<N THEN PRINT #2:REPEAT$(" + ",N)
NEXT J
FOR I=1 TO N
PRINT #1:" = ";
PRINT #2:" = ";
NEXT I
PRINT #1
PRINT #2
FOR I=1 TO N
PRINT #1:C(I);
PRINT #2:C(I);" ";
NEXT I
PRINT #1
PRINT #1
PRINT #2
PRINT #2
NEXT K
CLOSE #1
CLOSE #2
END
解答
2 + 2 + 2 + 2 = 8
+ + + +
2 + 1 + 2 + 1 = 6
+ + + +
2 + 1 + 2 + 1 = 6
+ + + +
1 + 2 + 2 + 1 = 6
= = = =
7 6 8 5
2 + 2 + 1 + 1 = 6
+ + + +
2 + 2 + 2 + 1 = 7
+ + + +
1 + 1 + 1 + 2 = 5
+ + + +
1 + 2 + 1 + 1 = 5
= = = =
6 7 5 5
1 + 1 + 2 + 1 = 5
+ + + +
2 + 2 + 2 + 2 = 8
+ + + +
1 + 1 + 2 + 2 = 6
+ + + +
1 + 1 + 2 + 1 = 5
= = = =
5 5 8 6
------------------------------------------------------------------------------------
実行すると下記のような足し算だけではなく、引き算も加えた問題を出力します。
Xに1か2を入れるパズルです。
+ X - X + X - X =-1
+ X + X + X + X = 6
+ X - X + X + X = 1
+ X + X - X - X = 1
= = = =
7 -2 3 -1
- X - X - X - X =-6
+ X - X - X + X = 0
+ X - X - X + X = 1
- X + X - X + X =-1
= = = =
-1 -3 -5 3
+ X + X - X - X = 1
+ X + X + X - X = 3
- X - X - X + X =-1
+ X + X + X - X = 2
= = = =
4 4 1 -4
RANDOMIZE
LET N=4
DIM NUM(N,N),SIGN(N,N),YOKO(N),TATE(N)
DIM NUMBER(2)
MAT READ NUMBER
DATA 1,2 ! 使用する数
OPEN #1:NAME "数字和算減算問題.txt"
OPEN #2:NAME "数字和算減算解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
MAT YOKO=ZER
MAT TATE=ZER
FOR J=1 TO N
FOR I=1 TO N
LET NUM(J,I)=NUMBER(INT(RND*UBOUND(NUMBER,1)+1))
LET SIGN(J,I)=(-1)^INT(2*RND)
NEXT I
NEXT J
FOR J=1 TO N
FOR I=1 TO N
LET TATE(I)=TATE(I)+NUM(J,I)*SIGN(J,I)
NEXT I
NEXT J
FOR J=1 TO N
FOR I=1 TO N
LET YOKO(J)=YOKO(J)+NUM(J,I)*SIGN(J,I)
NEXT I
NEXT J
FOR J=1 TO N
FOR I=1 TO N
PRINT #1:" ";SIGN$(SIGN(J,I));" X";
NEXT I
PRINT #1:" =";YOKO(J)
NEXT J
FOR J=1 TO N
FOR I=1 TO N
PRINT #2:SIGN$(SIGN(J,I));NUM(J,I);
NEXT I
PRINT #2:" =";YOKO(J)
NEXT J
PRINT #1:" ";
PRINT #2:" ";
PRINT #1:REPEAT$(" = ",N);
PRINT #2:REPEAT$(" = ",N);
PRINT #1
PRINT #2
PRINT #1:" ";
FOR I=1 TO N
PRINT #1:" ";TATE(I);
PRINT #2:" ";TATE(I);
NEXT I
PRINT #1
PRINT #1
PRINT #2
PRINT #2
NEXT K
CLOSE #1
CLOSE #2
END
EXTERNAL FUNCTION SIGN$(X)
IF X<0 THEN LET SIGN$="-" ELSE LET SIGN$="+"
END FUNCTION
解答
+ 2 - 2 + 1 - 2 =-1
+ 2 + 1 + 2 + 1 = 6
+ 1 - 2 + 1 + 1 = 1
+ 2 + 1 - 1 - 1 = 1
= = = =
7 -2 3 -1
- 2 - 2 - 1 - 1 =-6
+ 1 - 1 - 1 + 1 = 0
+ 2 - 1 - 2 + 2 = 1
- 2 + 1 - 1 + 1 =-1
= = = =
-1 -3 -5 3
+ 2 + 2 - 1 - 2 = 1
+ 1 + 2 + 2 - 2 = 3
- 1 - 1 - 1 + 2 =-1
+ 2 + 1 + 1 - 2 = 2
= = = =
4 4 1 -4
Re: 数式パズル - しばっち
2025/09/14 (Sun) 07:37:18
実行すると下記のような問題を出力します。
各A,B,C,Dには同じ数字が入ります。
A,B,C,Dには1か2か3か4が入ります。
+ D - A + C + B = 6
+ A - A / C - B =-4
- A - D * B - A =-16
- A - A - B + D =-5
= = = =
1 -9 0 1
+ A - C - A + C = 0
+ D + A / A - B = 0
- B + D - B * C =-5
- C + A - D + B = 2
= = = =
0 6 -8 1
+ D + A + A - C = 6
+ A + C - A * B =-5
+ D - B + C * A = 1
- A - A - D + A =-5
= = = =
6 -3 -2 -6
RANDOMIZE
LET PARA=4 ! パラメータ数 A,B,C,D... PARA>=2
LET N=4 ! 項数
DIM NUM(N,N),OPERATOR(N,N),ROW(N),COL(N),OP$(4),TERM$(PARA),NUMBER(PARA)
MAT READ OP$
DATA "+","-","*","/"
FOR I=1 TO PARA
READ TERM$(I) ! ! 置き換える文字
NEXT I
DATA A,B,C,D
FOR I=1 TO PARA
SWAP TERM$(I),TERM$(INT(RND*PARA)+1) ! シャッフルする
NEXT I
FOR I=1 TO PARA
READ NUMBER(I)
NEXT I
DATA 1,2,3,4 ! 使用する数値
FOR I=1 TO PARA
SWAP NUMBER(I),NUMBER(INT(RND*PARA+1))
NEXT I
OPEN #1:NAME "計算パズル問題.txt"
OPEN #2:NAME "計算パズル解答.txt"
ERASE #1
ERASE #2
FOR K=1 TO 20 ! 問題数
DO
FOR I=1 TO N
FOR J=1 TO N
LET NUM(I,J)=INT(RND*PARA+1) ! 1,2,3... パラメータ数 各A,B,C...には同じ数が入る
IF J=1 OR I=1 THEN
LET OPERATOR(I,J)=INT(RND*2+1)
ELSE
LET OPERATOR(I,J)=INT(RND*4+1)
END IF
NEXT J
NEXT I
FOR I=1 TO N
LET S$=""
FOR J=1 TO N
SELECT CASE OPERATOR(I,J)
CASE 1
LET S$=S$&"+"&STR$(NUMBER(NUM(I,J)))
CASE 2
LET S$=S$&"-"&STR$(NUMBER(NUM(I,J)))
CASE 3
LET S$=S$&"*"&STR$(NUMBER(NUM(I,J)))
CASE 4
LET S$=S$&"/"&STR$(NUMBER(NUM(I,J)))
END SELECT
NEXT J
CALL PARSER(S$,ANS,ERR)
IF FP(ANS)<>0 THEN LET ERR=1
IF ERR=0 THEN
LET ROW(I)=ANS
ELSE
EXIT FOR
END IF
NEXT I
IF ERR=0 THEN
FOR J=1 TO N
LET S$=""
FOR I=1 TO N
SELECT CASE OPERATOR(I,J)
CASE 1
LET S$=S$&"+"&STR$(NUMBER(NUM(I,J)))
CASE 2
LET S$=S$&"-"&STR$(NUMBER(NUM(I,J)))
CASE 3
LET S$=S$&"*"&STR$(NUMBER(NUM(I,J)))
CASE 4
LET S$=S$&"/"&STR$(NUMBER(NUM(I,J)))
END SELECT
NEXT I
CALL PARSER(S$,ANS,ERR)
IF FP(ANS)<>0 THEN LET ERR=1
IF ERR=0 THEN
LET COL(J)=ANS
ELSE
EXIT FOR
END IF
NEXT J
END IF
LOOP UNTIL ERR=0
CALL DISPLAY
CALL DISPLAY2
NEXT K
CLOSE #1
CLOSE #2
SUB DISPLAY ! 問題
FOR I=1 TO N
FOR J=1 TO N
LET P=OPERATOR(I,J)
PRINT #1:OP$(P);" ";TERM$(NUM(I,J));" ";
NEXT J
PRINT #1:"=";ROW(I)
NEXT I
FOR I=1 TO N
PRINT #1:" = ";
NEXT I
PRINT #1
FOR I=1 TO N
PRINT #1:USING$("-##",COL(I));" ";
NEXT I
PRINT #1
PRINT #1
END SUB
SUB DISPLAY2 ! 解答
FOR I=1 TO N
FOR J=1 TO N
LET P=OPERATOR(I,J)
PRINT #2:OP$(P);" ";STR$(NUMBER(NUM(I,J)));" ";
NEXT J
PRINT #2:"=";ROW(I)
NEXT I
FOR I=1 TO N
PRINT #2:" = ";
NEXT I
PRINT #2
FOR I=1 TO N
PRINT #2:USING$("-###",COL(I));
NEXT I
PRINT #2
PRINT #2
END SUB
END
EXTERNAL SUB PARSER(X$,ANS,ERR)
OPTION CHARACTER BYTE
LET ERR$=REPEAT$(" ",4)
IF X$="" THEN
LET ERR=1
LET ANS=0
EXIT SUB
END IF
LET ANS=PARSER16(LCASE$(X$),ERR$)
LET ERR=INT32(ERR$)
FUNCTION PARSER16(X$,ERR$)
ASSIGN ".\DLL\parser-exprtk.dll","parser16",FPU
END FUNCTION
END SUB
EXTERNAL FUNCTION INT32(S$)
OPTION CHARACTER BYTE
FOR I=1 TO 4
LET N=N+256^(I-1)*ORD(S$(I:I))
NEXT I
LET INT32=MOD(N+2^31,2^32)-2^31
END FUNCTION
解答
+ 3 - 2 + 1 + 4 = 6
+ 2 - 2 / 1 - 4 =-4
- 2 - 3 * 4 - 2 =-16
- 2 - 2 - 4 + 3 =-5
= = = =
1 -9 0 1
+ 2 - 1 - 2 + 1 = 0
+ 3 + 2 / 2 - 4 = 0
- 4 + 3 - 4 * 1 =-5
- 1 + 2 - 3 + 4 = 2
= = = =
0 6 -8 1
+ 3 + 2 + 2 - 1 = 6
+ 2 + 1 - 2 * 4 =-5
+ 3 - 4 + 1 * 2 = 1
- 2 - 2 - 3 + 2 =-5
= = = =
6 -3 -2 -6
Mac-silicon版最新で改行が行われない？ - MN-man
2025/09/02 (Tue) 11:56:47
先に質問などさせていただいたものです。
さっそくの返信ありがとうございます。
結果としては、いわゆる初心者によくある勘違い系かと‥‥お恥ずかしいです。
エディターの改行コードや ; や , の使い方を間違っていたようです。
８ビットPC以来で、混乱していました。m(__)m
Mac-silicon版最新で改行が行われない？ - MN-man
2025/09/01 (Mon) 01:32:00
初めて投稿します。よろしくお願いします。
Macの最新版OSで機種はMacAirです。
print文での改行が行われず、表示がずらずらと続いて行きます。
空print文を入れても変わりません。
私の環境だけなのか？bugなのか？判定できません。
原因など分かりましたらお教えください。
Re: Mac-silicon版最新で改行が行われない？ - SHIRAISHI Kazuo
2025/09/01 (Mon) 05:55:02
Mac OS 15.5だと問題ないのですが、OSの改定で改行文字の扱いが変わってしまったのでしょうか。
FOR x=1 TO 10
PRINT x,sqr(x)
NEXT x
END
実行結果
1 1
2 1.41421356237
3 1.73205080757
4 2
5 2.2360679775
6 2.44948974278
7 2.64575131106
8 2.82842712475
9 3
10 3.16227766017
十進BASIC Ver. 0.9.2.6 (ARM64）Mac mini(M1)
Re: Mac-silicon版最新で改行が行われない？ - SHIRAISHI Kazuo
2025/09/01 (Mon) 06:12:31
FOR x=1 TO 10
PRINT x,sqr(x),chr$(13);chr$(10);
NEXT x
END
だとどうなりますか。
Windowsだとこれが標準です。
また、
FOR x=1 TO 10
PRINT x,sqr(x),chr$(13);
NEXT x
END
あるいは
FOR x=1 TO 10
PRINT x,sqr(x),chr$(10);
NEXT x
END
ではどうでしょうか？
投稿者削除 - (削除)
2025/05/31 (Sat) 11:50:10
(投稿者により削除されました)
Re: 高DPI環境で文字がぼやけてしまいます - SHIRAISHI Kazuo
2025/05/31 (Sat) 15:49:26
Lazarus版については可能性があります。
https://wiki.lazarus.freepascal.org/High_DPI
Re: 高DPI環境で文字がぼやけてしまいます - SHIRAISHI Kazuo
2025/06/02 (Mon) 09:00:59
DPI-aware のテスト版を作成しました。
下記ページの最下部にあります。
https://decimalbasic.web.fc2.com/basicw32.htm
Windows DPI scaling - SHIRAISHI Kazuo
2025/08/28 (Thu) 09:18:08
Ver.8, Ver.0.9をWindowsのDPI SCALINGに対応させました。
https://decimalbasic.web.fc2.com/basicw32.htm#Ver8
の下のほうにあります。
Re: Windows DPI scaling - SHIRAISHI Kazuo
2025/08/30 (Sat) 10:11:37
Windows DPI scalingのLOCATE文への対応が欠落していました。次バージョンで修正します。
1 g の質量に対応するシュワルツシルト半径 - Tarosa
2025/08/19 (Tue) 23:05:16
!1 g の質量に対応するシュワルツシルト半径
!シュワルツシルト半径r_s = 2 G M / c^2
!OPTION ARITHMETIC COMPLEX
OPTION ARITHMETIC DECIMAL_HIGH
!LET G=6.67430*10^(-11)
LET G=6.6743E-11
!LET M=1.98847*10^30 ![kg] 太陽質量（IAU準拠）
LET M=1E-3 !
LET C=299792458
PRINT (2*G*M) / c^2
END
計算結果出力
チャットGPT
https://chatgpt.com
rs≈1.49×10−30m
これは原子核どころか素粒子スケールよりもはるかに小さい値です。
（参考までに陽子半径は ∼0.8×10−15m）
1.4852320538237331×10^-30
.0000000000000000000000000000014852320538237331
電子やクォークは、陽子の1万分の1程度、つまり10の-19乗メートル未満
計算上は素粒子よりも小さなブラックホールがあるといえる?
ブッタブロ - しばっち
2025/08/17 (Sun) 07:47:22
ブッタブロ
https://ja.wikipedia.org/wiki/ブッダブロ
https://note.com/108hassium/n/na144b0cb5567
マンデルブロート集合でのz(i+1)=z(i)^2+cの発散した場合の
点列z0,z1,z2,z3...を描画したものです。見た目がブッタに見える?
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KL=200 ! 繰り返し数
SET WINDOW -2,2,-2,2
LET N=2 ! 次数
LET TRUE=1
LET FALSE=0
FOR I=0 TO SIZE-1
FOR R=0 TO SIZE-1
LET C=COMPLEX(WORLDX(R),WORLDY(I))
LET Z=0
LET FL=FALSE
FOR K=1 TO KL
LET Z=CPOW(Z,N)+C
IF ABS(Z)>2 THEN ! 発散したら
LET FL=TRUE
EXIT FOR
END IF
NEXT K
IF FL=TRUE THEN
LET Z=0
FOR K=1 TO KL
LET Z=CPOW(Z,N)+C
IF ABS(Z)>2 THEN EXIT FOR
ASK PIXEL VALUE(RE(Z),IM(Z)) COL
SET POINT COLOR MIN(COL+8,255)
PLOT POINTS:Z
NEXT K
END IF
NEXT R
NEXT I
END
EXTERNAL FUNCTION CPOW(Z,N)
LET R=RE(Z)
LET I=IM(Z)
LET RR=SQR(R*R+I*I)
IF RR=0 THEN
LET CPOW=0
ELSE
LET TH=ANGLE(R,I)
LET CPOW=COMPLEX(RR^N*COS(TH*N),RR^N*SIN(TH*N))
END IF
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
FOR I=0 TO 255
SET COLOR MIX(I) I/255,I/255,I/255
NEXT I
CLEAR
END SUB
---------------------------------------------------------------------------
発散しない集合点を描画
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KL=200
SET WINDOW -2,2,-2,2
LET N=2
LET TRUE=1
LET FALSE=0
FOR I=0 TO SIZE-1
FOR R=0 TO SIZE-1
LET C=COMPLEX(WORLDX(R),WORLDY(I))
LET Z=0
LET FL=TRUE
FOR K=1 TO KL
LET Z=CPOW(Z,N)+C
IF ABS(Z)>2 THEN
LET FL=FALSE
EXIT FOR
END IF
NEXT K
IF FL=TRUE THEN
LET Z=0
FOR K=1 TO KL
LET Z=CPOW(Z,N)+C
ASK PIXEL VALUE(RE(Z),IM(Z)) COL
SET POINT COLOR MIN(COL+8,255)
PLOT POINTS:Z
NEXT K
END IF
NEXT R
NEXT I
END
Re: ブッタブロ - しばっち
2025/08/17 (Sun) 07:50:12
トライコーン
マンデルブロート集合 z←z^2+cをz←conj(z^2)+cにしたもの
conj(z)...zの共役複素数
https://en.wikipedia.org/wiki/Tricorn_(mathematics)
マンデルブロートの描き方には色々な亜種があるようだ。
自分で考えた手法でいろいろ描画させてみるのもおもしろいかもしれません。
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KL=50
SET WINDOW -2,2,-2,2
LET N=2
FOR R=0 TO SIZE-1
FOR I=0 TO SIZE-1
LET C=COMPLEX(WORLDX(R),WORLDY(I))
LET Z=0
FOR K=0 TO KL
LET Z=CONJ(CPOW(Z,N))+C
IF ABS(Z)>2 THEN
LET CC=MOD(K,7)+1
CALL PSET(WORLDX(R),WORLDY(I),CC)
EXIT FOR
END IF
NEXT K
NEXT I
NEXT R
END
EXTERNAL FUNCTION CPOW(Z,N)
LET R=RE(Z)
LET I=IM(Z)
LET RR=SQR(R*R+I*I)
IF RR=0 THEN
LET CPOW=0
ELSE
LET TH=ANGLE(R,I)
LET CPOW=COMPLEX(RR^N*COS(TH*N),RR^N*SIN(TH*N))
END IF
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
----------------------------------------------------------------
下記のようにするとバーニングシップフラクタルと呼ばれている。
https://ja.wikipedia.org/wiki/バーニングシップ・フラクタル
OPTION ARITHMETIC COMPLEX
LET SIZE=800
CALL GINIT(SIZE,SIZE)
LET KMAX=50
SET WINDOW -2,2,2,-2
LET N=2
FOR I=0 TO SIZE-1
FOR R=0 TO SIZE-1
LET C=COMPLEX(WORLDX(R),WORLDY(I))
LET Z=C
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=COMPLEX(ABS(RE(Z)),ABS(IM(Z)))^N+C
IF ABS(Z)>2 THEN
LET CC=MOD(K,7)+1
CALL PSET(WORLDX(R),WORLDY(I),CC)
EXIT FOR
END IF
USE
EXIT FOR
END WHEN
NEXT K
NEXT R
NEXT I
END
----------------------------------------------------------------
実部と虚部を入れ替えてみた。
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
CLEAR
SET POINT STYLE 1
LET KMAX=100
SET WINDOW -2,2,-2,2
ASK BITMAP SIZE XSIZE,YSIZE
FOR CI=0 TO YSIZE
FOR CR=0 TO XSIZE
LET C=COMPLEX(WORLDX(CR),WORLDY(CI))
LET Z=0
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=COMPLEX(IM(Z),RE(Z))
LET Z=Z*Z+C
IF ABS(Z)>2 THEN
CALL PSET(WORLDX(CR),WORLDY(CI),MOD(K,7)+1)
EXIT FOR
END IF
USE
END WHEN
NEXT K
NEXT CR
NEXT CI
END
----------------------------------------------------------------
パラメーターRを掛けてみた。
OPTION ANGLE DEGREES
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
CLEAR
SET POINT STYLE 1
LET KMAX=100
SET WINDOW -2,2,-2,2
ASK BITMAP SIZE XSIZE,YSIZE
FOR T=0 TO 359 STEP 15
CLEAR
LET R=COMPLEX(COS(T),SIN(T))
FOR CI=0 TO YSIZE
FOR CR=0 TO XSIZE
LET C=COMPLEX(WORLDX(CR),WORLDY(CI))
LET Z=C
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=R*Z*Z+C
IF CABS(Z)>2 THEN
CALL PSET(WORLDX(CR),WORLDY(CI),MOD(K,7)+1)
EXIT FOR
END IF
USE
END WHEN
NEXT K
NEXT CR
NEXT CI
LET N=N+1
!!GSAVE "mandel"&USING$("%%",N)&".png"
NEXT T
END
----------------------------------------------------------------
OPTION ANGLE DEGREES
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
CLEAR
SET POINT STYLE 1
LET KMAX=100
SET WINDOW -2,2,-2,2
ASK BITMAP SIZE XSIZE,YSIZE
FOR T=0 TO 89 STEP 5
CLEAR
FOR CI=0 TO YSIZE
FOR CR=0 TO XSIZE
LET R=COMPLEX(WORLDX(CR)+TAN(T)*WORLDY(CI),WORLDY(CI)+TAN(T)*WORLDX(CR))
LET C=COMPLEX(WORLDX(CR),WORLDY(CI))
LET Z=C
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=R*Z*Z+C
IF CABS(Z)>2 THEN
CALL PSET(WORLDX(CR),WORLDY(CI),MOD(K,7)+1)
EXIT FOR
END IF
USE
END WHEN
NEXT K
NEXT CR
NEXT CI
LET N=N+1
!!GSAVE "mandel"&USING$("%%",N)&".png"
NEXT T
END
----------------------------------------------------------------
RANDOMIZE
OPTION ANGLE DEGREES
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
CLEAR
SET POINT STYLE 1
LET KMAX=100
SET WINDOW -2,2,-2,2
ASK BITMAP SIZE XSIZE,YSIZE
LET A=RND
LET B=RND
LET C=RND
LET D=RND
PRINT A;B;C;D
FOR CI=0 TO YSIZE
FOR CR=0 TO XSIZE
LET R=COMPLEX(WORLDX(CR)*A+WORLDY(CI)*B,WORLDY(CI)*C+WORLDX(CR)*D) ! アフィン変換
LET CC=COMPLEX(WORLDX(CR),WORLDY(CI))
LET Z=CC
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=R*Z*Z+CC
IF CABS(Z)>2 THEN
CALL PSET(WORLDX(CR),WORLDY(CI),MOD(K,7)+1)
EXIT FOR
END IF
USE
END WHEN
NEXT K
NEXT CR
NEXT CI
END
----------------------------------------------------------------
座標を回転させながらニュートンフラクタル描かせてみた。
次のプログラムを雛型に色々な回転アニメーションを作成してみるのもおもしろいかもしれません。
４隅((XA,YA)～(XD,YD))を長方形や台形も指定できますが、グラフィック画面と縦横比が異なると画像は歪みます。
OPTION ANGLE DEGREES
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
CLEAR
SET POINT STYLE 1
ASK BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE,0,YSIZE
LET R=10 ! 半径
LET KMAX=100 ! 繰り返し数
LET OX=0
LET OY=0
FOR TH=0 TO 359 STEP 15 ! 右回転
CLEAR
LET XA=R*COS(135-TH)+OX ! 左上
LET YA=R*SIN(135-TH)+OY
LET XB=R*COS(45-TH)+OX ! 右上
LET YB=R*SIN(45-TH)+OY
LET XC=R*COS(-45-TH)+OX ! 右下
LET YC=R*SIN(-45-TH)+OY
LET XD=R*COS(-135-TH)+OX ! 左下
LET YD=R*SIN(-135-TH)+OY
FOR YY=0 TO YSIZE
FOR XX=0 TO XSIZE
LET S=XX/XSIZE ! 0<=S<=1
LET T=YY/YSIZE ! 0<=T<=1
LET X=(XA+XC-XD-XB)*S*T+(XD-XA)*T+(XB-XA)*S+XA ! 共一次変換
LET Y=(YA+YC-YD-YB)*S*T+(YD-YA)*T+(YB-YA)*S+YA
LET Z=COMPLEX(X,Y)
FOR K=1 TO KMAX
WHEN EXCEPTION IN
LET Z=Z-FUNC(Z)/DIFF(Z)
IF ABS(FUNC(Z))<1E-8 THEN ! 収束したら
SET POINT COLOR MOD(K,255)+1
PLOT POINTS:XX,YY
EXIT FOR
END IF
USE
EXIT FOR
END WHEN
NEXT K
NEXT XX
NEXT YY
LET N=N+1
!!GSAVE "newton"&USING$("%%%",N)&".png"
LET R=R/SQR(2)
NEXT TH
END
EXTERNAL FUNCTION FUNC(X)
OPTION ARITHMETIC COMPLEX
LET FUNC=X^8-X^6+2*X^5+X^4+3*X^2-X+1
END FUNCTION
EXTERNAL FUNCTION DIFF(X) ! 数値微分
OPTION ARITHMETIC COMPLEX
LET H=1/256
LET DIFF=(-FUNC(X-3*H)+9*FUNC(X-2*H)-45*FUNC(X-H)+45*FUNC(X+H)-9*FUNC(X+2*H)+FUNC(X+3*H))/(60*H)
END FUNCTION
Re: ブッタブロ - しばっち
2025/08/17 (Sun) 07:51:58
https://ja.wikipedia.org/wiki/平均
https://en.wikipedia.org/wiki/Harmonic_mean
https://en.wikipedia.org/wiki/Contraharmonic_mean
https://en.wikipedia.org/wiki/Generalized_mean
https://en.wikipedia.org/wiki/Heronian_mean
https://en.wikipedia.org/wiki/Lehmer_mean
https://en.wikipedia.org/wiki/Heinz_mean
https://en.wikipedia.org/wiki/Geometric_mean
https://en.wikipedia.org/wiki/Root_mean_square
https://en.wikipedia.org/wiki/Arithmetic?geometric_mean
https://en.wikipedia.org/wiki/Cubic_mean
https://en.wikipedia.org/wiki/Stolarsky_mean
https://en.wikipedia.org/wiki/Logarithmic_mean
https://en.wikipedia.org/wiki/Identric_mean
https://en.wikipedia.org/wiki/Circular_mean
https://en.wikipedia.org/wiki/Geometric?harmonic_mean
https://en.wikipedia.org/wiki/Neuman?Sandor_mean
DIM Z(2),A(2),ZZ(2)
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 WINDOW -2,2,-2,2
SET POINT STYLE 1
ASK BITMAP SIZE XSIZE,YSIZE
LET KMAX=100 ! 繰り返し数
LET N=2 ! 指数
FOR Y=0 TO YSIZE
FOR X=0 TO XSIZE
CALL CSET(A,WORLDX(X),WORLDY(Y))
MAT Z=A
FOR K=1 TO KMAX
WHEN EXCEPTION IN
CALL CCONJ(Z,Z) ! Z=CONJ(Z)
CALL CPOW(ZZ,Z,N) ! ZZ=Z^N
CALL CADD(Z,ZZ,A) ! Z=CONJ(Z)^N+A
IF CABS(Z)>2 THEN
SET POINT COLOR MOD(K,7)+1
PLOT POINTS:WORLDX(X),WORLDY(Y)
EXIT FOR
END IF
USE
EXIT FOR
END WHEN
NEXT K
NEXT X
NEXT Y
END
EXTERNAL SUB CSET(X(),A,B)
LET X(1)=A
LET X(2)=B
END SUB
EXTERNAL FUNCTION CABS(Z())
LET R=ABS(Z(1))
LET I=ABS(Z(2))
LET CABS=MINKOWSKI(R,I,2,2)
!IF ABS(R)>2 OR ABS(I)>2 THEN LET CABS=3 ELSE LET CABS=0
!IF ABS(R)>2 AND ABS(I)>2 THEN LET CABS=3 ELSE LET CABS=0
!LET CABS=MIN(R,I)
!LET CABS=MAX(R,I)
!LET CABS=R
!LET CABS=LOGMEAN(R,I)
!LET CABS=STOLARSKYMEAN(R,I,3)
!LET CABS=ROOTMEAN(R,I)
!LET CABS=AVERAGE(R,I,1,2)
!LET CABS=GEOMETRICMEAN(R,I,3,3)
!LET CABS=LEHMERMEAN(R,I,2)
!LET CABS=HARMONICMEAN(R,I,2,3)
!LET CABS=CONTRAHARMONICMEAN(R,I,3)
!LET CABS=HEINZMEAN(R,I,.2)
!LET CABS=HERONIANMEAN(R,I)
!LET CABS=AGM(R,I)
!LET CABS=SMIN(R,I)
!LET CABS=IDENTRICMEAN(R,I)
!LET CABS=CIRCULARMEAN(R,I)
!LET CABS=M(R,I)
!LET CABS=T(R,I)
!LET CABS=GHM(R,I)
END FUNCTION
EXTERNAL FUNCTION SMIN(A,B) !exponential smooth min
LET K=32
LET RES=EXP(-K*A)+EXP(-K*B)
LET SMIN=-LOG(RES)/K
END FUNCTION
EXTERNAL FUNCTION SMAX(A,B)
LET K=32
LET RES=EXP(K*A)+EXP(K*B)
LET SMAX=LOG(RES)/K
END FUNCTION
EXTERNAL FUNCTION MINKOWSKI(X,Y,N,M) ! ミンコフスキー距離
LET MINKOWSKI=(ABS(X)^N+ABS(Y)^M)^(2/(N+M))
END FUNCTION
EXTERNAL FUNCTION LOGMEAN(X,Y) ! 対数平均
IF X=0 OR Y=0 THEN
LET LOGMEAN=0
ELSEIF ABS(X-Y)<1E-8 THEN
LET LOGMEAN=X
ELSE
LET LOGMEAN=(X-Y)/(LOG(X)-LOG(Y))
END IF
END FUNCTION
EXTERNAL FUNCTION STOLARSKYMEAN(X,Y,P)
IF X=Y THEN
LET STOLARSKYMEAN=X
ELSE
LET STOLARSKYMEAN=((X^P-Y^P)/(P*(X-Y)))^(1/(P-1))
END IF
END FUNCTION
EXTERNAL FUNCTION ROOTMEAN(X,Y) ! RMS 二乗平均平方根
LET ROOTMEAN=SQR((X*X+Y*Y)/2)
END FUNCTION
EXTERNAL FUNCTION AVERAGE(A,B,N,M) ! 相加平均
LET AVERAGE=(A*N+B*M)/(N+M)
END FUNCTION
EXTERNAL FUNCTION GEOMETRICMEAN(A,B,N,M) ! 相乗平均
LET GEOMETRICMEAN=(ABS(A)^N*ABS(B)^M)^(1/(N+M))
END FUNCTION
EXTERNAL FUNCTION LEHMERMEAN(X,Y,P)
LET S=X^P+Y^P
LET SS=X^(P-1)+Y^(P-1)
LET LEHMERMEAN=S/SS
END FUNCTION
EXTERNAL FUNCTION HARMONICMEAN(A,B,M,N) ! 調和平均
IF A=0 OR B=0 THEN
LET HARMONICMEAN=0
ELSE
LET HARMONICMEAN=2*A^M*B^N/(A^M+B^N)
END IF
END FUNCTION
EXTERNAL FUNCTION CONTRAHARMONICMEAN(X,Y,P)
LET S=X^(P+1)+Y^(P+1)
LET SS=X^P+Y^P
LET CONTRAHARMONICMEAN=S/SS
END FUNCTION
EXTERNAL FUNCTION HEINZMEAN(A,B,X) ! 0<X<.5
LET HEINZMEAN=(A^X*B^(1-X)+A^(1-X)*B^X)/2
END FUNCTION
EXTERNAL FUNCTION HERONIANMEAN(A,B)
LET HERONIANMEAN=2/3*(A+B)/2+1/3*SQR(A*B)
END FUNCTION
EXTERNAL FUNCTION AGM(X,Y)
DO
LET XX=(X+Y)/2
LET YY=SQR(X*Y)
LET X=XX
LET Y=YY
LOOP UNTIL ABS(X-Y)<1E-8
LET AGM=X
END FUNCTION
EXTERNAL FUNCTION IDENTRICMEAN(X,Y)
IF X=Y THEN
LET IDENTRICMEAN=X
ELSE
LET IDENTRICMEAN=EXP((X*LOG(X)-Y*LOG(Y))/(X-Y)-1)
END IF
END FUNCTION
EXTERNAL FUNCTION CIRCULARMEAN(X,Y)
LET S=(SIN(X)+SIN(Y))/2
LET C=(COS(X)+COS(Y))/2
LET CIRCULARMEAN=ANGLE(S,C)
END FUNCTION
EXTERNAL FUNCTION M(A,B)
LET M=(A-B)/(2*ARCSINH((A-B)/(A+B)))
END FUNCTION
EXTERNAL FUNCTION T(A,B)
LET T=(A-B)/(2*ATN((A-B)/(A+B)))
END FUNCTION
EXTERNAL FUNCTION ARCSINH(X)
LET ARCSINH=LOG(X+SQR(X*X+1)) !'arc-hyperbolic sine
END FUNCTION
EXTERNAL FUNCTION GHM(X,Y)
DO
LET XX=SQR(X*Y)
LET YY=2*X*Y/(X+Y)
LET X=XX
LET Y=YY
LOOP UNTIL ABS(X-Y)<1E-8
LET GHM=X
END FUNCTION
EXTERNAL SUB CADD(S(),A(),B())
MAT S=A+B
END SUB
EXTERNAL SUB CMUL(S(),A(),B())
DIM SS(2)
LET SIGN=-1 ! SIGN=-1...複素数 SIGN=0...二重数 SIGN=1...分解型複素数
LET SS(1)=A(1)*B(1)+A(2)*B(2)*SIGN
LET SS(2)=A(2)*B(1)+A(1)*B(2)
MAT S=SS
END SUB
EXTERNAL SUB CPOW(S(),A(),M) ! S=A^M
DIM Y(2)
IF M<0 THEN LET SIGN=-1
LET N=ABS(M)
LET NN=IP(N)
LET N=FP(N)
MAT Y=A
CALL CSET(S,1,0)
FOR I=1 TO NN
CALL CMUL(S,S,A)
NEXT I
DO WHILE N>0 AND C<50
LET N=N*2
CALL CSQR(Y,Y)
IF N>=1 THEN CALL CMUL(S,S,Y)
LET N=FP(N)
LET C=C+1
LOOP
IF SIGN<0 THEN
CALL CSET(Y,1,0)
CALL CDIV(S,Y,S)
END IF
END SUB
EXTERNAL SUB CSQR(X(),Y()) ! Y=SQR(X)
DIM A(2),B(2)
MAT A=ZER
CALL CSET(B,1,0)
FOR I=1 TO 100
CALL CADD(B,A,B)
MAT B=.5*B
CALL CDIV(A,X,B)
IF CABS2(A,B)<1E-8 THEN EXIT FOR
NEXT I
MAT Y=B
END SUB
EXTERNAL FUNCTION CABS2(A(),B())
LET N=2
FOR I=1 TO 2
LET S=S+ABS(A(I)-B(I))^N ! ミンコフスキー距離
NEXT I
LET CABS2=S^(1/N)
END FUNCTION
EXTERNAL SUB CCONJ(S(),A())
LET S(1)=A(1)
LET S(2)=-A(2)
END SUB
EXTERNAL SUB CDIV(S(),A(),B()) ! S=A/B
DIM BB(2),S1(2),S2(2)
CALL CCONJ(BB,B) ! CONJ(B)
CALL CMUL(S1,A,BB) ! A*CONJ(B)
CALL CMUL(S2,B,BB) ! B*CONJ(B)
MAT S=(1/S2(1))*S1
END SUB
日本語文字が横向きになります - しばっち
2025/07/20 (Sun) 07:17:28
日本語文字が横向きになります
Windows版Lazarus版Basic0759Ja_win64で入力した日本語の文字が
横向きになります。
実行結果は問題ありません。
Lazarus版Basic0925Ja_win64では問題ないようです。
Lazarus版Basicで下記のような特殊文字(結合文字)を扱えるようにできませんか?
(現状対応はメモ帳とワードだけ?)
https://forest.watch.impress.co.jp/docs/serial/yajiuma/1626043.html
https://i-tsunagu.com/other/dakuten/
下記文字なら扱えますが2文字になります。("あ"+@キー)
あ゛い゛う゛え゛お゛
か゜き゜く゜け゜こ゜
Re: 日本語文字が横向きになります - SHIRAISHI Kazuo
2025/07/20 (Sun) 07:55:41
Windowsだと，@から始まる名前のフォントだと横向きになります。フォントを選び直してみてください。
Lazarus版が扱える文字はユニコード文字です。IMEパッドで選べる文字なら使えます。
ただし，その文字に対応するフォントを選ばないと正しく表示されません。
Re: 日本語文字が横向きになります - SHIRAISHI Kazuo
2025/07/21 (Mon) 10:36:12
表示メニューで「漢字入力枠」を選ぶとメモ帳と同等の入力が可能になるかもしれません。
Re: 日本語文字が横向きになります - SHIRAISHI Kazuo
2025/07/22 (Tue) 08:34:13
Noto San JP をフォントに指定すると右図のようになります。
PRINT LEN(s$)の実行結果を見ると，内部的には2文字として扱われていることがわかります。
DATA "あ゙"
READ s$
PRINT s$
PRINT LEN(s$)
SET TEXT HEIGHT 0.6
PLOT TEXT ,AT 0,0 :s$
END
Re: 日本語文字が横向きになります - SHIRAISHI Kazuo
2025/07/22 (Tue) 14:35:48
CHR$関数はユニコードで定義されているので，
10 LET s$="あ" & CHR$(BVAL("3099",16))
20 PRINT s$
30 END
とするのが，一番，簡単な気がします。