Question

我必须找到给定数组的所有组合而不重复（nCr）。例如，如果array = positions =（/ 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

对于python，＆＃34;有一个内置的方法，无论什么＆＃34; ; - ）

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)]

玩得开心： - ）

Answer 2

你想要的是Heap的算法：

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

Answer 4

关键思想是使用内在函数 btest 将十进制数转换为二进制数。当 n>=32 时，kind=4 的整数溢出。如果r接近n/2，下面的代码效率更高。

program combination
implicit none
integer(4),parameter :: n=5, r=3
integer(4),dimension(r) :: loc
integer(4) :: i,kr,i10,nCr
nCr=0
decimaloop:do i10=0,2**n-1
  kr=0
  do i=1,n
    if(btest(i10,i-1)) then
      kr=kr+1
      if(kr<=r) then
        loc(kr)=i
      else
        cycle decimaloop
      endif
    endif
  enddo
  if(kr==r) then
    nCr=nCr+1
    print 100,nCr,loc(:)
  endif
enddo decimaloop
print'("nCr=",i)',nCr
100 format(i10,3x,32i3)
end program combination

广义的计算机代码，无需重复即可找到组合

4 个答案: