スピログラフ（幾何学アート）

投稿者：山中和義投稿日：2008年10月13日(月)22時35分55秒

返信・引用

!参考. リンク集より !　彷徨の神殿　http://stillbe.web.fc2.com/compendium/basic/index.html FUNCTION GCD(a,b) !最大公約数 IF b=0 THEN LET GCD=a ELSE LET GCD=GCD(b, MOD(a,b)) END FUNCTION LET r1=8 !固定円の半径 LET r2=5 !動く円の半径　※r1*r2>0なら内側、r1*r2<0なら外側 LET r3=4 !点Pの位置（動く円の中心から）　※r3=r2ならサイクロイド、r3≠r2ならトロコイド IF r1*r2>0 THEN LET sz=ABS(r1)+ABS(r3)+1 ELSE LET sz=ABS(r1)+ABS(r2)+ABS(r3)+1 END IF SET WINDOW -sz,sz,-sz,sz !表示領域 DRAW grid !座標 DRAW circle WITH SCALE(r1) !大きな円 LET iter=r2/GCD(r1,r2) !周回数 FOR th=0 TO 360*iter !STEP 0.2 !※疎になるなら調整 DRAW p WITH ROTATE(r1/r2*RAD(th))*SHIFT(r1-r2,0)*ROTATE(-RAD(th)) !点P NEXT th PICTURE p !原点（動く円の中心）を基準に点Pを描く DRAW disk WITH SCALE(0.1)*SHIFT(r3,0) !点P END PICTURE END

Re: スピログラフ（幾何学アート）

投稿者：山中和義投稿日：2008年10月14日(火)07時54分28秒

返信・引用　編集済

> No.19[元記事へ] 作画の様子をアニメーションさせてみました。 FUNCTION GCD(a,b) !最大公約数 IF b=0 THEN LET GCD=a ELSE LET GCD=GCD(b, MOD(a,b)) END FUNCTION LET r1=8 !固定円の半径 LET r2=5 !動く円の半径　※r1*r2>0なら内側、r1*r2<0なら外側 LET r3=4 !点Pの位置（動く円の中心から）　※r3=r2ならサイクロイド、r3≠r2ならトロコイド !LET r1=8 !固定円の直径 r1:r2=2:1 !LET r2=4 !LET r3=r2 !LET r1=12 !アステロイド 4:1 !LET r2=3 !LET r3=r2 !LET r1=5 !カージオイド 1:1 !LET r2=-5 !LET r3=ABS(r2) !LET r1=4 !ネフロイド 2:1 !LET r2=-2 !LET r3=ABS(r2) IF r1*r2>0 THEN IF ABS(r1)>ABS(r2) THEN LET sz=MAX(ABS(r1),ABS(r1-r2)+ABS(r3))+1 ELSE LET sz=ABS(r1)+ABS(r3)+1 END IF ELSE LET sz=ABS(r1)+ABS(r2)+ABS(r3)+1 END IF SET WINDOW -sz,sz,-sz,sz !表示領域 DRAW grid !座標 DRAW circle WITH SCALE(r1) !大きな円 LET iter=r2/GCD(r1,r2) !周回数 SET DRAW MODE NOTXOR DIM w(4,4) !ローカル座標をワールド座標に変換する MAT w=SHIFT(r1-r2,0) !１つ前 DRAW p(0) WITH w FOR th=0 TO 360*iter !STEP 0.2 !※疎になるなら調整 DRAW p(0) WITH w !１つ前を消す MAT w=ROTATE(-r1/r2*RAD(th)) * SHIFT(r1-r2,0)*ROTATE(RAD(th)) !姿勢と位置 DRAW p(1) WITH w !ワールド座標に、動く円と点Pを描く WAIT DELAY 0.02 NEXT th PICTURE p(f) !ローカル座標の原点を基準に、動く円と点Pを描く IF f=1 THEN !描画順を考慮して、先に点Pを描く SET DRAW MODE OVERWRITE !描画diskにNOTXORを反映させない DRAW disk WITH SCALE(0.2)*SHIFT(r3,0) SET DRAW MODE NOTXOR END IF DRAW circle WITH SCALE(r2) !動く円 PLOT LINES: 0,0; r3,0 END PICTURE END

画像縮小補正プログラム

投稿者：荒田浩二投稿日：2008年10月15日(水)19時32分55秒

返信・引用　編集済

第2掲示板では画像のアップもできるようなので、試しに画像縮小の補正プログラムを投稿します。 MAT PLOT CELLSで画像を縮小して描画したときに生じるジャギー(ギザギザ)を補正するものです。縮小により欠損する画素の色情報を周囲の画素と加重平均しました。補正できる縮小率は次の2通りです。　1/2,1/3,1/4,...といった 1/n のタイプ。　2/3,3/4,4/5,...といった (n-1)/n のタイプ。縮小率を入力すると、まず画面右下に補正なしの画像が描画されます。ビープ音の後、何かキーを押すと左下に補正した画像が描画されます。プログラムで読み込んでいる画像は十進BASIC添付ファイルですが、サイズが小さいためか補正の効果をあまり確認できません。ぜひ、アップした写真をデスクトップにでもコピー＆ペーストして試してみてください。この写真は個人が撮影したもので著作権に問題はありません。 (JPEG形式でUpしたので画質が落ちてますが、DownLoadするとBMP形式で保存されます。) (掲示されているサイズは400×300、拡大すると元のサイズ800×600になります。どちらのサイズもダウンロードできます) REM ** 画像縮小補正プログラム ** OPTION ARITHMETIC NATIVE DECLARE EXTERNAL SUB revision1,revision2 GLOAD "C:\Program Files\Decimal BASIC\BASICw32\SAMPLE\ZENKOUJI.JPG" LET px0=PIXELX(1) LET py0=PIXELY(1) SET WINDOW 0,px0,0,py0 DIM pict0(0 TO px0,0 TO py0) ! 元画像(配列の下限は0以外も可) SET COLOR MODE "NATIVE" ASK PIXEL ARRAY (0,py0) pict0 ! 元画像の色指標 DO LET err=0 INPUT PROMPT "[縮小率入力] 分子,分母 (分子=1 or 分子=分母-1)" : num,denom IF num<1 OR INT(num)<>num THEN LET err=1 IF denom<2 OR INT(denom)<>denom THEN LET err=1 IF num<>1 AND num<>denom-1 THEN LET err=1 LOOP UNTIL err=0 LET t0=TIME LET kk=num/denom ! 縮小率 MAT PLOT CELLS, IN px0-px0*kk,py0*kk ; px0,0 : pict0 !! 補正なし ! LET px9=INT(SIZE(pict0,1)*kk+0.00001)-1 ! k=1/3,3*k<>1に対応 LET py9=INT(SIZE(pict0,2)*kk+0.00001)-1 DIM pict9(0 TO px9,0 TO py9) ! 縮小補正画像(配列の下限は0) IF num=1 THEN CALL revision1(pict0,pict9,denom) ! 縮小率=1/n ELSE CALL revision2(pict0,pict9,denom) ! 縮小率=(n-1)/n END IF IF TIME-t0<0.2 THEN WAIT DELAY 0.2 BEEP SET TEXT COLOR "RED" SET TEXT HEIGHT py0/30 PLOT TEXT ,AT 1,1 : "PUSH ANY KEY" DO FOR i=8 TO 239 IF GetKeyState(i)<0 THEN EXIT DO NEXT i LOOP MAT PLOT CELLS, IN 0,py9 ; px9,0 : pict9 !! 補正あり BEEP END REM 縮小率=1/n (1/2,1/3,1/4,...) EXTERNAL SUB revision1(sp0(,),sp9(,),k) OPTION ARITHMETIC NATIVE LET kk=1/k DIM c9(3) LET lx0=LBOUND(sp0,1) LET ly0=LBOUND(sp0,2) LET ux0=UBOUND(sp0,1) LET uy0=UBOUND(sp0,2) LET ux9=UBOUND(sp9,1) LET uy9=UBOUND(sp9,2) FOR i=lx0 TO ux0-(k-1) STEP k FOR j=ly0 TO uy0-(k-1) STEP k MAT c9=ZER FOR ii=0 TO k-1 FOR jj=0 TO k-1 CALL acm(i+ii,j+jj) NEXT jj NEXT ii LET sp9((i-lx0)*kk,(j-ly0)*kk)=COLORINDEX(c9(1)/k^2,c9(2)/k^2,c9(3)/k^2) NEXT j NEXT i LET rm2=MOD(uy0,k) ! 縁(横)の処理 IF rm2<>k-1 THEN FOR i=lx0 TO ux0-(k-1) STEP k MAT c9=ZER FOR j=0 TO rm2 CALL acm(i,uy0-j) NEXT j LET sp9((i-lx0)*kk,uy9)=COLORINDEX(c9(1)/(rm2+1),c9(2)/(rm2+1),c9(3)/(rm2+1)) NEXT i END IF LET rm1=MOD(ux0,k) ! 縁(縦)の処理 IF rm1<>k-1 THEN FOR j=ly0 TO uy0-(k-1) STEP k MAT c9=ZER FOR i=0 TO rm1 CALL acm(ux0-i,j) NEXT i LET sp9(ux9,(j-ly0)*kk)=COLORINDEX(c9(1)/(rm1+1),c9(2)/(rm1+1),c9(3)/(rm1+1)) NEXT j END IF IF rm1<>k-1 OR rm2<>k-1 THEN ! 角の処理 MAT c9=ZER FOR i=0 TO rm1 FOR j=0 TO rm2 CALL acm(ux0-i,uy0-j) NEXT j NEXT i LET rm12=(rm1+1)*(rm2+1) LET sp9(ux9,uy9)=COLORINDEX(c9(1)/rm12,c9(2)/rm12,c9(3)/rm12) END IF SUB acm(x0,y0) ASK COLOR MIX(sp0(x0,y0)) b,g,r LET c9(1)=c9(1)+b LET c9(2)=c9(2)+g LET c9(3)=c9(3)+r END SUB END SUB REM 縮小率=(n-1)/n (2/3,3/4,4/5,...) EXTERNAL SUB revision2(sp0(,),sp9(,),k) OPTION ARITHMETIC NATIVE DECLARE FUNCTION c_ave LET kk=(k-1)/k LET num1=(k-1)-1 LET lx0=LBOUND(sp0,1) LET ly0=LBOUND(sp0,2) LET ux0=UBOUND(sp0,1) LET uy0=UBOUND(sp0,2) LET ux9=UBOUND(sp9,1) LET uy9=UBOUND(sp9,2) FOR i=lx0 TO ux0-k STEP k FOR j=ly0 TO uy0-k STEP k CALL center CALL side1(i,j,1,0) CALL side1(i+k,j,-1,num1) CALL side2(i,j,1,0) CALL side2(i,j+k,-1,num1) CALL corner(i,j,1,1,0,0) CALL corner(i,j+k,1,-1,0,num1) CALL corner(i+k,j,-1,1,num1,0) CALL corner(i+k,j+k,-1,-1,num1,num1) NEXT j NEXT i LET x8=(i-lx0-k)*kk+num1 LET y8=(j-ly0-k)*kk+num1 IF uy9<>y8 THEN CALL edge1 IF ux9<>x8 THEN CALL edge2 IF ux9<>x8 AND uy9<>y8 THEN CALL edge_corner FUNCTION c_ave(c1,c2) ! 色強度加重平均 ASK COLOR MIX(c1) b1,g1,r1 ASK COLOR MIX(c2) b2,g2,r2 LET c_ave=COLORINDEX((b1+2*b2)/3,(g1+2*g2)/3,(r1+2*r2)/3) END FUNCTION SUB center FOR ii=2 TO num1 FOR jj=2 TO num1 LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+jj-1)=sp0(i+ii,j+jj) NEXT jj NEXT ii END SUB SUB side1(x,y,ii,m) FOR jj=2 TO num1 LET sp9((i-lx0)*kk+m,(j-ly0)*kk+jj-1)=c_ave(sp0(x,y+jj),sp0(x+ii,y+jj)) NEXT jj END SUB SUB side2(x,y,jj,n) FOR ii=2 TO num1 LET sp9((i-lx0)*kk+ii-1,(j-ly0)*kk+n)=c_ave(sp0(x+ii,y),sp0(x+ii,y+jj)) NEXT ii END SUB SUB corner(x,y,ii,jj,m,n) ASK COLOR MIX(sp0(x,y)) b1,g1,r1 ASK COLOR MIX(sp0(x,y+jj)) b2,g2,r2 ASK COLOR MIX(sp0(x+ii,y)) b3,g3,r3 ASK COLOR MIX(sp0(x+ii,y+jj)) b4,g4,r4 LET bb=(b1+2*b2+2*b3+4*b4)/9 LET gg=(g1+2*g2+2*g3+4*g4)/9 LET rr=(r1+2*r2+2*r3+4*r4)/9 LET sp9((i-lx0)*kk+m,(j-ly0)*kk+n)=COLORINDEX(bb,gg,rr) END SUB SUB edge1 FOR i=lx0 TO ux0-k STEP k ! 下辺の処理 FOR ii=0 TO num1 FOR jj=0 TO uy9-y8-2 LET sp9((i-lx0)*kk+ii,uy9-jj)=sp0(i+ii+1,uy0-jj) NEXT jj LET sp9((i-lx0)*kk+ii,uy9-jj)=c_ave(sp0(i+ii+1,uy0-(jj+1)),sp0(i+ii+1,uy0-jj)) NEXT ii NEXT i END SUB SUB edge2 FOR j=ly0 TO uy0-k STEP k ! 右辺の処理 FOR jj=0 TO num1 FOR ii=0 TO ux9-x8-2 LET sp9(ux9-ii,(j-ly0)*kk+jj)=sp0(ux0-ii,j+jj+1) NEXT ii LET sp9(ux9-ii,(j-ly0)*kk+jj)=c_ave(sp0(ux0-(ii+1),j+jj+1),sp0(ux0-ii,j+jj+1)) NEXT jj NEXT j END SUB SUB edge_corner FOR ii=ux9 TO x8+1 STEP-1 FOR jj=uy9 TO y8+1 STEP-1 LET sp9(ii,jj)=sp0(ux0-(ux9-ii),uy0-(uy9-jj)) NEXT jj NEXT ii END SUB END SUB

Re: 画像縮小補正プログラム

投稿者：山中和義投稿日：2008年10月18日(土)20時06分51秒

返信・引用　編集済

