DouKaku? Language detail: BASIC

伝統的BASICです。N88互換のつもりですが、ActiveBasic 2.62で動作確認しています。手元のリファレンスマニュアルを参考にN88でダメな構文は避けているつもりです。可読性のため、インデントしていますがご容赦ください。

RANDOMIZEが種を指定する命令語で、RNDが乱数を取得する関数です。それぞれ、Cでいうところのsrandとrandですね。なお、PRINT RND(1)の後ろのセミコロンは、ここで改行せず空白を置くという書式指定です（すなわち、シード固定の乱数という本題とは関係ありません）。

10 FOR I = 0 TO 3
20    RANDOMIZE 42
30    FOR J = 0 TO 5
40        PRINT RND(1);
50    NEXT J
60    PRINT
70 NEXT I

16進数から10進数の変換 (Nested Flatten)

有理数モードにすると桁数の制限がなくなるが
対応している演算は四則演算とべき乗だけである。
BVAL関数をそのまま使うと最初のサンプルは、うまくいくが
2番目のサンプルでは精度が足りない。
そこで、1桁ごとに分解して集計した。

OPTION ARITHMETIC RATIONAL

FUNCTION hex2dec$(h$)
   LET n = LEN(h$)
   LET t = 0
   FOR i = 0 TO n - 1
      LET t = t + BVAL(h$(n - i : n - i),16) * 16 ^ i
   NEXT I
   LET hex2dec$ = STR$(t)
END FUNCTION

PRINT hex2dec$("12437308CCB6")      !=>20080902065334
PRINT hex2dec$("2C9C1227FC6520B")   !=>200904012311450123
END

Hello, world! PDF版 (Nested Flatten)

Microsoft Word 2007のVBAです。SP2を入れているなどPDF保存ができる状態になっている必要があります。文字の大きさは決め打ちです。おそらく、参照設定さえすれば、VB(6まで)でも実行可能だと思います。

Option Explicit

Sub Macro1()
    Dim d As Document
    Set d = New Document
    Dim p As Paragraph
    Set p = d.Paragraphs.Add
    Dim r As Range
    Set r = p.Range
    r.Text = "Hello, world!"
    r.Font.Size = 120
    r.Font.Name = "Verdana"
    r.ParagraphFormat.Alignment = wdAlignParagraphCenter
    d.ExportAsFixedFormat OutputFileName:="H:\Hello.pdf", ExportFormat:=wdExportFormatPDF
    d.Close False
End Sub

初期設定の読み書き (Nested Flatten)

java.util.prefs.Preferencesでググってきました。どうやら、アプリケーション固有の設定情報(httpd.confや.vimrcのような)を読み書きするものらしいと理解しました。

というわけで、WindowsではINIファイルやレジストリ ("HKCUSoftware会社名アプリ名"以下)を専用のAPIで扱えば題意を満たすと考えました。この投稿では、Win16の老害、INIファイルを読み書きするGetPrivateProfileStringとWritePrivateProfileString関数を使っています。言語はActiveBasic 4です。

プログラムの内容は、（保存してある）前回のコマンドライン引数を表示した後、今回のコマンドライン引数を保存するというものです。ただし、初回起動時には(none)と表示されます。このプログラムで、例えばmyapp.exe hoge foo barと実行すると、次のようなMYAPP.INIが作成されます:

[option]
LastCommandLineArgs=hoge foo bar

なお、ファイル名は必ず絶対パスで指定します。そうしないと、Windowsディレクトリを基準とした相対パスになるはずです。NT系だとユーザ別のフォルダ(Document and Settings以下)になったような気もします。

さらに余談ですが、Program Files以下へインストールされるアプリでは、実行ファイルと同じフォルダにINIを置いてはいけません。それをやると、いかにもVistaでまともに動かない（XPまででも制限ユーザでは使えない）というダメダメなアプリの一丁上がりです。個人的には、アプリと同じフォルダに設定ファイルを置くのはインストーラ無しのフリーソフトの特権だと思っています。長々とした文章ですみませんでした。

#console

Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (
    lpAppName As *Byte,
    pKeyName As *Byte,
    lpString As *Byte,
    lpFileName As *Byte) As BOOL
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (
    lpAppName As *Byte,
    lpKeyName As *Byte,
    lpDefault As *Byte,
    lpReturnedString As *Byte,
    nSize As DWord,
    lpFileName As *Byte) As DWord

