|
|
!'N個の要素をR個の巡回列に分割する
DO
INPUT PROMPT "N,R=":N,R
LOOP UNTIL N>=R AND N>2
PRINT S1(N,R) !'第1種スターリング数
PUBLIC STRING A$(10),B$(10,1000)
PUBLIC NUMERIC C(10),S
SELECT CASE N
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
LET FL=ROTATECHK(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$
LET A$(I)=A$(I)&" 1"
LET A$(J)=A$(J)&" 3"
LET A$(K)=A$(K)&" 2"
FOR II=1 TO S
LET FL=CHECK(R,A$,B$,II)
IF FL<>0 THEN EXIT FOR
LET FL=ROTATECHK(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 II=1
FOR JJ=2 TO N
FOR KK=2 TO N
FOR LL=2 TO N
IF II<>JJ AND II<>KK AND II<>LL AND JJ<>KK AND JJ<>LL AND KK<>LL THEN
LET A$(I)=A$(I)&" "&STR$(II)
LET A$(J)=A$(J)&" "&STR$(JJ)
LET A$(K)=A$(K)&" "&STR$(KK)
LET A$(L)=A$(L)&" "&STR$(LL)
FOR Q=1 TO S
LET FL=CHECK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
LET FL=ROTATECHK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
NEXT Q
IF FL=0 THEN
LET S=S+1
FOR Q=1 TO R
LET B$(Q,S)=A$(Q)
NEXT Q
PRINT S;":";
FOR Q=1 TO R
PRINT "[";LTRIM$(A$(Q));"]";
NEXT Q
PRINT
END IF
MAT A$=NUL$
END IF
NEXT LL
NEXT KK
NEXT JJ
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 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 C(I)=1
LET C(J)=1
LET C(K)=1
LET C(L)=1
LET C(M)=1
LET FG=0
FOR II=1 TO R
IF C(II)=0 THEN LET FG=1
NEXT II
IF FG=0 THEN
LET II=1
FOR JJ=2 TO N
FOR KK=2 TO N
FOR LL=2 TO N
FOR MM=2 TO N
IF II<>JJ AND II<>KK AND II<>LL AND II<>MM AND JJ<>KK AND JJ<>LL AND JJ<>MM AND KK<>LL AND KK<>MM AND LL<>MM THEN
LET A$(I)=A$(I)&" "&STR$(II)
LET A$(J)=A$(J)&" "&STR$(JJ)
LET A$(K)=A$(K)&" "&STR$(KK)
LET A$(L)=A$(L)&" "&STR$(LL)
LET A$(M)=A$(M)&" "&STR$(MM)
FOR Q=1 TO S
LET FL=CHECK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
LET FL=ROTATECHK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
NEXT Q
IF FL=0 THEN
LET S=S+1
FOR Q=1 TO R
LET B$(Q,S)=A$(Q)
NEXT Q
PRINT S;":";
FOR Q=1 TO R
PRINT "[";LTRIM$(A$(Q));"]";
NEXT Q
PRINT
END IF
MAT A$=NUL$
END IF
NEXT MM
NEXT LL
NEXT KK
NEXT JJ
END IF
LET C(I)=0
LET C(J)=0
LET C(K)=0
LET C(L)=0
LET C(M)=0
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
LET C(I)=1
LET C(J)=1
LET C(K)=1
LET C(L)=1
LET C(M)=1
LET C(O)=1
LET FG=0
FOR II=1 TO R
IF C(II)=0 THEN LET FG=1
NEXT II
IF FG=0 THEN
LET II=1
FOR JJ=2 TO N
FOR KK=2 TO N
FOR LL=2 TO N
FOR MM=2 TO N
FOR NN=2 TO N
IF II<>JJ AND II<>KK AND II<>LL AND II<>MM AND II<>NN AND JJ<>KK AND JJ<>LL AND JJ<>MM AND JJ<>NN AND KK<>LL AND KK<>MM AND KK<>NN AND LL<>MM AND LL<>NN AND MM<>NN THEN
LET A$(I)=A$(I)&" "&STR$(II)
LET A$(J)=A$(J)&" "&STR$(JJ)
LET A$(K)=A$(K)&" "&STR$(KK)
LET A$(L)=A$(L)&" "&STR$(LL)
LET A$(M)=A$(M)&" "&STR$(MM)
LET A$(O)=A$(O)&" "&STR$(NN)
FOR Q=1 TO S
LET FL=CHECK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
LET FL=ROTATECHK(R,A$,B$,Q)
IF FL<>0 THEN EXIT FOR
NEXT Q
IF FL=0 THEN
LET S=S+1
FOR Q=1 TO R
LET B$(Q,S)=A$(Q)
NEXT Q
PRINT S;":";
FOR Q=1 TO R
PRINT "[";LTRIM$(A$(Q));"]";
NEXT Q
PRINT
END IF
MAT A$=NUL$
END IF
NEXT NN
NEXT MM
NEXT LL
NEXT KK
NEXT JJ
END IF
LET C(I)=0
LET C(J)=0
LET C(K)=0
LET C(L)=0
LET C(M)=0
LET C(O)=0
NEXT O
NEXT M
NEXT L
NEXT K
NEXT J
NEXT I
END SELECT
END
EXTERNAL FUNCTION S1(N,K) !'第1種スターリング数
IF K<1 OR K>N THEN
LET S1=0
EXIT FUNCTION
END IF
IF K=N THEN
LET S1=1
EXIT FUNCTION
END IF
LET S1=(N-1)*S1(N-1,K)+S1(N-1,K-1)
END FUNCTION
EXTERNAL FUNCTION CHECK(R,A$(),B$(,),II)
SELECT CASE R
CASE 1
FOR I=1 TO R
IF LTRIM$(A$(I))=LTRIM$(B$(1,II)) THEN
LET CHECK=1
EXIT FUNCTION
END IF
NEXT I
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 ELSE
DIM B(R)
FOR I=1 TO R
LET B(I)=I
NEXT I
CALL PERM(B,1)
END SELECT
SUB PERM(B(),N)
LOCAL I,J
LET M=UBOUND(B)
IF N=M THEN
LET FL=0
FOR K=1 TO M
IF LTRIM$(A$(B(K)))=LTRIM$(B$(K,II)) THEN LET FL=FL+1
NEXT K
IF FL=M THEN
LET CHECK=1
EXIT FUNCTION
END IF
ELSE
FOR I=N TO M
LET T=B(I)
FOR J=I-1 TO N STEP-1
LET B(J+1)=B(J)
NEXT J
LET B(N)=T
CALL PERM(B,N+1)
LET T=B(N)
FOR J=N TO I-1
LET B(J)=B(J+1)
NEXT J
LET B(I)=T
NEXT I
END IF
END SUB
END FUNCTION
EXTERNAL FUNCTION ROTATECHK(R,A$(),B$(,),II) !'巡回列かどうか
FOR I=1 TO R
FOR J=1 TO R
LET AA$=LTRIM$(A$(I))
LET BB$=LTRIM$(B$(J,II))
IF LEN(AA$)=LEN(BB$) THEN
FOR N=3 TO LEN(AA$) STEP 2
LET C$=""
LET K=N
FOR L=1 TO (LEN(AA$)+1)/2
LET C$=C$&AA$(K:K)&" "
IF K>=LEN(AA$) THEN LET K=1 ELSE LET K=K+2
NEXT L
IF BB$=RTRIM$(C$) THEN
LET ROTATECHK=1
EXIT FUNCTION
END IF
NEXT N
END IF
NEXT J
NEXT I
LET ROTATECHK=0
END FUNCTION
N,R=5,3
35
1 :[1 2 3][4][5]
2 :[1 2 4][3][5]
3 :[1 2 5][3][4]
4 :[1 3 2][4][5]
5 :[1 3 4][2][5]
6 :[1 3 5][2][4]
7 :[1 4 2][3][5]
8 :[1 4 3][2][5]
9 :[1 4 5][2][3]
10 :[1 5 2][3][4]
11 :[1 5 3][2][4]
12 :[1 5 4][2][3]
13 :[1 2][3 4][5]
14 :[1 2][3 5][4]
15 :[1 2][4 5][3]
16 :[1 3][2 4][5]
17 :[1 3][2 5][4]
18 :[1 3][4 5][2]
19 :[1 4][2 3][5]
20 :[1 4][2 5][3]
21 :[1 4][3 5][2]
22 :[1 5][2 3][4]
23 :[1 5][2 4][3]
24 :[1 5][3 4][2]
25 :[1][2 3 4][5]
26 :[1][2 3 5][4]
27 :[1][2 4 3][5]
28 :[1][2 4 5][3]
29 :[1][2 5 3][4]
30 :[1][2 5 4][3]
31 :[1][3 4 5][2]
32 :[1][3 5 4][2]
33 :[1][2 3][4 5]
34 :[1][2 4][3 5]
35 :[1][2 5][3 4]
|
|