Latest comments for language 'BASIC' on doukaku.org

syat's comment on LL Golf Hole 3 - 13日の金曜日を数え上げる

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

[ BASIC ] [ download code ] ]

syat's comment on 2次元ランダムウォーク

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

[ BASIC ] [ download code ] ]

syat's comment on ピラミッドを作る

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

BASICで短さに挑戦。66B

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

[ BASIC ] [ download code ] ]

syat's comment on 出力の一時停止と再開

出力の一時停止と再開 (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

[ BASIC ] [ download code ] ]

syat's comment on データの整列

データの整列 (Nested Flatten)

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

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

[ BASIC ] [ download code ] ]

syat's comment on 固定長データ

固定長データ (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

[ BASIC ] [ download code ] ]

syat's comment on Hello, world!その２

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

[ BASIC ] [ download code ] ]

pooq's comment on 立方根の計算

立方根の計算 (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

[ BASIC ] [ download code ] ]

pooq's comment on 除算・余剰を使わずに閏年

除算・余剰を使わずに閏年 (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

[ BASIC ] [ download code ] ]

pooq's comment on コラッツ・角谷の問題

コラッツ・角谷の問題 (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

[ BASIC ] [ download code ] ]

xsd's comment on 九九の表示

九九の表示 (Nested Flatten)

どうやって右端を揃うようにレイアウトするか、という重要な要件をあえてユーザーの反射神経に委ねてみました。
左右に移動しながら表示されるので、適当なところでキーを押すと止まります。

N88-BASICで昔のゲーム風に。

(補足)
195 E=0
を加えると、ユーザー入力無しでレイアウトされます。

100 DEFINT A-Z
110 FOR I = 1 TO 9
120   FOR J = 1 TO 9
130     S$ = RIGHT$(" "+STR$(I*J),2)+" "+CHR$(13)
140     X=7:VX=-1:E=1
150     WHILE E
160       PRINT STR$(I)+" *"+STR$(J)+" ="+SPACE$(X/3)+S$;
170       X=X+VX
180       IF X<4 OR X>10 THEN VX=-VX
190       IF INKEY$<>"" THEN E=0
200     WEND
210     PRINT
220   NEXT J
230 NEXT I


--- 筆者実行例
run
 1 * 1 =   1
 1 * 2 =  2
 1 * 3 =    3
 1 * 4 =   4
^C
Break in 170
Ok

[ BASIC ] [ download code ] ]