' PathGetArgsの利用にはIE4以上またはWindows 98/2000以上が必要。
Declare Function PathGetArgs Lib "shlwapi" Alias "PathGetArgsA" (pszPath As *Byte) As *Byte

Const BUF_SIZE = 1024

Dim lastCmdLine As String
lastCmdLine = ZeroString(BUF_SIZE)
GetPrivateProfileString("option", "LastCommandLineArgs", "(none)", StrPtr(lastCmdLine), BUF_SIZE , "H:\MYAPP.INI")
' "(none)"はファイル自体や中のエントリが見付からなかったときにlastCmdLineに格納する内容を指定する引数

Print "Last command line:"; lastCmdLine

Dim cmdLine As BytePtr
' PathGetArgsでコマンドライン引数から自身の実行ファイル名（Cでいうargv[0]）の部分を取り除いている。
cmdLine = PathGetArgs(GetCommandLine())

WritePrivateProfileString("option", "LastCommandLineArgs", cmdLine, "H:\MYAPP.INI")

環境変数の取得 (Nested Flatten)

今度は環境変数の一覧を取得する例です。こちらはVBScriptにしました。COMオブジェクトでの列挙操作は、VBScriptのほうがFor Eachが使えるので楽です。

Set sh = CreateObject("WScript.Shell")
Set env = sh.Environment

For Each e In env
    s = s & e & vbNewLine
Next

WScript.Echo s

2^i * 3^j * 5^k なる整数 (Nested Flatten)

十進BASICで。

LET n = 100
DO WHILE(n > 0)
   LET i = i + 1
   LET t = i
   LET h = 2
   DO WHILE(h < 6)
      DO WHILE(MOD(t,h) = 0)
         LET t = t / h
      LOOP
      LET h = h * 2 - 1
   LOOP
   IF t = 1 THEN
      PRINT i
      LET n = n - 1
   END IF
LOOP
END

外部の実行ファイルを呼び出し (Nested Flatten)

あれ？言語の選択肢にVisual Basicがない！まあこれVBScriptですけど。待つと待たないの区別が明示できるだけで、バッチファイルよりずっと便利だと思っています。

see: Windows Script Host — Run メソッド

Option Explicit

Dim sh
Set sh = WScript.CreateObject("WScript.Shell")
WScript.Echo "メモ帳を起動（待たない）"
sh.Run "notepad.exe", 1, False
WScript.Echo "メモ帳を起動（待つ）"
sh.Run "notepad.exe", 1, True

漢数字で九九の表 (Nested Flatten)

十進BASICで。

LET k$ = "〇一二三四五六七八九"
LET j = LEN(k$)
LET i = j / j
LET q = j - i
FOR y = i TO q
   FOR x = i TO q
      LET t$ = STR$(y * x)
      LET s$ = ""
      FOR m = i TO LEN(t$)
         LET s$ = s$ & mid$(k$,VAL(t$(m : m)) + i , i)
      NEXT M
      PRINT USING ">####" : s$ ;
   NEXT X
   PRINT
NEXT Y
END

自分自身を表示する (Nested Flatten)

これがマシンを起動してから初めて実行するプログラムならいいですが、場合によっては自分自身以外のコードも表示されてしまいませんかね？

（BASICのステートメントも忘れかけておりますけど）こういうのではいかがでしょう？

1	0 DELETE 1- : LIST

BASICで。
２番目の条件に該当していないと思いたい。
UBASICで確認。

   10   list

LL Golf Hole 3 - 13日の金曜日を数え上げる (Nested Flatten)

投稿 #7027 の式を借りました。N88互換BASICで確認。

1 z=08:n=8:c=1:if n<3 then n=n+12
2 for y=z to 13:for m=n+1 to 15:if 0<(m*26\10+y+y\4)mod 7 then 4
3 ?c,y+2000+m\14;(m-2)mod 12+1;13:c=c+1
4 n=3:next m,y

2次元ランダムウォーク (Nested Flatten)

BASICで。グラフィック機能が組み込まれた言語の見せ所だと思って、アニメーション。同時にファイルにも書きます。

