FTStringSetClass Module

FTStringSet is a class for an unordered collection of strings. Use a FTStringSet to store strings as an alternative to arrays when the order is not important, but testing for membership is.

Definition

       TYPE(FTStringSet) :: varName

Usage

Initialization

   CLASS(FTStringSet)  :: FTStringSet
   integer             :: N = 11
   logical             :: cs = .true.
   CALL FTStringSet % initFTStringSet(N,cs)

   CLASS(FTStringSet)  :: FTStringSet
   CHARACTER(LEN=*)    :: strings(:)
   CALL FTStringSet % initWithStrings(strings)

Destruction

  CALL FTStringSet  %  destuct() [Non Pointers]
  CALL releaseFTStringSet(stringSet) [Pointers]

Adding Strings

     CALL set % addString(str)

Testing membership:

  if(set % containsString(str))     THEN

Getting an array of members

  CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s
  s => set % strings
  ... do something ...
  DEALLOCATE(s)

Set operations, union, intersection, difference

  newSet => set1 % unionWithSet(set2)
  ... do something ...
  call releaseFTStringSet(newSet)

  newSet => set1 % intersectionWithSet(set2)
  ... do something ...
  call releaseFTStringSet(newSet)

  newSet => set1 % setFromDifference(set2)
  ... do something ...
  call releaseFTStringSet(newSet)

Uses

  • module~~ftstringsetclass~~UsesGraph module~ftstringsetclass FTStringSetClass module~ftdictionaryclass FTDictionaryClass module~ftstringsetclass->module~ftdictionaryclass module~ftobjectclass FTObjectClass module~ftstringsetclass->module~ftobjectclass module~ftkeyobjectpairclass FTKeyObjectPairClass module~ftdictionaryclass->module~ftkeyobjectpairclass module~ftlinkedlistclass FTLinkedListClass module~ftdictionaryclass->module~ftlinkedlistclass module~ftlinkedlistiteratorclass FTLinkedListIteratorClass module~ftdictionaryclass->module~ftlinkedlistiteratorclass module~ftmutableobjectarrayclass FTMutableObjectArrayClass module~ftdictionaryclass->module~ftmutableobjectarrayclass module~hashmodule HashModule module~ftdictionaryclass->module~hashmodule module~ftkeyobjectpairclass->module~ftobjectclass module~ftlinkedlistclass->module~ftmutableobjectarrayclass module~ftlinkedlistrecordclass FTLinkedListRecordClass module~ftlinkedlistclass->module~ftlinkedlistrecordclass module~ftlinkedlistiteratorclass->module~ftlinkedlistclass module~ftmutableobjectarrayclass->module~ftobjectclass module~ftlinkedlistrecordclass->module~ftobjectclass

Derived Types

type, public, extends(FTObject) ::  FTStringSet

Finalizations Procedures

final :: destructFTStringSet

Type-Bound Procedures

procedure, public :: init => initFTObject
procedure, public :: description => FTObjectDescription
procedure, public, non_overridable :: copy => copyFTObject
procedure, public, non_overridable :: retain => retainFTObject
procedure, public, non_overridable :: isUnreferenced
procedure, public, non_overridable :: refCount
procedure, public :: initFTStringSet
procedure, public :: initWithStrings
procedure, public :: addString => AddString
procedure, public :: containsString
procedure, public :: strings
procedure, public :: unionWithSet
procedure, public :: intersectionWithSet
procedure, public :: setFromDifference
procedure, public :: isEmpty
procedure, public :: count => stringCount
procedure, public :: printDescription => printFTStringSet
procedure, public :: className => FTStringSetClassName

Functions

public function stringCount(self)

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self

Return Value integer

public function containsString(self, str)

containsString returns .TRUE. if the set contains the string, .FALSE. otherwise.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
character(len=*) :: str

Return Value logical

public function strings(self) result(s)

strings returns a pointer to an array of strings that are in the set. Deallocate this array when done with it.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self

Return Value character(len=FTDICT_KWD_STRING_LENGTH), DIMENSION(:), POINTER

public function unionWithSet(self, set) result(newSet)

unionWithSet returns a pointer to a new set that is the union of two sets. the new set has reference count of 1. Release when done.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
class(FTStringSet) :: set

Return Value type(FTStringSet), POINTER

public function intersectionWithSet(self, set) result(newSet)

intersectionWithSet returns a pointer to a new set that is the intersection of two sets. the new set has reference count of 1. Release when done.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
class(FTStringSet) :: set

Return Value type(FTStringSet), POINTER

public function setFromDifference(self, set) result(newSet)

setFromDifference returns a pointer to a new set that is the difference of two sets. the new set has reference count of 1. Release when done.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
class(FTStringSet) :: set

Return Value type(FTStringSet), POINTER

public function isEmpty(self)

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self

Return Value logical

public function FTStringSetFromObject(obj) result(cast)

Generic Name: cast

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTObject), POINTER :: obj

Return Value class(FTStringSet), POINTER

public function FTStringSetClassName(self) result(s)

Class name returns a string with the name of the type of the object

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self

Return Value character(len=CLASS_NAME_CHARACTER_LENGTH)


Subroutines

public subroutine initFTStringSet(self, FTStringSetSize)

Designated initializer. Initializes the amount of storage, but the FTStringSet remains empty.

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
integer :: FTStringSetSize

public subroutine initWithStrings(self, strings)

initializer. Initializes the amount of storage from the strings passed Usage CLASS(FTStringSet) :: FTStringSet CHARACTER(LEN=) :: strings(:) CALL FTStringSet % initWithStrings(strings)

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
character(len=*) :: strings(:)

public subroutine destructFTStringSet(self)

Destructor for the class. This is called automatically when the reference count reaches zero. Do not call this yourself on pointers

Arguments

Type IntentOptional Attributes Name
type(FTStringSet) :: self

public subroutine releaseFTStringSet(self)

Public, generic name: release(self)

Read more…

Arguments

Type IntentOptional Attributes Name
type(FTStringSet), POINTER :: self

public subroutine AddString(self, str)

AddString adds a string to the set if it is not already present

Read more…

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
character(len=*) :: str

public subroutine printFTStringSet(self, iUnit)

Arguments

Type IntentOptional Attributes Name
class(FTStringSet) :: self
integer :: iUnit