Add a CONFORM function to check that argument dimensions match?

In my codes there is much boilerplate checking that array arguments have consistent dimensions. For arguments that are OPTIONAL I first have to check that they are PRESENT before verifying that their dimensions are correct. Should a CONFORM function be added to Fortran or the stdlib project? It would have return type logical and take two array arguments of the same rank (but possibly of different types) It would return .TRUE. if the arrays have the same dimensions or if either array is not PRESENT (to avoid requiring the user to check this). I can code CONFORM myself for a few cases, but an intrinsic function would work for arbitrary ranks and types. With the proposed CONFORM function, one could write for example

subroutine regress(x,y,coeff,tstat,resid,ierr)
! regress each column of y(:,:) on x(:,:)
real   , intent(in)            :: x(:,:)      ! (n,nindep)
real   , intent(in)            :: y(:,:)      ! (n,ndep)
real   , intent(out)           :: coeff(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: tstat(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: resid(:,:)  ! (n,ndep)
integer, intent(out)           :: ierr
if (.not. conform(yy,resid)) then
   ierr = 1
else if (.not. conform(coeff,tstat)) then
   ierr = 2
end if
if (ierr /= 0) return
end subroutine regress

instead of

subroutine regress(x,y,coeff,tstat,resid,ierr)
! regress each column of y(:,:) on x(:,:)
real   , intent(in)            :: x(:,:)      ! (n,nindep)
real   , intent(in)            :: y(:,:)      ! (n,ndep)
real   , intent(out)           :: coeff(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: tstat(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: resid(:,:)  ! (n,ndep)
integer, intent(out)           :: ierr
if (present(tstat)) then
   if (any(shape(tstat) /= shape(coeff))) then
      ierr = 1
      return
   end if
end if
if (present(resid)) then
   if (any(shape(resid) /= shape(y))) then
      ierr = 2
      return
   end if
end if
end subroutine regress
3 Likes

Sounds like a useful addition. A good usecase for class(*) as well:

!> SPDX-Identifier: CC0-1.0
pure function conform(mold, var)
    class(*), intent(in) :: mold(:, :)
    class(*), intent(in), optional :: var(:, :)
    logical :: conform
    if (present(var)) then
        conform = all(shape(mold) == shape(var))
    else
        conform = .true.
    end if
end function conform
2 Likes

With a CONFORM function, a logical array of assertions can be constructed, as in

subroutine regress(x, y,coeff,tstat,resid,ierr)
! regress each column of y(:,:) on x(:,:)
real   , intent(in)            :: x(:,:)      ! (n,nindep)
real   , intent(in)            :: y(:,:)      ! (n,ndep)
real   , intent(out)           :: coeff(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: tstat(:,:)  ! (nindep,ndep)
real   , intent(out), optional :: resid(:,:)  ! (n,ndep)
integer, intent(out)           :: ierr
!                  1                      2                         3                         4                 5
ierr = first_false[size(xx,1)==size(yy,1),size(xx,2)==size(coeff,1),size(yy,2)==size(coeff,2),conform(yy,resid),conform(coeff,tstat)]
if (ierr /= 0) return
end subroutine regress

pure function first_false(tf) result(i1)
! return the location of the first false element in tf(:), 0 if all true
logical, intent(in) :: tf(:)
integer             :: i1
integer             :: i
i1 = 0
do i=1,size(tf)
   if (.not. tf(i)) then
      i1 = i
      return
   end if
end do
end function first_false

Another way to implement first_false is with the command

i1 = findloc(tf,.false.,dim=1)
2 Likes

Maybe conform could support a dim argument?

if (.not.all([&
    & size(x, 2) == size(coeff, 1), &
    & conform(x, y, dim=1), &
    & conform(y, coeff, dim=2), &
    & conform(coeff, tstat), &
    & conform(y, resid)])) then
    ierr = 1
    return
end if

This would only leave one case open for this example.

I support that. If DIM is less than 1 or exceeds the rank of either argument, should CONFORM return .FALSE. or be undefined and produce a run-time error?

I think some helper functions for checking the shapes of arrays would be a good idea.

I’m not sure I like the proposed name or implementation though. “conform” has a specific meaning in the standard, which is not what this function is checking. Note that the compiler generally checks that arrays “conform” when necessary.

Also, if a not present argument doesn’t match the expected shape then your argument is effectively not optional any more. Note the difference in behavior between your examples using the boiler plate and your conform function.

Checking that the shapes of arrays are as expected is something that should be easy and we should encourage people to do it more often. Did you know that declaring a dummy argument with an explicit shape doesn’t mean that the compiler checks that the actual argument has that shape?

Arrays A and B conform if they have the same dimensions, so that you can make the assignment A = B. That is what the proposed CONFORM function tests. One can google “fortran conforming arrays” to find many examples of this usage.

Actually no. There is hardly any good use case for dummy arguments of CLASS(*) unlimited polymorphic type in Fortran. CLASS(*) is a pathway toward vulnerabilities in a library.

Instead one can argue this is a passable use case for the other type of unlimited polymorphic entity, TYPE(*) i.e., assumed-type dummy argument facility introduced in the language starting Fortran 2018: This is given the guardrails provided in the standard with assumed-type dummy arguments - there isn’t much a Fortranner inclined heavily toward domain expertise as opposed to sound software engineering can do with this type.

And also assumed-rank facility can be employed here.

module m
contains
   pure function conform(mold, var)
      ! Argument list
      type(*), intent(in) :: mold(..)          !<-- assumed-type, assumed-rank dummy
      type(*), intent(in), optional :: var(..) !<--       -ditto-
      ! Function result
      logical :: conform
      conform = .true.
      if ( present(var) ) then
          conform = all( shape(mold) == shape(var) )
      end if
   end function conform
end module
   use m, only : conform
   blk1: block
      integer :: foo, bar
      print *, "Block: scalar integers"
      print *, "conform(foo,bar)? ", conform(foo, bar), "; expected is T"
   end block blk1
   print *
   blk2: block
      character(len=1), dimension(2) :: foo, bar
      print *, "Block: shape=[2] character variables"
      print *, "conform(foo,bar)? ", conform(foo, bar), "; expected is T"
   end block blk2
   print *
   blk3: block
      real :: foo(1,2), bar(2,1)
      print *, "Block: rank-2 real variables of different shape"
      print *, "conform(foo,bar)? ", conform(foo, bar), "; expected is F"
   end block blk3
   print *
   blk4: block
      type :: t
      end type t
      type(t), dimension(2,3,4) :: foo, bar
      print *, "Block: rank-3 objects of type(t) with same shape"
      print *, "conform(foo,bar)? ", conform(foo, bar), "; expected is T"
   end block blk4
end 

See below with both Intel Fortran and gfortran:

C:\temp>ifort /standard-semantics /warn:all /stand:f18 p.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.2.0 Build 20210228_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.

Microsoft (R) Incremental Linker Version 14.27.29112.0
Copyright (C) Microsoft Corporation. All rights reserved.

-out:p.exe
-subsystem:console
p.obj

C:\temp>p.exe
Block: scalar integers
conform(foo,bar)? T ; expected is T

Block: shape=[2] character variables
conform(foo,bar)? T ; expected is T

Block: rank-2 real variables of different shape
conform(foo,bar)? F ; expected is F

Block: rank-3 objects of type(t) with same shape
conform(foo,bar)? T ; expected is T

C:\temp>gfortran -Wall p.f90 -o gcc-p.exe

C:\temp>gcc-p.exe
Block: scalar integers
conform(foo,bar)? T ; expected is T

Block: shape=[2] character variables
conform(foo,bar)? T ; expected is T

Block: rank-2 real variables of different shape
conform(foo,bar)? F ; expected is F

Block: rank-3 objects of type(t) with same shape
conform(foo,bar)? T ; expected is T

C:\temp>

3 Likes

Thanks, this is actually much nicer. I only found the result surprising when passing arrays of different ranks.

integer :: a(4, 5), b(4, 5, 2)
print *, conform(a, b)  ! T
print *, conform(b, a)  ! F

In this scenario we might also want to check for rank matching?

1 Like

I like the idea. The name conform is too general, I think, and what Brad said. I like the name is_congruent better.

I also think conform is too general. I like the precise meaning of congruent, but I had to Google what it means (and the translation to my mother tongue). Maybe something simpler like is_shape_equal or dimensions_match would be more (language) friendly?

Addendum: the term conformable matrix seems to be closer in meaning than matrix congruence.

I think the term congruence is good if we picture the array as a (hyper-) rectangle. With the word conform, we need to define whether we are talking about addition, multiplication, or a tensor reduction (like in einsum). Otherwise, it will be prone to confusion.

1 Like

I guess this pattern is similar to something like below (which I came across before in a different code)

program main
    implicit none
    !! integer :: a(3), b(2)   !! Line-1
    integer, allocatable :: a(:), b(:)

    a = [1,2,3]
    b = [1,2]
    print *, a == b   !! T T F
    print *, b == a   !! T T
    print *, all( a == b )  !! F
    print *, all( b == a )  !! T
end

so maybe it is safer to test something like shape(mold,1) == shape(var,1) … (Btw, the above case was detected at runtime by -fcheck=error in the case of gfortran. Also if the size is determined at compile-time (e.g. if I uncomment Line-1), a compile error occurs like

   11 |     print *, a == b   !! T T F
      |            1    2
Error: Shapes for operands at (1) and (2) are not conformable
2 Likes

Going by the needs expressed here and the naming conventions of the standard, perhaps a consideration should be: SAME_SHAPE_AS.

c.f. SAME_TYPE_AS in the standard.

If such a function were then to be experimented in the stdlib, it can be a candidate for eventual inclusion in the standard.

4 Likes

I like same_shape_as for the function name. Starting from Vipul’s suggestion of using type(*) with assumed rank and incorporating the dim argument we would arrive at the following implementation:

! SPDX-Identifier: CC0-1.0
module stdlib_  ! module name open for discussion
    implicit none
    private
    public :: same_shape_as
contains
pure function same_shape_as(mold, val, dim) result(conform)
    type(*), intent(in) :: mold(..)
    type(*), intent(in), optional :: val(..)
    integer, intent(in), optional :: dim
    logical :: conform
    if (present(val)) then
        if (present(dim)) then
            if (dim > 0 .and. dim <= rank(mold) .and. dim <= rank(val)) then
                conform = size(mold, dim=dim) == size(val, dim=dim)
            else
                error stop "Runtime error: Illegal dim argument provided in same_shape_as"
            end if
        else
            if (rank(val) == rank(mold)) then
                conform = all(shape(mold) == shape(val))
            else
                conform = .false.
            end if
        end if
   else
      conform = .true.
   end if
end function same_shape_as
end module stdlib_

Maybe the dim argument is a bit misplaced for this function, have to think about the actual usefulness of this one a bit further.

1 Like

Good catch, you can consider a workaround:

   pure function same_shape_as(mold, var) result(match)
      ! Argument list
      type(*), intent(in) :: mold(..)          !<-- assumed-type, assumed-rank dummy
      type(*), intent(in), optional :: var(..) !<--       -ditto-
      ! Function result
      logical :: match
      match = .true.
      if ( present(var) ) then
         if ( rank(mold) == rank(var) ) then
            match = all( shape(mold) == shape(var) )
         else
            match = .false.
         end if
      end if
   end function
1 Like

Is their a reason val/var has to be optional? Also the intrinsic functions seem to have mold as the second argument.

The OP looked for a function to check the shape of an optional argument against an existing array:

Regarding mold as name, I indeed took inspiration from allocate(..., mold=...) here, but thought since we are now comparing against a reference the first argument should be named mold. Naming stuff is hard and I’m open for better dummy argument names.

As usual, my suggestions for Fortran lead to @FortranFan teaching me about F2003+. Thanks! It seems that in Fortran, you can now write a function that accepts arguments of arbitrary types and ranks. Fortran has long had some features for generic programming, such as ELEMENTAL functions and intrinsics such as SUM that accept arrays of various types and ranks, but the “assumed-type, assumed-rank dummy” demonstrated above is more general and could have many applications.