05-15-2022, 11:02 AM
(This post was last modified: 05-15-2022, 11:05 AM by TarotRedhand.)
This is an implementation of mathematical sets that deals solely with characters. For an expanded explanation download the pdf readme below -
CHARSET README.pdf (Size: 259.26 KB / Downloads: 129)
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
Then the actual library code -
CHARSET.BM
Finally the test program -
TESTSETS.BAS
Thanks to @SMcNeill for helping me to port this.
Hope you find a use for this. Have fun.
TR
CHARSET README.pdf (Size: 259.26 KB / Downloads: 129)
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 TYPEThen 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 SUBFinally 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