156 lines
4.5 KiB
Plaintext
156 lines
4.5 KiB
Plaintext
#COMPILE EXE
|
|
#DIM ALL
|
|
'
|
|
' A B C p r o b l e m . b a s
|
|
'
|
|
' by Geary Chopoff
|
|
' for Chopoff Consulting and RosettaCode.org
|
|
' on 2014Jul23
|
|
'
|
|
'2014Jul23
|
|
'
|
|
'You are given a collection of ABC blocks. Just like the ones you had when you were a kid.
|
|
'There are twenty blocks with two letters on each block. You are guaranteed to have a complete
|
|
'alphabet amongst all sides of the blocks. The sample blocks are:
|
|
'((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) (J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M))
|
|
'The goal of this task is to write a function that takes a string and can determine whether
|
|
'you can spell the word with the given collection of blocks.
|
|
'
|
|
'The rules are simple:
|
|
'1.Once a letter on a block is used that block cannot be used again
|
|
'2.The function should be case-insensitive
|
|
'3. Show your output on this page for the following words:
|
|
' A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE
|
|
'-----------------------------------------------------------------------------
|
|
' G l o b a l C o n s t a n t s
|
|
'
|
|
%Verbose = 0 'make this 1 to have a lot of feedback
|
|
%MAX_BLOCKS = 20 'total number of blocks
|
|
%MAX_SIDES = 2 'total number of sides containing a unique letter per block
|
|
|
|
%MAX_ASC = 255
|
|
%FALSE = 0 'this is correct because there is ONLY ONE value for FALSE
|
|
%TRUE = (NOT %FALSE) 'this is one of MANY values of TRUE!
|
|
$FLAG_TRUE = "1"
|
|
$FLAG_FALSE = "0"
|
|
'-----------------------------------------------------------------------------
|
|
' G l o b a l V a r i a b l e s
|
|
'
|
|
GLOBAL blk() AS STRING
|
|
'-----------------------------------------------------------------------------
|
|
'i n i t B l o c k s
|
|
'
|
|
' as we will use this array only once we build it each time program is run
|
|
'
|
|
SUB initBlocks
|
|
LOCAL j AS INTEGER
|
|
j=1
|
|
blk(j)="BO"
|
|
j=j+1
|
|
blk(j)="XK"
|
|
j=j+1
|
|
blk(j)="DQ"
|
|
j=j+1
|
|
blk(j)="CP"
|
|
j=j+1
|
|
blk(j)="NA"
|
|
j=j+1
|
|
blk(j)="GT"
|
|
j=j+1
|
|
blk(j)="RE"
|
|
j=j+1
|
|
blk(j)="TG"
|
|
j=j+1
|
|
blk(j)="QD"
|
|
j=j+1
|
|
blk(j)="FS"
|
|
j=j+1
|
|
blk(j)="JW"
|
|
j=j+1
|
|
blk(j)="HU"
|
|
j=j+1
|
|
blk(j)="VI"
|
|
j=j+1
|
|
blk(j)="AN"
|
|
j=j+1
|
|
blk(j)="OB"
|
|
j=j+1
|
|
blk(j)="ER"
|
|
j=j+1
|
|
blk(j)="FS"
|
|
j=j+1
|
|
blk(j)="LY"
|
|
j=j+1
|
|
blk(j)="PC"
|
|
j=j+1
|
|
blk(j)="ZM"
|
|
IF j <> %MAX_BLOCKS THEN
|
|
STDOUT "initBlocks:Error: j is not same as MAX_BLOCKS!",j,%MAX_BLOCKS
|
|
END IF
|
|
END SUB
|
|
'-----------------------------------------------------------------------------
|
|
' m a k e W o r d
|
|
'
|
|
FUNCTION makeWord(tryWord AS STRING) AS BYTE
|
|
LOCAL retTF AS BYTE
|
|
LOCAL j AS INTEGER
|
|
LOCAL s AS INTEGER 'which side of block we are looking at
|
|
LOCAL k AS INTEGER
|
|
LOCAL c AS STRING 'character in tryWord we are looking for
|
|
|
|
|
|
FOR j = 1 TO LEN(tryWord)
|
|
c = UCASE$(MID$(tryWord,j,1)) 'character we want to show with block
|
|
|
|
retTF = %FALSE 'we assume this will fail
|
|
|
|
FOR k = 1 TO %MAX_BLOCKS
|
|
IF LEN(blk(k)) = %MAX_SIDES THEN
|
|
FOR s = 1 TO %MAX_SIDES
|
|
IF c = MID$(blk(k),s,1) THEN
|
|
retTF = %TRUE 'this block has letter we want
|
|
blk(k) = "" 'remove this block from further consideration
|
|
EXIT FOR
|
|
END IF
|
|
NEXT s
|
|
END IF
|
|
IF retTF THEN EXIT FOR 'can go on to next character in word
|
|
NEXT k
|
|
IF ISFALSE retTF THEN EXIT FOR 'if character not found then all is done
|
|
NEXT j
|
|
|
|
FUNCTION = retTF
|
|
END FUNCTION
|
|
'-----------------------------------------------------------------------------
|
|
' P B M A I N
|
|
'
|
|
FUNCTION PBMAIN () AS LONG
|
|
DIM blk(1 TO %MAX_BLOCKS, 1 TO %MAX_SIDES) AS STRING
|
|
LOCAL cmdLine AS STRING
|
|
|
|
initBlocks 'setup global array of blocks
|
|
|
|
cmdLine=COMMAND$
|
|
IF LEN(cmdLine)= 0 THEN
|
|
STDOUT "Useage for ABCproblem Version 1.00:"
|
|
STDOUT ""
|
|
STDOUT " >ABCproblem tryThisWord"
|
|
STDOUT ""
|
|
STDOUT "Where tryThisWord is a word you want to see if"+STR$(%MAX_BLOCKS)+" blocks can make."
|
|
STDOUT "If word can be made TRUE is returned."
|
|
STDOUT "Otherwise FALSE is returned."
|
|
EXIT FUNCTION
|
|
END IF
|
|
|
|
IF INSTR(TRIM$(cmdLine)," ") = 0 THEN
|
|
IF makeWord(cmdLine) THEN
|
|
STDOUT "TRUE"
|
|
ELSE
|
|
STDOUT "FALSE"
|
|
END IF
|
|
ELSE
|
|
STDOUT "Error:Missing word to try to make with blocks! <" & cmdLine & ">"
|
|
EXIT FUNCTION
|
|
END IF
|
|
END FUNCTION
|