> No.21[元記事へ] バイリニア法では、画像を縮小すればエッジ部分が強調される傾向があります。一般的な縮小率の場合、画像処理アプリケーションでの操作のように縮小率に応じて平滑化（ぼかす）して、バイリニア法で縮小すればよいかと思います。別解　※MAT文を使って処理が速くなりました。 !離散コサイン変換（DCT:Discrete Cosine Transform）による拡大縮小 OPTION ARITHMETIC NATIVE LET N=8 !ブロックサイズ FUNCTION phi(k,i,N) !基底関数φk(i) IF k=0 THEN LET phi=1/SQR(N) ELSE LET phi=SQR(2/N)*COS((2*i+1)*k*PI/(2*N)) END IF END FUNCTION SUB DCT(f(,),TBL(,),iTBL(,), FF(,)) !DCT変換 MAT FF=TBL*f MAT FF=FF*iTBL !F(k,l)=Σ[j=0,N-1]Σ[i=0,N-1]f(i,j)*φk(i)*φl(j) END SUB SUB iDCT(FF(,),TBL(,),iTBL(,), f(,)) !DCT逆変換 MAT f=iTBL*FF MAT f=f*TBL !f(i,j)=Σ[l=0,N-1]Σ[k=0,N-1]F(k,l)*φk(i)*φl(j) END SUB DIM TBLn(0 TO N-1,0 TO N-1) !変換行列 T MAT TBLn=ZER FOR k=0 TO N-1 !N×Nブロックのφk(i)のテーブルをつくる FOR i=0 TO N-1 LET TBLn(k,i)=phi(k,i,N) NEXT i NEXT k !!!MAT PRINT TBLn; DIM iTBLn(N,N) !※T^-1=T^t、∵ユニタリー行列 MAT iTBLn=TRN(TBLn) !-------------------- ここまでがサブルーチン SET COLOR MODE "NATIVE" !GLOAD "c:\BASICw32\SAMPLE\ZENKOUJI.JPG" !画像を読み込む GLOAD "c:\My Documents\test2.bmp" !画像を読み込む ASK PIXEL SIZE (0,0; 1,1) w,h !画像の縦横の大きさ(ピクセル単位)を調べる DIM p(w,h) !画像の大きさに対応する配列要素を用意する ASK PIXEL ARRAY (0,1) p !画像の各点の色情報を配列に格納する PRINT "画像の大きさ縦:";h;" 横:";w !SET BITMAP SIZE w,h !ウィンドウの大きさを画像に合わせる LET A=5 !拡大縮小率 A/N !LET A=11 !拡大縮小率 LET ww=INT(w*A/N+0.5) !変換後の画像の大きさ LET hh=INT(h*A/N+0.5) PRINT A;"/";N;"倍（縦横比は固定）縦:";hh;" 横:";ww IF ww<=0 OR hh<=0 THEN PRINT "画像の大きさが０または負になります。" STOP END IF DIM q(ww,hh) !変換後の画像を格納する配列 LET t0=TIME DIM TBLa(0 TO A-1,0 TO A-1) MAT TBLa=ZER FOR k=0 TO A-1 !A×Aブロックのφk(i)のテーブルをつくる FOR i=0 TO A-1 LET TBLa(k,i)=phi(k,i,A) NEXT i NEXT k DIM iTBLa(0 TO A-1,0 TO A-1) MAT iTBLa=TRN(TBLa) FOR by=0 TO INT((h-1)/N) !ブロック単位に分割する FOR bx=0 TO INT((w-1)/N) FOR j=1 TO N !ブロック内の画像 LET y=by*N+j IF y>h THEN EXIT FOR !下端なら FOR i=1 TO N LET x=bx*N+i IF x>w THEN EXIT FOR !右端なら !!!PRINT x;y,i;j LET c=p(x,y) ASK COLOR MIX(c) r,g,b !RGBを取得する DIM Br(N,N),Bg(N,N),Bb(N,N) !画素の色濃度　※画像信号 f(i,j) LET Br(i,j)=r LET Bg(i,j)=g LET Bb(i,j)=b NEXT i NEXT j DIM BVr(N,N),BVg(N,N),BVb(N,N) !DCT係数 F(k,l) CALL DCT(Br,TBLn,iTBLn, BVr) CALL DCT(Bg,TBLn,iTBLn, BVg) CALL DCT(Bb,TBLn,iTBLn, BVb) !※縮小なら高周波成分の行と列を除く、拡大なら不足部分は０を補う DIM Tr(A,A),Tg(A,A),Tb(A,A) IF A>N THEN !拡大なら MAT Tr=ZER(A,A) MAT Tg=ZER(A,A) MAT Tb=ZER(A,A) END IF FOR j=1 TO MIN(N,A) !copy it FOR i=1 TO MIN(N,A) LET Tr(i,j)=BVr(i,j) LET Tg(i,j)=BVg(i,j) LET Tb(i,j)=BVb(i,j) NEXT i NEXT j DIM iBr(A,A),iBg(A,A),iBb(A,A) !画素の色濃度　※画像信号 f(i,j) CALL iDCT(Tr,TBLa,iTBLa, iBr) CALL iDCT(Tg,TBLa,iTBLa, iBg) CALL iDCT(Tb,TBLa,iTBLa, iBb) FOR j=1 TO A !画像に割当てる LET yy=by*A+j IF yy>hh THEN EXIT FOR !下端なら FOR i=1 TO A LET xx=bx*A+i IF xx>ww THEN EXIT FOR !右端なら LET r=MIN(iBr(i,j)*A/N,1) !輝度調整 LET g=MIN(iBg(i,j)*A/N,1) LET b=MIN(iBb(i,j)*A/N,1) LET q(xx,yy)=colorindex(r,g,b) !指定位置の画素に書き込む NEXT i NEXT j NEXT bx NEXT by SET BITMAP SIZE ww,hh !ウィンドウの大きさを画像に合わせる MAT PLOT CELLS, IN 0,1; 1,0 :q !画像を表示する PRINT PRINT "計算時間=";TIME-t0 END

質問

投稿者：ゆう投稿日：2008年10月19日(日)09時43分19秒

返信・引用

グラフを描いています。 2つの関数f(x)とg(x)によって囲まれた図形を塗りつぶしたいのですが、どうやってやったら出来ますか？回答お願いします。

Re: 質問

投稿者：山中和義投稿日：2008年10月19日(日)11時51分12秒

投稿者：山中和義投稿日：2008年11月18日(火)18時56分39秒

投稿者：山中和義投稿日：2008年11月27日(木)19時37分25秒

投稿者：GAI 投稿日：2008年12月 1日(月)22時44分34秒

返信・引用

トランプが続いてすみませんが、次の手順を再現できるプログラムができないでしょうか？１．一組のカード（５２枚）をまずよくシャッフルする。２．デックを表向きに持ち、奇数のカードをアップジョグ（上にすこしずらす）していき　　これらのカード全てを抜き取り（順番を変えないで）、ボトム側へ回す。３．上半分（偶数群）から４，８，Q　のカードを、　　下半分（奇数群）から３，７，J　のカードをアップジョグしていき、これらを抜き取り、ボトムへ４．上三分の一位から２，１０のカード　　中三分の一位からA，９のカード　　下三分の一位から７，８のカードをアップジョグして、これを抜き取りボトムへ５．上から順に、６，５，４，３，２，Aのカードをアップジョグして抜き取りボトムへ６．赤カードをアップジョグしてボトムへ７．上半分（黒カード群）からクラブ、下半分（赤カード群）からダイアカードをアップジョグしてボトムへ以上の手順を行なうと、デックは裏向きトップからダイア、クラブ、ハート、スペードの順に A,2,3,・・・J,Q,k　と揃う。（原理は２進法の応用）これをどのカードを選びますか？の質問を受けながら入力待ちとして（2番では奇数、６番では赤、7番ではマーク、他は数字）進行していけるようにしたい。他の任意のカードの配列もこの方法を使って調べたいので、数字と色とマークが独立に選択できていけるよであればうれしいのですが...

Re: 再度トランプで

投稿者：山中和義投稿日：2008年12月 3日(水)11時06分36秒

返信・引用

> No.139[元記事へ] GAIさんへのお返事です。 > トランプが続いてすみませんが、次の手順を再現できるプログラムができないでしょうか？ > これをどのカードを選びますか？ > の質問を受けながら入力待ちとして（2番では奇数、６番では赤、7番ではマーク、他は数字）進行していけるようにしたい。メニュー形式ではありませんが、再現するプログラムを試作してみました。コーディング形式がマンネリなので、今回は「文字列操作」でカードの動きを実現しています。また、ビジュアル表示も追加していますが、必要に応じてその部分を削除してください。十進BASICは、ビットマップ画像の処理が苦手ですから処理速度は期待できません。ここからダウンロード（実行画面）

カードが並んでいます

投稿者：GAI 投稿日：2008年12月 3日(水)19時28分13秒

返信・引用

おおおおーワンダフル。トランプが実際に並んでいます。（どこから現れたのか？）いちいち手作業でやっていた操作が一瞬で終了します。しかも毎回カードは見事にばらばらでスタートできます。中の構造はおぼろげながら読み解けますが、細部はまだ解読する力が私にはありません。こんな長い過程のプログラムがよくこんな短時間にできますね。問題を見た瞬間、だいたいこうプログラムを組めばいいんだとわかるもんなんですか？プログラムを恐る恐る一部手直しをして、例えばダイアの２，４，５のカードだけをアウトジョグしてボトムへ回そうとあれこれ挑戦したのですが、いずれも機械がいうことを聞いてくれません。ダイアと他のマークを含めた２，４，５のカードがアウトジョグされたりします。 AND で繋ごうと試みても、”ここにはANDは入れられません”などのコメントを受けます。プログラムで特定のカード（マークと数字の指定）を、アウトジョグするにはどのように記述したらよいか教えてください。

Re: カードが並んでいます

投稿者：山中和義投稿日：2008年12月 3日(水)20時09分59秒

返信・引用

> No.141[元記事へ] GAIさんへのお返事です。 > 例えばダイアの２，４，５のカードだけをアウトジョグしてボトムへ回そう > プログラムで特定のカード（マークと数字の指定）を、アウトジョグするにはどのように記述したらよいか教えてください。 FOR i=1 TO N !該当するカード　※マークと数字 k=CNum(c$,i) IF CMark$(c$,i)="D" AND ( k=2 OR k=4 OR k=5 ) THEN LET flg(i)=1 NEXT i CALL shuffle(c$,flg) または FOR i=1 TO N !該当するカード　※カード SELECT CASE CGet$(c$,i) CASE "D2","D4","D5" LET flg(i)=1 CASE ELSE END SELECT NEXT i CALL shuffle(c$,flg)

旧掲示板

投稿者：白石　和夫投稿日：2008年12月 4日(木)20時48分13秒

返信・引用

旧掲示板が復活しています。フリーソフトWeBoxを利用してWeb全体を取り込んで過去ログのページにアップしました。

http://www.geocities.jp/thinking_math_education/log/logs.html

グラフィックでお願いします。

投稿者：GAI 投稿日：2008年12月 5日(金)07時34分7秒

返信・引用

カードでのグラフィックが可能なことを利用して、次の現象を再現したいのですが絵札（J,Q,K)とAの１６枚を使う。このカードを裏向きに４×４の行列形式に並べ(下の番号順に並べる）カードの位置を（演者側から見た番号） 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 とする。これ全体を一枚の紙と見立てて一枚のカードの大きさに折る操作を行なう。＜折り方の方法＞何処の位置（カードとカードの間の縦または横線）でもかまわない部分を指定してもらい例えば 1 2 3 4 -------------- 　　　 5 6 7 8 の間の線ならば、1 2 3 4 のカードをひっくり返して　　　　　　　　5 6 7 8 のカードの上に重ねる。また　2 | 3 6 | 7 10 | 11 14 | 15 の線なら右半分（または左半分でもよい。）を全て折り返して(カードはひっくり返ることになる。） 3 → 2 4 → 1 7 → 6 8 → 5 11 → 10 12 → 9 15 → 14 16 → 13 と重ねることとする。これを客にその都度線を指定させ、１６枚のカードが一つに重なるまで続ける。（パケットは表向き、裏向きが混ざった状態にある。）このパケットにおまじないをかけ、テーブルにリボンスプレッドしてみる。（このとき、パケット全体をひっくり返しておく必要がある時が起きることもある。）（パターンK）仕込み：１６枚のパケットの上から3,4,9,12枚目にKを配置しておく。スタート：４×４に並べたカードの　　　　　1,4,6,8,11,12,14,16番を表向きにする。（これは客から見てKに見える。）（パターンA）仕込み：１６枚のパケットの上から5,7,8,16枚目にAを配置しておく。スタート：４×４に並べたカードの　　　　　1,3,5,6,7,9,11,14番を表向きにする。（これは客から見てAに見える。）（パターンJ）仕込み：１６枚のパケットの上から4,9,10,15枚目にJを配置しておく。スタート：４×４に並べたカードの　　　　　2,5,7,9,12,13番を表向きにする。（これは客から見てJに見える。）（パターンQ）仕込み：１６枚のパケットの上から1,4,14,16枚目にQを配置しておく。スタート：４×４に並べたカードの　　　　　3,4,6,8,9,11番を表向きにする。（これは客から見てQに見える。これは少し苦しい）これらの仕込みと最初の初期設定からの折り返しを繰り返して、最後のパケットでのスプレッドをするとそれぞれのパターンでの４枚だけのカードが表向きで出現し、他のカードは裏向きになっている。というものです。（すみません、説明が長すぎて・・・）

Re: グラフィックでお願いします。

投稿者：山中和義投稿日：2008年12月 5日(金)19時39分34秒

投稿者：山中和義投稿日：2009年 2月 2日(月)10時38分2秒

投稿者：SECOND 投稿日：2009年 2月 9日(月)12時48分25秒

返信・引用　編集済

この回路で、700Hz 付近の、入出力電圧比を、計算して下さい。きっと、信じられないことが、見つかります。

Re: コンデンサと、抵抗だけ？

投稿者：大熊　正投稿日：2009年 2月10日(火)10時18分37秒

返信・引用

> No.268[元記事へ] SECONDさんへのお返事です。 > この回路で、700Hz 付近の、入出力電圧比を、計算して下さい。 > きっと、信じられないことが、見つかります。大熊です。最近、習い覚えた節点方程式で解いたところ、確かに 700Hz付近で0.7dB 程度の盛り上がりが、ゆるやかにありました。パッシブ素子のみで、トランスみたいな動作をするのは確かに不思議です。そこで御質問いたします。（１）この回路は「？？？回路」として有名な回路なのですか。（２）既に、なにかの製品に使われてるのでしょうか。その他（１）10進BASIC で既に作られた科学技術のソフトを　電気、　　　土木、医療・・・・などと分類して登録してある　　　インターネットの場所はありませんか。　　　LINUX でそういうのが、ある事を最近知りました。　　　10進BASIC でもあれば、皆が大層便利に使い発展に　　　繋がると思います。敬具

宣言可能な配列の大きさの上限

投稿者：白石　和夫投稿日：2009年 2月10日(火)11時28分54秒

返信・引用

> No.252[元記事へ] 十進BASICが記憶領域として用いるメモリは大別してヒープとスタックの2種類があります。スタックは，手続きの実行・終了にしたがって自動的に増減します。ヒープは手続きの進行と非同期に確保・解放されます。ヘルプの「言語使用の詳細」―「制限」の頁に記載されている「変数管理用メモリ」はスタックメモリに割り当てる領域です。十進BASICは， LET N=1000 DIM A(N) のような拡張構文を許容するため，配列要素の実領域をヒープ上に確保します。 DIM B(1000) のようにFull BASIC規格の範囲で宣言された配列はスタックメモリ上に確保できますが，内部構造の複雑さを避けるためにどちらの形式の配列も配列要素はヒープ上に置いています。配列を多用するプログラムを実行する場合には，変数管理用メモリを小さくとったほうが有利です。しかし，ヒープから1回に取得できるメモリの大きさにはOS，開発言語および実行環境に由来する制限があります。実装メモリ1GB(ビデオメモリを含む)のWindows XP機で， BASIC.INIの[FRAME]セクションに Virtualmemory=16 の記述を追加して実験すると， 10 OPTION ARITHMETIC NATIVE 20 DIM A(88000000) 30 END 程度が限界で，このプログラムを実行するとHDDへのスワップが発生します。 20行を A(90000000)に変えるとメモリ不足のエラーになります。 2進モードでは数値変数1個で8バイト占有するので，88000000個の変数は704MBに相当します。なお，プログラムを実行すると，ヒープ領域のメモリの断片化が起こるので，プログラムの実行に成功したとき続けて要素数を増やしたプログラムを実行すると失敗する可能性が高くなります。成功した後の試行は，一旦，BASIC.EXEを終了・再起動後に行う必要があります。また，このことは，プログラムの開発のために何度もプログラムの実行をくり返すような場面にもあてはまります。

Re: コンデンサと、抵抗だけ？

投稿者：SECOND 投稿日：2009年 2月10日(火)20時01分34秒

返信・引用

> No.269[元記事へ] ＞（１）この回路は「？？？回路」として有名な回路なのですか。　　実は、このままでは、実用にならないのですが、もう１段のＣＲを追加し、　　ＣＲ３段型の昇圧回路にしたものが、５０年も大昔（1962年以前）に、　　Ｒ－Ｃカソード・ホロワ発振器　米国特許2769088 　　------------------------------------------------------------ 　　参考文献：　エレクトロニクスエンジニアのためのラプラス変換　　　　　　　　ホルブルーク著　宮脇一男訳（朝倉書店）　　------------------------------------------------------------ 　　３段以上にすると、０移相での昇圧効果が得られ、ボルテージ・フォロアー　　のような、電圧利得＜１　のバッファーだけで、出力インピーダンスの低い　　発振器が、作れます。　　　（下記ベクトル図参照。直感的把握には、この方が解り易い。）＞（２）既に、なにかの製品に使われてるのでしょうか。　　殆んど知られていません。調べてはいませんが、もう時効だとも、思います。＞その他＞（１）10進BASIC で既に作られた科学技術のソフトを　電気、　　　土木、医療・・・・などと分類して登録してある　　　インターネットの場所はありませんか・・・　　それが、できるといいですね。複素数も使えない御本家よりは、　　「十進ＢＡＳＩＣ」の方がいいです。

Re: コンデンサと、抵抗だけ？（２）

投稿者：大熊　正投稿日：2009年 2月12日(木)14時21分48秒

返信・引用

> No.271[元記事へ] SECONDさんへのお返事です。 > ＞（１）この回路は「？？？回路」として有名な回路なのですか。 > > 　　実は、このままでは、実用にならないのですが、もう１段のＣＲを追加し、 > 　　ＣＲ３段型の昇圧回路にしたものが、５０年も大昔（1962年以前）に、 > 　　Ｒ－Ｃカソード・ホロワ発振器　米国特許2769088 > 　　------------------------------------------------------------ > 　　３段以上にすると、０移相での昇圧効果が得られ、ボルテージ・フォロアー > 　　のような、電圧利得＜１　のバッファーだけで、出力インピーダンスの低い > 　　発振器が、作れます。 > 大熊　です。勇を鼓して、３段に挑戦しました。1.225khz付近で0.9dbの盛り上がりでした。何か、負荷が重いのだろうと、抵抗を図の下から1.5k,15k,150kと増やし、容量を逆に下から0.1uF,0.01uF,0.001uFと減らすと、実に1.225khz付近で1.99db の盛り上がりになりました。これなら発振しそうです。・・・尚、２段でもこのようにすると、700HZ付近で1.153dbと増えました。質問ですが（１）発振器とは、何処とー何処を　つなぐのでしょうか。（２）其の時、マトリクスも答えがグジャグジャと止まらなく　　　成るのでしょうか。・・・それで発振とする？？？。（３）・・・別に方程式を作り時間で解くのでしょうか。　　　このような時の方程式のサンプルを教えていただけると　　　ありがたいのですが。敬具

Re: コンデンサと、抵抗だけ？（２）

投稿者：SECOND 投稿日：2009年 2月13日(金)00時43分30秒

返信・引用　編集済

> No.272[元記事へ] 大熊　正さんへのお返事です。プログラムではない為、ここに適当ではありませんが、ご参考に。オペアンプ自体の周波数、位相特性が問題になるような高周波発振器でない場合、帰還回路の計算だけで、十分だと思います。発振条件は、ループゲイン１（0dB)、移相量は、０を含む２πの整数倍ですが、 0dB では、開始起動が、できない場合を含むため、ゲインを多めにします。しかし、正弦波が欲しい場合、起動の信頼性を確保する程度の少なめにしないと、元々が、高調波を含んだ歪波なのに、益々正弦波形から、遠くなります。どれくらい多目のゲインが適当かについて、数学的には１を越えてさえおれば、いいのですが、実際のアンプの場合、無歪の正弦波を、維持するゲインに命中させても、不安定で固定できません。出力振幅で、抵抗値の変化する素子を用い、ゲインの自動制御をしない限り、正弦波は無理です。一般の発振器は、波形の尖頭を、出力飽和に、ぶつける事で、安定を保っているため、必ず歪んでいます。発振回路は、線型である限り、無限大か、減衰停止か、どちらかに流れますが、計算上は、１周ループの伝達関数（出力／入力）を複素数で求め、（実数部＝１、虚数部＝０）になる条件で、解としているようです。下図は、ＣＡＤで、発振させた例で、実物には、さらに、ダイナミック・レンジや、直流バイアスを、検討します。（適当な参考書をさがして下さい。）

Re: コンデンサと、抵抗だけ？（２）

投稿者：SECOND 投稿日：2009年 2月13日(金)06時08分54秒

投稿者：SECOND 投稿日：2009年 2月19日(木)11時24分57秒

返信・引用　編集済

> No.267[元記事へ] 大熊　正さんへのお返事です。 ! Rsを付加するのは、良くありません。 ! 下の２つの回路は、同じものです。テブナンの定理を。 ! ┌─C2─┬──────┐ ! │ │ ┌──┐ │ ! │ └─┤- │ │ ! │ │ ├─⑤─ ! ┌─R1─①─R2─②─R3─③─┤+ │ ↑ V5 ! ↑ ↑V1 ↑V2 ↑V3└──┘ │ ! Vin C1 C3 K=1 │ ! │ │ │ │ ! ０───┴───────┴──────┴─ ! ! |(1/R1)+(1/R2)+ω*C1*j -(1/R2) 0 | |V1| |Vin/R1| ! |-(1/R2) (1/R2)+(1/R3)+ω*C2*j -(1/R3)-K*ω*C2*j| |V2|=| 0 | ! |0 -(1/R3) (1/R3)+ω*C3*j | |V3| | 0 | ! ! ┌─C2─┬──────┐ ! │ │ ┌──┐ │ ! │ └─┤- │ │ ! ┌─────┐ │ │ ├─⑤─ ! │　┌─R1─①─R2─②─R3─③─┤+ │ ↑ V5 ! ↑ │　 ↑V1 ↑V2 ↑V3└──┘ │ ! Is=Vin/R1 │ C1 C3 K=1 │ ! ↑ │ │ │ │ ! ┴─０───┴───────┴──────┴─ ! ! Ｋ≒１は、ボルテージフォロアとしての利得で、AMP自体の電圧利得は、10E6 程度に極めて大きい。 ! 回路上で、Ｋ＜＞１にするには、 !　V5～Amp(-in)間に、減衰器を挿入→ Ｋ＞１、減衰器出力内部抵抗は、大きくても可。 !　V5～C2 間に、減衰器を挿入→ Ｋ＜１、減衰器出力内部抵抗は、十分に小さい事。 ! OPTION ANGLE DEGREES OPTION ARITHMETIC COMPLEX LET j=COMPLEX(0,1) LET NP=3 DIM FREQ(57,5), A(NP,NP), T(NP,NP), EOUT(NP,1), B(NP,1) !---- ! 周波数10Hz~100KHz、等比ステップ FOR i=1 TO 57 LET FREQ(i,1)=10^(1+4*(i-1)/56) NEXT i !---- ! CR 3段回路 LET R1=51000 !Ω LET R2=82000 !Ω LET R3=39000 !Ω LET C1=0.00685/(10^6) !F LET C2=0.022/(10^6) !F LET C3=330/(10^12) !F !---- SET WINDOW 0.5,5.5, -55,5 DRAW grid(1,5) FOR K=1-0.0125 TO 1.0125 STEP 0.0125 FOR P=1 TO 57 LET ω=(2*PI*FREQ(P,1)) ! LET A(1,1)=(1/R1)+(1/R2)+j*ω*C1 LET A(1,2)=-(1/R2) LET A(1,3)=0 ! LET A(2,1)=-(1/R2) LET A(2,2)=(1/R2)+(1/R3)+j*ω*C2 LET A(2,3)=-(1/R3)-K*j*ω*C2 ! LET A(3,1)=0 LET A(3,2)=-(1/R3) LET A(3,3)=(1/R3)+j*ω*C3 ! LET Vin=1 !1V LET B(1,1)=(Vin/R1) !電圧源Vin 直列抵抗R1を、電流源Vin/R1 並列抵抗R1 に変形。 LET B(2,1)=0 LET B(3,1)=0 MAT T=INV(A) MAT EOUT=T*B LET EE1=EOUT(1,1) LET EE2=EOUT(2,1) LET EE3=EOUT(3,1) ! LET Gv=K*EOUT(3,1)/Vin LET FREQ(P,2)=20*LOG10(ABS(Gv)) LET Pv=arg(Gv) IF Pv>0 THEN LET Pv=Pv-360 LET FREQ(P,4)=Pv NEXT P !------ !リスト PRINT "K=";K PRINT "番号周波数 E5 θ5" FOR i=1 TO 57 PRINT USING "###": i; PRINT USING " ###,###.#" : FREQ(i,1); PRINT USING " ####.### dB": FREQ(i,2); PRINT USING " ####.### 度": FREQ(i,4) NEXT i !------ !グラフ FOR f=1 TO 6 SET TEXT COLOR "black" PLOT TEXT ,AT f-0.1, 1: mid$("10 100 1k 10k 100k ",4*(f-1)+1,4) !ｘ軸 10Hz^100kHz PLOT TEXT ,AT 0.8,-10*(f-1)-2: mid$(" 0 -25 -50 -75 -100-125 ",4*(f-1)+1,4) !左y軸 0~-125dB SET TEXT COLOR "red" PLOT TEXT ,AT 5.1,-10*(f-1)-2: mid$(" 0 -80 -160-240-320-400 ",4*(f-1)+1,4) !右y軸 0~-400° NEXT f SET LINE COLOR "black" FOR i=1 TO 57 PLOT LINES:LOG10(FREQ(i,1)) ,FREQ(i,2)/2.5; !利得[dB] NEXT i PLOT LINES SET LINE COLOR "red" FOR i=1 TO 57 PLOT LINES:LOG10(FREQ(i,1)) ,0.125*FREQ(i,4); !位相角度[度] NEXT i PLOT LINES NEXT K END

Re: 節点解析法について　（３）

投稿者：大熊　正投稿日：2009年 2月20日(金)14時06分15秒

返信・引用

> No.284[元記事へ] SECONDさんへのお返事です。 > ! Rsを付加するのは、良くありません。 > ! 下の２つの回路は、同じものです。テブナンの定理を。 > ! > ! |(1/R1)+(1/R2)+ω*C1*j -(1/R2) 0 | |V1| |Vin/R1| > ! |-(1/R2) (1/R2)+(1/R3)+ω*C2*j -(1/R3)-K*ω*C2*j| |V2|=| 0 | > ! |0 -(1/R3) (1/R3)+ω*C3*j | |V3| | 0 | > ! > ! ┌─C2─┬──────┐ > ! │ │ ┌──┐ │ > ! │ └─┤- │ │ > ! ┌─────┐ │ │ ├─⑤─ > ! │　┌─R1─①─R2─②─R3─③─┤+ │ ↑ V5 > ! ↑ │　 ↑V1 ↑V2 ↑V3└──┘ │ > ! Is=Vin/R1 │ C1 C3 K=1 │ > ! ↑ │ │ │ │ > ! ┴─０───┴───────┴──────┴─ > ! > LET NP=3 > DIM FREQ(57,5), A(NP,NP), T(NP,NP), EOUT(NP,1), B(NP,1) > !---- > ! 周波数10Hz~100KHz、等比ステップ > FOR i=1 TO 57 > LET FREQ(i,1)=10^(1+4*(i-1)/56) > NEXT i > !---- > 大熊　です。お忙しいところ、色々御検討頂きまして有難うございます。（１）入力にRsが無くてもよいことや、（２）周波数10Hz~100KHz、等比ステップでプログラムが　　　簡素に綺麗になることなど勉強させていただきました。このプラグラムをコピーして、直ぐに動かしました。綺麗にグラフを描いてくれました。本当に有難うございます。今後とも御指導のほどよろしくお願いいたします。敬具

式の評価、もう１つの拡張

投稿者：山中和義投稿日：2009年 2月20日(金)15時39分28秒

返信・引用　編集済

「数の組」に対する「式の評価（計算）」ができるように次の拡張を行った。・構文解析と演算との部分を分離・FUNCTION文では返り値を１つのみのため、SUB文で記述「数の組」とは　　関数、変数、定数の通常の数式の場合、「値」（１つ）　　有理数の場合、「分子と分母」（２つ）　　複素数の場合、「実数部と虚数部」（２つ）　　ベクトル、行列の場合、「要素列」（ｎ個）　　１変数多項式の係数が整数の場合、「係数列」（ｎ個）　とする。記述例　１変数多項式の係数が整数の場合 !式（中置記法）の評価 - １変数多項式の係数が整数の場合　※UBASIC相当 DECLARE EXTERNAL SUB expr.eval !LET s$="(x-2)*(x-3)*(x-4)*(x-5)" LET s$="(x^2-2*x+3)^2" !LET s$="(x^5-5*x^3+5*x^2-1)/(x^2+3*x+1)" !商 x^3-3*x^2+3*x-1、余り 0 !LET s$="mod(2*x^3-13*x^2-26*x-15,x^2-2*x+3)" !商 2*x-9、余り -50*x+12 !LET s$="gcd(3*x^2+5*x-2,3*x^2-7*x+2)" !12*x-4 { 3*x-1 } !LET s$="lcm(3*x^2+5*x-2,3*x^2-7*x+2)" !3/4*x^3-1/4*x^2-3*x+1 { (x+2)*(x-2)*(3*x-1) } !LET s$="lcm(x^3-16*x,x^3-8*x^2+16*x)" DIM a(0 TO 8) !係数 a(n)*x^n+a(n-1)*x^(n-1)+ … +a(1)*x+a(0) CALL eval(s$, a,rc) !式 MAT PRINT a; !x^0,x^1,x^2, … の順　debug IF rc=0 THEN CALL poly_disp(a) !結果を表示する END MODULE expr PUBLIC NUMERIC p,ErrNo !共通変数 !●解析部分 !下位の共通ルーチン EXTERNAL FUNCTION token$(s$) !１文字読み込む CALL EatSpace(s$) IF p<=LEN(s$) THEN LET token$=s$(p:p) ELSE LET token$="" END FUNCTION EXTERNAL SUB EatSpace(s$) !空白を読み飛ばす DO WHILE s$(p:p)=" " AND p<=LEN(s$) LET p=p+1 LOOP END SUB EXTERNAL SUB CheckToken(s$,L$) !文字を確認する CALL EatSpace(s$) IF UCASE$(s$(p:p+LEN(L$)-1))<>L$ THEN CALL Error(L$&"がありません。") LET p=p+LEN(L$) !eat it END SUB EXTERNAL SUB Error(x$) !メッセージを表示する PRINT PRINT x$; p LET errNo=1 END SUB !上位ルーチン PUBLIC SUB eval EXTERNAL SUB eval(s$, v(),rc) !式の評価 LET errNo=0 !エラーコード LET p=1 !文字列へのポインタ CALL expression(s$, v) !計算する LET rc=errNo END SUB EXTERNAL SUB expression(s$, v()) !式 DIM w(0 TO UBOUND(v)) LET t$=token$(s$) IF t$="-" THEN !符号なら LET p=p+1 !eat it CALL term(s$, v) IF errNo<>0 THEN EXIT SUB CALL op_neg(v, v) !v=-v ELSE IF t$="+" THEN LET p=p+1 !eat it CALL term(s$, v) END IF IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) DO WHILE t$="+" OR t$="-" !加算、減算なら LET p=p+1 !eat it CALL term(s$, w) IF errNo<>0 THEN EXIT SUB IF t$="+" THEN !計算する CALL op_add(v,w, v) !v=v+w ELSE CALL op_sub(v,w, v) !v=v-w END IF IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) !次へ LOOP END SUB EXTERNAL SUB term(s$, v()) !項 DIM w(0 TO UBOUND(v)) CALL factor(s$,v) IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) DO WHILE t$="*" OR t$="/" !乗算、除算なら LET p=p+1 !eat it CALL factor(s$,w) IF errNo<>0 THEN EXIT SUB IF t$="*" THEN !計算する CALL op_mul(v,w, v) !v=v*w ELSE CALL op_div(v,w, v) !v=v/w END IF IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) !次へ LOOP END SUB EXTERNAL SUB factor(s$, v()) !因子 DIM w(0 TO UBOUND(v)) LET t$=token$(s$) IF t$="(" THEN !括弧なら LET p=p+1 !eat it CALL expression(s$,w) !式 IF errNo<>0 THEN EXIT SUB MAT v=w CALL CheckToken(s$,")") !閉じ括弧か確認する ELSE CALL num(s$,v) END IF IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) DO WHILE t$="^" !べき乗なら LET p=p+1 !eat it LET t$=token$(s$) IF t$="(" THEN !括弧なら LET p=p+1 !eat it CALL expression(s$,w) !式 IF errNo<>0 THEN EXIT SUB CALL CheckToken(s$,")") !閉じ括弧か確認する ELSE CALL num(s$,w) END IF IF errNo<>0 THEN EXIT SUB CALL op_pow(v,w, v) !計算する　v=v^w IF errNo<>0 THEN EXIT SUB LET t$=token$(s$) !次へ LOOP END SUB EXTERNAL SUB num(s$,v()) !数 DIM w(0 TO UBOUND(v)),x(0 TO UBOUND(v)) LET c=fnc(s$) IF c>0 THEN !関数なら LET t$=token$(s$) IF t$="(" THEN !括弧なら LET p=p+1 !eat it CALL expression(s$,w) !引数１ IF errNo<>0 THEN EXIT SUB MAT v=w CALL CheckToken(s$,",") !カンマか確認する CALL expression(s$,w) !引数２ IF errNo<>0 THEN EXIT SUB IF c=1 THEN !modpow(a,n,b)形式 CALL CheckToken(s$,",") !カンマか確認する CALL expression(s$,w) !引数３ IF errNo<>0 THEN EXIT SUB MAT x=w CALL set_fnc3(c,v,w,x, v) !v=fnc(v,w,x) ELSE CALL set_fnc2(c,v,w, v) !v=fnc(v,w) END IF IF errNo<>0 THEN EXIT SUB CALL CheckToken(s$,")") !閉じ括弧か確認する ELSE CALL Error("不正な文字です。") END IF ELSE LET c=var(s$) IF c>0 THEN !変数なら CALL set_var(c, v) ELSE LET c=number(s$) IF c>=0 THEN !定数（数値）なら CALL set_number(c, v) ELSE CALL Error("不正な文字です。") END IF END IF END IF END SUB EXTERNAL FUNCTION fnc(s$) !関数 DATA "MODPOW","MODINV","MOD","GCD","LCM" !※文字長が大きい順 LET k=0 DO LET k=k+1 READ IF MISSING THEN EXIT DO: d$ IF UCASE$(s$(p:p+LEN(d$)-1))=UCASE$(d$) THEN !一致したら LET p=p+LEN(d$) LET fnc=k EXIT FUNCTION END IF LOOP LET fnc=-1 END FUNCTION EXTERNAL FUNCTION var(s$) !変数 LET t$=UCASE$(token$(s$)) !大文字へ IF "A"<=t$ AND t$<="Z" THEN !!!IF t$="X" THEN LET p=p+1 !eat it LET var=ORD(t$)-ORD("@") !オフセット　@=0,A=1,B=2,…,Z=26 ELSE LET var=-1 END IF END FUNCTION EXTERNAL FUNCTION number(s$) !数値（０、正の整数） LET i0=p !先頭位置を記録する LET t$=token$(s$) DO WHILE t$>="0" AND t$<="9" LET p=p+1 LET t$=token$(s$) LOOP LET number=-1 IF p>i0 THEN LET number=VAL(s$(i0:p-1)) !数字列の範囲を切り取る END FUNCTION つづく

