transliterate Function

public pure function transliterate(instr, old_set, new_set) result(outstr)

NAME

transliterate(3f) - [M_strings:EDITING] replace characters from old
                    set with new set
(LICENSE:PD)

SYNOPSIS

pure function transliterate(instr,old_set,new_set) result(outstr)

 character(len=*),intent(in)  :: instr
 character(len=*),intent(in)  :: old_set
 character(len=*),intent(in)  :: new_set
 character(len=len(instr))    :: outstr

DESCRIPTION

Translate, squeeze, and/or delete characters from the input string.

OPTIONS

instr    input string to change
old_set  list of letters to change in INSTR if found

         Each character in the input string that matches a character
         in the old set is replaced.

new_set  list of letters to replace letters in OLD_SET with.

         If the new_set is the empty set the matched characters
         are deleted.

         If the new_set is shorter than the old set the last character
         in the new set is used to replace the remaining characters
         in the new set.

RETURNS

outstr   instr with substitutions applied

EXAMPLES

Sample Program:

program demo_transliterate

 use M_strings, only : transliterate
 implicit none
 character(len=80)   :: STRING

 STRING='aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ'
 write(*,'(a)') STRING

 ! convert a string to uppercase:
 write(*,*) TRANSLITERATE(STRING, &
 & 'abcdefghijklmnopqrstuvwxyz','ABCDEFGHIJKLMNOPQRSTUVWXYZ')

 ! change all miniscule letters to a colon (":"):
 write(*,*) TRANSLITERATE(STRING, &
 & 'abcdefghijklmnopqrstuvwxyz',':')

 ! delete all miniscule letters
 write(*,*) TRANSLITERATE(STRING, &
 & 'abcdefghijklmnopqrstuvwxyz','')

end program demo_transliterate

Expected output

 > aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ
 > AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQRRSSTTUUVVWWXXYYZZ
 > :A:B:C:D:E:F:G:H:I:J:K:L:M:N:O:P:Q:R:S:T:U:V:W:X:Y:Z
 > ABCDEFGHIJKLMNOPQRSTUVWXYZ

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr
character(len=*), intent(in) :: old_set
character(len=*), intent(in) :: new_set

Return Value character(len=LEN)


Contents

Source Code

transliterate

Source Code

PURE FUNCTION transliterate(instr,old_set,new_set) RESULT(outstr)

! ident_18="@(#) M_strings transliterate(3f) replace characters from old set with new set"

!-----------------------------------------------------------------------------------------------------------------------------------
CHARACTER(LEN=*),INTENT(IN)  :: instr                             ! input string to change
CHARACTER(LEN=*),intent(in)  :: old_set
CHARACTER(LEN=*),intent(in)  :: new_set
!-----------------------------------------------------------------------------------------------------------------------------------
CHARACTER(LEN=LEN(instr))    :: outstr                            ! output string to generate
!-----------------------------------------------------------------------------------------------------------------------------------
INTEGER                      :: i10                               ! loop counter for stepping thru string
INTEGER                      :: ii,jj
!-----------------------------------------------------------------------------------------------------------------------------------
   jj=LEN(new_set)
   IF(jj /= 0)THEN
      outstr=instr                                                ! initially assume output string equals input string
      stepthru: DO i10 = 1, LEN(instr)
         ii=iNDEX(old_set,instr(i10:i10))                         ! see if current character is in old_set
         IF (ii /= 0)THEN
            if(ii <= jj)then                                      ! use corresponding character in new_set
               outstr(i10:i10) = new_set(ii:ii)
            else
               outstr(i10:i10) = new_set(jj:jj)                   ! new_set not as long as old_set; use last character in new_set
            endif
         ENDIF
      ENDDO stepthru
   else                                                           ! new_set is null string so delete characters in old_set
      outstr=' '
      hopthru: DO i10 = 1, LEN(instr)
         ii=iNDEX(old_set,instr(i10:i10))                         ! see if current character is in old_set
         IF (ii == 0)THEN                                         ! only keep characters not in old_set
            jj=jj+1
            outstr(jj:jj) = instr(i10:i10)
         ENDIF
      ENDDO hopthru
   endif
END FUNCTION transliterate