十進BASIC第2掲示板過去ログ

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時15分17秒

!'N個の異なる球をR個の異なる箱に分ける(空箱なし) DO INPUT PROMPT "N,R=":N,R LOOP UNTIL N>=R PUBLIC STRING A$(10) PUBLIC NUMERIC B(10),S DIM AA(N) PRINT FACT(R)*S2(N,R) SELECT CASE N CASE 2 FOR I=1 TO R FOR J=1 TO R LET B(I)=1 LET B(J)=1 LET FL=0 FOR II=1 TO R IF B(II)=0 THEN LET FL=1 NEXT II IF FL=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT END IF MAT B=ZER NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R LET B(I)=1 LET B(J)=1 LET B(K)=1 LET FL=0 FOR II=1 TO R IF B(II)=0 THEN LET FL=1 NEXT II IF FL=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT END IF MAT B=ZER NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R LET B(I)=1 LET B(J)=1 LET B(K)=1 LET B(L)=1 LET FL=0 FOR II=1 TO R IF B(II)=0 THEN LET FL=1 NEXT II IF FL=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET A$(L)=A$(L)&" 4" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT END IF MAT B=ZER NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL PN(1,N,R,AA) END SELECT END EXTERNAL SUB PN(NN,M,R,AA()) IF M<NN THEN FOR II=1 TO M LET B(AA(II))=1 NEXT II LET FL=0 FOR II=1 TO R IF B(II)=0 THEN LET FL=1 NEXT II IF FL=0 THEN FOR II=1 TO M LET A$(AA(II))=A$(AA(II))&" "&STR$(II) NEXT II LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT END IF MAT B=ZER ELSE FOR I=1 TO R LET AA(NN)=I CALL PN(NN+1,M,R,AA) NEXT I END IF END SUB EXTERNAL FUNCTION S2(N,K) !'第2スターリング数 IF K<1 OR K>N THEN LET S2=0 EXIT FUNCTION END IF IF K=N OR K=1 THEN LET S2=1 EXIT FUNCTION END IF LET S2=K*S2(N-1,K)+S2(N-1,K-1) END FUNCTION N,R=5,3 150 1 :[1 2 3][4][5] 2 :[1 2 3][5][4] 3 :[1 2 4][3][5] 4 :[1 2][3 4][5] 5 :[1 2 5][3][4] 中略 144 :[4 5][3][1 2] 145 :[4][3 5][1 2] 146 :[4][3][1 2 5] 147 :[5][3 4][1 2] 148 :[5][3][1 2 4] 149 :[4][5][1 2 3] 150 :[5][4][1 2 3]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時15分55秒

!'N個の異なる球をR個の異なる箱に分ける(空箱あり) INPUT PROMPT "N,R=":N,R PUBLIC STRING A$(10) PUBLIC NUMERIC S DIM AA(N) PRINT R^N SELECT CASE N CASE 2 FOR I=1 TO R FOR J=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET A$(L)=A$(L)&" 4" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT NEXT L NEXT K NEXT J NEXT I CASE 5 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R FOR M=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET A$(L)=A$(L)&" 4" LET A$(M)=A$(M)&" 5" LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT NEXT M NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL PN(1,N,R,AA) END SELECT END EXTERNAL SUB PN(NN,M,R,AA()) IF M<NN THEN FOR II=1 TO M LET A$(AA(II))=A$(AA(II))&" "&STR$(II) NEXT II LET S=S+1 PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; LET A$(II)="" NEXT II PRINT ELSE FOR I=1 TO R LET AA(NN)=I CALL PN(NN+1,M,R,AA) NEXT I END IF END SUB N,R=5,3 243 1 :[1 2 3 4 5][][] 2 :[1 2 3 4][5][] 3 :[1 2 3 4][][5] 4 :[1 2 3 5][4][] 5 :[1 2 3][4 5][] 6 :[1 2 3][4][5] 7 :[1 2 3 5][][4] 中略 236 :[4][5][1 2 3] 237 :[4][][1 2 3 5] 238 :[5][4][1 2 3] 239 :[][4 5][1 2 3] 240 :[][4][1 2 3 5] 241 :[5][][1 2 3 4] 242 :[][5][1 2 3 4] 243 :[][][1 2 3 4 5]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時16分27秒

