squeeze Function

public function squeeze(str, charp) result(outstr)

NAME

squeeze(3f) - [M_strings:EDITING] delete adjacent duplicate occurrences
of a character from a string
(LICENSE:PD)

SYNOPSIS

function squeeze(STR,CHAR) result (OUTSTR)

 character(len=*),intent(in)          :: STR
 character(len=*),intent(in),optional :: CHAR
 character(len=len(str))              :: OUTSTR

DESCRIPTION

squeeze(3f) reduces adjacent duplicates of the specified character
to a single character

OPTIONS

STR     input string in which to reduce adjacent duplicate characters
        to a single character
CHAR    The character to remove adjacent duplicates of

RETURNS

OUTSTR  string with all contiguous adjacent occurrences of CHAR removed

EXAMPLES

Sample Program:

program demo_squeeze
use M_strings, only : squeeze
implicit none
character(len=:),allocatable :: strings(:)

strings=[ character(len=72) :: &
&'', &
&'"If I were two-faced,&
&would I be wearing this one?" --- Abraham Lincoln',  &
&'..1111111111111111111&
&111111111111111111111111111111111111111111117777888', &
&'I never give ''em hell,&
&I just tell the truth, and they think it''s hell.',&
&'                                                  &
& --- Harry S Truman'    &
&]
   call printme( trim(strings(1)), ' ' )
   call printme( strings(2:4),     ['-','7','.'] )
   call printme( strings(5),       [' ','-','r'] )
contains
impure elemental subroutine printme(str,chr)
character(len=*),intent(in) :: str
character(len=1),intent(in) :: chr
character(len=:),allocatable :: answer
   write(*,'(a)')repeat('=',11)
   write(*,'("IN:   <<<",g0,">>>")')str
   answer=squeeze(str,chr)
   write(*,'("OUT:  <<<",g0,">>>")')answer
   write(*,'("LENS: ",*(g0,1x))')"from",len(str),"to",len(answer), &
           & "for a change of",len(str)-len(answer)
   write(*,'("CHAR: ",g0)')chr
end subroutine printme
end program demo_squeeze

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
character(len=1), intent(in) :: charp

Return Value character(len=:), allocatable


Contents

Source Code

squeeze

Source Code

function squeeze(str,charp) result (outstr)

character(len=*),intent(in)  :: str
character(len=1),intent(in)  :: charp
character(len=:),allocatable :: outstr
character(len=1)             :: ch, last_one
integer                      :: i, pio ! position in output

   outstr=repeat(' ',len(str))      ! start with a string big enough to hold any output
   if(len(outstr)==0)return         ! handle edge condition
   last_one=str(1:1)                ! since at least this long start output with first character
   outstr(1:1)=last_one
   pio=1

   do i=2,len(str)
      ch=str(i:i)
      pio=pio+merge(0,1, ch == last_one.and.ch == charp) ! decide whether to advance before saving
      outstr(pio:pio)=ch  ! store new one or overlay the duplcation
      last_one=ch
   enddo

   outstr=outstr(:pio)              ! trim the output string to just what was set
end function squeeze