跳到主要內容

求出n取k組合的列表 Fortran 版

這次換個簡單一點的語言:Fortran 95
我很驚訝GFortran 4.7仍然預設是Fortran 77,所以副檔名若是.f或.for會錯, 要存成.f90或.f95才行。

Fortran是Column major語言,所以若要遞迴還需要宣告recursive,堆疊方式造成Fortran永遠處理遞迴會比C麻煩。再加上很遜的Format,我就用以前學的Fortran 77寫法完成 :P。

program Combinations
  implicit none
  integer, parameter :: all=5
    integer, parameter :: want=2
    integer :: currentrow 
  integer, dimension(:, :), pointer :: result
  call comb(all, want)


 contains
  function factorial(n)
   integer:: n, factorial, i
   factorial = product((/(i, i=1, n)/))
  end function

  subroutine addlist(before, beforelength, left, leftlength)
   integer, intent(in), dimension(0:)::before, left
   integer, intent(in) :: beforelength, leftlength
   integer ::i, j
   do i = 0, beforelength-1
    result(currentrow, i) = before(i)
   end do 
   do j=0, leftlength-1
    result(currentrow, i+j) = left(j)
   end do
   currentrow = currentrow + 1
  end subroutine

  subroutine comb(all, want)
   integer, intent(in) ::all, want
   integer :: resultno, i, j
   integer, dimension(0) :: before
   character (500) :: fmt
   fmt = '(i0' // repeat (', 1x, i0', all - 1) // ')'
   currentrow = 0
     resultno = factorial(all)/ ((factorial(want)* factorial(all-want)))
     allocate(result(resultno, all))
     write(*, "(a4, i2, a4)") "共:", resultno, "筆"
   call calc(before, 0, all, want)
   write (*, *) 'currentrow=', currentrow, ' all=', all
   do i=0, currentrow-1
    write (*, fmt)   (result(i, j), j=0, all-1)
   end do 
  end subroutine

 recursive subroutine calc(before, beforelength, all, want)
  integer, dimension(0:) :: before
  integer, intent(in) :: beforelength, all, want
  integer :: i, leftlength
  integer, dimension(0:all) :: strall, newbefore, left
  if (want == 0) then
   do i=1, all
    strall(i) = 0
   end do
   call addList(before, beforelength, strall, all)
  else if (all==want) then
   do i=0, all-1
    strall(i) = 1
   end do  
   call addList(before, beforelength, strall, all)
  else if(all == 1) then
   leftlength = 1
   select case(want)
    case (0)
     left(0)=0
    case (1)
     left(0)=1   
   end select
   call addlist(before, beforelength,  left, leftlength);
  else
   do i=0, beforelength-1
    newbefore(i) = before(i)
   end do
   newbefore(i) = 0
   call calc(newbefore, beforelength+1, all-1, want)
   newbefore(i) = 1
   call calc(newbefore, beforelength+1, all-1, want-1)
  end if
 end subroutine
 end program main

留言

這個網誌中的熱門文章

自然人憑證讀卡機驅動程式

鳥毅用的是第一代的自然人憑證讀卡機,EZ100PU(後來有同事買EZmini可以讀SIM卡似乎更好),每年報稅時用一次。

本來只是要申請些政府業務,一時之間找不到光碟,沒想到在驅動程式下載居然看到Linux和Mac的驅動程式,剩下的就是政府單位的網頁和程式應該改版了吧!!!

在Windows Server設定L2TP over IPSec VPN

簡單地說,macOS Sierra與iOS 10發表後,大家忽然發現Apple不再支援PPTP,所以一定得設定其他的VPN型態。若不要另外裝client,用L2TP是最方便的,SSL VPN雖然好,但若沒有安裝Agent要連線到任一電腦或是非網頁服務還是挺麻煩的。