Is there a function that removes all nonalphanumeric numbers in Fortran?

Viewed 82

New to Fortran,been trying to think of a function that replaces all non alphanumeric characters and spaces on a string so that it turns something like [AS:1] to AS1.

Anyone here got a clue how to?

Like I got a trimmer for open spaces to work but I don't know how to make it work for anything that's a non-alphanumeric character.

3 Answers

The intrinsic function SCANcan be used for membership searches.

If we have a character char of length-1 and a set set of non-zero size, then we have that SCAN(char, set) returns 1 (0) if char is in (not in) the set. (SCAN will return 0 if the set is of size zero.)

This functions is elemental so, for example, SCAN(char_array, set) returns an indicator for which elements of char_array are in the set.

We also have PACK which returns another array corresponding to a selection mask:

print*, PACK(char_array, SCAN(char_array,set).eq.1)

Which means we can write a subroutine like

subroutine s(in, out, keep, len)
  integer, intent(in) :: len
  character, intent(in) :: in(len), keep*(*)
  character, intent(out) :: out(len)
  integer :: i

  out = PACK(in, SCAN(in,keep).eq.1, [(' ',i=1,len)])
end subroutine s

taking an input character array of size len and returning an output character array of the same size with the elements which are in keep (and trailing elements being blanks).

Naturally, we don't like working with character arrays instead of scalars, so let's provide a nice subroutine using sequence association:

subroutine strip(in, out, keep)
  character(*), intent(in) :: in, keep
  character(*), intent(out) :: out

  call s(in, out, keep, LEN(in))
end subroutine

Complete example:

module stripping
  implicit none
  private s
contains
  subroutine strip(in, out, keep)
    character(*), intent(in) :: in, keep
    character(*), intent(out) :: out

    call s(in, out, keep, len(in))
  end subroutine strip

  subroutine s(in, out, keep, len)
    integer, intent(in) :: len
    character, intent(in) :: in(len), keep*(*)
    character, intent(out) :: out(len)
    integer :: i

    out = PACK(in, SCAN(in,keep).eq.1, [(' ',i=1,len)])
  end subroutine s
  
end module stripping

program test
  use stripping, only : strip
  implicit none
  
  character(10) in, out
  character(*), parameter :: keep="abcd"

  in = "a1b*2sdc]a"
  call strip(in, out, keep)
  print*, TRIM(out)

end program

There are doubtless better and clearer ways to do this: this answer mostly serves to have you think about what intrinsic functions there are and how they can be applied. There isn't an intrinsic function to do what you want in one step.

You need to define an external verification procedure that tells if a given character is to be kept or discarded. Then replace the equivalence check typically done in replace routines with this external function.

Here is an implementation that achieves the goal,

module str_mod
    implicit none
    integer, parameter :: IK = kind(0)
    integer, parameter :: SK = kind("a")
    integer, parameter :: LK = kind(.false.)
contains
    
    ! Returns `.true.` if it is a desired character.
    function isDesired(char) result(desired)
        character(1, SK), intent(in) :: char
        logical(LK) :: desired
        desired =   (SK_"0" <= char .and. char <= SK_"9") .or. &
                    (SK_"A" <= char .and. char <= SK_"Z") .or. &
                    (SK_"a" <= char .and. char <= SK_"z")
    end function

    function replace(str, isDesired) result(strrep)
        character(*, SK), intent(in)    :: str
        character(:, SK), allocatable   :: strrep
        procedure(logical(LK))          :: isDesired
        integer(IK)                     :: i, counter
        allocate(character(len(str), SK) :: strrep)
        counter = 0_IK
        do i = 1, len(str, kind = IK)
            if (.not. isDesired(str(i:i))) cycle
            counter = counter + 1_IK
            strrep(counter:counter) = str(i:i)
        end do
        strrep = strrep(1:counter)
    end function

end module str_mod

    use str_mod
    print *, replace("Fortran", isDesired)
    print *, replace("(Fortran)", isDesired)
    print *, replace("(Fortran) (Is) [_A_] (GREAT) {language}.", isDesired)
    print *, replace("[AS:1]", isDesired)

end

Here is the program output,

 Fortran
 Fortran
 FortranIsAGREATlanguage
 AS1

Test it here. Note that this implementation performs two allocations of the output strings, which you could likely avoid by counting the desired characters in str first and then allocating the output string to the proper size and filling it with the identified characters. But any performance gain or difference will likely be negligible in most scenarios. You would likely see better performance benefits if you instead reimplement replace() in the above as a subroutine with str input argument being an allocatable with intent(inout). In such a case, you can avoid an extra copy on exit from the procedure, which can lead to ~25% runtime speedup for small arrays. But again, such performance concerns become relevant only when you call replace() on the order of billions of times.

You would have to write a function to do it. As inspiration, here's a subroutine I recently wrote to do SQL "escaping" of quotes in a string. The key here is having separate indexes for input and output position. Your requirement is even easier - if the character is not alphanumeric or space, don't advance the output length. There are several ways of doing the comparison, an exercise left for the reader.

subroutine escape (text)
character(*), intent(inout) :: text
character(100) :: newtext
integer i,j
newtext = ' '
j = 1
do i=1,len_trim(text)
    if (text(i:i) == '"') then
        newtext(j:j) = "\"
        j = j + 1
    end if
    newtext(j:j) = text(i:i)
    j = j + 1
end do
text = newtext
end subroutine escape
Related