QB64 Phoenix Edition
CharSets - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Expanding Horizons (Libraries) (https://qb64phoenix.com/forum/forumdisplay.php?fid=21)
+---- Forum: One Hit Wonders (https://qb64phoenix.com/forum/forumdisplay.php?fid=24)
+---- Thread: CharSets (/showthread.php?tid=412)

CharSets - TarotRedhand - 05-15-2022

This is an implementation of mathematical sets that deals solely with characters. For an expanded explanation download the pdf readme below -

.pdf   CHARSET README.pdf (Size: 259.26 KB / Downloads: 130)

The actual library consists of a BI file and a BM file. There is also a test program that accompanies these. First off the BI

CHARSET.BI
Code: (Select All)
REM ******************************************************
REM * Filespec  :  charset.bas charset.bi                *
REM * Date      :  June 23 1997                          *
REM * Time      :  12:01                                *
REM * Revision  :  1.0B                                  *
REM * Update    :                                        *
REM ******************************************************
REM * Released to the Public Domain                      *
REM ******************************************************

CONST SetSize = 32      ' Number of bytes to store set contents
CONST Last = SetSize - 1
CONST TRUE  = -1
CONST FALSE = 0

TYPE CharSet
    MySet AS STRING * SetSize
    MySize AS INTEGER
END TYPE

Then the actual library code -

CHARSET.BM
Code: (Select All)
REM ******************************************************
REM * Private SUB - Do not call directly                *
REM ******************************************************
SUB SetError ( ErrMessage AS STRING )
    PRINT "ERROR : ";ErrMessage
    PRINT "ABORTING NOW!"
    STOP
END SUB

REM ******************************************************
REM * Private SUB - Do not call directly                *
REM ******************************************************
SUB LoadSet ( A AS CharSet, LoadChars AS STRING )
    IF LoadChars <> "" THEN
        LoadSize% = LEN(LoadChars)
        Here% = 1
        LocationNext% = INSTR(Here%, LoadChars, "...")
        DO WHILE LocationNext% > 0
            Start% = ASC(MID$(LoadChars, LocationNext% - 1, 1))
            Fini%  = ASC(MID$(LoadChars, LocationNext% + 3, 1))
            Here%  = LocationNext% + 4
            IF Start% > Fini% THEN
                Start% = (Start% XOR Fini%)
                Fini%  = (Start% XOR Fini%)
                Start% = (Start% XOR Fini%)
            END IF
            FOR X% = Start% TO Fini%
                Y% = 1 + (X% \ 8)
                Z% = X% MOD 8
                MID$(A.MySet, Y%, 1) = CHR$(ASC(MID$(A.Myset, Y%, 1)) OR PowerOf2%(Z%))
            NEXT X%
            IF Here% >= LoadSize% THEN
                EXIT DO
            END IF
            LocationNext% = INSTR(Here%, LoadChars, "...")
        LOOP
        IF Here% < LoadSize% THEN
            FOR X% = Here% TO LoadSize%
                AChar$ = MID$(LoadChars, X%, 1)
                Y% = 1 + (ASC(AChar$) \ 8)
                Z% = ASC(AChar$) MOD 8
                MID$(A.MySet, Y%, 1) = CHR$(ASC(MID$(A.MySet, Y%, 1)) OR PowerOf2%(Z%))
            NEXT X%
        END IF
    END IF
END SUB

REM ******************************************************
REM * Private SUB - Do not call directly                *
REM ******************************************************
SUB Recount ( A AS CharSet )
    A.MySize = 0
    FOR X% = 1 TO SetSize
        TestChar$ = MID$(A.MySet, X%, 1)
        FOR Y% = 0 TO 7
            IF (ASC(TestChar$) AND PowerOf2%(Y%)) <> 0 THEN
                A.MySize = A.MySize + 1
            END IF
        NEXT Y%
    NEXT X%
END SUB

REM ******************************************************
REM * Private FUNCTION - Do not call directly            *
REM ******************************************************
FUNCTION PowerOf2% ( Power AS INTEGER )
    SELECT CASE Power
        CASE 0
            PowerOf2% = 1
        CASE 1
            PowerOf2% = 2
        CASE 2
            PowerOf2% = 4
        CASE 3
            PowerOf2% = 8
        CASE 4
            PowerOf2% = 16
        CASE 5
            PowerOf2% = 32
        CASE 6
            PowerOf2% = 64
        CASE 7
            PowerOf2% = 128
        CASE ELSE
            PowerOf2% = 0
    END SELECT
END FUNCTION

REM *****************************************************************
REM * Must be called before a charset is used unless that charset  *
REM * is used to hold the results of a set operation.  Valid set    *
REM * operations that can be called in lieu of this routine are -  *
REM * CopySet, MakeSetEmpty, SetComplement, SetUnion, SetDifference,*
REM * SetIntersection and SymmetricSetDifference, where without    *
REM * exception the uninitialised set would be used for the        *
REM * rightmost parameter.                                          *
REM *                                                              *
REM * The string InitialChars is used to specify the initial        *
REM * contents of the CharSet being initialised.  The format of    *
REM * the string is as follows.                                    *
REM *                                                              *
REM * If an empty set is desired it is possible to pass an empty    *
REM * string "" to this routine, although the routine MakeSetEmpty  *
REM * would probably be quicker.                                    *
REM *                                                              *
REM * A range of characters can be specified by the use of a        *
REM * trigraph (...) in the form a...z which would tell this        *
REM * routine to include all the characters from lower case 'a' to  *
REM * lower case 'z' inclusive.  More than one range of characters  *
REM * may be specified for a set, but all ranges MUST be the first  *
REM * of the characters specified.                                  *
REM *                                                              *
REM * A list of the actual characters required to be contained      *
REM * within the set such as "axwf9\" may be part of (or the whole  *
REM * of) the string, but MUST appear after any range(s) of        *
REM * characters.                                                  *
REM *                                                              *
REM * See the example program for more help.                        *
REM *****************************************************************

SUB InitialiseSet ( A AS CharSet, InitialChars AS STRING )
    MakeSetEmpty A
    LoadSet A, InitialChars
    Recount A
END SUB

REM *****************************************************************
REM * Copies the contents of one set to another.                    *
REM *****************************************************************

SUB CopySet ( This AS CharSet, ToThis AS CharSet )
    ToThis.MySet = This.MySet
    ToThis.MySize = This.Mysize
END SUB

REM *****************************************************************
REM * Adds the characters of the string IncludeChars to set A.  The *
REM * same rules for the contents of the string used by the routine *
REM * InitialiseSet apply.                                          *
REM *****************************************************************

SUB IncludeInSet ( A AS CharSet, IncludeChars AS STRING )
    LoadSet A, IncludeChars
    Recount A
END SUB

REM *****************************************************************
REM * If any of the characters in ExcludedChars are also part of    *
REM * set A, such characters will be removed from set A.            *
REM *****************************************************************

SUB ExcludeFromSet ( A AS CharSet, ExcludedChars AS STRING )
    DIM TempSet AS CharSet
    IF ExcludedChars = "" THEN
        SetError("ExcludeFromSet - No chars to exclude!")
    END IF
    InitialiseSet TempSet, ExcludedChars
    FOR X% = 1 TO SetSize
        MID$(A.MySet, X%, 1) = CHR$(ASC(MID$(A.MySet, X%, 1)) AND NOT(ASC(MID$(TempSet.MySet, X%, 1))))
    NEXT X%
    Recount A
END SUB

REM *****************************************************************
REM * Returns the number of elements of set A.                      *
REM *****************************************************************

FUNCTION Cardinality% ( A AS CharSet )
    Cardinality% = A.MySize
END FUNCTION

REM *****************************************************************
REM * Tests for set A being empty.                                  *
REM *****************************************************************

FUNCTION SetIsEmpty ( A AS CharSet )
    SetIsEmpty = (A.MySize = 0)
END FUNCTION

REM *****************************************************************
REM * Empties set A.                                                *
REM *****************************************************************

SUB MakeSetEmpty ( A AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(A.MySet, X%, 1) = CHR$(0)
    NEXT X%
    A.MySize = 0
END SUB

REM *****************************************************************
REM * In order to use this routine, the string TestChar MUST only  *
REM * have a single character.  If the string is empty or it has    *
REM * more than 1 character, an error message will be displayed and *
REM * the program will be STOPped.                                  *
REM *                                                              *
REM * This routine tests whether the character TestChar is a member *
REM * of set A (TestChar IN A).                                    *
REM *****************************************************************

FUNCTION IsMember ( A AS CharSet, TestChar AS STRING )
    IF TestChar = "" THEN
        SetError("IsMember - No char to test!")
    END IF
    IF LEN(TestChar) > 1 THEN
        SetError("IsMember - Too many chars to test!")
    END IF
    Y% = 1 + (ASC(TestChar) \ 8)
    Z% = ASC(TestChar) MOD 8
    IsMember = ((ASC(MID$(A.MySet, Y%, 1)) AND PowerOf2(Z%)) <> 0)
END FUNCTION

REM *****************************************************************
REM * Converts the set A to the string OutChars for PRINTING etc.  *
REM *****************************************************************

SUB GetSetContents ( A AS CharSet, OutChars AS String )
    OutChars = ""
    FOR X% = 1 TO SetSize
        Temp$ = MID$(A.MySet, X%, 1)
        FOR Y% = 0 TO 7
            IF (ASC(Temp$) AND PowerOf2%(Y%)) <> 0 THEN
                OutChars = OutChars + CHR$(((X% - 1) * 8) + Y%)
            END IF
        NEXT Y%
    NEXT X%
END SUB

REM *****************************************************************
REM * Tests for A = B.                                              *
REM *****************************************************************

FUNCTION SetEquality ( A AS CharSet, B AS CharSet )
    SetEquality = (A.MySet = B.MySet)
END FUNCTION

REM *****************************************************************
REM * Tests for A <> B.                                            *
REM *****************************************************************

FUNCTION SetInequality ( A AS CharSet, B AS CharSet )
    SetInequality = (A.MySet <> B.MySet)
END FUNCTION

REM *****************************************************************
REM * Tests to see if all of the characters contained in the set    *
REM * This are also present in the set OfThis, i.e that the set    *
REM * This is a subset of the set OfThis.  Note if the 2 sets are  *
REM * equal or the set This is empty then the set This IS a subset  *
REM * of the set OfThis.                                            *
REM *****************************************************************

FUNCTION IsSubsetOf ( This AS CharSet, OfThis AS CharSet )
    IF SetEquality(This, OfThis) THEN
        IsSubsetOf = TRUE
        EXIT FUNCTION
    END IF
    IF SetIsEmpty(This) THEN
        IsSubsetOf = TRUE
        EXIT FUNCTION
    END IF
    IF This.MySize > OfThis.MySize THEN
        IsSubsetOf = FALSE
        EXIT FUNCTION
    END IF
    FOR X% = 1 TO SetSize
        TestChar1$ = MID$(This.MySet, X%, 1)
        TestChar2$ = MID$(OfThis.MySet, X%, 1)
        FOR Y% = 0 TO 7
            Z% = PowerOf2%(Y%)
            P% = (ASC(TestChar1$) AND Z%)
            Q% = (ASC(TestChar2$) AND Z%)
            IF ((P% <> 0) AND (Q% = 0)) THEN
                IsSubsetOf = FALSE
                EXIT FUNCTION
            END IF
        NEXT Y%
    NEXT X%
    IsSubsetOf = TRUE
END FUNCTION

REM *****************************************************************
REM * Identical to the routine IsSubsetOf with the exception that  *
REM * the 2 sets may not be equal (This <> OfThis).                *
REM *****************************************************************

FUNCTION IsStrictSubsetOf ( This AS CharSet, OfThis AS CharSet )
    IF SetEquality(This, OfThis) THEN
        IsStrictSubsetOf = FALSE
        EXIT FUNCTION
    END IF
    IsStrictSubsetOf = IsSubsetOf(This, OfThis)
END FUNCTION

REM *****************************************************************
REM * The operation set complement places all the characters that  *
REM * are NOT part of the set A into the set ComplementOfA.        *
REM *****************************************************************

SUB SetComplement ( A AS CharSet, ComplementOfA AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(ComplementOfA.MySet, X%, 1) = CHR$((ASC(MID$(A.MySet, X%, 1))) XOR 255)
    NEXT X%
    Recount ComplementOfA
END SUB

REM *****************************************************************
REM * The operation set union combines all the characters that are  *
REM * in set A and all the characters that are in set B and returns *
REM * the result of this in set C.                                  *
REM *****************************************************************

SUB SetUnion ( A AS CharSet, B AS CharSet, C AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(C.MySet, X%, 1) = CHR$(ASC(MID$(A.MySet, X%, 1)) OR ASC(MID$(B.MySet, X%, 1)))
    NEXT X%
    Recount C
END SUB

REM *****************************************************************
REM * The operation set difference places only those characters of  *
REM * set A which are NOT part of set B into set C.                *
REM *****************************************************************

SUB SetDifference ( A AS CharSet, B AS CharSet, C AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(C.MySet, X%, 1) = CHR$(ASC(MID$(A.MySet, X%, 1)) AND NOT(ASC(MID$(B.MySet, X%, 1))))
    NEXT X%
    Recount C
END SUB

REM *****************************************************************
REM * After this operation set C will contain only those characters *
REM * which occur in both set A and set C.                          *
REM *****************************************************************

SUB SetIntersection ( A AS CharSet, B AS CharSet, C AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(C.MySet, X%, 1) = CHR$(ASC(MID$(A.MySet, X%, 1)) AND ASC(MID$(B.MySet, X%, 1)))
    NEXT X%
    Recount C
END SUB

REM *****************************************************************
REM * This operation is the set equivalent of the logical operation *
REM * exclusive or, in that after this operation set C will contain *
REM * only those characters that occur in either set A or set B but *
REM * not in both.                                                  *
REM *****************************************************************

SUB SymmetricSetDifference ( A AS CharSet, B AS CharSet, C AS CharSet )
    FOR X% = 1 TO SetSize
        MID$(C.MySet, X%, 1) = CHR$(ASC(MID$(A.MySet, X%, 1)) XOR ASC(MID$(B.MySet, X%, 1)))
    NEXT X%
    Recount C
END SUB

Finally the test program -

TESTSETS.BAS
Code: (Select All)
'$INCLUDE: 'CHARSET.BI'

Dim ASet As CharSet, BSet As CharSet, CSet As CharSet, DSet As CharSet
Dim ESet As CharSet, FSet As CharSet, GSet As CharSet, HSet As CharSet
Dim ISet As CharSet, JSet As CharSet, KSet As CharSet, SetL As CharSet
Dim MSet As CharSet, NSet As CharSet, OSet As CharSet, SetP As CharSet
Dim QSet As CharSet, SetR As CharSet, SSet As CharSet, TSet As CharSet
AStr$ = Chr$(129) + "..." + Chr$(147)
BStr$ = Chr$(0) + "..." + Chr$(31)
CStr$ = Chr$(148) + "..." + Chr$(255)
DStr$ = Chr$(33) + "..." + Chr$(127)
EStr$ = Chr$(0) + "...MO..." + Chr$(255)
Screen _NewImage(235, 50, 0)
Cls
InitialiseSet ASet, "A...Za...z"
InitialiseSet BSet, ",.<>;':@#~{}[]"
InitialiseSet CSet, "0...9!œ$%^&*()_-+=\|"
InitialiseSet DSet, AStr$
InitialiseSet ESet, "a...z0...9!œ$%^&*()_-+=\|;:'@#~[]{}"
InitialiseSet FSet, "acegikmoqsuwy"
InitialiseSet GSet, "A...Z"
InitialiseSet HSet, "a...z"
CopySet ASet, ISet
InitialiseSet JSet, ""
SetComplement JSet, KSet
MakeSetEmpty SetL
InitialiseSet MSet, DStr$
InitialiseSet NSet, EStr$
SetComplement NSet, OSet
CopySet NSet, SetP
ExcludeFromSet NSet, BStr$
GetSetContents ASet, FStr$
Print "Set A contains - "; FStr$
GetSetContents BSet, FStr$
Print "Set B contains - "; FStr$
GetSetContents CSet, FStr$
Print "Set C contains - "; FStr$
GetSetContents DSet, FStr$
Print "Set D contains - "; FStr$
GetSetContents ESet, FStr$
Print "Set E contains - "; FStr$
GetSetContents FSet, FStr$
Print "Set F contains - "; FStr$
GetSetContents GSet, FStr$
Print "Set G contains - "; FStr$
GetSetContents HSet, FStr$
Print "Set H contains - "; FStr$
GetSetContents ISet, FStr$
Print "Set I contains - "; FStr$
GetSetContents JSet, FStr$
If Len(FStr$) = 0 Then FStr$ = "Nothing!"
Print "Set J contains - "; FStr$
ExcludeFromSet KSet, BStr$
GetSetContents KSet, FStr$
IncludeInSet KSet, BStr$
Print "Set K contains - "; FStr$
GetSetContents SetL, FStr$
If Len(FStr$) = 0 Then FStr$ = "Nothing!"
Print "Set L contains - "; FStr$
GetSetContents MSet, FStr$
Print "Set M contains - "; FStr$
GetSetContents NSet, FStr$
Print "Set N contains - "; FStr$
GetSetContents OSet, FStr$
Print "Set O contains - "; FStr$
ExcludeFromSet SetP, BStr$
GetSetContents SetP, FStr$
IncludeInSet SetP, BStr$
Print "Set P contains - "; FStr$
Print
Print "Cardinality of A = "; Cardinality%(ASet)
Print "Cardinality of B = "; Cardinality%(BSet)
Print "Cardinality of C = "; Cardinality%(CSet)
Print "Cardinality of D = "; Cardinality%(DSet)
Print "Cardinality of E = "; Cardinality%(ESet)
Print "Cardinality of F = "; Cardinality%(FSet)
Print "Cardinality of G = "; Cardinality%(GSet)
Print "Cardinality of H = "; Cardinality%(HSet)
Print "Cardinality of I = "; Cardinality%(ISet)
Print "Cardinality of J = "; Cardinality%(JSet)
Print "Cardinality of K = "; Cardinality%(KSet)
Print "Cardinality of L = "; Cardinality%(SetL)
Print "Cardinality of M = "; Cardinality%(MSet)
Print "Cardinality of N = "; Cardinality%(NSet)
Print "Cardinality of O = "; Cardinality%(OSet)
Print "Cardinality of P = "; Cardinality%(SetP)
Print
If SetIsEmpty(SetL) Then
    Print "Set L is EMPTY!"
Else
    Print "Error in SetIsEmpty!"
    Stop
End If
If IsMember(HSet, "a") Then
    Print "The letter 'a' is a member of set H."
Else
    Print "Error in IsMember!"
    Stop
End If
If SetEquality(ASet, ISet) Then
    Print "Set A = Set I"
Else
    Print "Error in SetEquality!"
    Stop
End If
If SetInequality(ASet, BSet) Then
    Print "Set A <> Set B"
Else
    Print "Error in SetInequality!"
    Stop
End If
If IsSubsetOf(ISet, ASet) Then
    Print "Set I is a subset of Set A"
Else
    Print "Error in IsSubsetOf!"
    Stop
End If
If Not (IsStrictSubsetOf(ISet, ASet)) And IsStrictSubsetOf(FSet, ASet) Then
    Print "Set I is NOT a strict subset of A while Set F is."
Else
    Print "Error in IsStrictSubsetOf!"
    Stop
End If
Print
Print "Press Any Key to continue"
WaitKey
Cls
Print
Print "Testing the operation of set union on -> G + B = Q."
Print
GetSetContents GSet, FStr$
Print "Set G contains - "; FStr$
GetSetContents BSet, FStr$
Print "Set B contains - "; FStr$
SetUnion GSet, BSet, QSet
GetSetContents QSet, FStr$
Print "After set union set Q contains - "; FStr$
Print
Print "Testing the operation of set Difference on -> H - F = R."
Print
GetSetContents HSet, FStr$
Print "Set H contains - "; FStr$
GetSetContents FSet, FStr$
Print "Set F contains - "; FStr$
SetDifference HSet, FSet, SetR
GetSetContents SetR, FStr$
Print "After set difference set R contains - "; FStr$
Print
Print "Testing the operation of set Intersection on -> H * E = S."
Print
GetSetContents HSet, FStr$
Print "Set H contains - "; FStr$
GetSetContents ESet, FStr$
Print "Set E contains - "; FStr$
SetIntersection HSet, ESet, SSet
GetSetContents SSet, FStr$
Print "After set intersection set S contains - "; FStr$
Print
Print "Testing the operation of symmetric set difference on -> C / E = T."
Print
GetSetContents CSet, FStr$
Print "Set C contains - "; FStr$
GetSetContents ESet, FStr$
Print "Set E contains - "; FStr$
SymmetricSetDifference CSet, ESet, TSet
GetSetContents TSet, FStr$
Print "After set symmetric set difference set T contains - "; FStr$
Print
Print "All tests complete."
Print
End

Sub WaitKey
    Do
    Loop While InKey$ = ""
End Sub

'$INCLUDE: 'CHARSET.BM'

Thanks to @SMcNeill for helping me to port this.

Hope you find a use for this. Have fun.

TR