0

我想知道是否有可能拥有一个从数组中删除所有 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:
...

对此你能说什么？

4

2 回答 2

1

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

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）我还没有测试过。
  • 我只在您的输入数据和一些小的变化上对此进行了测试。
  • 这会保留重复元素的第一个（最左侧）实例。
于 2013-01-03T12:16:44.180 回答
-1

我扩展了此功能并用于我的目的多年，我认为将其分发给需要它的其他人是有益的。！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
于 2021-04-13T20:10:49.030 回答