Question

我想知道是否有可能从一个数组中删除所有2D重复节点的功能，即：

A（XY，1：2）

A（xy，1）= / 1,2,4， 5 ，5,9,6,8,2， 5 ，4 /

A（xy，2）= / 5,2,5， 6 ，7,6,6,3,7， 6 ，6 /

在

A（xy，1）= / 1,2,4， 5 ，5,9,6,8,2,4 /

A（xy，2）= / 5,2,5， 6 ，7,6,6,3,7,6 /

当我尝试在空白程序中执行@ HighPerformanceMark的代码时，有几个我没有得到的编译错误：

  repeating.f90:24.20:

       mask(ix) = NOT(ANY(arraya(1,:ix-1)==arraya(1,ix).AND.&
                      1
  Error: 'i' argument of 'not' intrinsic at (1) must be INTEGER
  repeating.f90:29.11:

    ALLOCATE(index_vector, source=PACK([(ix, ix=1,numcols) ],mask))
             1
  Error: Array specification required in ALLOCATE statement at (1)
  repeating.f90:32.11:
...

你能说些什么呢？

Answer 1

是的，这是做你想做的事的一种方式。请注意，这会将数组A的唯一元素复制到名为B的新数组中，而不是动态调整大小A.我调用了数组arraya和arrayb，因为单字符名称违反了我的编码标准。

PROGRAM test

  USE iso_fortran_env

  IMPLICIT NONE

  INTEGER, PARAMETER :: numrows = 2
  INTEGER, PARAMETER :: numcols = 11

  INTEGER, DIMENSION(numrows,numcols) :: arraya
  LOGICAL, DIMENSION(:), ALLOCATABLE :: mask
  INTEGER, DIMENSION(:,:), ALLOCATABLE :: arrayb
  INTEGER :: ix
  INTEGER, DIMENSION(:), ALLOCATABLE :: index_vector

  arraya(1,:) = [1,2,4,5,5,9,6,8,2,5,4]
  arraya(2,:) = [5,2,5,6,7,6,6,3,7,6,6]

  ! First, find the duplicate elements
  ALLOCATE(mask(numcols))
  mask = .TRUE.

  DO ix = numcols,2,-1
     mask(ix) = .NOT.(ANY(arraya(1,:ix-1)==arraya(1,ix).AND.&
                    arraya(2,:ix-1)==arraya(2,ix)))
  END DO

  ! Make an index vector
  ALLOCATE(index_vector, source=PACK([(ix, ix=1,numcols) ],mask))

  ! Now copy the unique elements of a into b
  ALLOCATE(arrayb, source=arraya(:,index_vector))

END PROGRAM test

另请注意：

我把它写成一个程序，你可能想把它重写成一个返回我称之为arrayb的函数。
没有错误检查或任何类型的东西，这不是生产就绪代码。
你可以放弃index_vector并重写最后一句话，如ALLOCATE(arrayb, source=arraya(:,PACK([(ix, ix=1,numcols) ],mask)))但是（a）这有点神秘而且（b）我没有测试过。
我只是根据您的输入数据和一些小变化对此进行了测试。
这将保留重复元素的第一个（最左侧）实例。

Answer 2

我扩展了此功能并用于我的目的多年，我认为将其分发给需要它的其他人是有益的。！ ErrorMsg 只是一个简单的子程序，如 echo/print 语句。

    subroutine Unique2DArray_D(Arr_a,dim,dup,diff)
  IMPLICIT NONE
  real*8,DIMENSION(:,:),allocatable::Arr_a,Arr_b
  integer,intent(in),optional::dim
  integer,allocatable,optional::dup(:)
  real*8,optional::diff
  LOGICAL,DIMENSION(:), allocatable::TF(:,:),mask
  INTEGER,DIMENSION(:),allocatable::index_vector
  INTEGER::i,j,numrows,numcols,ns,dim_
  real*8::diff_
  logical::pres_dim,pres_dup
  numrows=size(Arr_a,1); numcols=size(Arr_a,2); 
  pres_dim=present(dim); pres_dup=present(dup)
 ! Arr_a(1,:)=[1,2,4,5,5,9,6,8,2,5,4]
 ! Arr_a(2,:)=[5,2,5,6,7,6,6,3,7,6,6]
 dim_=1; if(pres_dim)dim_=dim; diff_=1d-20; if(present(diff))diff_=diff
 if(dim_==2)then
    ALLOCATE(mask(numcols),TF(numrows,numcols)); mask=.TRUE.;
    DO j=numcols,2,-1
        TF(:,j-1)=.false.
      do i=1,numrows
        TF(i,:j-1)=(abs(Arr_a(i,:j-1)-Arr_a(i,j))<=diff_)
      end do; 
      mask(j)=.not.any(all(TF(:,:j-1),dim=1))
    END DO
    ! Make an index vector
    ns=size(PACK([(i,i=1,numcols)],mask));   
    ALLOCATE(index_vector(ns)); index_vector=PACK([(i,i=1,numcols)],mask)
    ! Now copy the unique elements of a into b
    if(pres_dup)then; 
        allocate(dup(numcols-ns)); dup=PACK([(i,i=1,numcols)],.not.mask)  
    end if
    ALLOCATE(Arr_b(numrows,ns));   Arr_b=Arr_a(:,index_vector)
 elseif(dim_==1)then
  ! Arr_a(:,1)=[1,   ! Arr_a(:,2)=[5,]
!               2,                 2,  
!               4,                 5,
!               5,                 6,
!               5,                 7,
!               9,                 6,
!               6,                 6,
!               8,                 3,
!               2,                 7,
!               5,                 6,    
!               4]                 6]

    ALLOCATE(mask(numrows),TF(numrows,numcols)); mask=.TRUE.;
    DO i=numrows,2,-1
        TF(i-1,:)=.false.
      do j=1,numcols
        TF(:i-1,j)=(abs(Arr_a(:i-1,j)-Arr_a(i,j))<=diff_)
      end do; 
      mask(i)=.not.any(all(TF(:i-1,:),dim=2))
    END DO
    ! Make an index vector
    ns=size(PACK([(i,i=1,numrows)],mask));
    ALLOCATE(index_vector(ns)); index_vector=PACK([(i,i=1,numrows)],mask)
    ! Now copy the unique elements of a into b
    if(pres_dup)then; 
        allocate(dup(numrows-ns)); dup=PACK([(i,i=1,numrows)],.not.mask)  
    end if
    ALLOCATE(Arr_b(ns,numcols)); Arr_b=Arr_a(index_vector,:)
    !ALLOCATE(Arr_b,source=Arr_a(index_vector,:))
 else
    call ErrorMsg('Dim is incorrect in Unique2DArrayD!',-1)
 end if
  call move_alloc(Arr_b,Arr_a)
end subroutine Unique2DArray_D

删除Fortran中2D数组中的重复元素

2 个答案: