諸量の計算プログラム

BASIC 多面体 諸量

フリーウェアーソフトの 十進BASIC を使って 諸量の計算ができます。
http://hp.vector.co.jp/authors/VA008683/ を参照
様々な場面で活用され 紹介されているソフトです。
英語版 Decimal BASIC もあります。

以下のプログラムを コピーして それを実行すると 走ります。
試してみては いかがでしょう。

! の記号の後ろの 文字は プログラムでは実行されません。
気にせず コピーの中に含めて かまいません。

!!コピー開始*******************************************
!*** プラトン多面体 アルキメデス多面体の 諸量の計算 ***
!******************************************************
OPTION ANGLE DEGREES ! 三角関数の角の大きさの単位を度(DEGREES)にする
DIM men(18,6) ! 多面体の一つの頂を構成する多角形の種類と数
DIM met$(18) ! 多面体の記号
DIM khn(18,10) ! 多面体の基本数など

FOR s1=1 TO 18
   FOR s2=1 TO 6
      READ men(s1,s2) ! データを読み込む 
   NEXT s2
   READ met$(s1) ! 多面体の記号を読込む 
NEXT s1

PRINT "名称","基本数"
PRINT "①仰角","L接合角","M接合角","S接合角"
PRINT "②頂芯寸","稜芯寸"
PRINT "③L面芯寸","M面芯寸","S面芯寸"
PRINT
!********************
!*** 諸量計算開始 ***
!********************
FOR ss=1 TO 18
   LET lk=men(ss,1) ! 大角形の角数
   LET mk=men(ss,2) ! 中角形の角数
   LET sk=men(ss,3) ! 小角形の角数
   LET la=0.5/SIN(180/lk) ! L角心寸
   LET ma=0.5/SIN(180/mk) ! M角心寸
   LET sa=0.5/SIN(180/sk) ! S角心寸
   ! 内角を二等辺三角形の頂角としたときの底辺の1/2の長さ l01 m02 s03
   LET l01=SIN((180-360/lk)/2) 
   LET m02=SIN((180-360/mk)/2)
   LET s03=SIN((180-360/sk)/2) 

   LET l04=men(ss,4) ! 頂を構成する大角形の個数
   LET m05=men(ss,5) ! 頂を構成する中角形の個数
   LET s06=men(ss,6) ! 頂を構成する小角形の個数

   LET f02 =0 ! 総接合角と360度との差の最小値 初期値は0
   LET c0=l01 ! 基本数より短い値
   LET c9=1 ! 基本数より長い値
101 
       LET c5=c9-(c9-c0)/2 ! 短と長の中間の 仮の基本数
       LET l01X=ASIN(l01/c5) ! 角数が一番多い多角形面に 接する側の接合角
       LET m02X=ASIN(m02/c5) ! 角数が次に多い多角形面に 接する側の接合角
       LET s03X=ASIN(s03/c5) ! 角数が一番小い多角形面に 接する側の接合角
       LET f01=360 -l01X*2*l04 -m02X*2*m05 -s03X*2*s06 ! 総接合角と360度との差 
       IF f01 = f02 THEN
          LET khn(ss,1)=c5 ! 基本数 
          LET khn(ss,2)=l01X ! 大接合角
          LET khn(ss,3)=m02X ! 中接合角
          LET khn(ss,4)=s03X ! 小接合角
          LET khn(ss,5)=ACOS(c5) !仰角
          LET khn(ss,6)=1/SQR(1-c5^2)/2 ! 頂芯寸 = 外接球半径
          LET khn(ss,7)=1/SQR(1-c5^2)/2*c5 ! 稜芯寸
          LET khn(ss,8)=SQR(khn(ss,6)^2-la^2) ! L面芯寸
          IF mk > 2 THEN
             LET khn(ss,9)=SQR(khn(ss,6)^2-ma^2) ! M面芯寸
          END IF
          IF sk > 2 THEN
             LET khn(ss,10)=SQR(khn(ss,6)^2-sa^2) ! S面芯寸
          END IF

          PRINT met$(ss), khn(ss,1)
          PRINT "①";khn(ss,5),khn(ss,2),khn(ss,3),khn(ss,4) 
          PRINT "②";khn(ss,6),khn(ss,7)
          PRINT "③";khn(ss,8),khn(ss,9),khn(ss,10)

          PRINT
          GO TO 102
       END IF
       LET f02 = f01
       IF f01 > 0 THEN !総接合角が360度に満たない→仮の基本数c5が基本数より長い
          LET c9 = c5 ! 基本数より長い値に仮の基本数c5を入れる
       ELSE ! 総接合角が 360度をオーバー → 仮の基本数c5が基本数より短い
          LET c0 = c5 ! 基本数より短い値に仮の基本数c5を入れる
       END IF
       GOTO 101
102 
    NEXT ss

    !*******************
    !*** データ領域 *** 
    !*******************

    ! 多面体の一つの頂を構成する多角形の種類と数 (2角数は ダミー)
    !     (1)L角数 (2)M角数 (3)S角数 (4)L個数 (5)M個数 (6)S個数 
    DATA       3,       2,       2,       3,       1,       1 , "01[3,3,3] "
    DATA       3,       2,       2,       4,       1,       1 , "02[3,3,3,3]"
    DATA       4,       2,       2,       3,       1,       1 , "03[4,4,4]"
    DATA       3,       2,       2,       5,       1,       1 , "04[3,3,3,3,3]"
    DATA       4,       3,       2,       2,       2,       1 , "05[3,4,3,4]"
    DATA       6,       3,       2,       2,       1,       1 , "06[3,6,6]"
    DATA       4,       3,       2,       1,       4,       1 , "07[3,3,3,3,4]"
    DATA       4,       3,       2,       3,       1,       1 , "08[3,4,4,4]"
    DATA       5,       2,       2,       3,       1,       1 , "09[5,5,5]"
    DATA       6,       4,       2,       2,       1,       1 , "10[4,6,6]"
    DATA       5,       3,       2,       2,       2,       1 , "11[3,5,3,5]"
    DATA       8,       3,       2,       2,       1,       1 , "12[3,8,8]"
    DATA       5,       3,       2,       1,       4,       1 , "13[3,3,3,3,5]"
    DATA       5,       4,       3,       1,       2,       1 , "14[3,4,5,4]"
    DATA       8,       6,       4,       1,       1,       1 , "15[4,6,8]"
    DATA       6,       5,       2,       2,       1,       1 , "16[5,6,6]"
    DATA      10,       3,       2,       2,       1,       1 , "17[3,10,10]"
    DATA      10,       6,       4,       1,       1,       1 , "18[4,6,10]"

 END ! コピー終わり


注 計算結果は  

一般解を求める BASIC program の出力一覧 (2015 8/4)  で表示しています。

« »