N88互換BASICで動作を確認。Microsoft BASIC系依存なので(仮称)十進BASICでは動きません。

100 cls 3
110 x=320 : y=200 : t=0
120 open "c:\RandomWalk.dat" for output as #1
130 print #1, t; x; y
140 *loop
150   circle(x,y),2,0
160   if rnd(1)<0.5 then x=x+1 else x=x-1
170   if rnd(1)<0.5 then y=y+1 else y=y-1
180   t=t+1
190   circle(x,y),2,7
200   print #1, t; x; y
210   if inkey$<>"" then goto *quit
220   goto *loop
230 *quit
240   close #1

ピラミッドを作る (Nested Flatten)

BASICで短さに挑戦。66B

1	1 input n:for i=1 to n:?string$(n-i," ");string$(i2-1,""):next

出力の一時停止と再開 (Nested Flatten)

スレッド？そりゃ食いもんか？

BASIC の INKEY$ はブロッキングしないので、ゲームとか作るのに便利です。

100 *Init           '*** 初期化 ***
110   cls
120   t$=time$
130   active=1      ' タイマー実行中フラグ
140 *MainLoop       '*** メインループ ***
150   ' キー入力を１文字読み込む
160   c$=inkey$
170   ' ｑで終了、ｐで停止／再開
180   if c$="q" then end
190   if c$="p" then active=1-active
200   ' time$ (=hh:mm:ss) が変化したらタイマー発動
210   if t$=time$ then goto *MainLoop
220   t$=time$
230   if active=1 then gosub *OnTimer
240   goto *MainLoop
250 *OnTimer        '*** タイマーイベントハンドラ ***
260   print "a"
270   return

データの整列 (Nested Flatten)

バブルソートってこんな感じだったかな。

see: バブルソート - Wikipedia

100   DATANUM = 5  ' データ個数
110 'データX、データY、並び替え配列
120   dim x(DATANUM), y(DATANUM), idx(DATANUM)
130 '関数：データ０と１が辞書順に整列してない場合に真
140   def fnNoSort0(x0,y0,x1,y1) = (x0 > x1) or ((x0 <= x1) and (y0 > y1))
150 '関数：データ０と１が距離順に整列してない場合に真
160   def fnNoSort1(x0,y0,x1,y1) = (x0 * x0 + y0 * y0 ) > (x1 * x1 + y1 * y1)
170 '関数：整列後のX, Y を取得する
180   def fnX(n) = dx(idx(n))
190   def fnY(n) = dy(idx(n))
200 'メイン
210   gosub *DataLoad
220   mode = 0 : gosub *Sort : print "辞書順" : gosub *PrintData
230   mode = 1 : gosub *Sort : print "距離順" : gosub *PrintData
240   end
250 'データロード
260 *DataLoad
270   for i = 1 to DATANUM
280     read dx(i), dy(i)
290     idx(i) = i
300   next i
310   return
320 'データ表示
330 *PrintData
340   for i = 1 to DATANUM
350     print fnX(i), fnY(i)
360   next i
370   return
380 'ソート
390 *Sort
400   for i = 1 to DATANUM - 1
410     for j = i + 1 to DATANUM
420       if mode = 0 and fnNoSort0(fnX(i),fnY(i),fnX(j),fnY(j)) then *doSwap
430       if mode = 1 and fnNoSort1(fnX(i),fnY(i),fnX(j),fnY(j)) then *doSwap
440       goto *goNext
450      *doSwap
460       swap idx(i), idx(j)
470      *goNext
480     next j
490   next i
500   return
510 'データ
520 data 1,2, 3,4, 1,3, 2,4, 1,8

固定長データ (Nested Flatten)

普通に。