Re: 式の評価、もう１つの拡張

投稿者：山中和義投稿日：2009年 2月20日(金)15時42分40秒

返信・引用　編集済

> No.286[元記事へ] つづき !●演算部分　※「数の組」に応じて演算を定義する EXTERNAL SUB op_neg(v1(), v()) !符号（負） MAT v=(-1)*v1 END SUB EXTERNAL SUB op_add(v1(),v2(), v()) !加算 MAT v=v1+v2 END SUB EXTERNAL SUB op_sub(v1(),v2(), v()) !減算 MAT v=v1-v2 END SUB EXTERNAL SUB op_mul(v1(),v2(), v()) !乗算 LET N=UBOUND(v) DIM w(0 TO N*2) !桁数は２倍になる MAT w=ZER FOR i=0 TO N !係数 FOR j=0 TO N LET w(i+j)=w(i+j)+v1(i)*v2(j) !畳み込み NEXT j NEXT i IF poly_degree(w)>N THEN CALL Error("オーバーフロー") FOR i=0 TO N !下n桁をコピーする LET v(i)=w(i) NEXT i END SUB EXTERNAL SUB op_div(v1(),v2(), v()) !除算 DIM Q(0 TO UBOUND(v)),R(0 TO UBOUND(v)) IF poly_degree(v2)=0 AND v2(0)=0 THEN !定数の０なら CALL Error("０では割れません。") EXIT SUB END IF CALL poly_div(v1,v2, Q,R) MAT v=Q !商　※v=INT(v1/v2)に相当 END SUB EXTERNAL SUB op_pow(v1(),v2(), v()) !べき算 DIM x(0 TO UBOUND(v)),T(0 TO UBOUND(v)) MAT x=v1 !x=v1 MAT T=ZER !定数１ LET T(0)=1 IF poly_degree(v1)=0 THEN !定数項のみ（定数） IF poly_degree(v2)>0 THEN CALL Error("べき数は整数のみ") IF errNo<>0 THEN EXIT SUB IF v1(0)=0 AND v2(0)<0 THEN CALL Error("０の負べき乗") IF errNo<>0 THEN EXIT SUB LET v(0)=v1(0)^v2(0) ELSE IF poly_degree(v2)>0 OR v2(0)<0 THEN CALL Error("べき数は非負整数のみ") IF errNo<>0 THEN EXIT SUB LET m=v2(0) DO UNTIL m=0 IF MOD(m,2)=1 THEN CALL op_mul(T,x, T) !ビットが１なら、T=T*x IF errNo<>0 THEN EXIT SUB CALL op_mul(x,x, x) !x=x^2 IF errNo<>0 THEN EXIT SUB LET m=INT(m/2) !２進数にする LOOP MAT v=T END IF END SUB EXTERNAL SUB set_fnc(c,v1(), v()) !関数（値）を設定する　※引数１個 !該当関数なし END SUB EXTERNAL SUB set_fnc2(c,v1(),v2(), v()) !関数（値）を設定する　※引数２個 LET N=UBOUND(v) DIM Q(0 TO N),R(0 TO N),A(0 TO N),B(0 TO N) SELECT CASE c !各関数に応じて CASE 2 !modinv PRINT "modinv関数は未サポート！" CASE 3 !剰余 CALL poly_div(v1,v2, Q,R) MAT v=R !余り CASE 4,5 !最大公約数、最小公倍数 MAT A=v1 MAT B=v2 DO UNTIL poly_degree(B)=0 AND B(0)=0 !b=0 CALL poly_div(A,B, Q,R) !R=MOD(a,b) MAT A=B !a=b MAT B=R !b=R LOOP IF c=5 THEN !LCM=v1*v2/GCD(v1,v2) CALL op_div(v1,A, Q) IF errNo<>0 THEN EXIT SUB CALL op_mul(Q,v2, v) ELSE !GCD MAT v=A END IF CASE ELSE END SELECT END SUB EXTERNAL SUB set_fnc3(c,v1(),v2(),v3(), v()) !関数（値）を設定する　※引数３個 PRINT "modpow関数は未サポート！" END SUB EXTERNAL SUB set_var(c, v()) !変数（値） MAT v=ZER LET v(1)=1 !x^1の係数 END SUB EXTERNAL SUB set_number(c, v()) !定数（数値） MAT v=ZER LET v(0)=c !x^0の係数 END SUB END MODULE !補助ルーチン !演算関連 EXTERNAL SUB poly_div(A(),B(), Q(),R()) !除算　※被除数=商*除数+余り DIM w(0 TO UBOUND(A)) LET aa=poly_degree(A) LET bb=poly_degree(B) MAT Q=ZER !商、その次数 LET qq=MAX(aa-bb,0) MAT R=A !余り、その次数 LET rr=aa DO WHILE rr>=bb !被除数の次数が除数のより大きいなら IF R(rr)<>0 THEN !係数が０以外なら LET k=R(rr)/B(bb) !商の係数 LET Q(rr-bb)=k !商 MAT w=ZER !余り FOR i=bb TO 0 STEP -1 !R=A-k*B　※筆算参照 LET w(rr-bb+i)=k*B(i) NEXT i MAT R=R-w END IF LET rr=rr-1 !次の次数へ LOOP END SUB EXTERNAL FUNCTION poly_degree(v()) !次数を得る FOR i=UBOUND(v) TO 1 STEP -1 IF v(i)<>0 THEN EXIT FOR !係数が０でない最初の位置 NEXT i LET poly_degree=i END FUNCTION !表示関連 EXTERNAL SUB poly_disp(A()) !多項式を表示する　a(X)=ΣAkX^k=AnX^n+An-1X^n-1+…+A1X+A0 LET aa=poly_degree(A) !最初の項 CALL mono_disp(A(aa),aa) FOR i=aa-1 TO 0 STEP -1 !次項 LET w=A(i) IF w>0 THEN PRINT "+"; IF w<>0 OR (w=0 AND aa=0) THEN CALL mono_disp(w,i) NEXT i END SUB EXTERNAL SUB mono_disp(ak,k) !単項式を表示する　Ak*X^k IF k<>0 THEN !x^nで IF ak=1 THEN !係数が１なら ELSEIF ak=-1 THEN !係数が－１なら PRINT "-"; ELSE PRINT STR$(ak);"*"; END IF END IF IF k=0 THEN !次数が０なら PRINT STR$(ak); ELSEIF k=1 THEN !次数が１なら PRINT "X"; ELSE PRINT "X^";STR$(k); END IF END SUB 以上

Re: 節点解析法について　（３）

投稿者：SECOND 投稿日：2009年 2月22日(日)01時18分14秒

投稿者：yossy 投稿日：2009年 3月 7日(土)11時59分10秒

返信・引用

!Parabola Mandala（幾何学アート） OPTION ANGLE DEGREES SUB circle(a,b,r) FOR t=0 TO 360 PLOT LINES: a+r*COS(t),b+r*SIN(t); NEXT t PLOT LINES END SUB DEF f(x)=x^2-x LET c=(2*SQR(2)) LET d=(12*SQR(2))/5 LET e=(4-c) LET g=24/5 LET h=(SQR(2)-1) DIM M(4,4)!図形の裏返し MAT READ M DATA 0, 1, 0, 0 DATA 1, 0, 0, 0 DATA 0, 0, 1, 0 DATA 0, 0, 0, 1 !Lotus Mandala（右側の曼荼羅） SET BITMAP SIZE 800,400 SET WINDOW -6.8,6.8,-6.8,6.8 SET VIEWPORT 0.5,1.0,0,0.5 CALL circle(0,0,c) CALL circle(d,-d,e) CALL circle(-d,d,e) CALL circle(d,d,e) CALL circle(-d,-d,e) CALL circle(0,g,e) CALL circle(0,-g,e) CALL circle(g,0,e) CALL circle(-g,0,e) DRAW nike DRAW nike WITH ROTATE(90) DRAW nike WITH ROTATE(180) DRAW nike WITH ROTATE(270) DRAW nike WITH M DRAW nike WITH M*ROTATE(90) DRAW nike WITH M*ROTATE(180) DRAW nike WITH M*ROTATE(270) DRAW pothos WITH SCALE(h)*SHIFT(d,-d) DRAW pothos WITH SCALE(h)*ROTATE(180)*SHIFT(-d,d) DRAW pothos WITH SCALE(h)*ROTATE(90)*SHIFT(d,d) DRAW pothos WITH SCALE(h)*ROTATE(270)*SHIFT(-d,-d) DRAW pothos WITH M*SCALE(h)*ROTATE(180)*SHIFT(0,g) DRAW pothos WITH M*SCALE(h)*SHIFT(0,-g) DRAW pothos WITH M*SCALE(h)*ROTATE(90)*SHIFT(g,0) DRAW pothos WITH M*SCALE(h)*ROTATE(270)*SHIFT(-g,0) !Pothos Mandala（左側の曼荼羅） SET BITMAP SIZE 800,400 SET WINDOW -6.8,6.8,-6.8,6.8 SET VIEWPORT 0,0.5,0,0.5 CALL circle(0,0,c) CALL circle(d,-d,e) CALL circle(-d,d,e) CALL circle(d,d,e) CALL circle(-d,-d,e) CALL circle(0,g,e) CALL circle(0,-g,e) CALL circle(g,0,e) CALL circle(-g,0,e) DRAW pothos DRAW pothos WITH SCALE(h)*SHIFT(d,-d) DRAW pothos WITH SCALE(h)*ROTATE(180)*SHIFT(-d,d) DRAW pothos WITH SCALE(h)*ROTATE(90)*SHIFT(d,d) DRAW pothos WITH SCALE(h)*ROTATE(270)*SHIFT(-d,-d) DRAW pothos WITH M*SCALE(h)*ROTATE(180)*SHIFT(0,g) DRAW pothos WITH M*SCALE(h)*SHIFT(0,-g) DRAW pothos WITH M*SCALE(h)*ROTATE(90)*SHIFT(g,0) DRAW pothos WITH M*SCALE(h)*ROTATE(270)*SHIFT(-g,0) PICTURE nike FOR x=0 TO 2 STEP 0.01 PLOT LINES: x,f(x); NEXT x FOR x=9/4 TO 1/4 STEP -0.01 PLOT LINES: x-1/4,f(x)-13/16; NEXT x END PICTURE PICTURE pothos FOR y=-2 TO 1 STEP 0.01 PLOT LINES: -f(ABS(y)),y; NEXT y FOR x=-1/4 TO -9/4 STEP -0.01 PLOT LINES: x+1/4,SGN(x)*f(ABS(x))+13/16; NEXT x FOR x=-2 TO 2 STEP 0.01 PLOT LINES: x,SGN(x)*f(ABS(x)); NEXT x END PICTURE END

http://www15.plala.or.jp/pothos/

Heart Magic （幾何学アート）

投稿者：yossy 投稿日：2009年 3月 7日(土)12時36分29秒

返信・引用

投稿者：山中和義投稿日：2009年 4月18日(土)14時14分37秒

投稿者：SECOND 投稿日：2009年 5月 2日(土)17時18分22秒

投稿者：SECOND 投稿日：2009年 6月12日(金)05時12分43秒

投稿者：白石　和夫投稿日：2009年 9月 2日(水)16時17分39秒

投稿者：白石　和夫投稿日：2009年 9月 3日(木)20時58分3秒

返信・引用

> No.526[元記事へ] OPTION ARITHMETIC NATIVE だとまずいみたいです。調べてみます。

http://sourceforge.jp/projects/decimalbasic/

Re: 覆面算はどう解くのか？

投稿者：荒田浩二投稿日：2009年 9月 3日(木)23時03分29秒

返信・引用

> No.524[元記事へ] 島村1243さんへのお返事です。 > 荒田さんの作成されたプログラムを、「コピー貼り付け」でFedora10 Linux上のBASIC-6.5.9で > 走らせたら、BASIC本体がクラッシュ（何度行ってもダメ）してしまいましたのでご報告致しま > す。 > パソコンのRAMは512MBですが、メモリが足りないのでしょうか。それは申し訳ないことをしました。私はLinuxはまったく知らないのですが、WindowsVista上で十進BASIC Ver.7.3.3では問題なく実行できました。　可能性としては、実は最初に投稿したときに脱字がありました。10分後には修正して再投稿したのですが、島村1243さんが最初の投稿記事で実行されたのかもしれません。修正箇所は外部副プログラムの宣言文です。誤) DECLARE EXTERNAL SUB perm,chara,headset 正) DECLARE EXTERNAL SUB perm,charac,headset ただし、ヘルプによると外部副プログラムの宣言は必須のものではないらしく、最初の誤った記事でもWindowsでは問題なく実行できました。　また、512MBあれば「メモリー不足」ということも考えにくいですよね。関数changeは確かに頻繁に呼び出されますが、最大でも 4*10! 回です。しかも先頭文字O,T,F,Sのいずれかが0のときは呼び出さないのでメモリーが不足するとは思えません。　あるいは、十進BASICの独自拡張である「主プログラム内で変数のPUBLIC宣言」を利用していますが、この機能がLinuxでは上手く働かないのでしょうか？ごめんなさい、まったくわかりません。

Re: 覆面算はどう解くのか？

投稿者：白石　和夫投稿日：2009年 9月 4日(金)08時11分10秒

返信・引用

