Task: Cartesian product of two or more lists








VB: Imports System.Runtime.CompilerServices

Module Module1

    <Extension()>
    Function CartesianProduct(Of T)(sequences As IEnumerable(Of IEnumerable(Of T))) As IEnumerable(Of IEnumerable(Of T))
        Dim emptyProduct As IEnumerable(Of IEnumerable(Of T)) = {Enumerable.Empty(Of T)}
        Return sequences.Aggregate(emptyProduct, Function(accumulator, sequence) From acc In accumulator From item In sequence Select acc.Concat({item}))
    End Function

    Sub Main()
        Dim empty(-1) As Integer
        Dim list1 = {1, 2}
        Dim list2 = {3, 4}
        Dim list3 = {1776, 1789}
        Dim list4 = {7, 12}
        Dim list5 = {4, 14, 23}
        Dim list6 = {0, 1}
        Dim list7 = {1, 2, 3}
        Dim list8 = {30}
        Dim list9 = {500, 100}

        For Each sequnceList As Integer()() In {
            ({list1, list2}),
            ({list2, list1}),
            ({list1, empty}),
            ({empty, list1}),
            ({list3, list4, list5, list6}),
            ({list7, list8, list9}),
            ({list7, empty, list9})
        }
            Dim cart = sequnceList.CartesianProduct().Select(Function(tuple) $"({String.Join(", ", tuple)})")
            Console.WriteLine($"{{{String.Join(", ", cart)}}}")
        Next
    End Sub

End Module



Fortran:  
  
 
 
 module tuple
    implicit none
    private
    public :: tuple_t, operator(*), print
 
    type tuple_t(n)
        integer, len     :: n
        integer, private :: v(n)
    contains
        procedure, public :: print => print_tuple_t
        generic, public :: assignment(=) => eq_tuple_t
        procedure, public :: eq_tuple_t
    end type tuple_t
 
    interface print
        module procedure print_tuple_a_t
    end interface print
    interface operator(*)
        module procedure tup_times_tup
    end interface
 
 contains
    subroutine eq_tuple_t(this, src)
        class(tuple_t(*)), intent(inout) :: this
        integer, intent(in)              :: src(:)
        this%v = src
    end subroutine eq_tuple_t

    pure function tup_times_tup(a, b) result(r)
        type(tuple_t(*)), intent(in)  :: a
        type(tuple_t(*)), intent(in)  :: b
        type(tuple_t(2)), allocatable :: r(:)
        integer :: i, j, k
 
        allocate(r(a%n*b%n))
        k = 0
        do i=1,a%n
            do j=1,b%n
                k = k + 1
                r(k)%v = [a%v(i),b%v(j)]
            end do
        end do
    end function tup_times_tup
 
    subroutine print_tuple_t(this)
        class(tuple_t(*)), intent(in) :: this
        integer :: i
        write(*,fmt='(a)',advance='no') '{'
        do i=1,size(this%v)
            write(*,fmt='(i0)',advance='no') this%v(i)
            if (i < size(this%v)) write(*,fmt='(a)',advance='no') ','
        end do
        write(*,fmt='(a)',advance='no') '}'
    end subroutine print_tuple_t
 
    subroutine print_tuple_a_t(r)
        type(tuple_t(*)), intent(in) :: r(:)
        integer :: i
        write(*,fmt='(a)',advance='no') '{'
        do i=1,size(r)
            call r(i)%print
            if (i < size(r)) write(*,fmt='(a)',advance='no') ','
        end do
        write(*,fmt='(a)') '}'
    end subroutine print_tuple_a_t
 end module tuple
 
 program cartesian_product
    use tuple
 
    implicit none
    type(tuple_t(2)) :: a, b
    type(tuple_t(0)) :: z
 
    a = [1,2]
    b = [3,4]
 
    call print_product(a, b)
    call print_product(b, a)
    call print_product(z, a)
    call print_product(a, z)
 
    stop
 contains
    subroutine print_product(s, t)
        type(tuple_t(*)), intent(in) :: s
        type(tuple_t(*)), intent(in) :: t
        call s%print
        write(*,fmt='(a)',advance='no') ' x '
        call t%print
        write(*,fmt='(a)',advance='no') ' = '
        call print(s*t)
    end subroutine print_product
 end program cartesian_product