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に固定されているように思われる‥‥‥ただし，すべての場合に成立するか不明）

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|
-----------------------------------------------------------------------

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

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

観測方程式
と
正規方程式
について簡単に説明していただけないでしょうか?
お願いします

一部バージョンの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に遭遇した方は報告をお願いします。
なお，最小化したデバッグ・ウィンドウ アイコンが，上端，下端，左端，右端のどこかに隠れているはずなので，どこにあったかの報告もあると有益です。

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

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

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

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で修正しました。

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だったかもしれません。