> No.527[元記事へ] 不具合箇所が特定できたので，修正版を作ります。 2進モードで次のプログラムを実行すると変な現象が起こります。 2進モードで文字列処理する人がいなかったのがバグ発覚が遅れた原因でしょうか。 OPTION ARITHMETIC NATIVE DIM a$(4) FOR i= 1 TO 4 PRINT a$(i) NEXT i END Linux版，Mac版はGPLなので「バグ報告の義務」を使用条件に書くことができないのですが，不具合を見つけたときは報告くださるようお願いします。

C++ data を　full basic で　graphick

投稿者：与坂　　昇平投稿日：2009年 9月 4日(金)10時00分41秒

返信・引用

有限要素法で　構造解析ソフトを　　作成しています接点数　　５５１１個の　　6層の　　フレ―ムを私の　ソフトで　解くと full basic で　　約　170時間　　かかりますそれを turbo C++ でとくと　　約　3時間の　　予定です turbo C++ で　　構造解析予定の 6層　フレ―ムの turbo C++ で　　作製した input data を数字の　　間に　　コンマ　印を　　入れるだけで簡単に full basic で　　computer graphic することに成功しましたファイル１　　に　　添付します turbo C++ での　　computer grahic は非常に　　難しく長い間　　悩んでいました

turbo C++ and full basic

投稿者：与坂　　昇平投稿日：2009年 9月 4日(金)14時52分42秒

返信・引用

私が　　作製した　　有限要素法の　　構造解析ソフトで 6層の　　フレ―ムの　　地震時の　　曲がりを解析しました接点数　　５５１１　個で turbo c++ で　　計算時間　1時間　　ですその　接点の　　変位量を full basic に　　移して 500 倍に　　拡大してグラヒックに　　しました添付します full basic で　　計算させると　　８０時間以上かかる　　予想です

2色の　応力図

投稿者：与坂　　昇平投稿日：2009年 9月 4日(金)20時02分35秒

返信・引用

turbo C++ で　　6層フレ―ムを　　下から　　押し上げた時の条件で　　計算させ full basic で　　6層フレ―ムの　　引っ張り　部分を　　青圧縮部分を　　赤で　　色ずけ　　しましたこれが有限要素法の　　人気のある computer graphic だと　　思います

Re: 2色の　応力図

投稿者：山中和義投稿日：2009年 9月 4日(金)20時55分57秒

返信・引用

> No.532[元記事へ] 与坂　　昇平さんへのお返事です。横長の図形を表示するとき、501×501の正方形の画面では効率よく表示できないのでは？グラフィックス画面も横長にすると良いでしょう。 SET bitmap SIZE 800,400 SET WINDOW -10,10,-5,5 DRAW grid END

色を　　変えて

投稿者：与坂　　昇平投稿日：2009年 9月 4日(金)21時36分45秒

返信・引用

前に　　投稿した有限要素法の　　computer grahic の　　色を変えて　　見ました約　1万本の　　線で　　描いています理論の　　有る　　理工科的　　芸術です赤色　　圧縮部分他　　　　引っ張り　　部分

BASICAccの威力恐るべしですね。５～６倍もスピードアップが可能なんだ！

Rolling Cube 1

投稿者：山中和義投稿日：2009年 9月17日(木)10時17分17秒

投稿者：GAI 投稿日：2009年10月 7日(水)09時30分50秒

返信・引用

プログラムとはまったく関係ないかもしれませんが、近頃次のことを知りました。逆立ちゴマというものを見られたことがあると思いますが、私はコマが自然と逆立ちすることが不思議な現象であるとばかり思っておりましたが、このコマの本当の不思議さは、もし右回りに回転をかけてコマを回しだし、逆立ちすれば当然上からは左回りに回転しておかなければならないはずですが、逆立ちした状態でもなんと右回りに回転している！！！これって超不思議ではないですか？

Re: 超不思議

投稿者：山中和義投稿日：2009年10月 7日(水)10時41分35秒

投稿者：荒田浩二投稿日：2009年10月26日(月)07時21分20秒

返信・引用

> No.676[元記事へ] GAIさんへのお返事です赤と黒の文字列からもとの数字を求めるには、次のようにします。先頭から11,22,44,1,2,4をベースとして、黒ならその数を加え最後に10を加えます。黒、赤、黒、黒、赤、赤　ならば 1*11+0*22+1*44+1*1+0*2+0*4+10=66 100 DEF base(j)=2^MOD(j+2,3)+2^MOD(j+2,3)*10*(1-INT(j/3.01)) ! 11,22,44,1,2,4 110 FUNCTION change(p$) 120 IF UCASE$(p$)="R" THEN 130 LET c=0 140 ELSEIF UCASE$(p$)="B" THEN 150 LET c=1 160 ELSE 170 PRINT "ERROR-2 !!" 180 END IF 190 LET change=c 200 END FUNCTION 210 INPUT PROMPT "赤を""R"",黒を""B""とした文字列 = ":rb$ ! 例) brbbrr 220 IF LEN(rb$)<>6 THEN PRINT "ERROR-1 !!" 230 LET d=10 240 FOR j=1 TO 6 250 LET d=d+change(rb$(j:j))*base(j) 260 NEXT j 270 PRINT "解答 =";d 280 END 次はタテの数字の列の構成をすべて記述するプログラムです。ここからどのような規則により７個の数列を抽出したのかは、私にはわかりませんでした。たぶん数字が重複しないように選んでいるのだと思いますが、次の数列は採用されていません。 *21 *32 *54 (すべて赤なのでこれを含むとヒントになってしまうから？) *11 *12 *14 生成できる数字は10～94のうちの64個(=2^6)ですが、他にも表に現れない数字があります。 DIM base(6),dwn(6),check(6) MAT READ base,dwn FUNCTION number(q) LET dd=10 FOR jj=1 TO 6 IF jj<>q THEN LET dd=dd+check(jj)*base(jj) ELSE LET dd=dd+((check(jj)-1)^2)*base(jj) END IF NEXT jj LET number=dd END FUNCTION FOR n=10 TO 94 MAT check=ZER LET d=10 LET nn=n-d FOR j=1 TO 6 ! baseの大きい数から引いていく IF nn-base(dwn(j))>=0 THEN LET check(dwn(j))=1 LET d=d+base(dwn(j)) LET nn=nn-base(dwn(j)) END IF NEXT j IF n=d THEN LET check(1)=(check(1)-1)^2 ! 0,1の入れ換え FOR j=1 TO 6 PRINT number(j); NEXT j PRINT FOR j=1 TO 6 IF check(j)=0 THEN PRINT " 赤 "; ELSE PRINT " 黒 "; NEXT j PRINT ELSE PRINT n;" この数は生成できません" END IF NEXT n DATA 11,22,44,1,2,4 ! base DATA 3,2,1,6,5,4 ! baseの降順 END

Re: 挑戦状

投稿者：山中和義投稿日：2009年10月26日(月)16時57分39秒

投稿者：荒田浩二投稿日：2009年11月19日(木)11時50分30秒

返信・引用　編集済

