[Shootout-list] fannkuch.f90

[Simon Geard]

This is a multi-part message in MIME format.
--------------020206060104030901030906
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit

I have fixed the fannkuch.f90 program to use an efficient permutation 
generator. The result for N=9 on my machine is

[simon@fawkes f90]$ time -p fannkuch 9
 Pfannkuchen(9) = 30
real 0.21
user 0.20
sys 0.00


How are you getting on with installing the f90 compiler on your test 
machine?

Simon


--------------020206060104030901030906
Content-Type: text/plain;
 name="fannkuch.f90"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="fannkuch.f90"

! Fannkuch access function implementation
! Simon Geard, 1/12/04
!
! Building info.
! ==============
!
! Linux  - using the Intel Fortran90 compiler:
!
!          ifort fannkuch.f90 -O3 -static-libcxa -o fannkuch
!
! WinXP  - Compaq Visual Fortran 6.6c
!
!          f90 fannkuch.f90 /link /libpath:"d:\Program Files\Microsoft Visual Studio\df98\lib"
!
! Cygwin - g95 compiler
!
!          g95 fannkuch.f90 -O3 -o fannkuch.exe
!
!!$"Take a permutation of {1,...,n}, for example: {4,2,1,5,3}. Take the first element, here 4, and reverse the order of the first 4 elements: {5,1,2,4,3}. Repeat this until the first element is a 1, so flipping won't change anything more: {3,4,2,1,5}, {2,4,3,1,5}, {4,2,3,1,5}, {1,3,2,4,5}. Count the number of flips, here 5. Do this for all n! permutations, and record the maximum number of flips needed for any permutation. The conjecture is that this maximum count is approximated by n*log(n) when n goes to infinity.
!!$
!!$FANNKUCH is an abbreviation for the German word Pfannkuchen, or pancakes, in analogy to flipping pancakes."
!!$
!!$Correct output N = 7 is:
!!$
!!$Pfannkuchen(7) = 16
!!$
!!$
!!$Correct output N = 8 is:
!!$
!!$Pfannkuchen(8) = 22
!!$
!!$
!!$Correct output N = 9 is:
!!$
!!$Pfannkuchen(9) = 30
!!$
!!$
!!$Correct output N = 10 is:
!!$
!!$Pfannkuchen(10) = 38

program fannkuch
  implicit none
  integer count, i, num
  character(len=8) argv
  integer, dimension(:), allocatable :: data
  intrinsic max

  call getarg(1,argv)
  read(argv,*) num
  allocate(data(num))

  count = 0
  data = (/ (i,i=1,num) /) ! Must start with the smallest number
  do i=1,factorial(num)
     count = max(count,countFlips(data))
     call getNextPerm(data)
  end do
  
  deallocate(data)
  
  write(*,'(1X,A,I0,A,I2)') 'Pfannkuchen(',num,') = ',count

contains

  recursive integer function factorial(n) result(if)
    integer, intent(in) :: n
    if (n == 1) then
       if = 1
    else
       if = n*factorial(n-1)
    end if
  end function factorial

  ! Reverse an array
  subroutine reverse(data)
    integer, dimension(:), intent(inout) :: data
    integer, dimension(size(data)) :: work
    integer i
   ! print *,'reversing ',data
    forall (i=1:size(data))
       work(i) = data(size(data)-i+1)
    end forall
    data = work
  end subroutine reverse

  ! Count the number of flips in a permutation
  integer function countFlips(data)
    integer, dimension(:), intent(in) :: data
    integer, dimension(size(data)) :: work
    work = data
    countFlips = 0
    do
       if (work(1) <= 1) exit
       call reverse(work(1:work(1)))
       countFlips = countFlips + 1
    end do
  end function countFlips

  ! Get next permutation
  subroutine getNextPerm(data)
    integer, dimension(:), intent(inout) :: data
    integer :: i, kx, e, ci, ce, tmp, N

    ! Find largest k s.t. data(k) < data(k+1)
    N = size(data)
    kx = 0
    do i=1,N-1
       if (data(i) < data(i+1)) then
          kx = i
       end if
    end do

    ! Find smallest data(k+j) > data(k)
    e = data(kx)
    ci = kx
    do i=kx+1,N
       if (data(i) > e .and. (ci == kx .or. data(i) < ce)) then
          ci = i
          ce = data(i)
       end if
    end do

    ! Swap data(k) and data(k+j)
    tmp = data(kx)
    data(kx) = data(ci)
    data(ci) = tmp

    ! Reverse data(k+1) ... data(N)
    call reverse(data(kx+1:N))
    
  end subroutine getNextPerm

end program fannkuch

--------------020206060104030901030906--