相当于unique的fortran语言

我发现了许多能够扭转这个问题的问题，但没有一个能直接回答这个问题：

-在fortran中，（a）最快（挂钟）和（b）最优雅（简洁明了）的消除整数列表中重复项的方法是什么

一定有比我的微弱尝试更好的方法：

Program unique
 implicit none
 !   find "indices", the list of unique numbers in "list"
 integer( kind = 4 ) :: kx, list(10)
 integer( kind = 4 ),allocatable :: indices(:)
 logical :: mask(10)
 !!$    list=(/3,2,5,7,3,1,4,7,3,3/)
 list=(/1,(kx,kx=1,9)/)
 mask(1)=.true.
 do kx=10,2,-1
   mask(kx)= .not.(any(list(:kx-1)==list(kx)))
 end do
 indices=pack([(kx,kx=1,10)],mask)
 print *,indices
End Program unique

---

我的尝试是希望列表按顺序排列，但如果取消这一要求会更好。我就是忍不住，所以我写了一个你可能喜欢的答案。以下代码将以升序返回未排序整数输入数组的唯一值数组。请注意，输出结果是实际值，而不仅仅是索引

program unique_sort
    implicit none
    integer :: i = 0, min_val, max_val
    integer, dimension(10) :: val, unique
    integer, dimension(:), allocatable :: final

    val = [ 3,2,5,7,3,1,4,7,3,3 ]
    min_val = minval(val)-1
    max_val = maxval(val)
    do while (min_val<max_val)
        i = i+1
        min_val = minval(val, mask=val>min_val)
        unique(i) = min_val
    enddo
    allocate(final(i), source=unique(1:i))   !<-- Or, just use unique(1:i) 
    print "(10i5:)", final
end program unique_sort
! output:    1    2    3    4    5    7

一句话：在我的机器（i7 8GB笔记本电脑）上，

unique\u index

比

remove\u dup

稍微快一点。但是，

remove_dups

不需要对输入数组进行预排序，实际上返回的是值而不是索引（请参阅

unique_index

的修改版本的要点，该版本返回的是值，这似乎并没有让它慢很多）

另一方面，

unique_sort

所用的时间大约是未排序输入的两倍，但设计用于处理未排序的输入，并且还以8 LOC（减去var声明）的顺序返回值。因此，这似乎是一个公平的权衡。不管是谁，我相信

unique\u sort

可以通过使用某种掩蔽语句来优化速度，但这是另一天的事了

---

更新

---

上面显示的计时是从一个测试程序中获得的，其中每个子例程被放置在一个模块中，并通过过程调用执行。然而，当

unique_sort

直接放在主程序中时，我发现性能有了惊人的提高，只需约0.08秒就完成了100万次运行。仅仅通过不使用一个过程就可以将速度提高25倍，这对我来说似乎很奇怪——通常，我认为编译器会优化过程调用的成本。例如，我发现

remove\u dup

或

unique\u index

无论是通过过程执行还是直接放在主程序中，它们的性能都没有差异

在@VladimirF指出我做了过度比较之后，我发现我可以将我的原始代码矢量化（删除do循环do kx…）。我将“unique”函数与一个基于wikipedia的mergesort算法结合起来。内脏包含在SortUnique模块中

Module SortUnique
contains
  Recursive Subroutine MergeSort(temp, Begin, Finish, list)
    ! 1st 3 arguments are input, 4th is output sorted list
    implicit none
    integer(kind=4),intent(inout) :: Begin,list(:),temp(:)
    integer(kind=4),intent(in) :: Finish
    integer(kind=4) :: Middle
    if (Finish-Begin<2) then    !if run size =1
       return                   !it is sorted
    else
       ! split longer runs into halves
       Middle = (Finish+Begin)/2
       ! recursively sort both halves from list into temp
       call MergeSort(list, Begin, Middle, temp)
       call MergeSort(list, Middle, Finish, temp)
       ! merge sorted runs from temp into list
       call Merge(temp, Begin, Middle, Finish, list)
     endif
  End Subroutine MergeSort

  Subroutine Merge(list, Begin, Middle, Finish, temp)
    implicit none
    integer(kind=4),intent(inout) :: list(:),temp(:)
    integer(kind=4),intent(in) ::Begin,Middle,Finish
    integer(kind=4)    :: kx,ky,kz
    ky=Begin
    kz=Middle
    !! While there are elements in the left or right runs...
    do kx=Begin,Finish-1
       !! If left run head exists and is <= existing right run head.
       if (ky.lt.Middle.and.(kz.ge.Finish.or.list(ky).le.list(kz))) then
          temp(kx)=list(ky)
          ky=ky+1
       else
          temp(kx)=list(kz)
          kz = kz + 1
       end if
    end do

  End Subroutine Merge

  Function Unique(list)
    !! usage sortedlist=Unique(list)
    implicit none
    integer(kind=4) :: strt,fin,N
    integer(kind=4), intent(inout) :: list(:)
    integer(kind=4), allocatable  :: unique(:),work(:)
    logical,allocatable :: mask(:)
    ! sort
    work=list;strt=1;N=size(list);fin=N+1
    call MergeSort(work,strt,fin,list) 
    ! cull duplicate indices
    allocate(mask(N));
    mask=.false.
    mask(1:N-1)=list(1:N-1)==list(2:N)
    unique=pack(list,.not.mask)

  End Function Unique

End Module SortUnique