スレッドが使えるようになったので、第2掲示板の投稿記事リストを作成しました。投稿記事の古い順に並べたリストです。タイトル部分をクリックすれば、その投稿記事にリンクします。掲示板のソースをテキストファイルにし、下のプログラムで投稿表題部分を抽出し作成しました。参考情報……スレッドへの投稿記事は、投稿者本人でも後から編集はできないようです。訂正……スレッドへの投稿記事も、投稿者本人による編集・削除が可能です。 LET t1$="<H2><A NAME=""CID" ! ID No. LET t1=LEN(t1$) LET t2$=""" HREF=""http://6317.teacup.com/basic/bbs/" ! ID No. LET t2=LEN(t2$) LET t3$=""" CLASS=""Kiji_Title"">" ! タイトル LET t3=LEN(t3$) LET t4$="</A></H2>" LET t4=LEN(t4$) ! LET p1$=" 投稿者：" ! 投稿者 LET p1=LEN(p1$) LET p2$="" LET p2=LEN(p2$) LET p3$="<A HREF=" ! mailto LET p3=LEN(p3$) LET p4$=""">" LET p4=LEN(p4$) LET p5$="</A>" LET p5=LEN(p4$) ! LET d1$=" 投稿日：" ! 投稿日時 LET d1=LEN(d1$) LET d2$="日(" ! 曜日 LET d2=LEN(d2$) ! LET l1$="> <A HREF=""http://6317.teacup.com/basic/bbs/" ! 元記事 No. LET l1=LEN(l1$) LET l2$=">No." ! 元記事 No. LET l2=LEN(l2$) LET l3$="[元記事へ]</A> " LET l3=LEN(l3$) ! LET finput$="source.txt" LET foutput$="boardlist.txt" OPEN #1 : NAME finput$ ,ACCESS INPUT ! DIM c$(1000) LET k=0 DO LINE INPUT #1 , IF MISSING THEN EXIT DO : a$ IF a$(1:l1)=l1$ THEN ! 元記事あり LET ps=POS(a$,l2$,l1+1) LET ps2=POS(a$,l3$,ps+l2) LET s$=s$&" "&a$(ps:ps2-1) ELSEIF a$(1:t1)=t1$ THEN IF s$<>"" THEN LET k=k+1 LET c$(k)=s$&"" END IF CALL title END IF LOOP IF s$<>"" THEN LET k=k+1 LET c$(k)=s$&"" END IF CLOSE #1 ! OPEN #2 : NAME foutput$ ,ACCESS OUTPUT SET #2 : POINTER END FOR i=k TO 1 STEP -1 PRINT #2 : c$(i) NEXT i CLOSE #2 ! SUB title LET s$="<A HREF=""http://6317.teacup.com/basic/bbs/" LET id$=a$(t1+1:POS(a$,"""",t1+1)-1) LET s$=id$&" "&s$&id$&"""><BIG>" LET ps=POS(a$,t3$,t1+2) LET ps2=POS(a$,t4$,ps+t3) LET s$=s$&a$(ps+t3:ps2-1)&"</BIG></A> 投稿者：" LINE INPUT #1 : a$ IF a$(1:p1)=p1$ THEN IF a$(p1+1:p1+p3)=p3$ THEN LET s$=s$&a$(POS(a$,p4$,p1+p3+1)+p4:POS(a$,p5$,p1+p3+3)-1)&"" ELSE LET s$=s$&a$(p1+1:POS(a$,p2$,p1+1)-1)&"" END IF END IF LINE INPUT #1 : a$ LINE INPUT #1 : a$ IF a$(1:d1)=d1$ THEN LET s$=s$&" "&a$(d1+1:POS(a$,d2$,d1+2)) END IF END SUB END

この現象を再現して下さい

投稿者：GAI 投稿日：2009年11月19日(木)14時15分35秒

返信・引用

http://web2.incl.ne.jp/yaoki/psychic.swf で起こる現象をbasic版でプログラムを組んで欲しいんです。原理は簡単ですが、最初はとてもびっくりしました。すこしずつ手直ししながら、もっと面白いものにしていきたいので・・・

Re: この現象を再現して下さい

投稿者：山中和義投稿日：2009年11月19日(木)17時37分23秒

返信・引用　編集済

> No.745[元記事へ] GAIさんへのお返事です。 ●現象の確認 FOR i=10 TO 99 !２桁の数を念じる LET a=INT(i/10) !十の位と一の位の２つの数字を足す LET b=MOD(i,10) !２桁の数字から足した答えを引く LET s=i-(a+b) !答え　s=(10*a+b)-(a+b)=9*a　∴９の倍数 PRINT i;s !９の倍数は同じマークにして、常にこのマークを表示すればよい。 !ただ、多少はずれるように異なるマークも表示する NEXT i END ●占星術のシンボルマークが表示できるか　ワープロWordがインストールされていれば、フォントWingdingsはあると思います。 RANDOMIZE SET bitmap SIZE 501,501 SET WINDOW -0.5,10.5,10,-1 LET z$="c" !９の倍数は同じマーク !!!SET TEXT font "MS明朝",12 FOR y=0 TO 9 !数字 FOR x=0 TO 9 PLOT TEXT ,AT x,y: STR$(10*y+x) NEXT x NEXT y SET TEXT font "Wingdings",18 !※大きさは調整が必要である FOR y=0 TO 9 !占星術のシンボル FOR x=0 TO 9 IF MOD(10*y+x,9)=0 THEN !９の倍数なら PLOT TEXT ,AT x+0.3,y+0.3: z$ ELSE PLOT TEXT ,AT x+0.3,y+0.3: CHR$(INT(RND*40)+ORD("T")) !T～z END IF NEXT x NEXT y INPUT PROMPT "何か文字を入力してください。":t$ !ダミー入力！！！ SET TEXT font "Wingdings",256 !※大きさは調整が必要である SET TEXT JUSTIFY "center","half" PLOT TEXT ,AT 5,4.5: z$ END

複素数の計算

投稿者：山中和義投稿日：2009年11月20日(金)09時17分31秒

返信・引用

複素数モードをサポートする十進BASICでは、あまり必要性はないと思いますが、アルゴリズムの勉強として参考にしてください。サンプルは1000桁モードですが、収束判定の精度を落とすことで、 10進や2進モードでも実行できます。その場合は、複素数モードと同じことになりますが、、、サンプル　リーマンのゼータ関数の零点 !複素数の計算 LET t0=TIME !リーマンのゼータ関数 !　ζ(s)=1/(1-2^(1-s))*∑[m=0,∞]{2^(-(m+1))*∑[j=0,m]{(-1)^j*comb(m,j)*(j+1)^(-s)}} LET M=100 !精度20桁程度　　※精度1000桁程度は、3000 DIM C(0 TO M) !∑2^(-(M+1))*∑comb(M,J) LET C(0)=1 FOR K=1 TO M !パスカルの三角形のM段より、二項係数comb(m,j)を求める FOR J=K TO 1 STEP -1 LET C(J)=(C(J)+C(J-1))/2 !※2^(-(m+1))も加味する NEXT J NEXT K PRINT C(M) !debug SUB fnZeta(ReS,ImS, ReZ,ImZ) !リーマンのゼータ関数 local J local ReU,ImU,ReT1,ImT1,ReT2,ImT2 LET ReU=0 !LET U=0 LET ImU=0 FOR J=M TO 0 STEP -1 CALL CompPow(J+1,0, ReS,ImS, ReT1,ImT1) !LET U=U+(-1)^J*C(J)/(J+1)^S CALL CompDiv((-1)^J*C(J),0, ReT1,ImT1, ReT2,ImT2) CALL CompAdd(ReU,ImU, ReT2,ImT2, ReU,ImU) NEXT J CALL CompPow(2,0, 1-ReS,-ImS, ReT1,ImT1) !LET fnZeta=U/(1-2^(1-S)) CALL CompDiv(ReU,ImU, 1-ReT1,ImT1, ReZ,ImZ) END SUB !ゼータ関数の零点の計算（Riemann zeta zeros） LET ReS=1/2 !非自明な零点　1/2+14*i LET ImS=14 !1/2+t*i　t=14, 21, 25, 30, 33, 38, 41, 43, 48, 50, … 付近 !ニュートン法で零点を求める !　sn+1 = sn-ζ(sn)/ζ'(sn)、ζ'(sn)≒(ζ(sn+h)-ζ(sn))/h hは微小な値より !　sn+1 = sn-ζ(sn)*h/(ζ(sn+h)-ζ(sn)) = sn+h/(1-ζ(sn+h)/ζ(sn)) となる。 !　h=ζ(sn)/sn として、収束の判定にはζ(s)の絶対値を使用する。 DO CALL fnZeta(ReS,ImS, ReZ,ImZ) !LET Z=fnZeta(S) CALL CompDiv(ReZ,ImZ,ReS,ImS, ReH,ImH) !LET H=Z/S CALL fnZeta(ReS+ReH,ImS+ImH, ReW,ImW) !LET W=fnZeta(S+H) CALL CompDiv(ReW,ImW, ReZ,ImZ, ReT1,ImT1) !LET S=S+H/(1-W/Z) CALL CompDiv(ReH,ImH, 1-ReT1,-ImT1, ReT2,ImT2) CALL CompAdd(ReS,ImS, ReT2,ImT2, ReS,ImS) PRINT USING "####.#################### ####.####################": ReS,ImS !PRINT S LOOP UNTIL CompABS(ReZ,ImZ)<1/10^18 !LOOP UNTIL ABS(Z)<1/10^18 !収束するまで　※精度は調整が必要である。10進モード、2進モードでは1/10^8程度 PRINT "計算時間=";TIME-t0 END !複素数の計算 EXTERNAL FUNCTION CompRe(x,y) !実部 (x+y*i)、x,yは実数、iは虚数単位 LET CompRe=x END FUNCTION EXTERNAL FUNCTION CompIm(x,y) !虚部 Im(x+y*i) LET CompIm=y END FUNCTION EXTERNAL SUB CompConj(x1,y1, x,y) !共役複素数 LET xx=x1 LET yy=-y1 LET x=xx LET y=yy END SUB EXTERNAL FUNCTION CompABS(x,y) !絶対値 |x+y*i| !a'=MAX(ABS(a),ABS(b))、b'=MIN(ABS(a),ABS(b))として、SQR(a*a+b*b)=a'*SQR(1+(b'/a')^2)を求める。 IF x=0 THEN LET r=ABS(y) ELSEIF y=0 THEN LET r=ABS(x) ELSEIF ABS(y)>ABS(x) THEN LET t=x/y LET r=ABS(y)*SQR(1+t*t) ELSE LET t=y/x LET r=ABS(x)*SQR(1+t*t) END IF LET CompABS=r END FUNCTION EXTERNAL FUNCTION CompARG(x,y) !偏角θ (-π,π] IF x>0 THEN !第１象限、第４象限 LET r=ATN2(y/x) ELSE IF x<0 THEN IF y>=0 THEN !第２象限 LET r=ATN2(y/x)+PI ELSE !第３象限 LET r=ATN2(y/x)-PI END IF ELSE !x=0 IF y>0 THEN !∞ LET r=PI/2 ELSE IF y<0 THEN !-∞ LET r=-PI/2 ELSE !y=0 PRINT "ARG関数は不定です。" STOP END IF END IF END IF END IF LET CompARG=r END FUNCTION !演算関連　べき乗 EXTERNAL SUB CompPow(x1,y1, x2,y2, x,y) !べき乗 (x1+y1*i) ^ (x2+y2*i) → x+y*i CALL CompLOG(x1,y1, s,t) !z1^z2=exp(log(z1)*z2)より CALL CompMul(s,t, x2,y2, a,b) CALL CompEXP(a,b, x,y) END SUB !演算関連　四則演算、関数など EXTERNAL SUB CompAdd(x1,y1, x2,y2, x,y) !加算 (x1+y1*i) + (x2+y2*i) → x+y*i LET xx=x1+x2 !実部 LET yy=y1+y2 !虚部 LET x=xx LET y=yy END SUB EXTERNAL SUB CompSub(x1,y1, x2,y2, x,y) !減算 (x1+y1*i) - (x2+y2*i) → x+y*i LET xx=x1-x2 LET yy=y1-y2 LET x=xx LET y=yy END SUB EXTERNAL SUB CompMul(x1,y1, x2,y2, x,y) !乗算 (x1+y1*i) * (x2+y2*i) → x+y*i LET xx=x1*x2-y1*y2 !丸め誤差対策 LET yy=x1*y2+y1*x2 LET x=xx LET y=yy END SUB EXTERNAL SUB CompDiv(x1,y1, x2,y2, x,y) !除算 (x1+y1*i) / (x2+y2*i) → x+y*i IF x2=0 AND y2=0 THEN PRINT "０では割れません。" STOP END IF IF ABS(x2)>=ABS(y2) THEN !上位桁あふれ対策 LET w=y2/x2 LET tt=x2+y2*w LET xx=(x1+y1*w)/tt LET yy=(y1-x1*w)/tt ELSE LET w=x2/y2 LET tt=x2*w+y2 LET xx=(x1*w+y1)/tt LET yy=(y1*w-x1)/tt END IF LET x=xx LET y=yy END SUB EXTERNAL SUB CompSQR(x1,y1, x,y) !平方根 LET SQRT05=SQR(1/2) !0.707106781186547524 LET r=CompABS(x1,y1) !r=SQR(x1*x1+y1*y1) LET w=SQR(r+ABS(x1)) IF x1>=0 THEN LET x=SQRT05*w LET y=SQRT05*y1/w ELSE LET x=SQRT05*ABS(y1)/w IF y1>=0 THEN LET y=SQRT05*w ELSE LET y=-SQRT05*w END IF END SUB EXTERNAL SUB CompEXP(x1,y1, x,y) !指数関数 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET t=EXP(x1) !EXP(x+i*y)=EXP(x)*EXP(i*y)=EXP(x)*(COS(y)+i*SIN(y)) LET xx=t*COS(y1) LET yy=t*SIN(y1) LET x=xx LET y=yy END SUB EXTERNAL SUB CompLOG(x1,y1, x,y) !対数関数 DECLARE EXTERNAL FUNCTION LOG !関数のオーバーロード LET xx=0.5*LOG(x1*x1+y1*y1) !LOG(r)+i*θ、-π<θ<=π LET yy=CompARG(x1,y1) LET x=xx LET y=yy END SUB !補助ルーチン　※多桁の関数 EXTERNAL FUNCTION ATN2(x) !アークタンジェント (-π/2,π/2) IF x>1 THEN LET cSGN=1 LET x=1/x ELSEIF x<-1 THEN LET cSGN=-1 LET x=1/x ELSE LET cSGN=0 END IF LET a=0 FOR i=1500 TO 1 STEP -1 !※繰り返し回数は調整が必要である LET a0=a LET a=(i*i*x*x)/(2*i+1 + a) IF ABS(a-a0)<=EPS(0) THEN EXIT FOR NEXT i IF cSGN>0 THEN LET ATN2=PI/2-x/(1+a) ELSEIF cSGN<0 THEN LET ATN2=-PI/2-x/(1+a) ELSE LET ATN2=x/(1+a) END IF END FUNCTION MERGE "EXP.LIB" !指数関数　※級数展開で関数を計算する MERGE "LOG.LIB" !対数関数 MERGE "TRIGONOM.LIB" !三角関数（正弦，余弦，正接）

Re: 複素数の計算

投稿者：山中和義投稿日：2009年11月20日(金)09時21分31秒

返信・引用

> No.747[元記事へ] 続き　　※必要に応じて追加してください。 !演算関連　べき乗、関数など EXTERNAL SUB CompPowN(x1,y1, n, x,y) !べき乗 (x1+y1*i) ^ n → x+y*i DECLARE EXTERNAL FUNCTION SIN,COS !関数のオーバーロード LET r=CompABS(x1,y1) !r,θ LET th=CompARG(x1,y1) LET t=r^n !z^n=r^n*(COS(n*θ)+i*SIN(n*θ))、r=SQR(x1*x1+y1*y1) LET x=t*COS(n*th) LET y=t*SIN(n*th) END SUB EXTERNAL SUB CompNPow(n, x1,y1, x,y) !べき乗 n ^ (x1+y1*i) → x+y*i DECLARE EXTERNAL FUNCTION LOG !関数のオーバーロード CALL CompMul(LOG(n),0, x1,y1, a,b) !n^z1=exp(log(n)*z1)より CALL CompEXP(a,b, x,y) END SUB EXTERNAL SUB CompSIN(x1,y1, x,y) !三角関数　正弦 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード !sin(x+yi) !={exp(x*i-y)-exp(-x*i+y)}/(2*i)　 ※sin(z)=(exp(i*z)-exp(-i*z))/(2*i)より !={exp(-y)*(cos(x)+i*sin(x))-exp(y)*(cos(x)-i*sin(x))}/(2*i)　※exp(i*x)=cos(x)+i*sin(x)より !={(exp(y)-exp(-y))*(-cos(x)) + (exp(y)+exp(-y))*sin(x)*i}/(2*i) !={(exp(y)-exp(-y))*cos(x)*i + (exp(y)+exp(-y))*sin(x)}/2 LET e=EXP(y1) LET f=1/e LET yy=0.5*(e-f)*COS(x1) LET xx=0.5*(e+f)*SIN(x1) LET x=xx LET y=yy END SUB EXTERNAL SUB CompCOS(x1,y1, x,y) !三角関数　余弦 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET e=EXP(y1) !(exp(i*z)+exp(-i*z))/2 LET f=1/e LET yy=0.5*(f-e)*SIN(x1) LET xx=0.5*(f+e)*COS(x1) LET x=xx LET y=yy END SUB EXTERNAL SUB CompTAN(x1,y1, x,y) !三角関数　正接 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET e=EXP(2*y1) LET f=1/e LET d=COS(2*x1)+0.5*(e+f) LET x=SIN(2*x1)/d LET y=(e-f)/d END SUB !逆三角関数 !　ArcSin(z)=-i*LOG(SQR(1-z^2)+z*i) !　ArcCos(z)=-i*LOG(z+i*SQR(1-z^2)) !　ArcTan(z)=i/2*LOG((i+z)/(i-z)) EXTERNAL SUB CompSinh(x1,y1, x,y) !双曲線正弦 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET e=EXP(x1) LET f=1/e LET xx=0.5*(e-f)*COS(y1) LET yy=0.5*(e+f)*SIN(y1) LET x=xx LET y=yy END SUB EXTERNAL SUB CompCosh(x1,y1, x,y) !双曲線余弦 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET e=EXP(x1) LET f=1/e LET xx=0.5*(e+f)*COS(y1) LET yy=0.5*(e-f)*SIN(y1) LET x=xx LET y=yy END SUB EXTERNAL SUB ComppTanh(x1,y1, x,y) !双曲線正接 DECLARE EXTERNAL FUNCTION EXP,SIN,COS !関数のオーバーロード LET e=EXP(2*x1) LET f=1/e LET d=0.5*(e+f)+COS(2*y1) LET y=SIN(2*y1)/d LET x=0.5*(e-f)/d END SUB

Re: この現象を再現して下さい

投稿者：山中和義投稿日：2009年11月20日(金)10時59分13秒

返信・引用

> No.746[元記事へ] 十進BASICで扱える半角文字です。フォントを切り替えることで絵文字が表示できます。登録させているフォントに依存します。 !ASCII,JISコード表 SET bitmap SIZE 501,501 SET WINDOW -1.5,16.5,16,-2 FOR i=0 TO 15 !行番号 PLOT TEXT ,AT -1,i: BSTR$(i,16) NEXT i FOR i=0 TO 15 !列番号 PLOT TEXT ,AT i,-1: BSTR$(i,16) NEXT i SET TEXT COLOR 4 FOR c=32 TO 255 !文字の表示 WHEN EXCEPTION IN PLOT TEXT ,AT MOD(c,16),INT(c/16): CHR$(c) USE PRINT c !使用不可コード　※MS漢字（2バイト文字）の先頭 END WHEN NEXT c SET TEXT font "Wingdings",12 !SET TEXT font "symbol",12 SET TEXT COLOR 1 FOR c=32 TO 255 !フォントの表示 WHEN EXCEPTION IN PLOT TEXT ,AT MOD(c,16)+0.2,INT(c/16)+0.4: CHR$(c) USE PRINT c END WHEN NEXT c END

!２階微分方程式の、ルンゲクッタ描画。

投稿者：SECOND 投稿日：2009年11月21日(土)09時27分17秒

返信・引用

!２階微分方程式の、ルンゲクッタ描画。 !ベッセルの微分方程式の場合。 !x^2*(d2y/dx2)+x*(dy/dx)+(x^2-a^2)*y=0 …ベッセル !x^2*(d2y/dx2)+x*(dy/dx)-(x^2+a^2)*y=0 …変形ベッセル !------------------------------- OPTION ARITHMETIC NATIVE OPTION BASE 0 SET TEXT background "opaque" DIM col(4), y0(4) MAT READ col DATA 4,10,2,14, 12 ! ０次～４次の色分け !----------------------------------------------------------------------- !0白 1黒 2青 3 緑 4赤 5水色 6黄色 7赤紫 ! 8灰色 9濃い青 10濃い緑 11青緑 12えび茶 13オリーブ色 14濃い紫 15銀色 !----------------------------------------------------------------------- SUB Dji( oddy,ody, iddy,idy,y) LET oddy=-( x*idy +(sj*x^2-a^2)*y)/x^2 ! ddy=(d2y/dx2) :sj=1(ベッセル) LET ody=-(x^2*iddy+(sj*x^2-a^2)*y)/x ! dy= (dy/dx) :sj=-1(変形ベッセル) END SUB SUB RungeKutta CALL Dji( oddy1,ody1, iddy, idy, y) CALL Dji( oddy2,ody2, iddy, idy+oddy1*dx/2, y+ody1*dx/2) CALL Dji( oddy3,ody3, iddy, idy+oddy2*dx/2, y+ody2*dx/2) CALL Dji( oddy4,ody4, iddy, idy+oddy3*dx , y+ody3*dx ) LET y=y+(ody1+2*ody2+2*ody3+ody4)*dx/6 LET idy=idy+(oddy1+2*oddy2+2*oddy3+oddy4)*dx/6 LET iddy=oddy4 END SUB LET dx=.0005 !pitch LET y0(0)=1 !ｙの初期値 LET y0(1)= 0.708248*dx LET y0(2)=-1.2017 *dx^2 LET y0(3)=-0.015 *dx^3 LET y0(4)= 0.00615 *dx^4 !----- LET sj=-1 LET m$="変形" CALL window_ CALL Rk_bessel !変形ベッセルの微分方程式( ルンゲクッタ描画 ) CALL fn_bessel !変形ベッセル関数１種 In(x) WAIT DELAY 2 !----- LET sj=1 LET m$="" CALL window_ CALL Rk_bessel ! ベッセルの微分方程式( ルンゲクッタ描画 ) CALL fn_bessel ! ベッセル関数１種 Jn(x) SUB window_ CLEAR IF sj=1 THEN !----ベッセル LET h=1 LET l=-1 LET xr=20 SET WINDOW -3,xr, l, h DRAW grid(xr/4,h/5) ELSEIF sj=-1 THEN !----変形ベッセル LET h=4 LET l=-1.5 LET xr=4 SET WINDOW -0.3,xr, l, h DRAW grid(xr/8,h/8) END IF ASK PIXEL SIZE(0,0;xr,0) px,py LET ss=Xr/px END SUB !-------------------- 微分方程式のルンゲクッタ描画 SUB Rk_bessel SET TEXT COLOR 4 PLOT TEXT,AT (.325+.225*sj)*xr,.9*h-(.2-.04*sj)*(h-l) :"ルンゲクッタ描画" FOR a=0 TO 4 LET y=y0(a) LET idy=0 LET iddy=0 SET LINE COLOR "gray" !col(a+4) SET TEXT COLOR "gray" !col(a+4) PLOT TEXT,AT .1*xr,.9*h-.04*(h-l)*a :m$& "ベッセルの微分方程式 "& STR$(a)& "次" !------------ FOR x=dx TO xr+dx STEP dx PLOT LINES: x,y; ! PEN-on IF FP(x)< dx THEN PRINT USING"##.## ###.######":x,y CALL RungeKutta NEXT x !------------ PLOT LINES !PEN-off PRINT NEXT a END SUB !********************* 解のベッセル関数を重ねて照合する。 SUB fn_bessel SET TEXT COLOR 1 PLOT TEXT,AT (.325+.225*sj)*xr,.9*h-(.2-.04*sj)*(h-l) :"関数で、重ね書き" FOR n=0 TO 4 SET LINE COLOR col(n) SET TEXT COLOR col(n) PLOT TEXT,AT .1*xr,.9*h-.04*(h-l)*n :m$& "ベッセル関数１種 "& STR$(n)& "次　　" !------------画素間隔のStep FOR x=dx TO xr+ss STEP ss PLOT LINES: x,bessel(n,x); ! PEN-on IF FP(x)< ss AND dx< x THEN PRINT USING"##.## ###.######":IP(x),bessel(n,IP(x)) NEXT x !------------ PLOT LINES !PEN-off PRINT NEXT n END SUB !------- ベッセル関数　変形ベッセル関数 FUNCTION bessel(n,x) LET m=2*INT( (6+MAX(n,1.5*ABS(x))+9*1.5*ABS(x)/(1.5*ABS(x)+2))/2) LET w=0 IF sj=1 THEN !---- ベッセル関数 Jn(x) FOR k=1 TO m/2 LET w=w+Tk(k*2,x) NEXT k LET bessel=Tk(n,x)/(Tk(0,x)+2*w) ELSEIF sj=-1 THEN !---- 変形ベッセル関数 In(x) FOR k=1 TO m LET w=w+Tk(k,x) NEXT k LET bessel=EXP(x)*Tk(n,x)/(Tk(0,x)+2*w) END IF END FUNCTION FUNCTION Tk(i,x) LET t2=0 LET t1=1e-9 LET t0=2*(m+1)/x*t1-sj*t2 FOR kp1=m TO i+1 STEP -1 LET t2=t1 LET t1=t0 LET t0=2*kp1/x*t1-sj*t2 NEXT kp1 LET Tk=t0 END FUNCTION END

ちょっと不思議

投稿者：GAI 投稿日：2009年11月22日(日)23時23分1秒

返信・引用

LET s=0 FOR k=1 TO 100 LET s=s+1/k^2 LET t=s+1/k PRINT USING "#.##########" : s; PRINT USING "####.##########" : t NEXT K END !Sは単調増加であるのに対し、Tが単調減少であるのがなんか不思議に感じてしまう？

広義積分の計算のプログラム

投稿者：GAI 投稿日：2009年11月22日(日)23時33分53秒

返信・引用

∫0～∞（e^(-t)/(1-e^(-t))-e^(-t)/t)dt の計算をするのは、どうやったらいいか教えてください。

