|
投稿者：しばっち
投稿日：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]
|
|
|
|
投稿者：しばっち
投稿日：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]
|
|
|
|
投稿者：しばっち
投稿日：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]
|
|
|
|
投稿者：しばっち
投稿日：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]
|
|
|
|
投稿者：しばっち
投稿日：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 :[●●●] [●] [●]
|
|
|
|
投稿者：しばっち
投稿日：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 : [●●●●] [] [●]
|
|
|
|
投稿者：しばっち
投稿日：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 : [●] [●●] [●●]
|
|
|
|
投稿者：しばっち
投稿日：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 : [●] [●●] [●●]
|
|
|
|
投稿者：山中和義
投稿日：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番目の箱が空になる場合はないのですか？
|
|
|
|
投稿者：しばっち
投稿日：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 :[●●●●●][][]
|
|
|
戻る