Commit 1a88494e authored by Luca's avatar Luca

shuffle algebra for arrays with dark magic

parent c3567fdc
PROGRAM shuffle_algebra
implicit none
integer :: v1(2), v2(2)
integer :: amount_shuffles
integer :: res(3,3)
v1 = (/1,2/)
v2 = (/3,4/)
call print_as_matrix(shuffle_product(v1,v2))
CONTAINS
FUNCTION append_to_each_row(a, m) result(res)
! appends element a to each row of m
integer :: a, m(:,:), i
integer :: res(size(m,1),size(m,2)+1)
do i=1,size(m,1)
res(i,:) = [a,m(i,:)]
end do
END FUNCTION append_to_each_row
FUNCTION stack_matrices_vertically(m1, m2) result(res)
! appends to matrix m1 the rows of matrix m2
integer :: m1(:,:), m2(:,:)
integer :: res(size(m1,1)+size(m2,1), size(m1,2))
res(1:size(m1,1), :) = m1
res(size(m1,1)+1:size(res,1),:) = m2
END FUNCTION stack_matrices_vertically
SUBROUTINE print_as_matrix(m)
! prints a 2d array as a matrix
integer :: m(:,:)
integer :: s(2), i
s = shape(m)
do i = 1,s(1)
print*, abs(m(i,:))
end do
END SUBROUTINE print_as_matrix
RECURSIVE FUNCTION factorial(n) result(res)
integer, intent(in) :: n
integer :: res
res = merge(1,n*factorial(n-1),n==0)
END FUNCTION factorial
RECURSIVE FUNCTION shuffle_product(v1, v2) result(res)
integer :: v1(:), v2(:)
integer :: i
integer :: res(product((/(i,i=1,size(v1)+size(v2))/))/ &
(product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2))/))), &
size(v1) + size(v2))
integer :: p1(product((/(i,i=1,size(v1)+size(v2)-1)/))/ &
(product((/(i,i=1,size(v1)-1)/))*product((/(i,i=1,size(v2))/))), &
size(v1) + size(v2) - 1)
integer :: p2(product((/(i,i=1,size(v1)+size(v2)-1)/))/ &
(product((/(i,i=1,size(v1))/))*product((/(i,i=1,size(v2)-1)/))), &
size(v1) + size(v2) - 1)
integer :: alpha, beta, w1(size(v1)-1), w2(size(v2)-1)
res = 0
if(size(v1) == 0) then
res(1,:) = v2
return
else if(size(v2) == 0) then
res(1,:) = v1
return
end if
alpha = v1(1)
beta = v2(1)
w1 = v1(2:size(v1))
w2 = v2(2:size(v2))
res = stack_matrices_vertically( &
append_to_each_row(alpha, shuffle_product(w1, v2)), &
append_to_each_row(beta, shuffle_product(v1, w2)) )
END FUNCTION shuffle_product
END PROGRAM shuffle_algebra
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment