1

我有大约一百万条记录的数据，每条记录有 6 个浮点数。我想找到共享相同六个值的记录集，理想情况下我想在 Fortran 中进行，因为其余的处理是在 Fortran 中完成的。推荐的方法是什么？最后，我希望将原始索引映射到新索引，这是这些数据集的压缩版本，没有重复。每条记录都有其他属性，我有兴趣根据六个属性为组聚合这些属性。

我试图通过将输出导出为 csv 来查找这些集合，将其导入 MS Access，然后找到这些集合的查询需要 10 秒左右才能运行。我写了一个代码，它执行http://rosettacode.org/wiki/Remove_duplicate_elements#Fortran this（“线性搜索”？），但是有百万条记录它在 10 分钟左右后没有完成，我只是放弃了这种方法。

我现在正在考虑的方法是从slatec或orderpack调整排名/排序例程，我认为这比我的粗略代码做得更好。但我想知道这些事情是否已经完成并且我可以下载，或者是否有更好的方法。

编辑：

我说“寻找重复”，但我实际上需要从原始数据记录映射到这个缩减集。我想要像 imap(1:n) 这样的映射数组，其中 imap(1)、imap(4)、imap(5) 如果这 6 个浮点 pt 具有相同的值。原始记录 1、4 和 5 中的值相同。希望这与我最初所说的没有太大的偏差...

4

1 回答 1

1

这就是我最终要做的……我mrgrnk从ORDERPACK中获取了代码，并根据我的目的进行了调整。下面的子程序findmap似乎正在做我想做的事情。

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
于 2012-08-28T04:37:35.193 回答