Re: 広義積分の計算のプログラム

投稿者：山中和義投稿日：2009年11月23日(月)10時37分28秒

返信・引用　編集済

> No.752[元記事へ] GAIさんへのお返事です。数値積分　0.5772156649015328606…　オイラーの定数γ !半無限区間積分　∫[0,∞]{EXP(-x)*f(x)}dx DEF F(X)=1/(1-EXP(-X)) - 1/X LET S=0 FOR I=1 TO 20 READ X,W LET S=S+W*F(X) NEXT I PRINT S DATA .0705398896919888, 1.6874680185111386E-01 !ガウス・ラゲール則の係数（分点、重み） DATA .3721268180016114, 2.9125436200606828E-01 !２０次ラゲール多項式より DATA .9165821024832736, 2.6668610286700129E-01 DATA 1.7073065310283439, 1.6600245326950684E-01 DATA 2.7491992553094321, 7.4826064668792371E-02 DATA 4.0489253138508869, 2.4964417309283221E-02 DATA 5.6151749708616165, 6.2025508445722368E-03 DATA 7.4590174536710633, 1.1449623864769082E-03 DATA 9.5943928695810968, 1.5574177302781197E-04 DATA 12.0388025469643163, 1.5401440865224916E-05 DATA 14.8142934426307400, 1.0864863665179824E-06 DATA 17.9488955205193760, 5.3301209095567148E-08 DATA 21.4787882402850110, 1.7579811790505820E-09 DATA 25.4517027931869055, 3.7255024025123209E-11 DATA 29.9325546317006120, 4.7675292515781905E-13 DATA 35.0134342404790000, 3.3728442433624384E-15 DATA 40.8330570567285711, 1.1550143395003988E-17 DATA 47.6199940473465021, 1.5395221405823436E-20 DATA 55.8107957500638989, 5.2864427255691578E-24 DATA 66.5244165256157538, 1.6564566124990233E-28 END

これがそうだったのか！

Re: 散歩コースの探索願い

投稿者：山中和義投稿日：2009年12月20日(日)11時08分38秒

返信・引用　編集済

> No.900[元記事へ] GAIさんへのお返事です。「横切る」や「同一」の判定は、図形が表示されるので、それを見て確認してください。 !散歩コースの探索 PUBLIC NUMERIC N !歩数 LET N=16 DIM d(N),x(0 TO N),y(0 TO N) !各歩数での方向と位置 MAT d=ZER MAT x=ZER !原点 MAT y=ZER LET x(1)=1 !１歩目は東へ　※0:東、1:北、2:西、3:南 CALL search(2,d,x,y) !２歩目以降 END EXTERNAL SUB search(s,d(),x(),y()) !バックトラックで検索する FOR i=-1 TO 1 STEP 2 !右と左のみ LET dd=MOD(d(s-1)+i,4) !１つ前を基準にする LET xx=x(s-1) !現在の位置 LET yy=y(s-1) SELECT CASE dd !s歩目の移動距離 CASE 0 !E LET xx=xx+s CASE 1 !N LET yy=yy+s CASE 2 !W LET xx=xx-s CASE 3 !S LET yy=yy-s CASE ELSE END SELECT LET x(s)=xx !進める LET y(s)=yy LET d(s)=dd !s歩目の方向 IF s=N THEN !指定の歩数に達したら IF x(N)=x(0) AND y(N)=y(0) THEN !元の位置に戻ったら MAT PRINT d; SET bitmap SIZE 600,600 !作画して交差などを確認する SET WINDOW -40,40,-40,40 CLEAR DRAW grid(5,5) SET LINE width 2 SET TEXT HEIGHT 1.5 !※調整が必要である SET TEXT JUSTIFY "center","half" FOR k=1 TO N SET LINE COLOR 1 !奇数と偶数で色分け IF MOD(k,2)=0 THEN SET LINE COLOR 4 PLOT LINES: x(k-1),y(k-1); x(k),y(k) !軌跡 PLOT TEXT ,AT (x(k-1)+2*x(k))/3,(y(k-1)+2*y(k))/3: STR$(k) NEXT k SET LINE width 1 !restore it pause !OK? !INPUT PROMPT "OKかNGを入力してください。": y$ END IF ELSE CALL search(s+1,d,x,y) !次へ END IF NEXT i END SUB !回答、情報、アルゴリズム、パズル !１歩目を東（水平方向）へ固定すると !奇数目は水平方向（東西方向）、偶数目は垂直方向（南北方向）になる。 !式で表現すると ! x=±1±3±5±7 ! y=±2±4±6±8 !プラスマイナスの組合せで０になるかどうかの検証になる。

跳ねるボールを、Ｎ角形の壁面へ拡張

投稿者：SECOND 投稿日：2009年12月22日(火)04時55分8秒

返信・引用　編集済

> No.899[元記事へ] ! 跳ねるボールを、Ｎ角形の壁面へ拡張 !-------------------------------------- !ボールの方向を、適当な無理数にすると、周期がなくなり、 !ベルヌーイ・シフト写像( 無理数の小数下位を、無限に読み進む構造で、周期を失うカオス ) !に、似たカオスが現れる。 OPTION BASE 0 SET WINDOW -7,7, -7,7 DRAW axes !---- LET ma=9 !多角形の角数 3,4,5,6,7,8,,,, DIM x(ma),y(ma),A(ma),px(ma),py(ma) LET r=0.7 !ボールの半径 LET r0=5.5 !計算で使用の多角形、外接円の半径 LET r1=r0+r/SIN(PI/2-PI/ma) !ボールの当る多角形、外接円の半径 ! !LET a0=PI*(1.5-1/ma) !(x1,y1)の角。 LET a0=PI*(1.5-3/ma) !(x1,y1)の１つ手前の角。 FOR i=0 TO ma LET x(i)=r0*COS(a0) LET y(i)=r0*SIN(a0) IF 0< i THEN SET LINE COLOR "silver" PLOT LINES: x(i-1),y(i-1); x(i),y(i) !計算壁面 SET LINE COLOR "black" PLOT LINES: r1/r0*x(i-1),r1/r0*y(i-1); r1/r0*x(i),r1/r0*y(i) !ボール壁面 END IF LET a0=a0+2*PI/ma NEXT i ! A3 A4 ４ A3 ! ３４──３５／＼３ ! A3 ／＼ A2 A4│ │A2 A5＼／A2 ・・・ ! １───２１──２１─２ ! A1 A1 A1 ! FOR i=1 TO ma LET j=MOD(i,ma)+1 LET A(i)=(y(j)-y(i))/(x(j)-x(i)) !直線ij の勾配 LET px(i)=(x(j)-x(i))/SQR((y(j)-y(i))^2+(x(j)-x(i))^2) LET py(i)=(y(j)-y(i))/SQR((y(j)-y(i))^2+(x(j)-x(i))^2) !直線ij に平行な、単位ベクトル NEXT i ! LET a0=ANGLE(x(1),y(1)) LET bx=r0*COS(a0)*0.999 ! ボールの初期位置X LET by=r0*SIN(a0)*0.999 ! ボールの初期位置Y LET a0=ANGLE(x(2)-x(1),y(2)-y(1))+SQR(2)*PI/ma/1.1313 !ボールの初期角度 LET m0=.23 !ボールの速さ⊿ LET mx=m0*COS(a0) !ボールの初期⊿X LET my=m0*SIN(a0) !ボールの初期⊿Y SUB Cross !各辺への衝突検出と反射 LET ok=0 IF ABS(A(n))< 1 THEN !---壁の直線(y-y0)=(x-x0)*A ,ボール位置と図中心を結ぶ線 y=x*by/bx の交点(xw,yw)。 LET xw=(x(n)*A(n)-y(n))/(A(n)-by/bx) !xw 優先 LET yw=(xw-x(n))*A(n)+y(n) IF 0< xw*bx+yw*by AND xw^2+yw^2<=bx^2+by^2 THEN !壁の外 !---壁の直線(y-y0)=(x-x0)*A, ボール軌跡線(y-by)=(x-bx)*my/mx の交点(xc,yc)。 LET xc=(x(n)*A(n)-y(n)-bx*my/mx+by)/(A(n)-my/mx) !xc 優先 LET yc=(xc-x(n))*A(n)+y(n) !---壁の一辺内なら、反射処理 IF (x(n)<=xc AND xc<=x(MOD(n,ma)+1) OR x(MOD(n,ma)+1)<=xc AND xc<=x(n)) THEN CALL Mirror END IF ELSE !---壁の直線(y-y0)=(x-x0)*A ,ボール位置と図中心を結ぶ線 y=x*by/bx の交点(xw,yw)。 LET yw=(y(n)/A(n)-x(n))/(1/A(n)-bx/by) !yw 優先 LET xw=(yw-y(n))/A(n)+x(n) IF 0< xw*bx+yw*by AND xw^2+yw^2<=bx^2+by^2 THEN !壁の外 !---壁の直線(y-y0)=(x-x0)*A, ボール軌跡線(y-by)=(x-bx)*my/mx の交点(xc,yc)。 LET yc=(y(n)/A(n)-x(n)-by*mx/my+bx)/(1/A(n)-mx/my) !yc 優先 LET xc=(Yc-y(n))/A(n)+x(n) !---壁の一辺内なら、反射処理 IF (y(n)<=yc AND yc<=y(MOD(n,ma)+1) OR y(MOD(n,ma)+1)<=yc AND yc<=y(n)) THEN CALL Mirror END IF END IF END SUB SUB Mirror !ベクトル(mx,my)の反射を、同じ(mx,my)に上書。 LET bx=xc !ボールを衝突点に置く LET by=yc ! 単位ベクトル：壁に平行( px(n), py(n) ) !---- 垂直(-py(n), px(n) ) LET wy=(mx*px(n)+my*py(n))*py(n)+(mx*py(n)-my*px(n))*px(n) LET mx=(mx*px(n)+my*py(n))*px(n)-(mx*py(n)-my*px(n))*py(n) LET my=wy ! 内積 *方向内積 *方向 LET ok=1 !反射報告 !ball速度ベクトルｍ= (mx*px+my*py)*ｐ－(mx*ox+my*oy)*ｏ END SUB ! 平行単位vect.ｐ垂直単位vect.ｏ SET LINE COLOR "blue" SET AREA COLOR "blue" SET DRAW MODE NOTXOR !２度書きで消える NOTXOR モード ! PLOT TEXT,AT 3.7, 6.4: "右クリック：停止" DO DRAW disk WITH SCALE(r)*SHIFT(bx,by) !ボールを書く ! SET DRAW mode explicit !ちらつき防止。| かなりな負荷が、かかります。遅い| ! SET DRAW mode hidden !ちらつき防止。| パソコンや省電力なら使わないが良| WAIT DELAY 0.02 ! 省電力効果と、速度 DRAW disk WITH SCALE(r)*SHIFT(bx,by) !ボールだけを消す PLOT LINES : bx,by; ! 履歴線を（書く・消す） LET bx=bx+mx LET by=by+my !---- FOR n=1 TO ma CALL Cross !衝突検出と反射 IF ok=1 THEN EXIT FOR NEXT n MOUSE POLL mox,moy,mlb,mrb LOOP UNTIL 0< mrb END

Re: 跳ねるボールを、Ｎ角形の壁面へ拡張

投稿者：山中和義投稿日：2009年12月22日(火)14時00分24秒

返信・引用　編集済

> No.940[元記事へ] 先のブロック崩しのボールの軌道の解析プログラムです。ベクトルと図形方程式で記述してみました。 LET cEps=1e-13 !精度 DIM t(2) !作業用 SET bitmap SIZE 600,600 SET WINDOW -5,5,-5,5 DRAW grid LET iter=200 !繰り返し回数 LET M=3 !ｍ角形　※３以上の整数 DIM Pw(M,4) !壁面の端 !DATA 3,-4, 3, 4 !正方形　始点(x1,y1)、終点(x2,y2) !DATA 3, 4, -3, 4 !DATA -3, 4, -3,-4 !DATA -3,-4, 3,-4 !MAT READ Pw !MAT PRINT Pw; LET R=4 !外接円の半径 FOR i=1 TO M !Ｘ軸上の点(R,0)から反時計まわりに頂点を得る LET th=2*PI*(i-1)/M !始点(x1,y1) LET Pw(i,1)=R*COS(th) LET Pw(i,2)=R*SIN(th) LET th=2*PI*i/M !終点(x2,y2) LET Pw(i,3)=R*COS(th) LET Pw(i,4)=R*SIN(th) NEXT i MAT PRINT Pw; DIM w(M,2) !壁面の法線ベクトル FOR i=1 TO M !線分の方向ベクトルから算出する LET t(1)=-(Pw(i,4)-Pw(i,2)) !Ｘ方向 LET t(2)= Pw(i,3)-Pw(i,1) !Ｙ方向 CALL Vec2Normalize(t,t) !正規化 MAT PRINT t; LET w(i,1)=t(1) LET w(i,2)=t(2) NEXT i FOR i=1 TO M !壁面を表示する PLOT LINES: Pw(i,1),Pw(i,2); Pw(i,3),Pw(i,4) NEXT i !ボールの軌道　直線p(t)=Pa+t*a DIM a(2) !ボールの移動方向ベクトル DATA 1,2 MAT READ a CALL Vec2Normalize(a,a) !|a|=1 MAT PRINT a; DIM Pa(2) !ボールの発射位置 DATA 1,0 MAT READ Pa DIM Pc(2) !衝突位置 DIM aa(2) !反射方向ベクトル FOR k=1 TO iter !バウンドさせる CALL CalcCollision(Pc,aa) MAT PRINT Pc; !debug PLOT LINES: Pa(1),Pa(2); Pc(1),Pc(2) !軌跡を描く MAT Pa=Pc !次へ MAT a=aa NEXT k !衝突する平面の法線ベクトルをn、入射方向ベクトルをaとする。 !反射方向ベクトルbは、b=a-2*(a・n)*n ! !また、平面上の任意の点をPs、入射方向ベクトルaの始点をPaとすると、 !衝突位置Pcは、Pc=Pa+{n・(Ps-Pa)/(a・n)}*a SUB CalcReflection(a(),n(), b()) !反射ベクトルを計算する MAT t=(2*DOT(a,n))*n !ベクトルaをベクトルnに射影して、その２倍のベクトル MAT b=a-t MAT PRINT b; !debug END SUB SUB CalcCollision(Pc(),b()) !壁面との衝突位置と反射方向ベクトルを計算する DIM n(2),Ps(2),Pe(2) FOR i=1 TO M CALL Vec2Set(w(i,1),w(i,2), n) !法線ベクトル CALL Vec2set(Pw(i,1),Pw(i,2), Ps) !平面上の任意の点 PRINT "壁面=";i !debug LET an=DOT(a,n) !ベクトルａとベクトルｎとのなす角を得る　|a||n|cosθ<0 IF an<0 THEN !衝突する壁面の表裏判定 MAT t=Ps-Pa LET nT=DOT(n,t) IF nT<0 THEN !壁面との位置関係から MAT t=(nT/an)*a MAT Pc=Pa+t !交点 CALL Vec2Set(Pw(i,3),Pw(i,4), Pe) !直線の終点 LET v=InRange(Pc, Ps,Pe) IF v>=0 AND v<=1 THEN !線分上なら MAT PRINT Pc; !debug CALL CalcReflection(a,n, b) !反射方向ベクトル EXIT SUB !１つ見つかれば ELSE PRINT "壁面の延長上で衝突する" MAT PRINT Pc; !debug END IF ELSEIF nT=0 THEN PRINT "衝突中" MAT PRINT Pa; !debug MAT Pc=Pa CALL CalcReflection(a,n, b) !反射方向ベクトル EXIT SUB !１つ見つかれば ELSE PRINT "衝突しない" END IF ELSE PRINT "衝突しない..." IF i=M THEN PRINT "すべての壁面と衝突しません。" STOP END IF END IF NEXT i END SUB !PsとPeを結ぶ線分を延長した直線上の点Pcと線分との位置関係 !0≦t≦1なら、線分上 FUNCTION InRange(Pc(), Ps(),Pe()) DIM t1(2),t2(2) MAT t1=Pe-Ps MAT t2=Pc-Ps IF ABS(t1(1))>=cEps THEN !t1(1)<>0 LET v=t2(1)/t1(1) !Ｘ方向の比 ELSE !垂直線 IF ABS(t1(2))>=cEps THEN !t1(2)<>0 LET v=t2(2)/t1(2) !Ｙ方向の比 ELSE !１点 LET v=0 END IF END IF LET InRange=v END FUNCTION END !ベクトル EXTERNAL FUNCTION Vec2Length(a()) !長さ |a| LET Vec2Length=SQR(a(1)*a(1)+a(2)*a(2)) END FUNCTION EXTERNAL SUB Vec2Normalize(a(),n()) !正規化 n=a/|a| LET L=Vec2Length(a) IF L>0 THEN MAT n=(1/L)*a END SUB !その他 EXTERNAL SUB Vec2Set(x,y, v()) LET v(1)=x LET v(2)=y END SUB