!'N個の異なる球をR個の同じ箱に分ける(空箱なし) DO INPUT PROMPT "N,R=":N,R LOOP UNTIL N>=R PRINT S2(N,R) PUBLIC STRING A$(10),B$(10,1000) PUBLIC NUMERIC C(10),S DIM AA(N) SELECT CASE N CASE 2 FOR I=1 TO R FOR J=1 TO R LET C(I)=1 LET C(J)=1 LET FG=0 FOR II=1 TO R IF C(II)=0 THEN LET FG=1 NEXT II IF FG=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF MAT A$=NUL$ END IF LET C(I)=0 LET C(J)=0 NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R LET C(I)=1 LET C(J)=1 LET C(K)=1 LET FG=0 FOR II=1 TO R IF C(II)=0 THEN LET FG=1 NEXT II IF FG=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF MAT A$=NUL$ END IF LET C(I)=0 LET C(J)=0 LET C(K)=0 NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R LET C(I)=1 LET C(J)=1 LET C(K)=1 LET C(L)=1 LET FG=0 FOR II=1 TO R IF C(II)=0 THEN LET FG=1 NEXT II IF FG=0 THEN LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET A$(L)=A$(L)&" 4" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF MAT A$=NUL$ END IF LET C(I)=0 LET C(J)=0 LET C(K)=0 LET C(L)=0 NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL PN(1,N,R,AA) END SELECT END EXTERNAL SUB PN(NN,M,R,AA()) IF M<NN THEN FOR II=1 TO M LET C(AA(II))=1 NEXT II LET FG=0 FOR II=1 TO R IF C(II)=0 THEN LET FG=1 NEXT II IF FG=0 THEN FOR II=1 TO M LET A$(AA(II))=A$(AA(II))&" "&STR$(II) NEXT II FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF MAT A$=NUL$ END IF MAT C=ZER ELSE FOR I=1 TO R LET AA(NN)=I CALL PN(NN+1,M,R,AA) NEXT I END IF END SUB EXTERNAL FUNCTION S2(N,R) !'第2スターリング数 FOR J=0 TO R LET V=V+COMB(R,J)*(-1)^J*(R-J)^N NEXT J LET S2=V/FACT(R) END FUNCTION EXTERNAL FUNCTION CHECK(R,A$(),B$(,),II) SELECT CASE R CASE 2 FOR I=1 TO R FOR J=1 TO R IF I<>J THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R IF I<>J AND J<>K AND I<>K THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R IF I<>J AND I<>K AND I<>L AND J<>K AND J<>L AND K<>L THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT L NEXT K NEXT J NEXT I CASE 5 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R FOR M=1 TO R IF I<>J AND I<>K AND I<>L AND I<>M AND J<>K AND J<>L AND J<>M AND K<>L AND K<>M AND L<>M THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) AND LTRIM$(A$(M))=LTRIM$(B$(5,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT M NEXT L NEXT K NEXT J NEXT I CASE 6 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R FOR M=1 TO R FOR O=1 TO R IF I<>J AND I<>K AND I<>L AND I<>M AND I<>O AND J<>K AND J<>L AND J<>M AND J<>O THEN IF K<>L AND K<>M AND K<>O AND L<>M AND L<>O AND M<>O THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) AND LTRIM$(A$(M))=LTRIM$(B$(5,II)) AND LTRIM$(A$(O))=LTRIM$(B$(6,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF END IF NEXT O NEXT M NEXT L NEXT K NEXT J NEXT I END SELECT END FUNCTION N,R=5,3 25 1 :[1 2 3][4][5] 2 :[1 2 4][3][5] 3 :[1 2][3 4][5] 4 :[1 2 5][3][4] 5 :[1 2][3 5][4] 6 :[1 2][3][4 5] 7 :[1 3 4][2][5] 8 :[1 3][2 4][5] 9 :[1 3 5][2][4] 10 :[1 3][2 5][4] 11 :[1 3][2][4 5] 12 :[1 4][2 3][5] 13 :[1][2 3 4][5] 14 :[1 5][2 3][4] 15 :[1][2 3 5][4] 16 :[1][2 3][4 5] 17 :[1 4 5][2][3] 18 :[1 4][2 5][3] 19 :[1 4][2][3 5] 20 :[1 5][2 4][3] 21 :[1][2 4 5][3] 22 :[1][2 4][3 5] 23 :[1 5][2][3 4] 24 :[1][2 5][3 4] 25 :[1][2][3 4 5]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時17分3秒

!'N個の異なる球をR個の同じ箱に分ける(空箱あり) DO INPUT PROMPT "N,R=":N,R LOOP UNTIL N>=R AND N>=2 DIM AA(N) PUBLIC STRING A$(10),B$(10,1000) PUBLIC NUMERIC S,SS FOR K=1 TO R LET SS=SS+S2(N,K) NEXT K PRINT SS SELECT CASE N CASE 2 FOR I=1 TO R FOR J=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF IF S=SS THEN STOP MAT A$=NUL$ NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF IF S=SS THEN STOP MAT A$=NUL$ NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R LET A$(I)=A$(I)&"1" LET A$(J)=A$(J)&" 2" LET A$(K)=A$(K)&" 3" LET A$(L)=A$(L)&" 4" FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF IF S=SS THEN STOP MAT A$=NUL$ NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL PN(1,N,R,AA) END SELECT END EXTERNAL SUB PN(NN,M,R,AA()) IF M<NN THEN FOR II=1 TO M LET A$(AA(II))=A$(AA(II))&" "&STR$(II) NEXT II FOR II=1 TO S LET FL=CHECK(R,A$,B$,II) IF FL<>0 THEN EXIT FOR NEXT II IF FL=0 THEN LET S=S+1 FOR II=1 TO R LET B$(II,S)=A$(II) NEXT II PRINT S;":"; FOR II=1 TO R PRINT "[";LTRIM$(A$(II));"]"; NEXT II PRINT END IF IF S=SS THEN STOP MAT A$=NUL$ ELSE FOR I=1 TO R LET AA(NN)=I CALL PN(NN+1,M,R,AA) NEXT I END IF END SUB EXTERNAL FUNCTION S2(N,R) !'第2スターリング数 FOR J=0 TO R LET V=V+COMB(R,J)*(-1)^J*(R-J)^N NEXT J LET S2=V/FACT(R) END FUNCTION EXTERNAL FUNCTION CHECK(R,A$(),B$(,),II) SELECT CASE R CASE 2 FOR I=1 TO R FOR J=1 TO R IF I<>J THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT J NEXT I CASE 3 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R IF I<>J AND J<>K AND I<>K THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT K NEXT J NEXT I CASE 4 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R IF I<>J AND I<>K AND I<>L AND J<>K AND J<>L AND K<>L THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT L NEXT K NEXT J NEXT I CASE 5 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R FOR M=1 TO R IF I<>J AND I<>K AND I<>L AND I<>M AND J<>K AND J<>L AND J<>M AND K<>L AND K<>M AND L<>M THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) AND LTRIM$(A$(M))=LTRIM$(B$(5,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF NEXT M NEXT L NEXT K NEXT J NEXT I CASE 6 FOR I=1 TO R FOR J=1 TO R FOR K=1 TO R FOR L=1 TO R FOR M=1 TO R FOR O=1 TO R IF I<>J AND I<>K AND I<>L AND I<>M AND I<>O AND J<>K AND J<>L AND J<>M AND J<>O THEN IF K<>L AND K<>M AND K<>O AND L<>M AND L<>O AND M<>O THEN IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) AND LTRIM$(A$(J))=LTRIM$(B$(2,II)) AND LTRIM$(A$(K))=LTRIM$(B$(3,II)) AND LTRIM$(A$(L))=LTRIM$(B$(4,II)) AND LTRIM$(A$(M))=LTRIM$(B$(5,II)) AND LTRIM$(A$(O))=LTRIM$(B$(6,II)) THEN LET CHECK=1 EXIT FUNCTION END IF END IF END IF NEXT O NEXT M NEXT L NEXT K NEXT J NEXT I END SELECT END FUNCTION N,R=5,3 41 1 :[1 2 3 4 5][][] 2 :[1 2 3 4][5][] 3 :[1 2 3 5][4][] 4 :[1 2 3][4 5][] 5 :[1 2 3][4][5] 6 :[1 2 4 5][3][] 7 :[1 2 4][3 5][] 8 :[1 2 4][3][5] 9 :[1 2 5][3 4][] 10 :[1 2][3 4 5][] 11 :[1 2][3 4][5] 12 :[1 2 5][3][4] 13 :[1 2][3 5][4] 14 :[1 2][3][4 5] 15 :[1 3 4 5][2][] 16 :[1 3 4][2 5][] 17 :[1 3 4][2][5] 18 :[1 3 5][2 4][] 19 :[1 3][2 4 5][] 20 :[1 3][2 4][5] 21 :[1 3 5][2][4] 22 :[1 3][2 5][4] 23 :[1 3][2][4 5] 24 :[1 4 5][2 3][] 25 :[1 4][2 3 5][] 26 :[1 4][2 3][5] 27 :[1 5][2 3 4][] 28 :[1][2 3 4 5][] 29 :[1][2 3 4][5] 30 :[1 5][2 3][4] 31 :[1][2 3 5][4] 32 :[1][2 3][4 5] 33 :[1 4 5][2][3] 34 :[1 4][2 5][3] 35 :[1 4][2][3 5] 36 :[1 5][2 4][3] 37 :[1][2 4 5][3] 38 :[1][2 4][3 5] 39 :[1 5][2][3 4] 40 :[1][2 5][3 4] 41 :[1][2][3 4 5]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時17分32秒

!'N個の同じ球をR個の異なる箱に分ける(空箱なし) DO INPUT PROMPT "N,R=":N,R LOOP UNTIL N>=R AND R>1 DIM A(N) PUBLIC NUMERIC S PRINT COMB(N-1,R-1) CALL COMBN(1,N-1,R-1,A) END EXTERNAL SUB COMBN(NN,N,R,A()) IF R<NN THEN LET S=S+1 PRINT S;":["; FOR J=1 TO N+1 PRINT "●"; FOR L=1 TO R IF A(L)=J THEN PRINT "] ["; NEXT L NEXT J PRINT "]" ELSE FOR I=1 TO N-R+NN LET A(NN)=I IF NN=1 OR A(NN-1)<A(NN) THEN CALL COMBN(NN+1,N,R,A) END IF NEXT I END IF END SUB N,R=5,3 6 1 :[●] [●] [●●●] 2 :[●] [●●] [●●] 3 :[●] [●●●] [●] 4 :[●●] [●] [●●] 5 :[●●] [●●] [●] 6 :[●●●] [●] [●]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時18分0秒

!'N個の同じ球をR個の異なる箱に分ける(空箱あり) PUBLIC NUMERIC S INPUT PROMPT "N,R=":N,R PRINT COMB(N+R-3,R-1) DIM A(N+R-1) CALL RECURSIVE(1,N-1,R-1,A) END EXTERNAL SUB RECURSIVE(NN,M,N,A()) IF N<NN THEN LET S=S+1 PRINT S;": ["; FOR J=1 TO M+1 PRINT "●"; FOR L=1 TO N IF A(L)=J THEN PRINT "] ["; NEXT L NEXT J PRINT "]" ELSE FOR I=1 TO M LET A(NN)=I IF NN=1 OR A(NN-1)<=A(NN) THEN CALL RECURSIVE(NN+1,M,N,A) END IF NEXT I END IF END SUB N,R=5,3 10 1 : [●] [] [●●●●] 2 : [●] [●] [●●●] 3 : [●] [●●] [●●] 4 : [●] [●●●] [●] 5 : [●●] [] [●●●] 6 : [●●] [●] [●●] 7 : [●●] [●●] [●] 8 : [●●●] [] [●●] 9 : [●●●] [●] [●] 10 : [●●●●] [] [●]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時18分26秒

!'N個の同じ球をR個の同じ箱に分ける(空箱なし) PUBLIC NUMERIC S DO INPUT PROMPT "N,R=":N,R LOOP UNTIL N>=R AND N>=2 DIM A(N) PRINT P(N,R) SELECT CASE R CASE 2 FOR I=1 TO N LET J=N-I IF I<=J THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT I CASE 3 FOR I=1 TO N FOR J=I TO N-I LET K=N-I-J IF I<=J AND J<=K THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT J NEXT I CASE 4 FOR I=1 TO N FOR J=I TO N-I FOR K=J TO N-I-J LET L=N-I-J-K IF I<=J AND J<=K AND K<=L THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J OR II=I+J+K THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT K NEXT J NEXT I CASE 5 FOR I=1 TO N FOR J=I TO N-I FOR K=J TO N-I-J FOR L=K TO N-I-J-K LET M=N-I-J-K-L IF I<=J AND J<=K AND K<=L AND L<=M THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J OR II=I+J+K OR II=I+J+K+L THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL RECURSIVE(1,R,N,A) END SELECT END EXTERNAL SUB RECURSIVE(NN,N,M,A()) IF NN=N THEN LET SS=M FOR J=0 TO NN LET SS=SS-A(J) NEXT J IF SS=0 THEN IF A(NN-1)<=A(NN) THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; LET SS=SS+A(II) IF II=SS THEN PRINT "] ["; NEXT II PRINT "]" END IF EXIT SUB END IF ELSE FOR I=1 TO M LET A(NN)=I IF NN=1 OR A(NN-1)<=A(NN) THEN CALL RECURSIVE(NN+1,N,M,A) END IF NEXT I END IF END SUB EXTERNAL FUNCTION P(N,M) !'分割数 IF M=1 OR N=M THEN LET P=1 ELSEIF N>=3 AND 2<=M AND M<=N-1 THEN LET P=P(N-M,M)+P(N-1,M-1) ELSE LET P=0 END IF END FUNCTION N,R=5,3 2 1 : [●] [●] [●●●] 2 : [●] [●●] [●●]

N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月16日(土)19時18分48秒

!'N個の同じ球をR個の同じ箱に分ける(空箱あり) PUBLIC NUMERIC S INPUT PROMPT "N,R=":N,R DIM A(N) FOR K=1 TO R LET SS=SS+P(N,K) NEXT K PRINT SS SELECT CASE R CASE 2 FOR I=0 TO N LET J=N-I IF I<=J THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT I CASE 3 FOR I=0 TO N FOR J=I TO N-I LET K=N-I-J IF I<=J AND J<=K THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT J NEXT I CASE 4 FOR I=0 TO N FOR J=I TO N-I FOR K=J TO N-I-J LET L=N-I-J-K IF I<=J AND J<=K AND K<=L THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J OR II=I+J+K THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT K NEXT J NEXT I CASE 5 FOR I=0 TO N FOR J=I TO N-I FOR K=J TO N-I-J FOR L=K TO N-I-J-K LET M=N-I-J-K-L IF I<=J AND J<=K AND K<=L AND L<=M THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; IF II=I OR II=I+J OR II=I+J+K OR II=I+J+K+L THEN PRINT "] ["; NEXT II PRINT "]" END IF NEXT L NEXT K NEXT J NEXT I CASE ELSE CALL RECURSIVE(1,R,N,A) END SELECT END EXTERNAL SUB RECURSIVE(NN,N,M,A()) IF NN=N THEN LET SS=M FOR J=0 TO NN LET SS=SS-A(J) NEXT J IF SS=0 THEN IF A(NN-1)<=A(NN) THEN LET S=S+1 PRINT S;": ["; FOR II=1 TO N PRINT "●"; LET SS=SS+A(II) IF II=SS THEN PRINT "] ["; NEXT II PRINT "]" END IF EXIT SUB END IF ELSE FOR I=0 TO M LET A(NN)=I IF NN=1 OR A(NN-1)<=A(NN) THEN CALL RECURSIVE(NN+1,N,M,A) END IF NEXT I END IF END SUB EXTERNAL FUNCTION P(N,M) !'分割数 IF M=1 OR N=M THEN LET P=1 ELSEIF N>=3 AND 2<=M AND M<=N-1 THEN LET P=P(N-M,M)+P(N-1,M-1) ELSE LET P=0 END IF END FUNCTION N,R=5,3 5 1 : [●●●●●] 2 : [●] [●●●●] 3 : [●●] [●●●] 4 : [●] [●] [●●●] 5 : [●] [●●] [●●]

Re: N個の球をR個の箱に分ける

投稿者：山中和義投稿日：2013年11月17日(日)10時01分8秒

> No.3198[元記事へ] しばっちさんへのお返事です。 > N個の同じ球をR個の異なる箱に分ける(空箱あり) > N,R=5,3 > 10 > 1 : [●] [] [●●●●] > 2 : [●] [●] [●●●] > 3 : [●] [●●] [●●] > 4 : [●] [●●●] [●] > 5 : [●●] [] [●●●] > 6 : [●●] [●] [●●] > 7 : [●●] [●●] [●] > 8 : [●●●] [] [●●] > 9 : [●●●] [●] [●] > 10 : [●●●●] [] [●] 1番目や3番目の箱が空になる場合はないのですか？

Re: N個の球をR個の箱に分ける

投稿者：しばっち投稿日：2013年11月17日(日)20時38分51秒

> No.3201[元記事へ] 山中和義さんへのお返事です。 > しばっちさんへのお返事です。 > > > N個の同じ球をR個の異なる箱に分ける(空箱あり) > > N,R=5,3 > > 10 > > 1 : [●] [] [●●●●] > > 2 : [●] [●] [●●●] > > 3 : [●] [●●] [●●] > > 4 : [●] [●●●] [●] > > 5 : [●●] [] [●●●] > > 6 : [●●] [●] [●●] > > 7 : [●●] [●●] [●] > > 8 : [●●●] [] [●●] > > 9 : [●●●] [●] [●] > > 10 : [●●●●] [] [●] > > 1番目や3番目の箱が空になる場合はないのですか？ご指摘有難うございます。こちらの勘違いでした。取り急ぎ作成しましたので、とりあえずはこれでよろしいでしょうか? !'N個の同じ球をR個の異なる箱に分ける(空箱あり) INPUT PROMPT "N,R=":N,R PRINT COMB(N+R-1,R-1) SELECT CASE R CASE 2 FOR I=0 TO N LET J=N-I LET S=S+1 PRINT S;":["; FOR II=1 TO I PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO J PRINT "●"; NEXT II PRINT "]" NEXT I CASE 3 FOR I=0 TO N FOR J=0 TO N-I LET K=N-J-I LET S=S+1 PRINT S;":["; FOR II=1 TO I PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO J PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO K PRINT "●"; NEXT II PRINT "]" NEXT J NEXT I CASE 4 FOR I=0 TO N FOR J=0 TO N-I FOR K=0 TO N-I-J LET L=N-I-J-K LET S=S+1 PRINT S;":["; FOR II=1 TO I PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO J PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO K PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO L PRINT "●"; NEXT II PRINT "]" NEXT K NEXT J NEXT I CASE 5 FOR I=0 TO N FOR J=0 TO N-I FOR K=0 TO N-I-J FOR L=0 TO N-I-J-K LET M=N-I-J-K-L LET S=S+1 PRINT S;":["; FOR II=1 TO I PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO J PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO K PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO L PRINT "●"; NEXT II PRINT "]["; FOR II=1 TO M PRINT "●"; NEXT II PRINT "]" NEXT L NEXT K NEXT J NEXT I END SELECT END N,R=5,3 21 1 :[][][●●●●●] 2 :[][●][●●●●] 3 :[][●●][●●●] 4 :[][●●●][●●] 5 :[][●●●●][●] 6 :[][●●●●●][] 7 :[●][][●●●●] 8 :[●][●][●●●] 9 :[●][●●][●●] 10 :[●][●●●][●] 11 :[●][●●●●][] 12 :[●●][][●●●] 13 :[●●][●][●●] 14 :[●●][●●][●] 15 :[●●][●●●][] 16 :[●●●][][●●] 17 :[●●●][●][●] 18 :[●●●][●●][] 19 :[●●●●][][●] 20 :[●●●●][●][] 21 :[●●●●●][][]

戻る

十進BASIC 第2掲示板 過去ログ

十進BASIC 第2掲示板過去ログ