ISM 階層計算( 隣接行列-Warshallのアルゴリズムによる) ISMW.BAS

10000 ' ISM 階層計算( 隣接行列-Warshallのアルゴリズムによる) ISMW.BAS   1991.06.25-28 Z.SEKIYA
10002 ' 推移的閉包(Warshallのアルゴリズム) 奥村,C言語によるアルゴリズム事典,
10003 '      pp.127,技術評論社,1991      1992.1.6 関谷
10010 clear,varptr(system,0)-&H800,&HF00,&HF00,&H1000
10020 defint A-Z: LPSW=0
10030 dim A(40,40),M(40,40), RS(40,40),ANS(40,40),HS(40,40),HSN(40)
10040 dim AIK(50,50),OE(50),HDEL(50)
10050 cls: input "ファイル名:",INPFN$
10054 print using"【隣接行列による階層計算】 @";date$
10055 if LPSW then lprint using"【隣接行列による階層計算】 @";date$
10060 if LPSW then lprint using"ファイル名:@";INPFN$
10070 if INPFN$<>"" then goto 10300
10080 input "モデル名, 要素数 N:";MODEL$,N
10090 NODT=0
10100 if LPSW then lprint using"モデル名:@, 要素数:##";MODEL$,N
10110 NODT=NODT+1: 'print using"R-No.[##]";
10120 input "I->Jの要素番号I, 要素番号J (終わりは､0,0)";I,J
10130 if I=0 and J=0 then ISW=1: goto 10180
10140 if I>N or J>N then print "要素番号が Ｎを越えています｡":goto 10110
10150 if I=J then print "要素番号が同じです。": goto 10110
10160 A(I,J)=1
10170 goto 10110
10179 '                 隣接行列のプリント
10180 print using"[@],要素数: ## @";MODEL$,N,time$
10182 print "  隣接行列": print "I/J ";: for J=1 to N:print using"##";J;:next J: print""
10190 if LPSW then lprint using"[@],要素数: ## @";MODEL$,N,time$
10192 if LPSW then lprint "  隣接行列":lprint "I/J ";: for J=1 to N:lprint using"##";J;:next J:lprint
10200 for I=1 to N: print using "##  ";I;:for J=1 to N: print using "##";A(I,J);:next J: print: next I
10210 if LPSW then for I=1 to N:lprint using "##  ";I;:for J=1 to N:lprint using "##";A(I,J);:next J:lprint: next I
10220 if ISW=2 then goto 10360
10230 input "保存するファイル名:";SAVEFN$
10240 if LPSW then lprint using"保存するファイル名:@";SAVEFN$
10250 if SAVEFN$="" then goto 10360
10260 open "A",#1,SAVEFN$ :print #1,using" @ , ##";MODEL$,N
10270 for I=1 to N: for J=1 to N: if A(I,J) then print #1,using"## ##";I,J
10280 next J: next I: print #1,"0 0"
10290 close #1 :goto 10360
10300 open "I",#1,INPFN$ :input #1,MODEL$,N
10310 for I=1 to 100: input #1,II,JJ:if II=0 and JJ=0 then goto 10320 else A(II,JJ)=1: next I
10320 close #1
10330 ISW=2:goto 10180
10340 '
10350 '                  可到達行列の計算
10351 '
10360 for I=1 to N: for J=1 to N: AIK(I,J)=A(I,J): if I=J then AIK(I,I)=1
10370 next J: next I
10380 for K=1 to N
10390   for I=1 to N
10400     if not AIK(I,K)  then goto 10440
10410       for J=1 to N
10420         if (AIK(I,J) or AIK(K,J)) then AIK(I,J)=1 else AIK(I,J)=0
10430       next J
10440   next I
10450 next K
10460 print: print using"可到達行列 M(i,j) @";time$: print "I/J ";: for J=1 to N:print using"##";J;:next J: print
10470 if LPSW then lprint:lprint using"可到達行列 M(i,j) @";time$:lprint "I/J ";: for J=1 to N:lprint using"##";J;:next J:lprint
10480 for I=1 to N: print using " ## ";I;:for J=1 to N: print using " #";AIK(I,J);:next J: print: next I
10490 if LPSW then for I=1 to N:lprint using " ## ";I;:for J=1 to N:lprint using " #";AIK(I,J);:next J:lprint: next I
10499 '
10500 '                 階層の計算
10501 '
10510 NI=N : NHJ=1:IHN=1: for I=1 to N: OE(I)=I: next I
10520 for I=1 to NI
10530   for IJ=1 to NI
10540     RS(I,IJ)=AIK(I,IJ): ANS(I,IJ)=AIK(IJ,I)
10550   next IJ
10560 next I
10570 '
10580 for I=1 to NI: FLAG=0
10590   for IJ=1 to NI
10600     if RS(I,IJ) = 0 then goto 10620
10610     if RS(I,IJ) and ANS(I,IJ) then goto 10620 else FLAG=1
10620   next IJ
10630   if FLAG=0 then HS(IHN,NHJ)=OE(I): HDEL(NHJ)=I:HSN(IHN)=NHJ: NHJ=NHJ+1 else FLAG=0
10640 next I
10650 if NI-HSN(IHN)<=0 then goto 10750
10660 II=0: for I=1 to NI: for IC=1 to HSN(IHN): if I=HDEL(IC) then goto 10720
10670 next IC: II=II+1: OE(II)=OE(I)
10680      JJ=0: for J=1 to NI: for JC=1 to HSN(IHN): if J=HDEL(JC) then goto 10710
10690      next JC
10700        JJ=JJ+1: AIK(II,JJ)=AIK(I,J)
10710    next J
10720  next I
10730 NI=NI-HSN(IHN)
10740 IHN=IHN+1: NHJ=1 : goto 10520
10749 '                       階層データ表 プリント
10750 print: print using"[@], 階層データ表 @";MODEL$,time$: print "レベル:要素群"
10760 if LPSW then lprint:lprint using"[@], 階層データ表 @";MODEL$,time$:lprint "レベル:要素群"
10770 for I=1 to IHN:print using"  ##  : ";I;:if LPSW then lprint using"  ##  :";I;
10780   for J=1 to HSN(I): print using " ## ";HS(I,J);: next J: print
10790   if LPSW then for J=1 to HSN(I):lprint using " ## ";HS(I,J);: next J:lprint
10800 next I