簡易ゲームで

投稿者：Night 投稿日：2009年12月22日(火)15時08分25秒

返信・引用

はじめまして今、10進Basicで簡易ダンジョンRPGを作ろうと思っていますそこで質問なのですが・グラフィックスを重ねずどんどん表示する方法・ダンジョンを移動する際のキーを矢印にする方法・歩く場所を決められるかどうかの３点をお願いします本当は大まかなプログラムを教えていただきたいのですが自分でやらなければ意味はないので、がんばれるだけやってみようと思いますよろしくお願いします

Re: 簡易ゲームで

投稿者：山中和義投稿日：2009年12月22日(火)19時17分46秒

返信・引用

> No.942[元記事へ] Nightさんへのお返事です。十進BASICは、リアルタイム系ゲームの作成には不向きです。・ビットマップ画像を高速に処理できない。（切り出し表示など）・３Ｄは自前で処理する必要がある。また、他のライブラリを利用できない。以前作成したものです。参考にしてください。 !ファミコン時代の2D RPGを作る !マップの構成 !　「正面見下ろし」形式のチップ画像を用意して、タイル状に配置する。 !　フィールド、オブジェクトの２層で構成される。 !　オブジェクト層が移動可能判定の対象とする。 !チップ画像 !　十進BASICはビットマップ画像を扱うのが苦手のため、ベクトル図形（PLOT文）で描画する。 !　Ｘ、Ｙとも－１～１の範囲の座標で表現して、描画単位はPICTURE文でまとめる。 ! !マップの展開 !　十進BASICの問題座標にマップ全体をDRAW文で描画する。 !　フィールド、オブジェクトの順に描画する。 !マップの表示（ビュー） !　SET WINDOWS文でビューを構成して、マップの一部を画面に表示する。 !ビューのスクロール !　ＰＣ（Player Character）の「中央固定」で追従する。 !キャラクタの移動 !　チップ単位、上下左右の４方向。 !　仮想ゲームパッドからの入力をサポートする。 !　　移動キー：カーソルキー !　　Ａボタン：SPACEキー !　　Ｂボタン： !マップの定義 DATA 15,12 !マップの大きさ READ msx,msy !マップ情報を読み込む DATA 1,1,1,2,2, 2,1,1,1,1, 2,2,2,1,1 !チップ配置情報（フィールド） DATA 1,1,1,2,2, 2,1,1,1,1, 2,2,2,1,1 DATA 1,1,1,2,2, 2,1,1,1,1, 1,1,1,1,1 DATA 1,1,1,1,2, 1,1,1,1,1, 1,1,1,1,1 DATA 1,1,1,1,1, 1,1,1,1,1, 1,1,1,1,1 DATA 1,2,2,1,1, 1,1,1,1,1, 1,1,1,1,1 DATA 1,2,2,1,1, 1,2,2,2,1, 1,1,1,1,1 DATA 2,2,1,1,1, 1,2,2,2,1, 3,3,1,1,1 DATA 2,2,1,1,1, 1,2,2,2,1, 3,2,2,1,1 DATA 2,2,2,2,1, 1,1,1,1,1, 3,2,2,1,1 DATA 2,2,2,2,1, 1,1,1,1,1, 3,3,2,1,1 DATA 1,1,1,1,1, 1,1,1,1,1, 3,3,3,1,1 DIM mapFld(msy,msx) MAT READ mapFld DATA 0, 0, 0, 0,12, 0, 0, 0, 0,11, 0,12,12, 0, 0 !チップ配置情報（オブジェクト） DATA 0, 0, 0, 0,12, 0, 0, 0, 0,11, 0, 0,12, 0, 0 DATA 0, 0, 0, 0,12, 0, 0, 0, 0,11, 11, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0,11,11, 0, 0, 0, 0, 0 DATA 0, 0 ,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 DATA 0,12,12, 0, 0, 0, 0, 0,12, 0, 0, 0, 0, 0, 0 DATA 0, 0,11,11, 0, 0, 0,21,12, 0, 13,13, 0, 0, 0 DATA 0,12,11,11, 0, 0, 0, 0,12, 0, 13,12, 0, 0, 0 DATA 0,12,12,12, 0, 0, 0, 0, 0, 0, 13,12,12, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 13, 0, 0, 0, 0 DATA 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 DIM mapObj(msy,msx) MAT READ mapObj !ゲーム画面の定義 LET GAME_TITLE=1 !タイトル LET GAME_MOVE=2 !移動 LET GAME_TALK=3 !会話 LET GAME_BATTLE=4 !戦闘 LET gs=GAME_TITLE !タイトル画面から !ビューポートの定義 LET vsx=15 !ビューポートの大きさ（1/2チップ単位） LET vsy=15 LET vx=0 !位置（左下。※問題座標） LET vy=0 !移動方向の定義 LET MOVE_NONE=-1 !なし LET MOVE_RIGHT=0 !右 LET MOVE_UP=2 !上 LET MOVE_LEFT=4 !左 LET MOVE_DOWN=6 !下 !会話文の定義 DATA "はじめる：Ａボタン（SPACEキー）" !#1　※４行単位 DATA "おわる：ESCキー" DATA "" DATA "移動：十字(カーソルキー)、ＯＫ：Ａボタン" DATA "" !#2 DATA "" DATA "" DATA "" DATA "コーヒータイム♪" !#3 DATA "" DATA "「休憩をとったら出発だ！」" DATA "" DATA "「残念、ぼくは泳げないんだ。」" !#4 DATA "「飛び越えられないぞ．．．」" DATA "" DATA "" DATA "" !#5 DATA "" DATA "" DATA "" DIM ms$(4*5) MAT READ ms$ DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 !イベント配置情報 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 4,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,4,4, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,3,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DATA 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0 DIM mapEvt(msy,msx) MAT READ mapEvt LET evt=0 !ゲームの初期化 LET x=6 !キャラクタの位置（チップ単位） LET y=5 LET d=MOVE_DOWN !向き CALL SetViewPort !ビューポート移動 LET t0=TIME LET fRun=-1 !ゲーム開始 DO WHILE fRun<0 !ゲームループ IF gs=GAME_TITLE THEN !タイトル画面なら SET DRAW mode hidden !ちらつき防止(開始) CLEAR DRAW Hiro(6,d) WITH SHIFT(vx+8,vy+8) !キャラクタ PLOT TEXT ,AT vx+6,vy+11: "チョコボの冒険" CALL DrawSpeak(0,0) SET DRAW mode explicit !ちらつき防止(終了) CALL GetAButton(t0) !Ａボタンの入力 END IF IF gs=GAME_MOVE THEN !移動画面なら CALL GetMoveKey(dx,dy,dr,t0) !移動キーの入力 IF dx<>0 OR dy<>0 THEN !移動なら LET d=dr !移動方向に向く LET xx=x+dx !仮に移動する（チップ単位） LET yy=y+dy IF xx>0 AND xx<=msx AND yy>0 AND yy<=msy THEN !マップ内で IF mapObj(yy,xx)=0 THEN !障害物がなければ LET x=xx !実際に移動させる LET y=yy END IF END IF CALL SetViewPort !ビューポート移動 LET evt=CheckEvent(mapEvt,x,y) !フィールド上のイベントを確認 END IF CALL DrawView !ビュー表示 END IF IF gs=GAME_TALK THEN !会話画面なら CALL DrawView !ビュー表示 CALL GetAButton(t0) !Ａボタンの入力 END IF IF GetKeyState(27)<0 THEN LET fRun=0 !ESCキーで終了 LOOP SUB GetMoveKey(dx,dy,dr,t0) !移動キーの入力を確認する LET dx=0 !移動量 LET dy=0 LET dr=MOVE_NONE !移動方向 IF TIME-t0>0.2 THEN !200ミリ秒ごとに IF GetKeyState(37)<0 THEN !いずれか１つのみ LET dx=-1 LET dr=MOVE_LEFT !左カーソルキー ELSE IF GetKeyState(38)<0 THEN LET dy=-1 LET dr=MOVE_UP !上 ELSE IF GetKeyState(39)<0 THEN LET dx=1 LET dr=MOVE_RIGHT !右 ELSE IF GetKeyState(40)<0 THEN LET dy=1 LET dr=MOVE_DOWN !下 END IF END IF END IF END IF LET t0=TIME !次へ END IF END SUB SUB GetAButton(t0) !Ａボタンの入力を確認する IF TIME-t0>0.2 THEN !200ミリ秒ごとに IF GetKeyState(32)<0 THEN LET gs=GAME_MOVE !SPACEキー LET t0=TIME !次へ END IF END SUB SUB SetViewPort !ビューポートの設定する LET vx=2*x-vsx/2-1 !「キャラクタの中央固定」でビューポートを追従させる LET vy=2*(msy-y)-vsy/2+1 SET WINDOW vx,vx+vsx,vy,vy+vsy END SUB SUB DrawView !マップ、キャラクタを表示する SET DRAW mode hidden !ちらつき防止(開始) CLEAR CALL DrawLayer(mapFld,msx,msy) !フィールド CALL DrawLayer(mapObj,msx,msy) !オブジェクト DRAW Hiro(6,d) WITH SHIFT(2*x-1,2*(msy-y)+1) !キャラクタ IF gs=GAME_TALK THEN CALL DrawSpeak(evt,0) !会話文 SET DRAW mode explicit !ちらつき防止(終了) END SUB SUB DrawSpeak(n,v) !会話文を表示する SET AREA COLOR 199 !ふきだし PLOT AREA: vx+1,vy+1; vx+vsx-1,vy+1; vx+vsx-1,vy+5; vx+1,vy+5 SET LINE COLOR 1 SET LINE width 3 PLOT LINES: vx+1,vy+1; vx+vsx-1,vy+1; vx+vsx-1,vy+5; vx+1,vy+5; vx+1,vy+1 SET TEXT HEIGHT 0.4 FOR i=1 TO 4 !４行単位 PLOT TEXT ,AT vx+2,vy+4.75-i*0.75: ms$(n+i) NEXT i END SUB FUNCTION CheckEvent(e(,),x,y) !フィールド上のイベントを確認する LET a=e(y,x) IF a>0 THEN LET gs=GAME_TALK !会話画面へ LET CheckEvent=4*(a-1) END FUNCTION END 続く

Re: 簡易ゲームで

投稿者：山中和義投稿日：2009年12月22日(火)19時18分57秒

投稿者：山中和義投稿日：2010年 1月 8日(金)19時51分35秒

返信・引用

> No.966[元記事へ] angelさんへのお返事です。 100 LET N=100 110 LET c=0 120 FOR i=2 TO N 130 FOR k=2 TO i-1 !約数を確認する 140 IF MOD(i,k)=0 THEN GOTO 170 !ひとつでも割り切れるなら、素数でない 150 NEXT k 160 LET c=c+1 !素数 170 NEXT i 180 PRINT c !結果を表示する 190 END

Re: グラフ　の一部の文字の大きさ

投稿者：山中和義投稿日：2010年 1月 9日(土)11時46分59秒

投稿者：与坂　　昇平投稿日：2010年 1月26日(火)16時11分14秒

投稿者：GAI 投稿日：2010年 1月31日(日)08時40分56秒

返信・引用

１～１０の番号（同一マークで）のカードを準備し１．客に電話番号を何気に聞く。（ただし４つの数字はすべて異なってなければならない。そうでないなら、他の数字を考えてもらう。）＜例＞客の番号：９２６５これを小さい順に並べ、基準数とする。基準数　：２５６９２．１０枚のカードを上からすべて裏向きで２番目に９５番目に２６番目に６９番目に５のカードが位置するように（０はカード１０で作業する。）何気にセットしておく。他の位置のカードは何でもよい。＜頭の中で電話番号と基準数を対応させて作業する。＞３．このパケットをフォールスシャッフルし先の方法で基準数の数字が表向きに出現する操作をやる。演技的には、如何にも無造作にやっていると感じさせるように・・・「これらをよーく混ぜます。」などの口上と共に作業する。この例では１回目：上から１枚持ち上げひっくり返して元に戻す２回目：２枚持ち上げ同じく返して戻す３回目：４枚４回目：６枚５回目：８枚６回目：９枚このとき最後の操作でトップに４枚の表向きカード（５，６，２，９の順番）が来るから、最後の時にパケットをひっくり返しながらこれがボトム側へ来るように持ち替える。４．上から５枚を数え取り（すべて表向きカード）右手に持つ。５．残った左手のパケットとパーフェト・リフル・シャッフルをする。　（右手から先ず１枚落とし、次に左手から１枚、次に右手より１枚、・・・と交互にパラパラとテーブルにカードを噛み合わせながら落としていく。：慣れると簡単です。）６．カードを揃え、パケットをすべてひっくり返して右手に持つ。　　「電話番号は何でしたっけ？」と確認をとり　　テーブルへパケットをリボンスプレッドして下さい。　　＊＊９＊２＊６＊５＊　　　　（＊は裏向きカード）　　で並びます。客を驚かせるようにするのは大変です。

この問いはプログラム可能ですか？

投稿者：GAI 投稿日：2010年 1月31日(日)09時44分45秒

返信・引用

１＾３＋２＾３＋３＾３＋・・・・＋ｎ＾３＝１＊１＾２＋２＊２＾２＋３＊３＾２＋・・・・ｎ＊ｎ＾２＝（１＋２＋３＋・・・・＋ｎ）＾２（＝｛ｎ（ｎ＋１）/２｝＾２）のよく知られた関係式は一辺が１の正方形が１個一辺が２の正方形が２個一辺が３の正方形が３個・・・・・・・・・・一辺がｎの正方形がｎ個を使って、一辺がｎ（ｎ＋１）/2　の正方形を敷き詰める可能性を示唆する。さて本当にこのことを実現できるのはｎがいくつのときでしょうか？その最小値を調べてください。（ｎ＞１の条件で）またこの時の敷き詰め図は？