2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,37 +1,44 @@
|
|||
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:
|
||||
You are given a collection of ABC blocks (maybe like the ones you had when you were a kid).
|
||||
|
||||
There are twenty blocks with two letters on each block.
|
||||
|
||||
A complete alphabet is guaranteed amongst all sides of the blocks.
|
||||
|
||||
The sample collection of blocks:
|
||||
(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)
|
||||
|
||||
|
||||
;Task:
|
||||
Write a function that takes a string (word) and determines whether the word can be spelled with the given collection of blocks.
|
||||
|
||||
:((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:
|
||||
::# Once a letter on a block is used that block cannot be used again
|
||||
::# The function should be case-insensitive
|
||||
::# Show the output on this page for the following 7 words in the following example
|
||||
|
||||
#Once a letter on a block is used that block cannot be used again
|
||||
#The function should be case-insensitive
|
||||
# Show your output on this page for the following words:
|
||||
|
||||
;Example:
|
||||
|
||||
<lang python>
|
||||
>>> can_make_word("A")
|
||||
<lang python> >>> can_make_word("A")
|
||||
True
|
||||
>>> can_make_word("BARK")
|
||||
True
|
||||
|
|
@ -44,5 +51,5 @@ The rules are simple:
|
|||
>>> can_make_word("SQUAD")
|
||||
True
|
||||
>>> can_make_word("CONFUSE")
|
||||
True
|
||||
</lang>
|
||||
True</lang>
|
||||
<br><br>
|
||||
|
|
|
|||
125
Task/ABC-Problem/BASIC/abc-problem.basic
Normal file
125
Task/ABC-Problem/BASIC/abc-problem.basic
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
|
||||
' ABC_Problem '
|
||||
' '
|
||||
' Developed by A. David Garza Marín in VB-DOS for '
|
||||
' RosettaCode. November 29, 2016. '
|
||||
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
|
||||
|
||||
' Comment the following line to run it in QB or QBasic
|
||||
OPTION EXPLICIT ' Modify to OPTION _EXPLICIT for QB64
|
||||
|
||||
' SUBs and FUNCTIONs
|
||||
DECLARE SUB doCleanBlocks ()
|
||||
DECLARE FUNCTION ICanMakeTheWord (WhichWord AS STRING) AS INTEGER
|
||||
DECLARE SUB doReadBlocks ()
|
||||
|
||||
' rBlock Data Type
|
||||
TYPE regBlock
|
||||
Block AS STRING * 2
|
||||
Used AS INTEGER
|
||||
END TYPE
|
||||
|
||||
' Initialize
|
||||
CONST False = 0, True = NOT False, HMBlocks = 20
|
||||
DATA "BO", "XK", "DQ", "CP", "NA", "GT","RE", "TG"
|
||||
DATA "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER"
|
||||
DATA "FS", "LY", "PC","ZM"
|
||||
|
||||
DIM rBlock(1 TO HMBlocks) AS regBlock
|
||||
DIM i AS INTEGER, aWord AS STRING, YorN AS STRING
|
||||
|
||||
doReadBlocks ' Read the data in the blocks
|
||||
|
||||
'-------------- Main program cycle ------------------
|
||||
CLS
|
||||
PRINT "This program has the following blocks: ";
|
||||
FOR i = 1 TO HMBlocks
|
||||
PRINT rBlock(i).Block; "|";
|
||||
NEXT i
|
||||
PRINT : PRINT
|
||||
PRINT "Please, write a word or a short sentence to see if the available"
|
||||
PRINT "blocks can make it. If so, I will tell you."
|
||||
DO
|
||||
doCleanBlocks ' Clean all blocks
|
||||
PRINT
|
||||
INPUT "Which is the word"; aWord
|
||||
aWord = LTRIM$(RTRIM$(aWord))
|
||||
|
||||
IF aWord <> "" THEN
|
||||
IF ICanMakeTheWord(aWord) THEN
|
||||
PRINT "Yes, i can make it."
|
||||
ELSE
|
||||
PRINT "No, I can't make it."
|
||||
END IF
|
||||
ELSE
|
||||
PRINT "At least, you need to type a letter."
|
||||
END IF
|
||||
|
||||
PRINT
|
||||
PRINT "Do you want to try again (Y/N) ";
|
||||
DO
|
||||
YorN = INPUT$(1)
|
||||
YorN = UCASE$(YorN)
|
||||
LOOP UNTIL YorN = "Y" OR YorN = "N"
|
||||
PRINT YorN
|
||||
|
||||
LOOP UNTIL YorN = "N"
|
||||
' -------------- End of Main program ----------------
|
||||
END
|
||||
|
||||
SUB doCleanBlocks ()
|
||||
' Var
|
||||
SHARED rBlock() AS regBlock
|
||||
DIM i AS INTEGER
|
||||
|
||||
' Will clean the Used status of all blocks
|
||||
FOR i = 1 TO HMBlocks
|
||||
rBlock(i).Used = False
|
||||
NEXT i
|
||||
|
||||
END SUB
|
||||
|
||||
SUB doReadBlocks ()
|
||||
' Var
|
||||
SHARED rBlock() AS regBlock
|
||||
DIM i AS INTEGER
|
||||
|
||||
' Will read the block values from DATA
|
||||
FOR i = 1 TO HMBlocks
|
||||
READ rBlock(i).Block
|
||||
NEXT i
|
||||
END SUB
|
||||
|
||||
FUNCTION ICanMakeTheWord (WhichWord AS STRING) AS INTEGER ' Comment AS INTEGER to run in QBasic, QB64 and QuickBASIC
|
||||
' Var
|
||||
SHARED rBlock() AS regBlock
|
||||
DIM i AS INTEGER, l AS INTEGER, j AS INTEGER, iYesICan AS INTEGER
|
||||
DIM c AS STRING, sUWord AS STRING
|
||||
|
||||
' Will evaluate if can make the word
|
||||
sUWord = UCASE$(WhichWord)
|
||||
l = LEN(sUWord)
|
||||
i = 0
|
||||
|
||||
DO
|
||||
i = i + 1
|
||||
iYesICan = False
|
||||
c = MID$(sUWord, i, 1)
|
||||
j = 0
|
||||
DO
|
||||
j = j + 1
|
||||
IF NOT rBlock(j).Used THEN
|
||||
iYesICan = (INSTR(rBlock(j).Block, c) > 0)
|
||||
rBlock(j).Used = iYesICan
|
||||
END IF
|
||||
LOOP UNTIL j >= HMBlocks OR iYesICan
|
||||
|
||||
LOOP UNTIL i >= l OR NOT iYesICan
|
||||
|
||||
' The result will depend on the last value of
|
||||
' iYesICan variable. If the last value is True
|
||||
' is because the function found even the last
|
||||
' letter analyzed.
|
||||
ICanMakeTheWord = iYesICan
|
||||
|
||||
END FUNCTION
|
||||
|
|
@ -1,3 +1,5 @@
|
|||
blockList = [ 'BO', 'XK', 'DQ', 'CP', 'NA', 'GT', 'RE', 'TG', 'QD', 'FS', 'JW', 'HU', 'VI', 'AN', 'OB', 'ER', 'FS', 'LY', 'PC', 'ZM' ]
|
||||
|
||||
canMakeWord = (word="") ->
|
||||
# Create a shallow clone of the master blockList
|
||||
blocks = blockList.slice 0
|
||||
|
|
@ -7,9 +9,10 @@ canMakeWord = (word="") ->
|
|||
for block, idx in blocks
|
||||
# If letter is in block, blocks.splice will return an array, which will evaluate as true
|
||||
return blocks.splice idx, 1 if letter.toUpperCase() in block
|
||||
return false
|
||||
false
|
||||
# Return true if there are no falsy values
|
||||
return false not in (checkBlocks letter for letter in word)
|
||||
false not in (checkBlocks letter for letter in word)
|
||||
|
||||
# Expect true, true, false, true, false, true, true, true
|
||||
console.log (canMakeWord word for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"])
|
||||
for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"]
|
||||
console.log word + " -> " + canMakeWord(word)
|
||||
|
|
|
|||
17
Task/ABC-Problem/Ela/abc-problem.ela
Normal file
17
Task/ABC-Problem/Ela/abc-problem.ela
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
open list monad io char
|
||||
|
||||
:::IO
|
||||
|
||||
null = foldr (\_ _ -> false) true
|
||||
|
||||
mapM_ f = foldr ((>>-) << f) (return ())
|
||||
|
||||
abc _ [] = [[]]
|
||||
abc blocks (c::cs) =
|
||||
[b::ans \\ b <- blocks | c `elem` b, ans <- abc (delete b blocks) cs]
|
||||
|
||||
blocks = ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"]
|
||||
|
||||
mapM_ (\w -> putLn (w, not << null $ abc blocks (map char.upper w)))
|
||||
["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"]
|
||||
37
Task/ABC-Problem/Elena/abc-problem.elena
Normal file
37
Task/ABC-Problem/Elena/abc-problem.elena
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
#import system.
|
||||
#import system'routines.
|
||||
#import system'collections.
|
||||
#import extensions.
|
||||
#import extensions'routines.
|
||||
|
||||
#class(extension)op
|
||||
{
|
||||
#method canMakeWord &from:blocks
|
||||
[
|
||||
#var list := ArrayList new:blocks.
|
||||
|
||||
^ $nil == self literal upperCase seek &each:ch
|
||||
[
|
||||
#var index := list indexOf:(word [ word indexOf:ch &at:0 != -1 ] asComparer).
|
||||
|
||||
(index>=0)
|
||||
? [ list remove &at:index. ^ false. ]
|
||||
! [ ^ true. ].
|
||||
].
|
||||
]
|
||||
}
|
||||
|
||||
#symbol program =
|
||||
[
|
||||
#var blocks := ("BO", "XK", "DQ", "CP", "NA",
|
||||
"GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB",
|
||||
"ER", "FS", "LY", "PC", "ZM").
|
||||
|
||||
#var words := ("", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse").
|
||||
|
||||
words run &each:word
|
||||
[
|
||||
console writeLine:"can make '":word:"' : ":(word canMakeWord &from:blocks).
|
||||
].
|
||||
].
|
||||
277
Task/ABC-Problem/Fortran/abc-problem-2.f
Normal file
277
Task/ABC-Problem/Fortran/abc-problem-2.f
Normal file
|
|
@ -0,0 +1,277 @@
|
|||
MODULE PLAYPEN !Messes with a set of alphabet blocks.
|
||||
INTEGER MSG !Output unit number.
|
||||
PARAMETER (MSG = 6) !Standard output.
|
||||
INTEGER MS !I dislike unidentified constants...
|
||||
PARAMETER (MS = 2) !So this is the maximum number of lettered sides.
|
||||
INTEGER LETTER(26),SUPPLY(26) !For counting the alphabet.
|
||||
CONTAINS
|
||||
SUBROUTINE SWAP(I,J) !This really should be known to the compiler.
|
||||
INTEGER I,J,K !Which could generate in-place code,
|
||||
K = I !Using registers, maybe.
|
||||
I = J !Or maybe, there are special op-codes.
|
||||
J = K !Rather than this clunkiness.
|
||||
END SUBROUTINE SWAP !And it should be for any type of thingy.
|
||||
|
||||
INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank.
|
||||
Concocted yet again by R.N.McLean (whom God preserve) December MM.
|
||||
Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!
|
||||
Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces.
|
||||
Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.
|
||||
Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.
|
||||
Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.
|
||||
Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.
|
||||
Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!
|
||||
Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.
|
||||
CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back.
|
||||
INTEGER L !The length of the bumf.
|
||||
L = LEN(TEXT) !So, what is it?
|
||||
1 IF (L.LE.0) GO TO 2 !Are we there yet?
|
||||
IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also.
|
||||
L = L - 1 !Step back one.
|
||||
GO TO 1 !And try again.
|
||||
2 LSTNB = L !The last non-blank, possibly zero.
|
||||
RETURN !Unsafe to use LSTNB as a variable.
|
||||
END FUNCTION LSTNB !Compilers can bungle it.
|
||||
|
||||
SUBROUTINE LETTERCOUNT(TEXT) !Count the occurrences of A-Z.
|
||||
CHARACTER*(*) TEXT !The text to inspect.
|
||||
INTEGER I,K !Assistants.
|
||||
DO I = 1,LEN(TEXT) !Step through the text.
|
||||
K = ICHAR(TEXT(I:I)) - ICHAR("A") + 1 !This presumes that A-Z have contiguous codes!
|
||||
IF (K.GE.1 .AND. K.LE.26) LETTER(K) = LETTER(K) + 1 !Not so with EBCDIC!!
|
||||
END DO !On to the next letter.
|
||||
END SUBROUTINE LETTERCOUNT !Be careful with LETTER.
|
||||
|
||||
SUBROUTINE UPCASE(TEXT) !In the absence of an intrinsic...
|
||||
Converts any lower case letters in TEXT to upper case...
|
||||
Concocted yet again by R.N.McLean (whom God preserve) December MM.
|
||||
Converting from a DO loop evades having both an iteration counter to decrement and an index variable to adjust.
|
||||
CHARACTER*(*) TEXT !The stuff to be modified.
|
||||
c CHARACTER*26 LOWER,UPPER !Tables. a-z may not be contiguous codes.
|
||||
c PARAMETER (LOWER = "abcdefghijklmnopqrstuvwxyz")
|
||||
c PARAMETER (UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
CAREFUL!! The below relies on a-z and A-Z being contiguous, as is NOT the case with EBCDIC.
|
||||
INTEGER I,L,IT !Fingers.
|
||||
L = LEN(TEXT) !Get a local value, in case LEN engages in oddities.
|
||||
I = L !Start at the end and work back..
|
||||
1 IF (I.LE.0) RETURN !Are we there yet? Comparison against zero should not require a subtraction.
|
||||
c IT = INDEX(LOWER,TEXT(I:I)) !Well?
|
||||
c IF (IT .GT. 0) TEXT(I:I) = UPPER(IT:IT) !One to convert?
|
||||
IT = ICHAR(TEXT(I:I)) - ICHAR("a") !More symbols precede "a" than "A".
|
||||
IF (IT.GE.0 .AND. IT.LE.25) TEXT(I:I) = CHAR(IT + ICHAR("A")) !In a-z? Convert!
|
||||
I = I - 1 !Back one.
|
||||
GO TO 1 !Inspect..
|
||||
END SUBROUTINE UPCASE !Easy.
|
||||
|
||||
SUBROUTINE ORDERSIDE(LETTER) !Puts the letters into order.
|
||||
CHARACTER*(*) LETTER !The letters.
|
||||
INTEGER I,N,H !Assistants.
|
||||
CHARACTER*1 T !A scratchpad.
|
||||
LOGICAL CURSE !A bit.
|
||||
N = LEN(LETTER) !So, how many letters?
|
||||
H = N - 1 !Last - First, and not +1.
|
||||
IF (H.LE.0) RETURN !Ha ha.
|
||||
1 H = MAX(1,H*10/13) !The special feature.
|
||||
IF (H.EQ.9 .OR. H.EQ.10) H = 11 !A twiddle.
|
||||
CURSE = .FALSE. !So far, so good.
|
||||
DO I = N - H,1,-1 !If H = 1, this is a BubbleSort.
|
||||
IF (LETTER(I:I).LT.LETTER(I + H:I + H)) THEN !One compare.
|
||||
T = LETTER(I:I) !One swap.
|
||||
LETTER(I:I) = LETTER(I + H:I + H) !Alas, no SWAP(A,B)
|
||||
LETTER(I + H:I + H) = T !Is recognised by the compiler.
|
||||
CURSE = .TRUE. !If once a tiger is seen...
|
||||
END IF !So much for that comparison.
|
||||
END DO !On to the next.
|
||||
IF (CURSE .OR. H.GT.1) GO TO 1!Another pass?
|
||||
END SUBROUTINE ORDERSIDE !Simple enough.
|
||||
SUBROUTINE ORDERBLOCKS(N,SOME) !Puts the collection of blocks into order.
|
||||
INTEGER N !The number of blocks.
|
||||
CHARACTER*(*) SOME(:) !Their lists of letters.
|
||||
INTEGER I,H !Assistants.
|
||||
CHARACTER*(LEN(SOME(1))) T !A scratchpad matching an element of SOME.
|
||||
LOGICAL CURSE !Since there is still no SWAP(SOME(I),SOME(I + H)).
|
||||
H = N - 1 !So here comes another CombSort.
|
||||
IF (H.LE.0) RETURN !With standard suspicion.
|
||||
1 H = MAX(1,H*10/13) !This is the outer loop.
|
||||
IF (H.EQ.9 .OR. H.EQ.10) H = 11 !This is a fiddle.
|
||||
CURSE = .FALSE. !Start the next pass in hope.
|
||||
DO I = N - H,1,-1 !Going backwards, just for fun.
|
||||
IF (SOME(I).LT.SOME(I + H)) THEN !So then?
|
||||
T = SOME(I) !Disorder.
|
||||
SOME(I) = SOME(I + H) !So once again,
|
||||
SOME(I + H) = T !Swap the two miscreants.
|
||||
CURSE = .TRUE. !And remember.
|
||||
END IF !So much for that comparison.
|
||||
END DO !On to the next.
|
||||
IF (CURSE .OR. H.GT.1) GO TO 1!Are we there yet?
|
||||
END SUBROUTINE ORDERBLOCKS !Not much code, but ringing the changes is still tedious.
|
||||
|
||||
SUBROUTINE PLAY(N,SOME) !Mess about with the collection of blocks.
|
||||
INTEGER N !Their number.
|
||||
CHARACTER*(*) SOME(:) !Their letters.
|
||||
INTEGER NH,HIT(N) !A list of blocks.
|
||||
INTEGER B,I,J,K,L,M !Assistants.
|
||||
CHARACTER*1 C !A letter of the moment.
|
||||
L = LEN(SOME(1)) !The maximum number of letters to any block.
|
||||
Cast the collection on to the floor.
|
||||
WRITE (MSG,1) N,L,SOME !Announce the set as it is supplied.
|
||||
1 FORMAT (I7," blocks, with at most",I2," letters:",66(1X,A))
|
||||
Change the "orientation" of some blocks.
|
||||
DO B = 1,N !Step through each block.
|
||||
CALL UPCASE(SOME(B)) !Paranoia rules.
|
||||
CALL ORDERSIDE(SOME(B)) !Put its letter list into order.
|
||||
END DO !On to the next block.
|
||||
WRITE (MSG,2) SOME !Reveal the orderly array.
|
||||
2 FORMAT (6X,"... the letters in reverse order:",66(1X,A))
|
||||
Collate the collection of blocks.
|
||||
CALL ORDERBLOCKS(N,SOME) !Now order the blocks by their letters.
|
||||
WRITE (MSG,3) SOME !Reveal them in neato order.
|
||||
3 FORMAT (7X,"... the blocks in reverse order:",66(1X,A))
|
||||
Count the appearances of the letters of the alphabet.
|
||||
LETTER = 0 !Enough of shuffling blocks around.
|
||||
DO B = 1,N !Now inspect their collective letters.
|
||||
CALL LETTERCOUNT(SOME(B)) !A block's worth at a go.
|
||||
END DO !On to the next block.
|
||||
SUPPLY = LETTER !Save the counts of supplied letters.
|
||||
WRITE (MSG,4) (CHAR(ICHAR("A") + I - 1),I = 1,26),SUPPLY !Results.
|
||||
4 FORMAT (15X,"Letters of the alphabet:",26A<MS + 1>,/, !First, a line with A ... Z.
|
||||
1 11X,"... number thereof supplied:",26I<MS + 1>) !Then a line of the associated counts.
|
||||
Check for blocks with duplicated letters.
|
||||
WRITE (MSG,5) !Announce.
|
||||
5 FORMAT (8X,"Blocks with duplicated letters:",$) !Further output impends.
|
||||
M = 0 !No duplication found.
|
||||
DO B = 1,N !So step through each block.
|
||||
JJ:DO J = 2,L !Inspecting successive letters of the block,
|
||||
IF (SOME(B)(J:J).LE." ") EXIT JJ !Provided they've not run out.
|
||||
DO K = 1,J - 1 !To see if it has appeared earlier.
|
||||
IF (SOME(B)(K:K).LE." ") EXIT JJ!Reverse order means that spaces will be at the end!
|
||||
IF (SOME(B)(J:J).EQ.SOME(B)(K:K)) THEN !Well?
|
||||
M = M + 1 !A match!
|
||||
WRITE (MSG,6) SOME(B) !Name the block.
|
||||
6 FORMAT (1X,A,$) !With further output still impending,
|
||||
EXIT JJ !And give up on this block.
|
||||
END IF !One duplicated letter is sufficient for its downfall.
|
||||
END DO !Next letter up.
|
||||
END DO JJ !On to the next letter of the block.
|
||||
END DO !On to the next block.
|
||||
CALL HIC(M) !Show the count and end the line.
|
||||
Check for duplicate blocks, knowing that the array of blocks is ordered.
|
||||
WRITE (MSG,7) !Announce.
|
||||
7 FORMAT (21X,"Duplicated blocks:",$) !Again, leave the line dangling.
|
||||
K = 0 !No duplication found.
|
||||
B = 1 !Syncopation.
|
||||
70 B = B + 1 !Advance one.
|
||||
IF (B.GT.N) GO TO 72 !Are we there yet?
|
||||
IF (SOME(B).NE.SOME(B - 1)) GO TO 70 !No match? Search on.
|
||||
K = K + 1 !A match is counted.
|
||||
WRITE (MSG,6) SOME(B) !Name it.
|
||||
71 B = B + 1 !And speed through continued matching.
|
||||
IF (B.GT.N) GO TO 72 !Unless we're of the end.
|
||||
IF (SOME(B).EQ.SOME(B - 1)) GO TO 71 !Continued matching?
|
||||
GO TO 70 !Mismatch: resume the normal scan.
|
||||
72 CALL HIC(K) !So much for that.
|
||||
Check for duplicated letters across different blocks.
|
||||
IF (ALL(SUPPLY.LE.1)) RETURN !Unless there are no duplicated letters.
|
||||
WRITE (MSG,8) !Announce.
|
||||
8 FORMAT ("Duplicated letters on different blocks:",$) !More to come.
|
||||
K = 0 !Start another count.
|
||||
DO I = 1,26 !A well-known span.
|
||||
IF (SUPPLY(I).LE.1) CYCLE !Any duplicated letters?
|
||||
C = CHAR(ICHAR("A") + I - 1)!Yes. This is the character.
|
||||
NH = 0 !So, how many blocks contribute?
|
||||
DO B = 1,N !Find out.
|
||||
IF (INDEX(SOME(B),C).GT.0) THEN !On this block?
|
||||
NH = NH + 1 !Yes.
|
||||
HIT(NH) = B !Keep track of which.
|
||||
END IF !So much for that block.
|
||||
END DO !On to the next.
|
||||
IF (ANY(SOME(HIT(2:NH)) .NE. SOME(HIT(1)))) THEN !All have the same collection of letters?
|
||||
K = K + 1 !No!
|
||||
WRITE (MSG,9) C !Name the heterogenously supported letter.
|
||||
9 FORMAT (A<MS + 1>,$) !Use the same spacing even though one character only.
|
||||
END IF !So much for that letter's search.
|
||||
END DO !On to the next letter.
|
||||
CALL HIC(K) !Finish the line with the count report.
|
||||
CONTAINS !This is used often enough.
|
||||
SUBROUTINE HIC(N) !But has very specific context.
|
||||
INTEGER N !The count.
|
||||
IF (N.LE.0) WRITE (MSG,*) "None." !Yes, we have no bananas.
|
||||
IF (N.GT.0) WRITE (MSG,*) N !Either way, end the line.
|
||||
END SUBROUTINE HIC !This service routine is not needed elsewhere.
|
||||
END SUBROUTINE PLAY !Look mummy! All the blockses are neatened!
|
||||
|
||||
LOGICAL FUNCTION CANBLOCK(WORD,N,SOME) !Can the blocks spell out the word?
|
||||
Creates a move tree based on the letters of WORD and for each, the blocks available.
|
||||
CHARACTER*(*) WORD !The word to spell out.
|
||||
INTEGER N !The number of blocks.
|
||||
CHARACTER*(*) SOME(:) !The blocks and their letters.
|
||||
INTEGER NA,AVAIL(N) !Say not the struggle naught availeth!
|
||||
INTEGER NMOVE(LEN(WORD)) !I need a list of acceptable blocks,
|
||||
INTEGER MOVE(LEN(WORD),N) !One list for each letter of WORD.
|
||||
INTEGER I,L,S !Assistants.
|
||||
CHARACTER*1 C !The letter of the moment.
|
||||
CANBLOCK = .FALSE. !Initial pessimism.
|
||||
L = LSTNB(WORD) !Ignore trailing spaces.
|
||||
IF (L.GT.N) RETURN !Enough blocks?
|
||||
LETTER = 0 !To make rabbit stew,
|
||||
CALL LETTERCOUNT(WORD(1:L)) !First catch your rabbit.
|
||||
IF (ANY(SUPPLY .LT. LETTER)) RETURN !The larder is lacking.
|
||||
NA = N !Prepare a list.
|
||||
FORALL (I = 1:N) AVAIL(I) = I !That fingers every block.
|
||||
I = 0 !Step through the letters of the WORD.
|
||||
Chug through the letters of the WORD.
|
||||
1 I = I + 1 !One letter after the other.
|
||||
IF (I.GT.L) GO TO 100 !Yay! We're through!
|
||||
C = WORD(I:I) !The letter of the moment.
|
||||
NMOVE(I) = 0 !No moves known at this new level.
|
||||
DO S = 1,NA !So, look for them amongst the available slots.
|
||||
IF (INDEX(SOME(AVAIL(S)),C) .GT. 0) THEN !A hit?
|
||||
NMOVE(I) = NMOVE(I) + 1 !Yes! Count up another possible move.
|
||||
MOVE(I,NMOVE(I)) = S !Remember its slot.
|
||||
END IF !So much for that block.
|
||||
END DO !On to the next.
|
||||
2 IF (NMOVE(I).GT.0) THEN !Have we any moves?
|
||||
S = MOVE(I,NMOVE(I)) !Yes! Recover the last found.
|
||||
NMOVE(I) = NMOVE(I) - 1 !Uncount, as it is about to be used.
|
||||
IF (S.NE.NA) CALL SWAP(AVAIL(S),AVAIL(NA)) !This block is no longer available.
|
||||
NA = NA - 1 !Shift the boundary back.
|
||||
GO TO 1 !Try the next letter!
|
||||
END IF !But if we can't find a move at that level...
|
||||
I = I - 1 !Retreat a level.
|
||||
IF (I.LE.0) RETURN !Oh dear!
|
||||
S = MOVE(I,NMOVE(I) + 1) !Undo the move that had been made at this level.
|
||||
NA = NA + 1 !And make its block is re-available.
|
||||
IF (S.NE.NA) CALL SWAP(AVAIL(S),AVAIL(NA)) !Move it back.
|
||||
GO TO 2 !See what moves remain at this level.
|
||||
Completed!
|
||||
100 CANBLOCK = .TRUE. !That's a relief.
|
||||
END FUNCTION CANBLOCK !Some revisions might have been made.
|
||||
END MODULE PLAYPEN !No sand here.
|
||||
|
||||
USE PLAYPEN !Just so.
|
||||
INTEGER HAVE,TESTS !Parameters for the specified problem.
|
||||
PARAMETER (HAVE = 20, TESTS = 7) !Number of blocks, number of tests.
|
||||
CHARACTER*(MS) BLOCKS(HAVE) !Have blocks, will juggle.
|
||||
DATA BLOCKS/"BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS", !The specified set
|
||||
1 "JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"/ !Of letter blocks.
|
||||
CHARACTER*8 WORD(TESTS) !Now for the specified test words.
|
||||
LOGICAL ANS(TESTS),T,F !And the given results.
|
||||
PARAMETER (T = .TRUE., F = .FALSE.) !Enable a more compact specification.
|
||||
DATA WORD/"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"/ !So that these
|
||||
DATA ANS/ T , T , F , T , F , T , T / !Can be aligned.
|
||||
LOGICAL YAY
|
||||
INTEGER I
|
||||
|
||||
WRITE (MSG,1)
|
||||
1 FORMAT ("Arranges alphabet blocks, attending only to the ",
|
||||
1 "letters on the blocks, and ignoring case and orientation.",/)
|
||||
|
||||
CALL PLAY(HAVE,BLOCKS) !Some fun first.
|
||||
|
||||
WRITE (MSG,'(/"Now to see if some words can be spelled out.")')
|
||||
DO I = 1,TESTS
|
||||
CALL UPCASE(WORD(I))
|
||||
YAY = CANBLOCK(WORD(I),HAVE,BLOCKS)
|
||||
WRITE (MSG,*) YAY,ANS(I),YAY.EQ.ANS(I),WORD(I)
|
||||
END DO
|
||||
END
|
||||
39
Task/ABC-Problem/Kotlin/abc-problem.kotlin
Normal file
39
Task/ABC-Problem/Kotlin/abc-problem.kotlin
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
package abc
|
||||
|
||||
object ABC_block_checker {
|
||||
fun run() {
|
||||
val blocks = arrayOf("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM")
|
||||
|
||||
println("\"\": " + blocks.canMakeWord(""))
|
||||
val words = arrayOf("A", "BARK", "book", "treat", "COMMON", "SQuAd", "CONFUSE")
|
||||
for (w in words) println("$w: " + blocks.canMakeWord(w))
|
||||
}
|
||||
|
||||
private fun Array<String>.swap(i: Int, j: Int) {
|
||||
val tmp = this[i]
|
||||
this[i] = this[j]
|
||||
this[j] = tmp
|
||||
}
|
||||
|
||||
private fun Array<String>.canMakeWord(word: String): Boolean {
|
||||
if (word.length == 0)
|
||||
return true
|
||||
|
||||
val c = Character.toUpperCase(word.first())
|
||||
var i = 0
|
||||
forEach { b ->
|
||||
if (b.first().toUpperCase() == c || b[1].toUpperCase() == c) {
|
||||
swap(0, i)
|
||||
if (drop(1).toTypedArray().canMakeWord(word.substring(1)))
|
||||
return true
|
||||
swap(0, i)
|
||||
}
|
||||
i++
|
||||
}
|
||||
|
||||
return false
|
||||
}
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) = ABC_block_checker.run()
|
||||
42
Task/ABC-Problem/Liberty-BASIC/abc-problem-1.liberty
Normal file
42
Task/ABC-Problem/Liberty-BASIC/abc-problem-1.liberty
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
print "Rosetta Code - ABC problem (recursive solution)"
|
||||
print
|
||||
blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
|
||||
data "A"
|
||||
data "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"
|
||||
data "XYZZY"
|
||||
|
||||
do
|
||||
read text$
|
||||
if text$="XYZZY" then exit do
|
||||
print ">>> can_make_word("; chr$(34); text$; chr$(34); ")"
|
||||
if canDo(text$,blocks$) then print "True" else print "False"
|
||||
loop while 1
|
||||
print "Program complete."
|
||||
end
|
||||
|
||||
function canDo(text$,blocks$)
|
||||
'endcase
|
||||
if len(text$)=1 then canDo=(instr(blocks$,text$)<>0): exit function
|
||||
'get next letter
|
||||
ltr$=left$(text$,1)
|
||||
'cut
|
||||
if instr(blocks$,ltr$)=0 then canDo=0: exit function
|
||||
'recursion
|
||||
text$=mid$(text$,2) 'rest
|
||||
'loop by all word in blocks. Need to make "newBlocks" - all but taken
|
||||
'optimisation: take only fitting blocks
|
||||
wrd$="*"
|
||||
i=0
|
||||
while wrd$<>""
|
||||
i=i+1
|
||||
wrd$=word$(blocks$, i)
|
||||
if instr(wrd$, ltr$) then
|
||||
'newblocks without wrd$
|
||||
pos=instr(blocks$,wrd$)
|
||||
newblocks$=left$(blocks$, pos-1)+mid$(blocks$, pos+3)
|
||||
canDo=canDo(text$,newblocks$)
|
||||
'first found cuts
|
||||
if canDo then exit while
|
||||
end if
|
||||
wend
|
||||
end function
|
||||
133
Task/ABC-Problem/Liberty-BASIC/abc-problem-2.liberty
Normal file
133
Task/ABC-Problem/Liberty-BASIC/abc-problem-2.liberty
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
print "Rosetta Code - ABC problem (procedural solution)"
|
||||
print
|
||||
w$(1)="A"
|
||||
w$(2)="BARK"
|
||||
w$(3)="BOOK"
|
||||
w$(4)="TREAT"
|
||||
w$(5)="COMMON"
|
||||
w$(6)="SQUAD"
|
||||
w$(7)="CONFUSE"
|
||||
|
||||
for x=1 to 7
|
||||
print ">>> can_make_word("; chr$(34); w$(x); chr$(34); ")"
|
||||
if CanMakeWord(w$(x)) then print "True" else print "False"
|
||||
next x
|
||||
print "Program complete."
|
||||
end
|
||||
|
||||
function CanMakeWord(x$)
|
||||
global DoneWithWord, BlocksUsed, LetterOK, Possibility
|
||||
dim block$(20,2), block(20,2)
|
||||
'numeric blocks, col 0 flags used block
|
||||
block(1,1)=asc("B")-64: block(1,2)=asc("O")-64
|
||||
block(2,1)=asc("X")-64: block(2,2)=asc("K")-64
|
||||
block(3,1)=asc("D")-64: block(3,2)=asc("Q")-64
|
||||
block(4,1)=asc("C")-64: block(4,2)=asc("P")-64
|
||||
block(5,1)=asc("N")-64: block(5,2)=asc("A")-64
|
||||
block(6,1)=asc("G")-64: block(6,2)=asc("T")-64
|
||||
block(7,1)=asc("R")-64: block(7,2)=asc("E")-64
|
||||
block(8,1)=asc("T")-64: block(8,2)=asc("G")-64
|
||||
block(9,1)=asc("Q")-64: block(9,2)=asc("D")-64
|
||||
block(10,1)=asc("F")-64: block(10,2)=asc("S")-64
|
||||
block(11,1)=asc("J")-64: block(11,2)=asc("W")-64
|
||||
block(12,1)=asc("H")-64: block(12,2)=asc("U")-64
|
||||
block(13,1)=asc("V")-64: block(13,2)=asc("I")-64
|
||||
block(14,1)=asc("A")-64: block(14,2)=asc("N")-64
|
||||
block(15,1)=asc("O")-64: block(15,2)=asc("B")-64
|
||||
block(16,1)=asc("E")-64: block(16,2)=asc("R")-64
|
||||
block(17,1)=asc("F")-64: block(17,2)=asc("S")-64
|
||||
block(18,1)=asc("L")-64: block(18,2)=asc("Y")-64
|
||||
block(19,1)=asc("P")-64: block(19,2)=asc("C")-64
|
||||
block(20,1)=asc("Z")-64: block(20,2)=asc("M")-64
|
||||
|
||||
x$=upper$(x$)
|
||||
for x=1 to len(x$)
|
||||
y$=mid$(x$,x,1)
|
||||
if y$>="A" and y$<="Z" then w$=w$+y$
|
||||
next x
|
||||
if w$="" then exit function
|
||||
DoneWithWord=0: BlocksUsed=0
|
||||
l=len(w$)
|
||||
dim LetterOK(l)
|
||||
dim alphabet(26,1) 'clear letter-usage array
|
||||
for x=1 to 20 'load block letters into letter-usage array col 0
|
||||
alphabet(block(x,1),0)+=1
|
||||
alphabet(block(x,2),0)+=1
|
||||
next x
|
||||
for x=1 to l 'load current word into letter-usage aray col 1
|
||||
wl$=mid$(w$,x,1): w=asc(wl$)-64
|
||||
alphabet(w,1)+=1
|
||||
next x
|
||||
|
||||
for x=1 to 26 ' test for more of any letter in the word than in the blocks
|
||||
if alphabet(x,1)>alphabet(x,0) then exit function
|
||||
next x
|
||||
|
||||
[NextLetter]
|
||||
if wl<l then wl=wl+1 else goto [DoneWithWord]
|
||||
wl$=mid$(w$,wl,1): w=asc(wl$)-64
|
||||
LetterOK=0
|
||||
' if there's only one of the letter in the blocks then you must use that block
|
||||
if alphabet(w,0)=1 then
|
||||
call OnlyBlock w
|
||||
LetterOK(wl)=1
|
||||
if DoneWithWord then goto [DoneWithWord] else goto [NextLetter]
|
||||
end if
|
||||
' if more than one of the letter in the blocks, then try to use one that has
|
||||
' an unused letter on other side (a "Free Block")
|
||||
call FindFreeBlock w
|
||||
if LetterOK then LetterOK(wl)=1
|
||||
goto [NextLetter]
|
||||
|
||||
[DoneWithWord]
|
||||
if BlocksUsed=l then CanMakeWord=1: exit function
|
||||
if DoneWithWord then exit function
|
||||
for x=1 to l
|
||||
if not(LetterOK(x)) then
|
||||
NumericLetter=asc(mid$(w$,x,1))-64
|
||||
LetterOK=0
|
||||
call OnlyBlock NumericLetter
|
||||
if LetterOK then LetterOK(x)=1 else exit for
|
||||
end if
|
||||
next x
|
||||
goto [DoneWithWord]
|
||||
end function
|
||||
|
||||
sub OnlyBlock NumericLetter
|
||||
for x=1 to 20
|
||||
if (block(x, 1)=NumericLetter or block(x, 2)=NumericLetter) _
|
||||
and block(x, 0)=0 then
|
||||
call UseBlock x, NumericLetter
|
||||
exit sub
|
||||
end if
|
||||
next x
|
||||
DoneWithWord=1
|
||||
end sub
|
||||
|
||||
sub FindFreeBlock NumericLetter
|
||||
Possibility=0
|
||||
for x=1 to 20
|
||||
if block(x, 0)=0 then 'block not used
|
||||
if block(x,1)=NumericLetter then
|
||||
if alphabet(block(x,2),1)=0 then
|
||||
call UseBlock x, NumericLetter
|
||||
exit sub
|
||||
end if
|
||||
Possibility=Possibility+1
|
||||
end if
|
||||
if block(x,2)=NumericLetter then
|
||||
if alphabet(block(x,1),1)=0 then
|
||||
call UseBlock x, NumericLetter
|
||||
exit sub
|
||||
end if
|
||||
Possibility=Possibility+1
|
||||
end if
|
||||
end if
|
||||
next x
|
||||
end sub
|
||||
|
||||
sub UseBlock BlockNumber, NumericLetter
|
||||
block(BlockNumber, 0)=1 'Mark block as used
|
||||
BlocksUsed=BlocksUsed+1
|
||||
LetterOK=1
|
||||
end sub
|
||||
31
Task/ABC-Problem/Lua/abc-problem.lua
Normal file
31
Task/ABC-Problem/Lua/abc-problem.lua
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
blocks = {
|
||||
{"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"};
|
||||
};
|
||||
|
||||
function canUse(table, letter)
|
||||
for i,v in pairs(blocks) do
|
||||
if (v[1] == letter:upper() or v[2] == letter:upper()) and table[i] then
|
||||
table[i] = false;
|
||||
return true;
|
||||
end
|
||||
end
|
||||
return false;
|
||||
end
|
||||
|
||||
function canMake(Word)
|
||||
local Taken = {};
|
||||
for i,v in pairs(blocks) do
|
||||
table.insert(Taken,true);
|
||||
end
|
||||
local found = true;
|
||||
for i = 1,#Word do
|
||||
if not canUse(Taken,Word:sub(i,i)) then
|
||||
found = false;
|
||||
end
|
||||
end
|
||||
print(found)
|
||||
end
|
||||
22
Task/ABC-Problem/Maple/abc-problem.maple
Normal file
22
Task/ABC-Problem/Maple/abc-problem.maple
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
canSpell := proc(w)
|
||||
local blocks, i, j, word, letterFound;
|
||||
blocks := [["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"]];
|
||||
word := StringTools[UpperCase](convert(w, string));
|
||||
for i to length(word) do
|
||||
letterFound := false;
|
||||
for j to numelems(blocks) do
|
||||
if not letterFound and (substring(word, i) = blocks[j][1] or substring(word, i) = blocks[j][2]) then
|
||||
blocks[j][1] := undefined;
|
||||
blocks[j][2] := undefined;
|
||||
letterFound := true;
|
||||
end if;
|
||||
end do;
|
||||
if not letterFound then
|
||||
return false;
|
||||
end if;
|
||||
end do;
|
||||
return true;
|
||||
end proc:
|
||||
|
||||
seq(printf("%a: %a\n", i, canSpell(i)), i in [a, Bark, bOok, treat, COMMON, squad, confuse]);
|
||||
102
Task/ABC-Problem/OpenEdge-Progress/abc-problem.openedge
Normal file
102
Task/ABC-Problem/OpenEdge-Progress/abc-problem.openedge
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
FUNCTION canMakeWord RETURNS LOGICAL (INPUT pWord AS CHARACTER) FORWARD.
|
||||
|
||||
/* List of blocks */
|
||||
DEFINE TEMP-TABLE ttBlocks NO-UNDO
|
||||
FIELD ttFaces AS CHARACTER FORMAT "x(1)" EXTENT 2
|
||||
FIELD ttUsed AS LOGICAL.
|
||||
|
||||
/* Fill in list of blocks */
|
||||
RUN AddBlock("BO").
|
||||
RUN AddBlock("XK").
|
||||
RUN AddBlock("DQ").
|
||||
RUN AddBlock("CP").
|
||||
RUN AddBlock("NA").
|
||||
RUN AddBlock("GT").
|
||||
RUN AddBlock("Re").
|
||||
RUN AddBlock("TG").
|
||||
RUN AddBlock("QD").
|
||||
RUN AddBlock("FS").
|
||||
RUN AddBlock("JW").
|
||||
RUN AddBlock("HU").
|
||||
RUN AddBlock("VI").
|
||||
RUN AddBlock("AN").
|
||||
RUN AddBlock("OB").
|
||||
RUN AddBlock("ER").
|
||||
RUN AddBlock("FS").
|
||||
RUN AddBlock("LY").
|
||||
RUN AddBlock("PC").
|
||||
RUN AddBlock("ZM").
|
||||
|
||||
DEFINE VARIABLE chWords AS CHARACTER EXTENT 7 NO-UNDO.
|
||||
ASSIGN chWords[1] = "A"
|
||||
chWords[2] = "BARK"
|
||||
chWords[3] = "BOOK"
|
||||
chWords[4] = "TREAT"
|
||||
chWords[5] = "COMMON"
|
||||
chWords[6] = "SQUAD"
|
||||
chWords[7] = "CONFUSE".
|
||||
|
||||
DEFINE FRAME frmResult
|
||||
WITH NO-LABELS 7 DOWN USE-TEXT.
|
||||
|
||||
DEFINE VARIABLE i AS INTEGER NO-UNDO.
|
||||
DO i = 1 TO 7:
|
||||
DISPLAY chWords[i] + " = " + STRING(canMakeWord(chWords[i])) FORMAT "x(25)" WITH FRAME frmResult.
|
||||
DOWN WITH FRAME frmResult.
|
||||
END.
|
||||
|
||||
|
||||
PROCEDURE AddBlock:
|
||||
DEFINE INPUT PARAMETER i-chBlockvalue AS CHARACTER NO-UNDO.
|
||||
|
||||
IF (LENGTH(i-chBlockValue) <> 2)
|
||||
THEN RETURN ERROR.
|
||||
|
||||
CREATE ttBlocks.
|
||||
ASSIGN ttBlocks.ttFaces[1] = SUBSTRING(i-chBlockValue, 1, 1)
|
||||
ttBlocks.ttFaces[2] = SUBSTRING(i-chBlockValue, 2, 1).
|
||||
END PROCEDURE.
|
||||
|
||||
|
||||
FUNCTION blockInList RETURNS LOGICAL (pChar AS CHARACTER):
|
||||
/* Find first unused block in list */
|
||||
FIND FIRST ttBlocks WHERE (ttBlocks.ttFaces[1] = pChar
|
||||
OR ttBlocks.ttFaces[2] = pChar)
|
||||
AND NOT ttBlocks.ttUsed NO-ERROR.
|
||||
IF (AVAILABLE ttBlocks) THEN DO:
|
||||
/* found it! set to used and return true */
|
||||
ASSIGN ttBlocks.ttUsed = TRUE.
|
||||
RETURN TRUE.
|
||||
END.
|
||||
ELSE RETURN FALSE.
|
||||
END FUNCTION.
|
||||
|
||||
|
||||
FUNCTION canMakeWord RETURNS LOGICAL (INPUT pWord AS CHARACTER):
|
||||
DEFINE VARIABLE i AS INTEGER NO-UNDO.
|
||||
DEFINE VARIABLE chChar AS CHARACTER NO-UNDO.
|
||||
|
||||
/* Word has to be valid */
|
||||
IF (LENGTH(pWord) = 0)
|
||||
THEN RETURN FALSE.
|
||||
|
||||
DO i = 1 TO LENGTH(pWord):
|
||||
/* get the char */
|
||||
chChar = SUBSTRING(pWord, i, 1).
|
||||
|
||||
/* Check to see if this is a letter? */
|
||||
IF ((ASC(chChar) < 65) OR (ASC(chChar) > 90) AND
|
||||
(ASC(chChar) < 97) OR (ASC(chChar) > 122))
|
||||
THEN RETURN FALSE.
|
||||
|
||||
/* Is block is list (and unused) */
|
||||
IF NOT blockInList(chChar)
|
||||
THEN RETURN FALSE.
|
||||
END.
|
||||
|
||||
/* Reset all blocks */
|
||||
FOR EACH ttBlocks:
|
||||
ASSIGN ttUsed = FALSE.
|
||||
END.
|
||||
RETURN TRUE.
|
||||
END FUNCTION.
|
||||
18
Task/ABC-Problem/PARI-GP/abc-problem.pari
Normal file
18
Task/ABC-Problem/PARI-GP/abc-problem.pari
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
BLOCKS = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM";
|
||||
WORDS = ["A","Bark","BOOK","Treat","COMMON","SQUAD","conFUSE"];
|
||||
|
||||
can_make_word(w) = check(Vecsmall(BLOCKS), Vecsmall(w))
|
||||
|
||||
check(B,W,l=1,n=1) =
|
||||
{
|
||||
if (l > #W, return(1), n > #B, return(0));
|
||||
|
||||
forstep (i = 1, #B-2, 2,
|
||||
if (B[i] != bitand(W[l],223) && B[i+1] != bitand(W[l],223), next());
|
||||
B[i] = B[i+1] = 0;
|
||||
if (check(B, W, l+1, n+2), return(1))
|
||||
);
|
||||
0
|
||||
}
|
||||
|
||||
for (i = 1, #WORDS, printf("%s\t%d\n", WORDS[i], can_make_word(WORDS[i])));
|
||||
66
Task/ABC-Problem/Pascal/abc-problem.pascal
Normal file
66
Task/ABC-Problem/Pascal/abc-problem.pascal
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
#!/usr/bin/instantfpc
|
||||
//program ABCProblem;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses SysUtils, Classes;
|
||||
|
||||
const
|
||||
// every couple of chars is a block
|
||||
// remove one by replacing its 2 chars by 2 spaces
|
||||
Blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM';
|
||||
BlockSize = 3;
|
||||
|
||||
function can_make_word(Str: String): boolean;
|
||||
var
|
||||
wkBlocks: string = Blocks;
|
||||
c: Char;
|
||||
iPos : Integer;
|
||||
begin
|
||||
// all chars to uppercase
|
||||
Str := UpperCase(Str);
|
||||
Result := Str <> '';
|
||||
if Result then
|
||||
begin
|
||||
for c in Str do
|
||||
begin
|
||||
iPos := Pos(c, wkBlocks);
|
||||
if (iPos > 0) then
|
||||
begin
|
||||
// Char found
|
||||
wkBlocks[iPos] := ' ';
|
||||
// Remove the other face
|
||||
if (iPos mod BlockSize = 1) then
|
||||
wkBlocks[iPos + 1] := ' '
|
||||
else
|
||||
wkBlocks[iPos - 1] := ' ';
|
||||
end
|
||||
else
|
||||
begin
|
||||
// missed
|
||||
Result := False;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// Debug...
|
||||
//WriteLn(Blocks);
|
||||
//WriteLn(wkBlocks);
|
||||
End;
|
||||
|
||||
procedure TestABCProblem(Str: String);
|
||||
const
|
||||
boolStr : array[boolean] of String = ('False', 'True');
|
||||
begin
|
||||
WriteLn(Format('>>> can_make_word("%s")%s%s', [Str, LineEnding, boolStr[can_make_word(Str)]]));
|
||||
End;
|
||||
|
||||
begin
|
||||
TestABCProblem('A');
|
||||
TestABCProblem('BARK');
|
||||
TestABCProblem('BOOK');
|
||||
TestABCProblem('TREAT');
|
||||
TestABCProblem('COMMON');
|
||||
TestABCProblem('SQUAD');
|
||||
TestABCProblem('CONFUSE');
|
||||
END.
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
multi can-spell-word(Str $word, @blocks) {
|
||||
my @regex = @blocks.map({ EVAL "/{.comb.join('|')}/" }).grep: { .ACCEPTS($word.uc) }
|
||||
my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) }
|
||||
can-spell-word $word.uc.comb.list, @regex;
|
||||
}
|
||||
|
||||
|
|
|
|||
25
Task/ABC-Problem/Run-BASIC/abc-problem.run
Normal file
25
Task/ABC-Problem/Run-BASIC/abc-problem.run
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
blocks$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
|
||||
makeWord$ = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse"
|
||||
b = int((len(blocks$) /3) + 1)
|
||||
dim blk$(b)
|
||||
|
||||
for i = 1 to len(makeWord$)
|
||||
wrd$ = word$(makeWord$,i,",")
|
||||
dim hit(b)
|
||||
n = 0
|
||||
if wrd$ = "" then exit for
|
||||
for k = 1 to len(wrd$)
|
||||
w$ = upper$(mid$(wrd$,k,1))
|
||||
for j = 1 to b
|
||||
if hit(j) = 0 then
|
||||
if w$ = left$(word$(blocks$,j,","),1) or w$ = right$(word$(blocks$,j,","),1) then
|
||||
hit(j) = 1
|
||||
n = n + 1
|
||||
exit for
|
||||
end if
|
||||
end if
|
||||
next j
|
||||
next k
|
||||
print wrd$;chr$(9);
|
||||
if n = len(wrd$) then print " True" else print " False"
|
||||
next i
|
||||
21
Task/ABC-Problem/ZX-Spectrum-Basic/abc-problem.zx
Normal file
21
Task/ABC-Problem/ZX-Spectrum-Basic/abc-problem.zx
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
10 LET b$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
|
||||
20 READ p
|
||||
30 FOR c=1 TO p
|
||||
40 READ p$
|
||||
50 GO SUB 100
|
||||
60 NEXT c
|
||||
70 STOP
|
||||
80 DATA 7,"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"
|
||||
90 REM Can make?
|
||||
100 LET u$=b$
|
||||
110 PRINT "Can make word ";p$;"? ";
|
||||
120 FOR i=1 TO LEN p$
|
||||
130 FOR j=1 TO LEN u$
|
||||
140 IF p$(i)=u$(j) THEN GO SUB 200: GO TO 160
|
||||
150 NEXT j
|
||||
160 IF j>LEN u$ THEN PRINT "No": RETURN
|
||||
170 NEXT i
|
||||
180 PRINT "Yes": RETURN
|
||||
190 REM Erase pair
|
||||
200 IF j/2=INT (j/2) THEN LET u$(j-1 TO j)=" ": RETURN
|
||||
210 LET u$(j TO j+1)=" ": RETURN
|
||||
Loading…
Add table
Add a link
Reference in a new issue