Program TestUnique
  use SortUnique
  implicit none
  !   find "indices", the list of unique numbers in "list"
  integer (kind=4),allocatable :: list(:),newlist(:)
  integer (kind=4)  :: kx,N=100000 !N  even
  real (kind=4) :: start,finish,myrandom

  allocate(list(N))
  do kx=1,N
     call random_number(myrandom)
     list(kx)=ifix(float(N)/2.*myrandom)
  end do

  call cpu_time(start)

  newlist=unique(list)

  call cpu_time(finish)
  print *,"cull duplicates: ",finish-start
  print *,"size(newlist) ",size(newlist)

End Program TestUnique

模块SortUnique
包含
递归子例程MergeSort（临时、开始、完成、列表）
! 前3个参数是输入，第4个是输出排序列表
隐式无
整数（种类=4），意图（inout）：：开始，列表（：），临时（：）
整数（种类=4），意图（in）：：完成
整数（种类=4）：：中间
如果（Finish Begin）你看了吗？在和@Aryamcarthy中有一些东西Rosetta代码确实发现了重复，但我不会称之为快速或优雅：它涉及嵌套do循环，并且需要两倍于我的示例的相同sied数组的时间…@VladimirF第一个问题[本质上与我自己的示例相同，只是在使用gfortran编译时会抛出错误。第二个[，超过50行的代码永远不会被称为优雅。在我看来，我的问题归结为“我的示例中的do循环是否可以矢量化（非SIMD含义）”请注意，您自己的示例进行了更多必要的比较，但我认为您无法更简洁地编写它（当然，我看不出您想要的是什么矢量化）。如果您要求，则没有内在的。您可以使用任何方法编写自己的函数，并且对该函数的调用将很短。我得到
forrtl:severe（157）：程序异常-访问冲突
当我试图运行这个程序时，编译了ifort 17。@MattP我没有收到gfortran的投诉，编译后的程序运行正常。我想我会调用上面提到的Vladimir Fs规则，如果它能在你的编译器上运行，不要担心。说真的，我没有IFORTRAN的任何版本。Anyway、 如果有机会，我可能会尝试让它编译ifort。获得您所观察到的性能可能是值得的。@MattP如果您发现ifort标记的问题，请与我沟通：其他帖子建议编译器在“触摸”未分配内存时抛出该错误我不知道这个词在这里的意思，但我怀疑mergesort例程的可重入部分可能是这个问题的根源。我已经检查了许多案例的答案，但没有发现任何问题。好的，我已经使用了
ifort
。主要问题是
strt=0
，应该是
strt=1
。否则，
Merge
第一次调用时失败，在循环
kx=Begin，Finish-1
。这是因为
Begin
取
strt
的值，并且0小于
list
的下限（即1）。
Module SortUnique
contains
  Recursive Subroutine MergeSort(temp, Begin, Finish, list)
    ! 1st 3 arguments are input, 4th is output sorted list
    implicit none
    integer(kind=4),intent(inout) :: Begin,list(:),temp(:)
    integer(kind=4),intent(in) :: Finish
    integer(kind=4) :: Middle
    if (Finish-Begin<2) then    !if run size =1
       return                   !it is sorted
    else
       ! split longer runs into halves
       Middle = (Finish+Begin)/2
       ! recursively sort both halves from list into temp
       call MergeSort(list, Begin, Middle, temp)
       call MergeSort(list, Middle, Finish, temp)
       ! merge sorted runs from temp into list
       call Merge(temp, Begin, Middle, Finish, list)
     endif
  End Subroutine MergeSort

  Subroutine Merge(list, Begin, Middle, Finish, temp)
    implicit none
    integer(kind=4),intent(inout) :: list(:),temp(:)
    integer(kind=4),intent(in) ::Begin,Middle,Finish
    integer(kind=4)    :: kx,ky,kz
    ky=Begin
    kz=Middle
    !! While there are elements in the left or right runs...
    do kx=Begin,Finish-1
       !! If left run head exists and is <= existing right run head.
       if (ky.lt.Middle.and.(kz.ge.Finish.or.list(ky).le.list(kz))) then
          temp(kx)=list(ky)
          ky=ky+1
       else
          temp(kx)=list(kz)
          kz = kz + 1
       end if
    end do

  End Subroutine Merge

  Function Unique(list)
    !! usage sortedlist=Unique(list)
    implicit none
    integer(kind=4) :: strt,fin,N
    integer(kind=4), intent(inout) :: list(:)
    integer(kind=4), allocatable  :: unique(:),work(:)
    logical,allocatable :: mask(:)
    ! sort
    work=list;strt=1;N=size(list);fin=N+1
    call MergeSort(work,strt,fin,list) 
    ! cull duplicate indices
    allocate(mask(N));
    mask=.false.
    mask(1:N-1)=list(1:N-1)==list(2:N)
    unique=pack(list,.not.mask)

  End Function Unique

End Module SortUnique

Program TestUnique
  use SortUnique
  implicit none
  !   find "indices", the list of unique numbers in "list"
  integer (kind=4),allocatable :: list(:),newlist(:)
  integer (kind=4)  :: kx,N=100000 !N  even
  real (kind=4) :: start,finish,myrandom

  allocate(list(N))
  do kx=1,N
     call random_number(myrandom)
     list(kx)=ifix(float(N)/2.*myrandom)
  end do

  call cpu_time(start)

  newlist=unique(list)

  call cpu_time(finish)
  print *,"cull duplicates: ",finish-start
  print *,"size(newlist) ",size(newlist)

End Program TestUnique