Fortran: Set operations

Question

Fortran: There are two large arrays of integers, the goal is to find out if they have any number in common or not, how?
You may conside

Answer 1

Maybe this will work.

added from here

The main idea is using intrinsic function ANY().

1. ANY(x(:) == y) returns .true. if a scalar value y exists in an array x. When y is also an array ANY(x == y) returns x(1)==y(1) & x(2)==y(2) &..., so we have to use do loop for each element of y.

Now we try to delete duplicate numbers in the arrays.

1. First we sort the arrays. Quick-sort can be written concisely in a Haskell-like manner. (Reference : Arjen Markus, ACM Fortran Forum 27 (2008) 2-5.) But because recursion consumes stacks, Shell-sort might be a better choice, which does not require extra memories. It is often stated in textbooks that Shell-sort works in O(N^3/2~5/4), but it works much faster using special gap functions.wikipedia

2. Next we delete duplicate numbers by comparing successive elements using the idea of zip pairs. [x(2)/=x(1), ..., x(n)/=x(n-1)] We need to add extra one element to match array size. The intrinsic function PACK() is used as a Filter.

to here

  program SetAny
    implicit none
    integer, allocatable :: ia(:), ib(:)
! fortran2008
!    allocate(ia, source = [1,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5])
!    allocate(ib, source = [0,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9])
    allocate(ia(size([1,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5])))
    allocate(ib(size([0,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9])))
    ia = [1,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5,2,3,4,5]
    ib = [0,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9,6,7,8,9]

    print *, isin( shrnk( ia ), shrnk( ib ) )
    stop
contains
  logical pure function isin(ia, ib)
    integer, intent(in) :: ia(:), ib(:)
    integer :: i
    isin = .true.
    do i = 1, size(ib)
      if ( any(ia == ib(i)) ) return 
    end do
    isin = .false.
    return
  end function isin

  pure function shrnk(ia) result(res)
    integer, intent(in) :: ia(:)
    integer, allocatable :: res(:) ! f2003
    integer :: iwk(size(ia))
    iwk = qsort(ia)
    res = pack(iwk, [.true., iwk(2:) /= iwk(1:)]) ! f2003
    return
  end function shrnk

  pure recursive function qsort(ia) result(res)
    integer, intent(in) :: ia(:)
    integer :: res(size(ia))
    if (size(ia) .lt. 2) then 
     res = ia
    else
     res = [ qsort( pack(ia(2:), ia(2:) < ia(1)) ), ia(1), qsort( pack(ia(2:), ia(2:) >= ia(1)) ) ]
    end if
    return
  end function qsort

end program SetAny

Shell sort

  pure function ssort(ix) ! Shell Sort
    integer, intent(in) :: ix(:)  
    integer, allocatable :: ssort(:)
    integer :: i, j, k, kmax, igap, itmp
    ssort = ix
    kmax = 0
    do  ! Tokuda's gap sequence ; h_k=Ceiling( (9(9/4)^k-4)/5 ), h_k < 4N/9 ; O(N)~NlogN 
      if ( ceiling( (9.0 * (9.0 / 4.0)**(kmax + 1) - 4.0) / 5.0 ) > size(ix) * 4.0 / 9.0 ) exit
      kmax = kmax + 1
    end do

    do k = kmax, 0, -1
      igap = ceiling( (9.0 * (9.0 / 4.0)**k - 4.0) / 5.0 )
      do i = igap, size(ix)
        do j = i - igap, 1, -igap
          if ( ssort(j) <= ssort(j + igap) ) exit
            itmp           = ssort(j)
            ssort(j)       = ssort(j + igap)
            ssort(j + igap) = itmp
          end do
        end do
      end do
    return
  end function ssort