100 close #1
110 open "c:\固定長.dat" for input as #1
120 dim day$(31), breakfast$(31), lunch$(31), dinner$(31)
130 for record = 1 to 500
140   if eof(1) then goto *LoopEnd
150   'データの読み込み
160   family$ = input$(12, #1)
170   name$   = input$(12, #1)
180   sex$    = input$(1, #1)
190   age$    = input$(3, #1)
200   year$   = input$(4, #1)
210   month$  = input$(2, #1)
220   '日ごとデータの読み込み
230   for d = 1 to 31
240     day$(d)       = input$(2, #1)
250     breakfast$(d) = input$(500, #1)
260     lunch$(d)     = input$(500, #1)
270     dinner$(d)    = input$(500, #1)
280   next d
290   'データ出力
300   print "名前：";family$;" ";name$
301   print "31日の朝食：";mid$(breakfast$(31),1, 20)
310 next record
320 *LoopEnd
330 close #1

Hello, world!その２ (Nested Flatten)

N88互換BASICで確認。
BASICは、
＜よい＞
・大文字小文字は区別されないので、同じアルファベットを２回まで使える。
・PRINT の省略形で ? を使える。
＜わるい＞
・文字列中のエスケープシーケンスを解釈しない。
・配列を扱う便利機能が皆無。
・文字列を配列解釈できない。
・read & data だと、aが3回出てくるのでダメ。
・関数定義(def fnX) は、定義した時点で f が２回だし、関数名冒頭は fn 固定のため使えない。
・変数は全般的に、設定と参照の１回ずつしか使えない。
　例えば、インクリメントがないので n = N + 1 とすることになるが、
　するとその変数は参照できない。

これはマゾプレイｗ
答えは平凡なものになったけど、結構長いこと試行錯誤しました。
乱数とかpokeの使用を考えたくらい（笑）
全角半角変換する KACNV$ 関数があるけれど、#1872　で既出なので回避。

10 cls
20 z$="072 101 108 108 111 044 032 119 111 114 108 100 033"
30 for q = 1 tO 13
40 ? ChR$(vaL(mid$(Z$,Q*4-3,3)));
50 nexT

立方根の計算 (Nested Flatten)

電卓でルートキーを使って立方根を求める方法を試そうと思って。

!立方根の計算
FUNCTION cube_root(x)
   LET  y = x
   LET  E = 1e-13
   DO
      LET  y0 = y
      LET  y = SQR(SQR(y * x))
   LOOP  WHILE y0 - y > E
   LET  cube_root = y
END FUNCTION

FOR i = 1 TO 1000
   PRINT  i;cube_root(i)
NEXT i
END

除算・余剰を使わずに閏年 (Nested Flatten)

文字列にしてやってみました。うるう年のときに1を
それ以外のとき0を返します。

1800 0 
2000 1 
2007 0 
2008 1

FUNCTION leap(n)
   LET  y$ = STR$(n)
   LET  a$ = RIGHT$(y$,2)
   IF a$ = "00" THEN  LET  a$ = LEFT$(y$,LEN(y$)-2)
   IF RIGHT$(BSTR$(VAL(a$),2),2) = "00" THEN
      LET  leap = 1
   ELSE
      LET  leap = 0
   END IF  
END FUNCTION

PRINT "1800";leap(1800)
PRINT "2000";leap(2000)
PRINT "2007";leap(2007)
PRINT "2008";leap(2008)
END

コラッツ・角谷の問題 (Nested Flatten)

十進BASIC Ver7.0.4の2進モードで。
実行環境は、pentiumM 1.3GHz、メモリ256MB、WindowsXPです。 

f( 837799 ) = 524 
 3.15000000000873 sec

!コラッツ・角谷の問題
LET  st = TIME
LET  n = 2^20
DIM  c(n)

FUNCTION f(k)
   IF k = 1 THEN
      LET  f = 0
   ELSEIF k <= n AND c(k) <> 0 THEN
      LET  f = c(k)
   ELSE
      IF  MOD(k,2) = 0  THEN
         LET  s = f(k / 2) + 1
      ELSE
         LET  s = f((3 *  k + 1) / 2) + 2
      END IF
      IF k <= n THEN  LET  c(k) = s 
      LET  f = s
   END IF
END FUNCTION 

LET  mx = f(n)
LET  no = n
FOR i = 3 TO n STEP 2
   LET  j = f(i)
   IF j > mx THEN 
      LET  mx = j
      LET  no = i
   END IF
NEXT I 
PRINT "f(";no;") =";mx
PRINT TIME - st;"sec"
END

DouKaku?

Language detail: BASIC

Unsolved challenges

codes

Index

Feed

Other

Link

Pathtraq