通用計算機代碼查找組合，無需重複

Question

我必須爲給定數組找到所有沒有重複的組合（nCr）。例如，如果數組=位置=（/ 1,2,3,4,5 /），並且我想找到3的組合（這裏，r = 3），則所有的組合是： （1 2 3; 1 2 4; 1 2 5; 1 3 4; 1 3 5; 1 4 5; 2 3 4; 2 3 5; 2 4 5; 3 4 5）

我問題是將這個過程概括爲r的任何值。根據我當前的代碼， ，for循環的數量隨着r的增加而增加。 有沒有可能用fortran將這個過程推廣到任何r？

我爲R = 3

program combinations 

integer i,j,k,l 
integer loc1,loc2,loc3 
integer, dimension(5) ::positions 

positions = (/ 1, 2, 3, 4, 5/) 

do i =1,5 
loc1 = positions(i) 
    do j =1,5 
    if (j .gt. i) then 
    loc2 = positions(j) 
    do k=1,5 
     if (k .gt. j) then 
     loc3 = positions(k) 

     write(*,*) loc1,loc2,loc3 

    endif 
    enddo 
    endif 
enddo 
enddo 

end program 

`

Answer 1

在蟒蛇的情況下，當前的代碼， 「有因任何一個內置的方法」 ;-)

from itertools import combinations 
list(combinations(range(1, 6), 3)) 
# Output will be [(1, 2, 3), (1, 2, 4), (1, 2, 5), (1, 3, 4), (1, 3, 5), (1, 4, 5), (2, 3, 4), (2, 3, 5), (2, 4, 5), (3, 4, 5)] 

有fun :-)

Answer 2

你想要的是堆算法：

https://en.wikipedia.org/wiki/Heap%27s_algorithm

文章中的僞代碼可以很容易地轉換成Fortran。不要忘記將子程序聲明爲RECURSIVE。

Answer 3

COMMON ICOUNT 
    CHARACTER *70 OFIL 
    OFIL='ALLCOMB.TXT' 
    WRITE(*,*)'FEED N AND M (NOTE: N OR M LARGER THAN 20 TAKES TIME)' 
    READ(*,*) N,M 
    WRITE(*,*)'FEED FILE NAME TO STORE RESULTS' 
    READ(*,*) OFIL 
    ICOUNT=0 
    CALL COMBIN(N,M,OFIL) 
    WRITE(*,*)'OVER' 
    END 
    !--------------------------------------------------------------- 
    SUBROUTINE COMBIN(N,M,OFIL) 
    PARAMETER (MX=20)! MX IS MAXIMUM DIMENSION 
    ! Program by SK Mishra http://skmishra.net/computer-programs/comb.txt 
    COMMON ICOUNT 
    INTEGER A(MX),B(MX),C 
    DOUBLE PRECISION NCM,IC 
    CHARACTER *70 OFIL 
    OPEN(15,FILE=OFIL) 
    NCM=1 
    DO I=1,M 
    A(I)=I ! A IS LEAST INDEXED COMBINATION 
    B(I)=N-M+I ! B IS MAXIMUM INDEXED COMBINATION 
    NCM=NCM*B(I)/I ! TOTAL POSSIBLE COMBINATIONS 
    ENDDO 
    IF(M.GT.0) THEN 
    ICOUNT=ICOUNT+1 
    WRITE (15,*) (A(I),I=1,M), ICOUNT! INITIAL (LEAST INDEXED) COMBINATION 
    ELSE 
    WRITE(15,*) 'NONE' 
    ENDIF 
    INCMPL=1 
    IC=1 
    ! -------------------------------------------------------------- 
    DO WHILE (INCMPL.NE.0 .AND.INT(IC).LT.NCM) 
    INCM=0 
    DO I=1,M 
    INCM=INCM+(B(I)-A(I)) 
    ENDDO 
    INCMPL=INCM 
    A(M)=A(M)+1 
    DO I=1,M 
    II=M-I+1 
     IF(A(II).GT.B(II)) THEN 
     A(II-1)=A(II-1)+1 
     DO J=II,M 
     A(J)=A(J-1)+1 
     ENDDO 
     ENDIF 
    ENDDO 
    IC=IC+1 
    ICOUNT=ICOUNT+1 
    WRITE(15,*)(A(K),K=1,M),ICOUNT 
    ENDDO ! END DO WHILE LOOP 
    ! -------------------------------------------------------------- 
    CLOSE(15) 
    RETURN 
    END