存储列表的所有 r 组合

Question

我需要一个 Fortran 通用程序来获取 n 元素列表中 r 元素的所有可能组合。我发现这段代码打印了所有组合 (r=3, n =5) 但我需要将它们存储在数组中。

我试图将它们记录为 write 语句附近的行，但它不起作用。把递归子程序变成递归函数也不行。

program combinations
  implicit none
  
  integer, parameter :: m_max = 3
  integer, parameter :: n_max = 5
  integer, dimension (m_max) :: comb
  character (*), parameter :: fmt = '(i0' // repeat (', 1x, i0', m_max - 1) // ')'
  
  call gen (1)
contains
  recursive subroutine gen (m)
    implicit none
    
    integer, intent (in) :: m
    integer :: n
    
    if (m > m_max) then
      write (*, fmt) comb
    else
      do n = 1, n_max
        if ((m == 1) .or. (n > comb (m - 1))) then
          comb (m) = n
          call gen (m + 1)
        end if
      end do
    end if     
  end subroutine gen
end program combinations

Answer 1

首先，混合全局变量和递归过程是造成很多不必要的混乱和调试的好方法，所以让我们把comb和n_max变成过程参数，使用size(comb) 给出 m_max，现在将 fmt 替换为 *:

program combinations
  implicit none

  integer :: comb(3)

  call gen(comb, 1, 5)
contains
  recursive subroutine gen(comb, m, n_max)
    integer, intent(inout) :: comb(:)
    integer, intent(in) :: m
    integer, intent(in) :: n_max

    integer :: n

    if (m > size(comb)) then
      write (*, *) comb
    else
      do n = 1, n_max
        if ((m == 1) .or. (n > comb(m - 1))) then
          comb(m) = n
          call gen(comb, m+1, n_max)
        end if
      end do
    end if
  end subroutine gen
end program combinations

接下来要注意的是您的代码中有一个细微的错误。行

if ((m == 1) .or. (n > comb (m - 1))) then

如果 m=1，

不能保证有效。 Fortran does not guarantee short-circuiting of logical operators，因此即使 (m == 1) 的计算结果为 .true.，(n > comb (m - 1)) 也可能被计算，从而导致段错误。让我们通过引入一个变量 n_min 并正确计算它来解决这个问题：

  recursive subroutine gen(comb, m, n_max)
    integer, intent(inout) :: comb(:)
    integer, intent(in) :: m
    integer, intent(in) :: n_max

    integer :: n
    integer :: n_min

    if (m > size(comb)) then
      write (*, *) comb
    else
      if (m == 1) then
        n_min = 1
      else
        n_min = comb(m-1) + 1
      endif

      do n = n_min, n_max
        comb(m) = n
        call gen (comb, m+1, n_max)
      end do
    end if
  end subroutine gen

好的，现在我们可以开始考虑 return 对 gen 的组合了。为此，让我们将 gen 从 subroutine 更改为 function，并使其 return 成为一个二维数组。我们需要将一个二维数组附加到另一个二维数组上，所以让我们现在编写一个函数来执行此操作：

  function append_combinations(input, new_combinations) result(output)
    integer, intent(in) :: input(:,:)
    integer, intent(in) :: new_combinations(:,:)
    integer, allocatable :: output(:,:)

    allocate(output(size(input,1), size(input,2)+size(new_combinations,2)))
    output(:, :size(input,2)) = input
    output(:, size(input,2)+1:) = new_combinations
  end function

现在整个程序看起来像

program combinations
  implicit none

  integer :: comb(3)
  integer, allocatable :: combs(:,:)
  integer :: i

  combs = gen(comb, 1, 5)

  write(*, *) ""
  do i=1,size(combs,2)
    write(*, *) combs(:,i)
  enddo
contains
  recursive function gen(comb, m, n_max) result(combs)
    integer, intent(inout) :: comb(:)
    integer, intent(in) :: m
    integer, intent(in) :: n_max
    integer, allocatable :: combs(:,:)

    integer :: n
    integer :: n_min
    integer, allocatable :: new_combs(:,:)

    if (m > size(comb)) then
      write (*, *) comb
      combs = reshape(comb, [size(comb),1])
    else
      if (m == 1) then
        n_min = 1
      else
        n_min = comb(m-1) + 1
      endif

      allocate(combs(size(comb), 0))
      do n = n_min, n_max
        comb(m) = n
        new_combs = gen(comb, m+1, n_max)
        combs = append_combinations(combs, new_combs)
      end do
    end if
  end function gen

  function append_combinations(input, new_combinations) result(output)
    integer, intent(in) :: input(:,:)
    integer, intent(in) :: new_combinations(:,:)
    integer, allocatable :: output(:,:)

    allocate(output(size(input,1), size(input,2)+size(new_combinations,2)))
    output(:, :size(input,2)) = input
    output(:, size(input,2)+1:) = new_combinations
  end function
end program combinations

存储列表的所有 r 组合

Store all r combinations of a list

recursion

fortran