57 lines
950 B
Forth
57 lines
950 B
Forth
module top
|
|
implicit none
|
|
contains
|
|
recursive function f(x) result(m)
|
|
integer :: n, m, x(:),y(size(x)), fst
|
|
fst = x(1)
|
|
if (fst == 1) then
|
|
m = 0
|
|
else
|
|
y(1:fst) = x(fst:1:-1)
|
|
y(fst+1:) = x(fst+1:)
|
|
m = 1 + f(y)
|
|
end if
|
|
end function
|
|
|
|
recursive function perms(x) result(p)
|
|
integer, pointer :: p(:,:), q(:,:)
|
|
integer :: x(:), n, k, i
|
|
n = size(x)
|
|
if (n == 1) then
|
|
allocate(p(1,1))
|
|
p(1,:) = x
|
|
else
|
|
q => perms(x(2:n))
|
|
k = ubound(q,1)
|
|
allocate(p(k*n,n))
|
|
p = 0
|
|
do i = 1,n
|
|
p(1+k*(i-1):k*i,1:i-1) = q(:,1:i-1)
|
|
p(1+k*(i-1):k*i,i) = x(1)
|
|
p(1+k*(i-1):k*i,i+1:) = q(:,i:)
|
|
end do
|
|
end if
|
|
end function
|
|
end module
|
|
|
|
program topswort
|
|
use top
|
|
implicit none
|
|
integer :: x(10)
|
|
integer, pointer :: p(:,:)
|
|
integer :: i, j, m
|
|
|
|
forall(i=1:10)
|
|
x(i) = i
|
|
end forall
|
|
|
|
do i = 1,10
|
|
p=>perms(x(1:i))
|
|
m = 0
|
|
do j = 1, ubound(p,1)
|
|
m = max(m, f(p(j,:)))
|
|
end do
|
|
print "(i3,a,i3)", i,": ",m
|
|
end do
|
|
end program
|