1

I have a data approximately a million record, each record have 6 floating point number. I want to find sets of records who share identical six values, and ideally I want to do it in Fortran since the rest of processing is done in Fortran. What would be the recommended approach for this? At the end i want to have mapping from original index to new index which is condensed version of these dataset without duplicate. Each record has other attributes and i am interested in aggregating those for groups based on the six attributes.

I tried to find those sets by exporting output as csv, import it into MS Access, then a query that finds those sets took 10 seconds or so to run. I wrote a code which does http://rosettacode.org/wiki/Remove_duplicate_elements#Fortran this ("linear search"?), but with million record it didnt complete after 10 min or so, i just abandoned this approach.

Approach I am thinking now is adapting ranking/sorting routine from slatec or orderpack which i assume do better than my crude code. But I am wondering if such things are already done and i can download, or if there is better approach for this.

EDIT:

I said "finding duplicate", but i actually need mapping from original data records to this reduced sets. I want to have mapping array like imap(1:n), where imap(1), imap(4), imap(5) has same values if those 6 float pt. values in original record 1, 4 and 5 are the same. Hope this is not too much a deviation from what I said originally...

yosukesabai
  • 6,184
  • 4
  • 30
  • 42
  • are you looking for exact binary equality, or doing something like abs(x-y) – agentp Aug 27 '12 at 20:11
  • 1
    Possible algorithms: http://stackoverflow.com/questions/1532819/algorithm-efficient-way-to-remove-duplicate-integers-from-an-array – M. S. B. Aug 27 '12 at 20:24
  • @george, exactly binary equality is fine for my application, and i believe that makes programming easier. i know that my code works for smaller size. portability is nice, but i dont mind using some widely used implementation on Linux environment if that makes things easier (i am programming on Linux using PGI compiler). – yosukesabai Aug 27 '12 at 20:41
  • @M.S.B., thank you for pointer. When I think about it, what I need is not just reduced set of records but mapping from original data set to condensed data set, because i need to aggregate other attributes of those group of records. So it is somewhat similar to UNIRNK.F in [ORDERPACK](http://www.fortran-2000.com/rank/#3.3), except that (1) i dont care order and (2) my data to be ranked is neither integer or float. I revised my Q. – yosukesabai Aug 27 '12 at 20:50

1 Answers1

1

This is what I ended up doing... I took code mrgrnk from ORDERPACK , and adapted for my purpose. The subroutine findmap below appears to be doing what I wanted it to do.

module fndmap
use m_mrgrnk, only:mrgrnk
implicit none
contains
  subroutine findmap(stkprm, stkmap )
    ! given 2-d real array stkprm, find a mapping described below:
    !
    ! (identical records are assigned with same index)
    !   stkmap(i) == stkmap(j)  iff stkprm(:,i) == stkprm(:,j)
    ! (order conserved)
    !   if i < j and stkmap(i) /= stkmap(j), then stkmap(i) < stkmap(j)
    ! (new index are contiguous)
    !   set(stkmap) == {1,2,..,maxval(stkmap)}
    !
    real,dimension(:,:),intent(in) :: stkprm
    integer,dimension(:), intent(out) :: stkmap
    integer, dimension(size(stkprm,2)) :: irngt
    integer, dimension(size(stkprm,2)) :: iwork
    integer ::  nrec, i, j
    nrec = size(stkprm,2)
    ! find rank of each record, duplicate records kept
    call ar_mrgrnk(stkprm, irngt)

    ! construct iwork array, which has index of original array where the
    ! record are identical, and the index is youguest
    i = 1
    do while(i<=nrec)
      do j=i+1,nrec
        if (any(stkprm(:,irngt(i))/=stkprm(:,irngt(j)))) exit
      enddo
      iwork(irngt(i:j-1)) = minval(irngt(i:j-1))
      i = j
    enddo

    ! now construct the map, where stkmap(i) shows index of new array 
    ! with duplicated record eliminated, original order kept
    j = 0
    do i=1,nrec
      if (i==iwork(i)) then
        j = j+1
        stkmap(i) = j
      else
        stkmap(i) = stkmap(iwork(i))
      endif
    enddo
  end subroutine

  recursive subroutine ar_mrgrnk(xdont, irngt)
    ! behaves like mrgrnk of ORDERPACK, except that array is 2-d
    ! each row are ranked by first field, then second and so on
    real, dimension(:,:), intent(in) :: xdont
    integer, dimension(:), intent(out), target :: irngt
    integer, dimension(size(xdont,2)) :: iwork

    integer :: nfld,nrec
    integer :: i, j
    integer, dimension(:), pointer :: ipt

    nfld=size(xdont,1)
    nrec=size(xdont,2)

    ! rank by the first field
    call mrgrnk(xdont(1,:), irngt)

    ! if there's only one field, it's done
    if (nfld==1) return

    ! examine the rank to see if multiple record has identical
    ! values for the first field
    i = 1
    do while(i<=nrec)
      do j=i+1,nrec
        if (xdont(1,irngt(i))/=xdont(1,irngt(j))) exit
      enddo
      ! if one-to-one, do nothing
      if (j-1>i) then
      ! if many-to-one, 
        ! gather those many, and rank them
        call ar_mrgrnk(xdont(2:,irngt(i:j-1)),iwork)
        ! rearrange my rank based on those fields to the right
        ipt => irngt(i:j-1)
        ipt = ipt(iwork(1:j-i))
      endif
      i = j
    enddo
    if(associated(ipt)) nullify(ipt)
  end subroutine
end module
yosukesabai
  • 6,184
  • 4
  • 30
  • 42