June 2018 Update
This commit is contained in:
Ingy döt Net
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
|
|
@ -1,41 +1,361 @@
|
|||
program nptest
|
||||
integer n,i,a
|
||||
logical nextp
|
||||
external nextp
|
||||
parameter(n=4)
|
||||
dimension a(n)
|
||||
do i=1,n
|
||||
a(i)=i
|
||||
enddo
|
||||
10 print *,(a(i),i=1,n)
|
||||
if(nextp(n,a)) go to 10
|
||||
end
|
||||
program testing_permutation_algorithms
|
||||
|
||||
implicit none
|
||||
integer :: nmax
|
||||
integer, dimension(:),allocatable :: ida
|
||||
logical :: mtc
|
||||
logical :: even
|
||||
integer :: i
|
||||
integer(8) :: ic
|
||||
integer :: clock_rate, clock_max, t1, t2
|
||||
real(8) :: dt
|
||||
integer :: pos_min, pos_max
|
||||
!
|
||||
!
|
||||
! Beginning:
|
||||
!
|
||||
write(*,*) 'INPUT N:'
|
||||
read *, nmax
|
||||
write(*,*) 'N =', nmax
|
||||
allocate ( ida(1:nmax) )
|
||||
!
|
||||
!
|
||||
! (1) Starting:
|
||||
!
|
||||
do i = 1, nmax
|
||||
ida(i) = i
|
||||
enddo
|
||||
!
|
||||
ic = 0
|
||||
call system_clock ( t1, clock_rate, clock_max )
|
||||
!
|
||||
mtc = .false.
|
||||
!
|
||||
do
|
||||
call subnexper ( nmax, ida, mtc, even )
|
||||
!
|
||||
! 1) counting the number of permutatations
|
||||
!
|
||||
ic = ic + 1
|
||||
!
|
||||
! 2) writing out the result:
|
||||
!
|
||||
! do i = 1, nmax
|
||||
! write (100,"(i3,',')",advance = "no") ida(i)
|
||||
! enddo
|
||||
! write(100,*)
|
||||
!
|
||||
! repeat if not being finished yet, otherwise exit.
|
||||
!
|
||||
if (mtc) then
|
||||
cycle
|
||||
else
|
||||
exit
|
||||
endif
|
||||
!
|
||||
enddo
|
||||
!
|
||||
call system_clock ( t2, clock_rate, clock_max )
|
||||
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
|
||||
!
|
||||
! Finishing (1)
|
||||
!
|
||||
write(*,*) "1) subnexper:"
|
||||
write(*,*) 'Total permutations :', ic
|
||||
write(*,*) 'Total time elapsed :', dt
|
||||
!
|
||||
!
|
||||
! (2) Starting:
|
||||
!
|
||||
do i = 1, nmax
|
||||
ida(i) = i
|
||||
enddo
|
||||
!
|
||||
pos_min = 1
|
||||
pos_max = nmax
|
||||
!
|
||||
ic = 0
|
||||
call system_clock ( t1, clock_rate, clock_max )
|
||||
!
|
||||
call generate ( pos_min )
|
||||
!
|
||||
call system_clock ( t2, clock_rate, clock_max )
|
||||
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
|
||||
!
|
||||
! Finishing (2)
|
||||
!
|
||||
write(*,*) "2) generate:"
|
||||
write(*,*) 'Total permutations :', ic
|
||||
write(*,*) 'Total time elapsed :', dt
|
||||
!
|
||||
!
|
||||
! (3) Starting:
|
||||
!
|
||||
do i = 1, nmax
|
||||
ida(i) = i
|
||||
enddo
|
||||
!
|
||||
ic = 0
|
||||
call system_clock ( t1, clock_rate, clock_max )
|
||||
!
|
||||
i = 1
|
||||
call perm ( i )
|
||||
!
|
||||
call system_clock ( t2, clock_rate, clock_max )
|
||||
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
|
||||
!
|
||||
! Finishing (3)
|
||||
!
|
||||
write(*,*) "3) perm:"
|
||||
write(*,*) 'Total permutations :', ic
|
||||
write(*,*) 'Total time elapsed :', dt
|
||||
!
|
||||
!
|
||||
! (4) Starting:
|
||||
!
|
||||
do i = 1, nmax
|
||||
ida(i) = i
|
||||
enddo
|
||||
!
|
||||
ic = 0
|
||||
call system_clock ( t1, clock_rate, clock_max )
|
||||
!
|
||||
do
|
||||
!
|
||||
! 1) counting the number of permutatations
|
||||
!
|
||||
ic = ic + 1
|
||||
!
|
||||
! 2) writing out the result:
|
||||
!
|
||||
! do i = 1, nmax
|
||||
! write (100,"(i3,',')",advance = "no") ida(i)
|
||||
! enddo
|
||||
! write(100,*)
|
||||
!
|
||||
! repeat if not being finished yet, otherwise exit.
|
||||
!
|
||||
if ( nextp(nmax,ida) ) then
|
||||
cycle
|
||||
else
|
||||
exit
|
||||
endif
|
||||
!
|
||||
enddo
|
||||
!
|
||||
call system_clock ( t2, clock_rate, clock_max )
|
||||
dt = ( dble(t2) - dble(t1) )/ dble(clock_rate)
|
||||
!
|
||||
! Finishing (4)
|
||||
!
|
||||
write(*,*) "4) nextp:"
|
||||
write(*,*) 'Total permutations :', ic
|
||||
write(*,*) 'Total time elapsed :', dt
|
||||
!
|
||||
!
|
||||
! What's else?
|
||||
! ...
|
||||
!
|
||||
!==
|
||||
deallocate(ida)
|
||||
!
|
||||
stop
|
||||
!==
|
||||
contains
|
||||
!==
|
||||
! Modified version of SUBROUTINE NEXPER from the book of
|
||||
! Albert Nijenhuis and Herbert S. Wilf, "Combinatorial
|
||||
! Algorithms For Computers and Calculators", 2nd Ed, p.59.
|
||||
!
|
||||
subroutine subnexper ( n, a, mtc, even )
|
||||
implicit none
|
||||
integer,intent(in) :: n
|
||||
integer,dimension(n),intent(inout) :: a
|
||||
logical,intent(inout) :: mtc, even
|
||||
!
|
||||
! local varialbes:
|
||||
!
|
||||
integer,save :: nm3
|
||||
integer :: ia, i, s, d, i1, l, j, m
|
||||
!
|
||||
if (mtc) goto 10
|
||||
|
||||
nm3 = n-3
|
||||
|
||||
do i = 1,n
|
||||
a(i) = i
|
||||
enddo
|
||||
|
||||
mtc = .true.
|
||||
5 even = .true.
|
||||
|
||||
if ( n .eq. 1 ) goto 8
|
||||
|
||||
6 if ( a(n) .ne. 1 .or. a(1) .ne. 2+mod(n,2) ) return
|
||||
|
||||
if ( n .le. 3 ) goto 8
|
||||
|
||||
do i = 1,nm3
|
||||
if( a(i+1) .ne. a(i)+1 ) return
|
||||
enddo
|
||||
|
||||
8 mtc = .false.
|
||||
|
||||
function nextp(n,a)
|
||||
integer n,a,i,j,k,t
|
||||
logical nextp
|
||||
dimension a(n)
|
||||
i=n-1
|
||||
10 if(a(i).lt.a(i+1)) go to 20
|
||||
i=i-1
|
||||
if(i.eq.0) go to 20
|
||||
go to 10
|
||||
20 j=i+1
|
||||
k=n
|
||||
30 t=a(j)
|
||||
a(j)=a(k)
|
||||
a(k)=t
|
||||
j=j+1
|
||||
k=k-1
|
||||
if(j.lt.k) go to 30
|
||||
j=i
|
||||
if(j.ne.0) go to 40
|
||||
nextp=.false.
|
||||
return
|
||||
40 j=j+1
|
||||
if(a(j).lt.a(i)) go to 40
|
||||
t=a(i)
|
||||
a(i)=a(j)
|
||||
a(j)=t
|
||||
nextp=.true.
|
||||
end
|
||||
|
||||
10 if ( n .eq. 1 ) goto 27
|
||||
|
||||
if( .not. even ) goto 20
|
||||
|
||||
ia = a(1)
|
||||
a(1) = a(2)
|
||||
a(2) = ia
|
||||
even = .false.
|
||||
|
||||
goto 6
|
||||
|
||||
20 s = 0
|
||||
|
||||
do i1 = 2,n
|
||||
ia = a(i1)
|
||||
i = i1-1
|
||||
d = 0
|
||||
do j = 1,i
|
||||
if ( a(j) .gt. ia ) d = d+1
|
||||
enddo
|
||||
s = d+s
|
||||
if ( d .ne. i*mod(s,2) ) goto 35
|
||||
enddo
|
||||
|
||||
27 a(1) = 0
|
||||
|
||||
goto 8
|
||||
|
||||
35 m = mod(s+1,2)*(n+1)
|
||||
|
||||
do j = 1,i
|
||||
if(isign(1,a(j)-ia) .eq. isign(1,a(j)-m)) cycle
|
||||
m = a(j)
|
||||
l = j
|
||||
enddo
|
||||
|
||||
a(l) = ia
|
||||
a(i1) = m
|
||||
even = .true.
|
||||
|
||||
return
|
||||
end subroutine
|
||||
!=====
|
||||
!
|
||||
! http://rosettacode.org/wiki/Permutations#Fortran
|
||||
!
|
||||
recursive subroutine generate (pos)
|
||||
|
||||
implicit none
|
||||
integer,intent(in) :: pos
|
||||
integer :: val
|
||||
|
||||
if (pos > pos_max) then
|
||||
!
|
||||
! 1) counting the number of permutatations
|
||||
!
|
||||
ic = ic + 1
|
||||
!
|
||||
! 2) writing out the result:
|
||||
!
|
||||
! write (*,*) permutation
|
||||
!
|
||||
else
|
||||
do val = 1, nmax
|
||||
if (.not. any (ida( : pos-1) == val)) then
|
||||
ida(pos) = val
|
||||
call generate (pos + 1)
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
|
||||
end subroutine
|
||||
!=====
|
||||
!
|
||||
! http://rosettacode.org/wiki/Permutations#Fortran
|
||||
!
|
||||
recursive subroutine perm (i)
|
||||
implicit none
|
||||
integer,intent(inout) :: i
|
||||
!
|
||||
integer :: j, t, ip1
|
||||
!
|
||||
if (i == nmax) then
|
||||
!
|
||||
! 1) couting the number of permutatations
|
||||
!
|
||||
ic = ic + 1
|
||||
!
|
||||
! 2) writing out the result:
|
||||
!
|
||||
! write (*,*) a
|
||||
!
|
||||
else
|
||||
ip1 = i+1
|
||||
do j = i, nmax
|
||||
t = ida(i)
|
||||
ida(i) = ida(j)
|
||||
ida(j) = t
|
||||
call perm ( ip1 )
|
||||
t = ida(i)
|
||||
ida(i) = ida(j)
|
||||
ida(j) = t
|
||||
enddo
|
||||
endif
|
||||
return
|
||||
end subroutine
|
||||
!=====
|
||||
!
|
||||
! http://rosettacode.org/wiki/Permutations#Fortran
|
||||
!
|
||||
function nextp ( n, a )
|
||||
logical :: nextp
|
||||
integer,intent(in) :: n
|
||||
integer,dimension(n),intent(inout) :: a
|
||||
!
|
||||
! local variables:
|
||||
!
|
||||
integer i,j,k,t
|
||||
!
|
||||
i = n-1
|
||||
10 if ( a(i) .lt. a(i+1) ) goto 20
|
||||
i = i-1
|
||||
if ( i .eq. 0 ) goto 20
|
||||
goto 10
|
||||
20 j = i+1
|
||||
k = n
|
||||
30 t = a(j)
|
||||
a(j) = a(k)
|
||||
a(k) = t
|
||||
j = j+1
|
||||
k = k-1
|
||||
if ( j .lt. k ) goto 30
|
||||
j = i
|
||||
if (j .ne. 0 ) goto 40
|
||||
!
|
||||
nextp = .false.
|
||||
!
|
||||
return
|
||||
!
|
||||
40 j = j+1
|
||||
if ( a(j) .lt. a(i) ) goto 40
|
||||
t = a(i)
|
||||
a(i) = a(j)
|
||||
a(j) = t
|
||||
!
|
||||
nextp = .true.
|
||||
!
|
||||
return
|
||||
end function
|
||||
!=====
|
||||
!
|
||||
! What's else ?
|
||||
! ...
|
||||
|
||||
!=====
|
||||
end program
|
||||
|
|
|
|||
41
Task/Permutations/Fortran/permutations-4.f
Normal file
41
Task/Permutations/Fortran/permutations-4.f
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
program nptest
|
||||
integer n,i,a
|
||||
logical nextp
|
||||
external nextp
|
||||
parameter(n=4)
|
||||
dimension a(n)
|
||||
do i=1,n
|
||||
a(i)=i
|
||||
enddo
|
||||
10 print *,(a(i),i=1,n)
|
||||
if(nextp(n,a)) go to 10
|
||||
end
|
||||
|
||||
function nextp(n,a)
|
||||
integer n,a,i,j,k,t
|
||||
logical nextp
|
||||
dimension a(n)
|
||||
i=n-1
|
||||
10 if(a(i).lt.a(i+1)) go to 20
|
||||
i=i-1
|
||||
if(i.eq.0) go to 20
|
||||
go to 10
|
||||
20 j=i+1
|
||||
k=n
|
||||
30 t=a(j)
|
||||
a(j)=a(k)
|
||||
a(k)=t
|
||||
j=j+1
|
||||
k=k-1
|
||||
if(j.lt.k) go to 30
|
||||
j=i
|
||||
if(j.ne.0) go to 40
|
||||
nextp=.false.
|
||||
return
|
||||
40 j=j+1
|
||||
if(a(j).lt.a(i)) go to 40
|
||||
t=a(i)
|
||||
a(i)=a(j)
|
||||
a(j)=t
|
||||
nextp=.true.
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue