Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,77 +1,77 @@
|
|||
org 100h
|
||||
jmp test
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Subroutine 'blocks': takes a $-terminated string in
|
||||
;;; DE containing a word, and checks whether it can be
|
||||
;;; written with the blocks.
|
||||
;;; Returns: carry flag set if word is accepted.
|
||||
;;; Uses registers: A, B, D, E, H, L
|
||||
blocks: push d ; Store string pointer
|
||||
lxi h,blockslist ; At the start, all blocks are
|
||||
lxi d,blocksavail ; available
|
||||
mvi b,40
|
||||
blocksinit: mov a,m
|
||||
stax d
|
||||
inx h
|
||||
inx d
|
||||
dcr b
|
||||
jnz blocksinit
|
||||
pop d ; Restore string pointer
|
||||
blockschar: ldax d ; Get current character
|
||||
cpi '$' ; End of string?
|
||||
stc ; Set carry flag (accept string)
|
||||
rz ; And then we're done
|
||||
ani 0DFh ; Make uppercase
|
||||
lxi h,blocksavail ; Is it available?
|
||||
mvi b,40
|
||||
blockscheck: cmp m
|
||||
jz blocksaccept ; Yes, we found it
|
||||
inx h ; Try next available char
|
||||
dcr b
|
||||
jnz blockscheck
|
||||
ana a ; Char unavailable, clear
|
||||
ret ; carry and stop.
|
||||
blocksaccept: mvi m,0 ; We've now used this char
|
||||
mov a,l ; And its blockmate
|
||||
xri 1
|
||||
mov l,a
|
||||
mvi m,0
|
||||
inx d ; Try next char in string
|
||||
jmp blockschar
|
||||
;; Note: 'blocksavail' must not cross page boundary
|
||||
blockslist: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
|
||||
blocksavail: ds 40
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Test code: run the subroutine on the given words.
|
||||
test: lxi h,words
|
||||
doword: mov e,m ; Get pointer to next word
|
||||
inx h
|
||||
mov d,m
|
||||
inx h
|
||||
mov a,e ; If zero, end of word list
|
||||
ora d
|
||||
rz
|
||||
push h ; Save pointer to list
|
||||
push d ; Save pointer to word
|
||||
mvi c,9 ; Write word to console
|
||||
call 5
|
||||
pop d ; Retrieve word ponter
|
||||
call blocks ; Run the 'blocks' routine
|
||||
lxi d,yes ; Say 'yes',
|
||||
jc yesno ; if the carry is set.
|
||||
lxi d,no ; Otherwise, say 'no'.
|
||||
yesno: mvi c,9
|
||||
call 5
|
||||
pop h ; Restore list pointer
|
||||
jmp doword ; Do next word
|
||||
yes: db ': Yes',13,10,'$'
|
||||
no: db ': No',13,10,'$'
|
||||
words: dw wrda,wrdbark,wrdbook,wrdtreat,wrdcommon
|
||||
dw wrdsquad,wrdconfuse,0
|
||||
wrda: db 'A$'
|
||||
wrdbark: db 'BARK$'
|
||||
wrdbook: db 'BOOK$'
|
||||
wrdtreat: db 'TREAT$'
|
||||
wrdcommon: db 'COMMON$'
|
||||
wrdsquad: db 'SQUAD$'
|
||||
wrdconfuse: db 'CONFUSE$'
|
||||
org 100h
|
||||
jmp test
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Subroutine 'blocks': takes a $-terminated string in
|
||||
;;; DE containing a word, and checks whether it can be
|
||||
;;; written with the blocks.
|
||||
;;; Returns: carry flag set if word is accepted.
|
||||
;;; Uses registers: A, B, D, E, H, L
|
||||
blocks: push d ; Store string pointer
|
||||
lxi h,blockslist ; At the start, all blocks are
|
||||
lxi d,blocksavail ; available
|
||||
mvi b,40
|
||||
blocksinit: mov a,m
|
||||
stax d
|
||||
inx h
|
||||
inx d
|
||||
dcr b
|
||||
jnz blocksinit
|
||||
pop d ; Restore string pointer
|
||||
blockschar: ldax d ; Get current character
|
||||
cpi '$' ; End of string?
|
||||
stc ; Set carry flag (accept string)
|
||||
rz ; And then we're done
|
||||
ani 0DFh ; Make uppercase
|
||||
lxi h,blocksavail ; Is it available?
|
||||
mvi b,40
|
||||
blockscheck: cmp m
|
||||
jz blocksaccept ; Yes, we found it
|
||||
inx h ; Try next available char
|
||||
dcr b
|
||||
jnz blockscheck
|
||||
ana a ; Char unavailable, clear
|
||||
ret ; carry and stop.
|
||||
blocksaccept: mvi m,0 ; We've now used this char
|
||||
mov a,l ; And its blockmate
|
||||
xri 1
|
||||
mov l,a
|
||||
mvi m,0
|
||||
inx d ; Try next char in string
|
||||
jmp blockschar
|
||||
;; Note: 'blocksavail' must not cross page boundary
|
||||
blockslist: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
|
||||
blocksavail: ds 40
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Test code: run the subroutine on the given words.
|
||||
test: lxi h,words
|
||||
doword: mov e,m ; Get pointer to next word
|
||||
inx h
|
||||
mov d,m
|
||||
inx h
|
||||
mov a,e ; If zero, end of word list
|
||||
ora d
|
||||
rz
|
||||
push h ; Save pointer to list
|
||||
push d ; Save pointer to word
|
||||
mvi c,9 ; Write word to console
|
||||
call 5
|
||||
pop d ; Retrieve word ponter
|
||||
call blocks ; Run the 'blocks' routine
|
||||
lxi d,yes ; Say 'yes',
|
||||
jc yesno ; if the carry is set.
|
||||
lxi d,no ; Otherwise, say 'no'.
|
||||
yesno: mvi c,9
|
||||
call 5
|
||||
pop h ; Restore list pointer
|
||||
jmp doword ; Do next word
|
||||
yes: db ': Yes',13,10,'$'
|
||||
no: db ': No',13,10,'$'
|
||||
words: dw wrda,wrdbark,wrdbook,wrdtreat,wrdcommon
|
||||
dw wrdsquad,wrdconfuse,0
|
||||
wrda: db 'A$'
|
||||
wrdbark: db 'BARK$'
|
||||
wrdbook: db 'BOOK$'
|
||||
wrdtreat: db 'TREAT$'
|
||||
wrdcommon: db 'COMMON$'
|
||||
wrdsquad: db 'SQUAD$'
|
||||
wrdconfuse: db 'CONFUSE$'
|
||||
|
|
|
|||
|
|
@ -1,63 +1,63 @@
|
|||
cpu 8086
|
||||
bits 16
|
||||
org 100h
|
||||
section .text
|
||||
jmp demo
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Subroutine "blocks": see if the $-terminated string in DS:BX
|
||||
;;; can be written with the blocks.
|
||||
;;; Returns: carry flag set if word is accepted.
|
||||
;;; Uses registers: AL, BX, CX, SI, DI
|
||||
;;; Assumes CS=DS=ES
|
||||
blocks: mov si,.list ; Set all blocks available
|
||||
mov di,.avail
|
||||
mov cx,20
|
||||
rep movsw
|
||||
.char: mov al,[bx] ; Get current character
|
||||
inc bx
|
||||
cmp al,'$' ; Are we at the end?
|
||||
je .ok ; Then the string is accepted
|
||||
mov cx,40 ; If not, check if block is available
|
||||
mov di,.avail
|
||||
repne scasb
|
||||
test cx,cx ; This clears the carry flag
|
||||
jz .out ; If zero, block is not available
|
||||
dec di ; Zero out the block we found
|
||||
mov [di],ch ; CH is guaranteed 0 here
|
||||
xor di,1 ; Point at other character on block
|
||||
mov [di],ch ; Zero out that one too.
|
||||
jmp .char
|
||||
.ok: stc
|
||||
.out: ret
|
||||
.list: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
|
||||
.avail: db ' '
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Test code: run the subroutine on the given words
|
||||
demo: mov bp,words
|
||||
wrd: mov dx,[bp] ; Get word
|
||||
test dx,dx ; End of words?
|
||||
jz stop
|
||||
mov ah,9 ; Print word
|
||||
int 21h
|
||||
mov bx,dx ; Run subroutine
|
||||
call blocks
|
||||
mov dx,yes ; Print yes or no depending on carry
|
||||
jc print
|
||||
mov dx,no
|
||||
print: mov ah,9
|
||||
int 21h
|
||||
inc bp
|
||||
inc bp
|
||||
jmp wrd
|
||||
stop: ret
|
||||
section .data
|
||||
yes: db ': Yes',13,10,'$'
|
||||
no: db ': No',13,10,'$'
|
||||
words: dw .a,.bark,.book,.treat,.cmn,.squad,.confs,0
|
||||
.a: db 'A$'
|
||||
.bark: db 'BARK$'
|
||||
.book: db 'BOOK$'
|
||||
.treat: db 'TREAT$'
|
||||
.cmn: db 'COMMON$'
|
||||
.squad: db 'SQUAD$'
|
||||
.confs: db 'CONFUSE$'
|
||||
cpu 8086
|
||||
bits 16
|
||||
org 100h
|
||||
section .text
|
||||
jmp demo
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Subroutine "blocks": see if the $-terminated string in DS:BX
|
||||
;;; can be written with the blocks.
|
||||
;;; Returns: carry flag set if word is accepted.
|
||||
;;; Uses registers: AL, BX, CX, SI, DI
|
||||
;;; Assumes CS=DS=ES
|
||||
blocks: mov si,.list ; Set all blocks available
|
||||
mov di,.avail
|
||||
mov cx,20
|
||||
rep movsw
|
||||
.char: mov al,[bx] ; Get current character
|
||||
inc bx
|
||||
cmp al,'$' ; Are we at the end?
|
||||
je .ok ; Then the string is accepted
|
||||
mov cx,40 ; If not, check if block is available
|
||||
mov di,.avail
|
||||
repne scasb
|
||||
test cx,cx ; This clears the carry flag
|
||||
jz .out ; If zero, block is not available
|
||||
dec di ; Zero out the block we found
|
||||
mov [di],ch ; CH is guaranteed 0 here
|
||||
xor di,1 ; Point at other character on block
|
||||
mov [di],ch ; Zero out that one too.
|
||||
jmp .char
|
||||
.ok: stc
|
||||
.out: ret
|
||||
.list: db 'BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM'
|
||||
.avail: db ' '
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Test code: run the subroutine on the given words
|
||||
demo: mov bp,words
|
||||
wrd: mov dx,[bp] ; Get word
|
||||
test dx,dx ; End of words?
|
||||
jz stop
|
||||
mov ah,9 ; Print word
|
||||
int 21h
|
||||
mov bx,dx ; Run subroutine
|
||||
call blocks
|
||||
mov dx,yes ; Print yes or no depending on carry
|
||||
jc print
|
||||
mov dx,no
|
||||
print: mov ah,9
|
||||
int 21h
|
||||
inc bp
|
||||
inc bp
|
||||
jmp wrd
|
||||
stop: ret
|
||||
section .data
|
||||
yes: db ': Yes',13,10,'$'
|
||||
no: db ': No',13,10,'$'
|
||||
words: dw .a,.bark,.book,.treat,.cmn,.squad,.confs,0
|
||||
.a: db 'A$'
|
||||
.bark: db 'BARK$'
|
||||
.book: db 'BOOK$'
|
||||
.treat: db 'TREAT$'
|
||||
.cmn: db 'COMMON$'
|
||||
.squad: db 'SQUAD$'
|
||||
.confs: db 'CONFUSE$'
|
||||
|
|
|
|||
|
|
@ -171,8 +171,8 @@ var ix
|
|||
' chkokpath s:each \ | path
|
||||
rdrop \
|
||||
success @ \ success
|
||||
if \
|
||||
break \
|
||||
if \
|
||||
break \
|
||||
then
|
||||
;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,78 +0,0 @@
|
|||
with Ada.Characters.Handling;
|
||||
use Ada.Characters.Handling;
|
||||
|
||||
|
||||
package Abc is
|
||||
type Block_Faces is array(1..2) of Character;
|
||||
type Block_List is array(positive range <>) of Block_Faces;
|
||||
function Can_Make_Word(W: String; Blocks: Block_List) return Boolean;
|
||||
end Abc;
|
||||
|
||||
|
||||
package body Abc is
|
||||
|
||||
function Can_Make_Word(W: String; Blocks: Block_List) return Boolean is
|
||||
Used : array(Blocks'Range) of Boolean := (Others => False);
|
||||
subtype wIndex is Integer range W'First..W'Last;
|
||||
wPos : wIndex;
|
||||
begin
|
||||
if W'Length = 0 then
|
||||
return True;
|
||||
end if;
|
||||
wPos := W'First;
|
||||
while True loop
|
||||
declare
|
||||
C : Character := To_Upper(W(wPos));
|
||||
X : constant wIndex := wPos;
|
||||
begin
|
||||
for I in Blocks'Range loop
|
||||
if (not Used(I)) then
|
||||
if C = To_Upper(Blocks(I)(1)) or C = To_Upper(Blocks(I)(2)) then
|
||||
Used(I) := True;
|
||||
if wPos = W'Last then
|
||||
return True;
|
||||
end if;
|
||||
wPos := wIndex'Succ(wPos);
|
||||
exit;
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
if X = wPos then
|
||||
return False;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
return False;
|
||||
end Can_Make_Word;
|
||||
|
||||
end Abc;
|
||||
|
||||
with Ada.Text_IO, Ada.Strings.Unbounded, Abc;
|
||||
use Ada.Text_IO, Ada.Strings.Unbounded, Abc;
|
||||
|
||||
procedure Abc_Problem is
|
||||
Blocks : Block_List := (
|
||||
('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 "+" (S : String) return Unbounded_String renames To_Unbounded_String;
|
||||
words : array(positive range <>) of Unbounded_String := (
|
||||
+"A"
|
||||
, +"BARK"
|
||||
, +"BOOK"
|
||||
, +"TREAT"
|
||||
, +"COMMON"
|
||||
, +"SQUAD"
|
||||
, +"CONFUSE"
|
||||
-- Border cases:
|
||||
-- , +"CONFUSE2"
|
||||
-- , +""
|
||||
);
|
||||
begin
|
||||
for I in words'Range loop
|
||||
Put_Line ( To_String(words(I)) & ": " & Boolean'Image(Can_Make_Word(To_String(words(I)),Blocks)) );
|
||||
end loop;
|
||||
end Abc_Problem;
|
||||
|
|
@ -16,8 +16,8 @@ canMakeWord?: function [wrd][
|
|||
ref: new blocks
|
||||
loop split wrd 'chr [
|
||||
cib: charInBlock chr ref
|
||||
if? cib = ø [ return false ]
|
||||
else [ ref: remove ref .index cib ]
|
||||
switch cib = ø [ return false ]
|
||||
[ ref: remove ref .index cib ]
|
||||
]
|
||||
return true
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,24 +1,24 @@
|
|||
isWordPossible(blocks, word){
|
||||
o := {}
|
||||
loop, parse, blocks, `n, `r
|
||||
o.Insert(A_LoopField)
|
||||
loop, parse, word
|
||||
if !(r := isWordPossible_contains(o, A_LoopField, word))
|
||||
return 0
|
||||
return 1
|
||||
o := {}
|
||||
loop, parse, blocks, `n, `r
|
||||
o.Insert(A_LoopField)
|
||||
loop, parse, word
|
||||
if !(r := isWordPossible_contains(o, A_LoopField, word))
|
||||
return 0
|
||||
return 1
|
||||
}
|
||||
isWordPossible_contains(byref o, letter, word){
|
||||
loop 2 {
|
||||
for k,v in o
|
||||
if Instr(v,letter)
|
||||
{
|
||||
StringReplace, op, v,% letter
|
||||
if RegExMatch(op, "[" word "]")
|
||||
sap := k
|
||||
else added := 1 , sap := k
|
||||
if added
|
||||
return "1" o.remove(sap)
|
||||
}
|
||||
added := 1
|
||||
}
|
||||
loop 2 {
|
||||
for k,v in o
|
||||
if Instr(v,letter)
|
||||
{
|
||||
StringReplace, op, v,% letter
|
||||
if RegExMatch(op, "[" word "]")
|
||||
sap := k
|
||||
else added := 1 , sap := k
|
||||
if added
|
||||
return "1" o.remove(sap)
|
||||
}
|
||||
added := 1
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -34,5 +34,5 @@ CONFUSE
|
|||
)"
|
||||
|
||||
loop, parse, wordlist, `n
|
||||
out .= A_LoopField " - " isWordPossible(blocks, A_LoopField) "`n"
|
||||
out .= A_LoopField " - " isWordPossible(blocks, A_LoopField) "`n"
|
||||
msgbox % out
|
||||
|
|
|
|||
|
|
@ -5,42 +5,42 @@ b = int((length(blocks$) /3) + 1)
|
|||
dim blk$(b)
|
||||
|
||||
for i = 1 to length(makeWord$)
|
||||
wrd$ = word$(makeWord$,i,",")
|
||||
dim hit(b)
|
||||
n = 0
|
||||
if wrd$ = "" then exit for
|
||||
for k = 1 to length(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 += 1
|
||||
exit for
|
||||
end if
|
||||
end if
|
||||
next j
|
||||
next k
|
||||
print wrd$; chr(9);
|
||||
if n = length(wrd$) then print " True" else print " False"
|
||||
wrd$ = word$(makeWord$,i,",")
|
||||
dim hit(b)
|
||||
n = 0
|
||||
if wrd$ = "" then exit for
|
||||
for k = 1 to length(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 += 1
|
||||
exit for
|
||||
end if
|
||||
end if
|
||||
next j
|
||||
next k
|
||||
print wrd$; chr(9);
|
||||
if n = length(wrd$) then print " True" else print " False"
|
||||
next i
|
||||
end
|
||||
|
||||
function word$(sr$, wn, delim$)
|
||||
j = wn
|
||||
if j = 0 then j += 1
|
||||
res$ = "" : s$ = sr$ : d$ = delim$
|
||||
if d$ = "" then d$ = " "
|
||||
sd = length(d$) : sl = length(s$)
|
||||
while true
|
||||
n = instr(s$,d$) : j -= 1
|
||||
if j = 0 then
|
||||
if n = 0 then res$ = s$ else res$ = mid(s$,1,n-1)
|
||||
return res$
|
||||
end if
|
||||
if n = 0 then return res$
|
||||
if n = sl - sd then res$ = "" : return res$
|
||||
sl2 = sl-n : s$ = mid(s$,n+1,sl2) : sl = sl2
|
||||
end while
|
||||
return res$
|
||||
j = wn
|
||||
if j = 0 then j += 1
|
||||
res$ = "" : s$ = sr$ : d$ = delim$
|
||||
if d$ = "" then d$ = " "
|
||||
sd = length(d$) : sl = length(s$)
|
||||
while true
|
||||
n = instr(s$,d$) : j -= 1
|
||||
if j = 0 then
|
||||
if n = 0 then res$ = s$ else res$ = mid(s$,1,n-1)
|
||||
return res$
|
||||
end if
|
||||
if n = 0 then return res$
|
||||
if n = sl - sd then res$ = "" : return res$
|
||||
sl2 = sl-n : s$ = mid(s$,n+1,sl2) : sl = sl2
|
||||
end while
|
||||
return res$
|
||||
end function
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ import ballerina/io;
|
|||
function r(string word, string[] bl) returns boolean {
|
||||
if word == "" { return true; }
|
||||
int c = word[0].toBytes()[0] | 32;
|
||||
foreach int i in 0..<bl.length() {
|
||||
foreach int i in 0..<bl.length() {
|
||||
var b = bl[i];
|
||||
if c == (b.toBytes()[0] | 32) || c == (b.toBytes()[1] | 32) {
|
||||
bl[i] = bl[0];
|
||||
|
|
@ -13,8 +13,8 @@ function r(string word, string[] bl) returns boolean {
|
|||
bl[i] = bl[0];
|
||||
bl[0] = t;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
function newSpeller(string blocks) returns (function(string) returns boolean) {
|
||||
|
|
|
|||
|
|
@ -3,80 +3,80 @@ using System.Linq;
|
|||
|
||||
void Main()
|
||||
{
|
||||
List<string> blocks =
|
||||
new List<string>() { "bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs",
|
||||
"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm" };
|
||||
List<string> words = new List<string>() {
|
||||
"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"};
|
||||
|
||||
var solver = new ABC(blocks);
|
||||
|
||||
foreach( var word in words)
|
||||
{
|
||||
Console.WriteLine("{0} :{1}", word, solver.CanMake(word));
|
||||
}
|
||||
List<string> blocks =
|
||||
new List<string>() { "bo", "xk", "dq", "cp", "na", "gt", "re", "tg", "qd", "fs",
|
||||
"jw", "hu", "vi", "an", "ob", "er", "fs", "ly", "pc", "zm" };
|
||||
List<string> words = new List<string>() {
|
||||
"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"};
|
||||
|
||||
var solver = new ABC(blocks);
|
||||
|
||||
foreach( var word in words)
|
||||
{
|
||||
Console.WriteLine("{0} :{1}", word, solver.CanMake(word));
|
||||
}
|
||||
}
|
||||
|
||||
class ABC
|
||||
{
|
||||
readonly Dictionary<char, List<int>> _blockDict = new Dictionary<char, List<int>>();
|
||||
bool[] _used;
|
||||
int _nextBlock;
|
||||
readonly Dictionary<char, List<int>> _blockDict = new Dictionary<char, List<int>>();
|
||||
bool[] _used;
|
||||
int _nextBlock;
|
||||
|
||||
readonly List<string> _blocks;
|
||||
readonly List<string> _blocks;
|
||||
|
||||
private void AddBlockChar(char c)
|
||||
{
|
||||
if (!_blockDict.ContainsKey(c))
|
||||
{
|
||||
_blockDict[c] = new List<int>();
|
||||
}
|
||||
_blockDict[c].Add(_nextBlock);
|
||||
}
|
||||
private void AddBlockChar(char c)
|
||||
{
|
||||
if (!_blockDict.ContainsKey(c))
|
||||
{
|
||||
_blockDict[c] = new List<int>();
|
||||
}
|
||||
_blockDict[c].Add(_nextBlock);
|
||||
}
|
||||
|
||||
private void AddBlock(string block)
|
||||
{
|
||||
AddBlockChar(block[0]);
|
||||
AddBlockChar(block[1]);
|
||||
_nextBlock++;
|
||||
}
|
||||
private void AddBlock(string block)
|
||||
{
|
||||
AddBlockChar(block[0]);
|
||||
AddBlockChar(block[1]);
|
||||
_nextBlock++;
|
||||
}
|
||||
|
||||
public ABC(List<string> blocks)
|
||||
{
|
||||
_blocks = blocks;
|
||||
foreach (var block in blocks)
|
||||
{
|
||||
AddBlock(block);
|
||||
}
|
||||
}
|
||||
public ABC(List<string> blocks)
|
||||
{
|
||||
_blocks = blocks;
|
||||
foreach (var block in blocks)
|
||||
{
|
||||
AddBlock(block);
|
||||
}
|
||||
}
|
||||
|
||||
public bool CanMake(string word)
|
||||
{
|
||||
word = word.ToLower();
|
||||
if (word.Length > _blockDict.Count)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
_used = new bool[_blocks.Count];
|
||||
return TryMake(word);
|
||||
}
|
||||
public bool CanMake(string word)
|
||||
{
|
||||
word = word.ToLower();
|
||||
if (word.Length > _blockDict.Count)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
_used = new bool[_blocks.Count];
|
||||
return TryMake(word);
|
||||
}
|
||||
|
||||
public bool TryMake(string word)
|
||||
{
|
||||
if (word == string.Empty)
|
||||
{
|
||||
return true;
|
||||
}
|
||||
var blocks = _blockDict[word[0]].Where(b => !_used[b]);
|
||||
foreach (var block in blocks)
|
||||
{
|
||||
_used[block] = true;
|
||||
if (TryMake(word.Substring(1)))
|
||||
{
|
||||
return true;
|
||||
}
|
||||
_used[block] = false;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
public bool TryMake(string word)
|
||||
{
|
||||
if (word == string.Empty)
|
||||
{
|
||||
return true;
|
||||
}
|
||||
var blocks = _blockDict[word[0]].Where(b => !_used[b]);
|
||||
foreach (var block in blocks)
|
||||
{
|
||||
_used[block] = true;
|
||||
if (TryMake(word.Substring(1)))
|
||||
{
|
||||
return true;
|
||||
}
|
||||
_used[block] = false;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,39 +3,39 @@
|
|||
|
||||
int can_make_words(char **b, char *word)
|
||||
{
|
||||
int i, ret = 0, c = toupper(*word);
|
||||
int i, ret = 0, c = toupper(*word);
|
||||
|
||||
#define SWAP(a, b) if (a != b) { char * tmp = a; a = b; b = tmp; }
|
||||
|
||||
if (!c) return 1;
|
||||
if (!b[0]) return 0;
|
||||
if (!c) return 1;
|
||||
if (!b[0]) return 0;
|
||||
|
||||
for (i = 0; b[i] && !ret; i++) {
|
||||
if (b[i][0] != c && b[i][1] != c) continue;
|
||||
SWAP(b[i], b[0]);
|
||||
ret = can_make_words(b + 1, word + 1);
|
||||
SWAP(b[i], b[0]);
|
||||
}
|
||||
for (i = 0; b[i] && !ret; i++) {
|
||||
if (b[i][0] != c && b[i][1] != c) continue;
|
||||
SWAP(b[i], b[0]);
|
||||
ret = can_make_words(b + 1, word + 1);
|
||||
SWAP(b[i], b[0]);
|
||||
}
|
||||
|
||||
return ret;
|
||||
return ret;
|
||||
}
|
||||
|
||||
int main(void)
|
||||
{
|
||||
char* blocks[] = {
|
||||
"BO", "XK", "DQ", "CP", "NA",
|
||||
"GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB",
|
||||
"ER", "FS", "LY", "PC", "ZM",
|
||||
0 };
|
||||
char* blocks[] = {
|
||||
"BO", "XK", "DQ", "CP", "NA",
|
||||
"GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB",
|
||||
"ER", "FS", "LY", "PC", "ZM",
|
||||
0 };
|
||||
|
||||
char *words[] = {
|
||||
"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse", 0
|
||||
};
|
||||
char *words[] = {
|
||||
"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse", 0
|
||||
};
|
||||
|
||||
char **w;
|
||||
for (w = words; *w; w++)
|
||||
printf("%s\t%d\n", *w, can_make_words(blocks, *w));
|
||||
char **w;
|
||||
for (w = words; *w; w++)
|
||||
printf("%s\t%d\n", *w, can_make_words(blocks, *w));
|
||||
|
||||
return 0;
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,84 +1,84 @@
|
|||
MODULE ABCProblem;
|
||||
IMPORT
|
||||
StdLog, DevCommanders, TextMappers;
|
||||
StdLog, DevCommanders, TextMappers;
|
||||
CONST
|
||||
notfound = -1;
|
||||
TYPE
|
||||
String = ARRAY 3 OF CHAR;
|
||||
notfound = -1;
|
||||
TYPE
|
||||
String = ARRAY 3 OF CHAR;
|
||||
VAR
|
||||
blocks : ARRAY 20 OF String;
|
||||
|
||||
blocks : ARRAY 20 OF String;
|
||||
|
||||
PROCEDURE Check(s: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
used: SET;
|
||||
i,blockIndex: INTEGER;
|
||||
|
||||
PROCEDURE GetBlockFor(c: CHAR): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
c := CAP(c);
|
||||
i := 0;
|
||||
WHILE (i < LEN(blocks)) DO
|
||||
IF (c = blocks[i][0]) OR (c = blocks[i][1]) THEN
|
||||
IF ~(i IN used) THEN RETURN i END
|
||||
END;
|
||||
INC(i)
|
||||
END;
|
||||
RETURN notfound
|
||||
END GetBlockFor;
|
||||
|
||||
used: SET;
|
||||
i,blockIndex: INTEGER;
|
||||
|
||||
PROCEDURE GetBlockFor(c: CHAR): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
c := CAP(c);
|
||||
i := 0;
|
||||
WHILE (i < LEN(blocks)) DO
|
||||
IF (c = blocks[i][0]) OR (c = blocks[i][1]) THEN
|
||||
IF ~(i IN used) THEN RETURN i END
|
||||
END;
|
||||
INC(i)
|
||||
END;
|
||||
RETURN notfound
|
||||
END GetBlockFor;
|
||||
|
||||
BEGIN
|
||||
used := {};
|
||||
FOR i := 0 TO LEN(s$) - 1 DO
|
||||
blockIndex := GetBlockFor(s[i]);
|
||||
IF blockIndex = notfound THEN
|
||||
RETURN FALSE
|
||||
ELSE
|
||||
INCL(used,blockIndex)
|
||||
END
|
||||
END;
|
||||
RETURN TRUE
|
||||
END Check;
|
||||
used := {};
|
||||
FOR i := 0 TO LEN(s$) - 1 DO
|
||||
blockIndex := GetBlockFor(s[i]);
|
||||
IF blockIndex = notfound THEN
|
||||
RETURN FALSE
|
||||
ELSE
|
||||
INCL(used,blockIndex)
|
||||
END
|
||||
END;
|
||||
RETURN TRUE
|
||||
END Check;
|
||||
|
||||
PROCEDURE CanMakeWord*;
|
||||
VAR
|
||||
s: TextMappers.Scanner;
|
||||
s: TextMappers.Scanner;
|
||||
BEGIN
|
||||
s.ConnectTo(DevCommanders.par.text);
|
||||
s.SetPos(DevCommanders.par.beg);
|
||||
s.Scan;
|
||||
WHILE (~s.rider.eot) DO
|
||||
IF (s.type = TextMappers.char) & (s.char = '~') THEN
|
||||
RETURN
|
||||
ELSIF (s.type = TextMappers.string) THEN
|
||||
StdLog.String(s.string);StdLog.String(":> ");
|
||||
StdLog.Bool(Check(s.string));StdLog.Ln
|
||||
END;
|
||||
s.Scan
|
||||
END
|
||||
s.ConnectTo(DevCommanders.par.text);
|
||||
s.SetPos(DevCommanders.par.beg);
|
||||
s.Scan;
|
||||
WHILE (~s.rider.eot) DO
|
||||
IF (s.type = TextMappers.char) & (s.char = '~') THEN
|
||||
RETURN
|
||||
ELSIF (s.type = TextMappers.string) THEN
|
||||
StdLog.String(s.string);StdLog.String(":> ");
|
||||
StdLog.Bool(Check(s.string));StdLog.Ln
|
||||
END;
|
||||
s.Scan
|
||||
END
|
||||
END CanMakeWord;
|
||||
|
||||
BEGIN
|
||||
blocks[0] := "BO";
|
||||
blocks[1] := "XK";
|
||||
blocks[2] := "DQ";
|
||||
blocks[3] := "CP";
|
||||
blocks[4] := "NA";
|
||||
blocks[5] := "GT";
|
||||
blocks[6] := "RE";
|
||||
blocks[7] := "TG";
|
||||
blocks[8] := "QD";
|
||||
blocks[9] := "FS";
|
||||
blocks[10] := "JW";
|
||||
blocks[11] := "HU";
|
||||
blocks[12] := "VI";
|
||||
blocks[13] := "AN";
|
||||
blocks[14] := "OB";
|
||||
blocks[15] := "ER";
|
||||
blocks[16] := "FS";
|
||||
blocks[17] := "LY";
|
||||
blocks[18] := "PC";
|
||||
blocks[19] := "ZM";
|
||||
|
||||
blocks[0] := "BO";
|
||||
blocks[1] := "XK";
|
||||
blocks[2] := "DQ";
|
||||
blocks[3] := "CP";
|
||||
blocks[4] := "NA";
|
||||
blocks[5] := "GT";
|
||||
blocks[6] := "RE";
|
||||
blocks[7] := "TG";
|
||||
blocks[8] := "QD";
|
||||
blocks[9] := "FS";
|
||||
blocks[10] := "JW";
|
||||
blocks[11] := "HU";
|
||||
blocks[12] := "VI";
|
||||
blocks[13] := "AN";
|
||||
blocks[14] := "OB";
|
||||
blocks[15] := "ER";
|
||||
blocks[16] := "FS";
|
||||
blocks[17] := "LY";
|
||||
blocks[18] := "PC";
|
||||
blocks[19] := "ZM";
|
||||
|
||||
END ABCProblem.
|
||||
|
|
|
|||
|
|
@ -24,5 +24,5 @@ writeLine("word".padEnd(11, " "), "|", "canMakeWord", "|", "isCorrect")
|
|||
for each text word in words
|
||||
writeLine(word.padEnd(11, " "), "|",
|
||||
(text!canMakeWord(word)).padEnd(11, " "), "|",
|
||||
(canMakeWord(word) æ checks[wordIndex]))
|
||||
(canMakeWord(word) æ checks[wordIndex]))
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,16 +1,15 @@
|
|||
(lib 'list) ;; list-delete
|
||||
|
||||
(define BLOCKS '("BO" "XK" "DQ" "CP" "NA" "GT" "RE" "TG" "QD" "FS"
|
||||
"JW" "HU" "VI" "AN" "OB" "ER" "FS" "LY" "PC" "ZM" ))
|
||||
|
||||
"JW" "HU" "VI" "AN" "OB" "ER" "FS" "LY" "PC" "ZM" ))
|
||||
|
||||
(define WORDS '("A" "BARK" "BOOK" "TREAT" "COMMON" "SQUAD" "CONFUSE"))
|
||||
|
||||
|
||||
(define (spell word blocks)
|
||||
(cond
|
||||
((string-empty? word) #t)
|
||||
((empty? blocks) #f)
|
||||
(else
|
||||
(for/or [(block blocks)]
|
||||
#:continue (not (string-match block (string-first word)))
|
||||
(spell (string-rest word) (list-delete blocks block))))))
|
||||
|
||||
((string-empty? word) #t)
|
||||
((empty? blocks) #f)
|
||||
(else
|
||||
(for/or [(block blocks)]
|
||||
#:continue (not (string-match block (string-first word)))
|
||||
(spell (string-rest word) (list-delete blocks block))))))
|
||||
|
|
|
|||
|
|
@ -27,14 +27,14 @@ extension op
|
|||
}
|
||||
}
|
||||
|
||||
public program()
|
||||
public Program()
|
||||
{
|
||||
var blocks := new string[]{"BO", "XK", "DQ", "CP", "NA",
|
||||
"GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB",
|
||||
"ER", "FS", "LY", "PC", "ZM"};
|
||||
auto blocks := new const string[]{"BO", "XK", "DQ", "CP", "NA",
|
||||
"GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB",
|
||||
"ER", "FS", "LY", "PC", "ZM"};
|
||||
|
||||
var words := new string[]{"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
|
||||
auto words := new const string[]{"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
|
||||
|
||||
Enumerator e := words.enumerator();
|
||||
e.next();
|
||||
|
|
|
|||
|
|
@ -1,35 +0,0 @@
|
|||
include std/text.e
|
||||
|
||||
sequence 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'}}
|
||||
sequence words = {"A","BarK","BOOK","TrEaT","COMMON","SQUAD","CONFUSE"}
|
||||
|
||||
sequence current_word
|
||||
sequence temp
|
||||
integer matches
|
||||
|
||||
for i = 1 to length(words) do
|
||||
current_word = upper(words[i])
|
||||
temp = blocks
|
||||
matches = 0
|
||||
for j = 1 to length(current_word) do
|
||||
for k = 1 to length(temp) do
|
||||
if find(current_word[j],temp[k]) then
|
||||
temp = remove(temp,k)
|
||||
matches += 1
|
||||
exit
|
||||
end if
|
||||
end for
|
||||
if length(current_word) = matches then
|
||||
printf(1,"%s: TRUE\n",{words[i]})
|
||||
exit
|
||||
end if
|
||||
end for
|
||||
if length(current_word) != matches then
|
||||
printf(1,"%s: FALSE\n",{words[i]})
|
||||
end if
|
||||
end for
|
||||
|
||||
if getc(0) then end if
|
||||
|
|
@ -1,44 +1,44 @@
|
|||
#APPTYPE CONSOLE
|
||||
SUB MAIN()
|
||||
BlockCheck("A")
|
||||
BlockCheck("BARK")
|
||||
BlockCheck("BooK")
|
||||
BlockCheck("TrEaT")
|
||||
BlockCheck("comMON")
|
||||
BlockCheck("sQuAd")
|
||||
BlockCheck("Confuse")
|
||||
pause
|
||||
BlockCheck("A")
|
||||
BlockCheck("BARK")
|
||||
BlockCheck("BooK")
|
||||
BlockCheck("TrEaT")
|
||||
BlockCheck("comMON")
|
||||
BlockCheck("sQuAd")
|
||||
BlockCheck("Confuse")
|
||||
pause
|
||||
END SUB
|
||||
|
||||
FUNCTION BlockCheck(str)
|
||||
print str " " iif( Blockable( str ), "can", "cannot" ) " be spelled with blocks."
|
||||
print str " " iif( Blockable( str ), "can", "cannot" ) " be spelled with blocks."
|
||||
END FUNCTION
|
||||
|
||||
FUNCTION Blockable(str AS STRING)
|
||||
DIM blocks AS STRING = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
|
||||
DIM C AS STRING = ""
|
||||
DIM POS AS INTEGER = 0
|
||||
|
||||
FOR DIM I = 1 TO LEN(str)
|
||||
C = str{i}
|
||||
POS = INSTR(BLOCKS, C, 0, 1) 'case insensitive
|
||||
IF POS > 0 THEN
|
||||
'if the pos is odd, it's the first of the pair
|
||||
IF POS MOD 2 = 1 THEN
|
||||
'so clear the first and the second
|
||||
poke(@blocks + pos - 1," ")
|
||||
poke(@blocks + pos," ")
|
||||
'otherwise, it's the last of the pair
|
||||
ELSE
|
||||
'clear the second and the first
|
||||
poke(@blocks + pos - 1," ")
|
||||
poke(@blocks + pos - 2," ")
|
||||
END IF
|
||||
ELSE
|
||||
'not found, so can't be spelled
|
||||
RETURN FALSE
|
||||
END IF
|
||||
NEXT
|
||||
'got thru to here, so can be spelled
|
||||
RETURN TRUE
|
||||
DIM blocks AS STRING = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"
|
||||
DIM C AS STRING = ""
|
||||
DIM POS AS INTEGER = 0
|
||||
|
||||
FOR DIM I = 1 TO LEN(str)
|
||||
C = str{i}
|
||||
POS = INSTR(BLOCKS, C, 0, 1) 'case insensitive
|
||||
IF POS > 0 THEN
|
||||
'if the pos is odd, it's the first of the pair
|
||||
IF POS MOD 2 = 1 THEN
|
||||
'so clear the first and the second
|
||||
poke(@blocks + pos - 1," ")
|
||||
poke(@blocks + pos," ")
|
||||
'otherwise, it's the last of the pair
|
||||
ELSE
|
||||
'clear the second and the first
|
||||
poke(@blocks + pos - 1," ")
|
||||
poke(@blocks + pos - 2," ")
|
||||
END IF
|
||||
ELSE
|
||||
'not found, so can't be spelled
|
||||
RETURN FALSE
|
||||
END IF
|
||||
NEXT
|
||||
'got thru to here, so can be spelled
|
||||
RETURN TRUE
|
||||
END FUNCTION
|
||||
|
|
|
|||
|
|
@ -1,264 +1,264 @@
|
|||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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 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...
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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?
|
||||
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!
|
||||
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?
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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.
|
||||
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
|
||||
|
||||
|
|
@ -266,7 +266,7 @@ Completed!
|
|||
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.
|
||||
CALL PLAY(HAVE,BLOCKS) !Some fun first.
|
||||
|
||||
WRITE (MSG,'(/"Now to see if some words can be spelled out.")')
|
||||
DO I = 1,TESTS
|
||||
|
|
|
|||
|
|
@ -1,39 +1,39 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"strings"
|
||||
"fmt"
|
||||
"strings"
|
||||
)
|
||||
|
||||
func newSpeller(blocks string) func(string) bool {
|
||||
bl := strings.Fields(blocks)
|
||||
return func(word string) bool {
|
||||
return r(word, bl)
|
||||
}
|
||||
bl := strings.Fields(blocks)
|
||||
return func(word string) bool {
|
||||
return r(word, bl)
|
||||
}
|
||||
}
|
||||
|
||||
func r(word string, bl []string) bool {
|
||||
if word == "" {
|
||||
return true
|
||||
}
|
||||
c := word[0] | 32
|
||||
for i, b := range bl {
|
||||
if c == b[0]|32 || c == b[1]|32 {
|
||||
bl[i], bl[0] = bl[0], b
|
||||
if r(word[1:], bl[1:]) == true {
|
||||
return true
|
||||
}
|
||||
bl[i], bl[0] = bl[0], bl[i]
|
||||
}
|
||||
}
|
||||
return false
|
||||
if word == "" {
|
||||
return true
|
||||
}
|
||||
c := word[0] | 32
|
||||
for i, b := range bl {
|
||||
if c == b[0]|32 || c == b[1]|32 {
|
||||
bl[i], bl[0] = bl[0], b
|
||||
if r(word[1:], bl[1:]) == true {
|
||||
return true
|
||||
}
|
||||
bl[i], bl[0] = bl[0], bl[i]
|
||||
}
|
||||
}
|
||||
return false
|
||||
}
|
||||
|
||||
func main() {
|
||||
sp := newSpeller(
|
||||
"BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM")
|
||||
for _, word := range []string{
|
||||
"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"} {
|
||||
fmt.Println(word, sp(word))
|
||||
}
|
||||
sp := newSpeller(
|
||||
"BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM")
|
||||
for _, word := range []string{
|
||||
"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"} {
|
||||
fmt.Println(word, sp(word))
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,5 +7,5 @@
|
|||
(.. and (map in-block? word)))
|
||||
|
||||
(-> ["A" "bark" "Book" "TREAT" "Common" "squaD" "CoNFuSe"] ; Notice case insensitivity
|
||||
(map #(str % " => " (can-make-word %)))
|
||||
(map #"{%} => {can-make-word %}")
|
||||
(join ", "))
|
||||
|
|
|
|||
|
|
@ -1,37 +1,37 @@
|
|||
fp.canMakeWord = ($word, $blocks) -> {
|
||||
if(!$word) {
|
||||
return 1
|
||||
}
|
||||
|
||||
$word = fn.toLower($word)
|
||||
|
||||
$c $= $word[0]
|
||||
$i = 0
|
||||
while($i < @$blocks) {
|
||||
$block $= fn.toLower($blocks[$i])
|
||||
|
||||
if($block[0] != $c && $block[1] != $c) {
|
||||
$i += 1
|
||||
|
||||
con.continue
|
||||
}
|
||||
|
||||
$blocksCopy $= ^$blocks
|
||||
fn.listRemoveAt($blocksCopy, $i)
|
||||
|
||||
if(fp.canMakeWord(fn.substring($word, 1), $blocksCopy)) {
|
||||
return 1
|
||||
}
|
||||
|
||||
$i += 1
|
||||
}
|
||||
|
||||
return 0
|
||||
if(!$word) {
|
||||
return 1
|
||||
}
|
||||
|
||||
$word = fn.toLower($word)
|
||||
|
||||
$c $= $word[0]
|
||||
$i = 0
|
||||
while($i < @$blocks) {
|
||||
$block $= fn.toLower($blocks[$i])
|
||||
|
||||
if($block[0] != $c && $block[1] != $c) {
|
||||
$i += 1
|
||||
|
||||
con.continue
|
||||
}
|
||||
|
||||
$blocksCopy $= ^$blocks
|
||||
fn.listRemoveAt($blocksCopy, $i)
|
||||
|
||||
if(fp.canMakeWord(fn.substring($word, 1), $blocksCopy)) {
|
||||
return 1
|
||||
}
|
||||
|
||||
$i += 1
|
||||
}
|
||||
|
||||
return 0
|
||||
}
|
||||
|
||||
$blocks = fn.listOf(BO, XK, DQ, CP, NA, GT, RE, TG, QD, FS, JW, HU, VI, AN, OB, ER, FS, LY, PC, ZM)
|
||||
|
||||
$word
|
||||
foreach($[word], [\e, A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE, Treat, cOmMoN]) {
|
||||
fn.printf(%s: %s%n, $word, fp.canMakeWord($word, $blocks))
|
||||
fn.printf(%s: %s%n, $word, fp.canMakeWord($word, $blocks))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,31 +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"};
|
||||
};
|
||||
{"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;
|
||||
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)
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,98 +1,98 @@
|
|||
-- This is the blocks array
|
||||
global GlobalBlocks = #("BO","XK","DQ","CP","NA", \
|
||||
"GT","RE","TG","QD","FS", \
|
||||
"JW","HU","VI","AN","OB", \
|
||||
"ER","FS","LY","PC","ZM")
|
||||
"GT","RE","TG","QD","FS", \
|
||||
"JW","HU","VI","AN","OB", \
|
||||
"ER","FS","LY","PC","ZM")
|
||||
|
||||
-- This function returns true if "_str" is part of "_word", false otherwise
|
||||
fn occurs _str _word =
|
||||
(
|
||||
if _str != undefined and _word != undefined then
|
||||
(
|
||||
matchpattern _word pattern:("*"+_str+"*")
|
||||
) else return false
|
||||
if _str != undefined and _word != undefined then
|
||||
(
|
||||
matchpattern _word pattern:("*"+_str+"*")
|
||||
) else return false
|
||||
)
|
||||
|
||||
-- This is the main function
|
||||
fn isWordPossible word blocks: = -- blocks is a keyword argument
|
||||
(
|
||||
word = toupper word -- convert the string to upper case, to make it case insensitive
|
||||
if blocks == unsupplied do blocks = GlobalBlocks
|
||||
-- if blocks (keyword argument) is unsupplied, use the global blocks array (this is for recursion)
|
||||
|
||||
blocks = deepcopy blocks
|
||||
word = toupper word -- convert the string to upper case, to make it case insensitive
|
||||
if blocks == unsupplied do blocks = GlobalBlocks
|
||||
-- if blocks (keyword argument) is unsupplied, use the global blocks array (this is for recursion)
|
||||
|
||||
local pos = 1 -- start at the beginning of the word
|
||||
local solvedLetters = #() -- this array stores the indices of solved letters
|
||||
|
||||
while pos <= word.count do -- loop through every character in the word
|
||||
(
|
||||
local possibleBlocks = #() -- this array stores the blocks which can be used to make that letter
|
||||
for b = 1 to Blocks.count do -- this loop finds all the possible blocks that can be used to make that letter
|
||||
(
|
||||
if occurs word[pos] blocks[b] do
|
||||
(
|
||||
appendifunique possibleBlocks b
|
||||
)
|
||||
)
|
||||
if possibleBlocks.count > 0 then -- if it found any blocks
|
||||
(
|
||||
if possibleBlocks.count == 1 then -- if it found one block, then continue
|
||||
(
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[1]
|
||||
pos += 1
|
||||
)
|
||||
else -- if it found more than one
|
||||
(
|
||||
for b = 1 to possibleBlocks.count do -- loop through every possible block
|
||||
(
|
||||
local possibleBlock = blocks[possibleBlocks[b]]
|
||||
local blockFirstLetter = possibleBlock[1]
|
||||
local blockSecondLetter = possibleBlock[2]
|
||||
local matchingLetter = if blockFirstLetter == word[pos] then 1 else 2
|
||||
-- ^ this is the index of the matching letter on the block
|
||||
|
||||
local notMatchingIndex = if matchingLetter == 1 then 2 else 1
|
||||
local notMatchingLetter = possibleBlock[notMatchingIndex]
|
||||
-- ^ this is the other letter on the block
|
||||
|
||||
if occurs notMatchingLetter (substring word (pos+1) -1) then
|
||||
( -- if the other letter occurs in the rest of the word
|
||||
local removedBlocks = deepcopy blocks -- copy the current blocks array
|
||||
deleteitem removedBlocks possibleBlocks[b] -- remove the item from the copied array
|
||||
|
||||
-- recursively check if the word is possible if that block is taken away from the array:
|
||||
if (isWordPossible (substring word (pos+1) -1) blocks:removedBlocks) then
|
||||
( -- if it is, then remove the block and move to next character
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[1]
|
||||
pos += 1
|
||||
exit
|
||||
)
|
||||
else
|
||||
( -- if it isn't and it looped through every possible block, then the word is not possible
|
||||
if b == possibleBlocks.count do return false
|
||||
)
|
||||
)
|
||||
else
|
||||
( -- if the other letter on this block doesn't occur in the rest of the word, then the letter is solved, continue
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[b]
|
||||
pos += 1
|
||||
exit
|
||||
)
|
||||
)
|
||||
)
|
||||
) else return false -- if it didn't find any blocks, then return false
|
||||
)
|
||||
blocks = deepcopy blocks
|
||||
|
||||
makeuniquearray solvedLetters -- make sure there are no duplicates in the solved array
|
||||
if solvedLetters.count != word.count then return false -- if number of solved letters is not equal to word length
|
||||
else
|
||||
( -- this checks if all the solved letters are the same as the word
|
||||
check = ""
|
||||
for bit in solvedLetters do append check word[bit]
|
||||
if check == word then return true else return false
|
||||
)
|
||||
local pos = 1 -- start at the beginning of the word
|
||||
local solvedLetters = #() -- this array stores the indices of solved letters
|
||||
|
||||
while pos <= word.count do -- loop through every character in the word
|
||||
(
|
||||
local possibleBlocks = #() -- this array stores the blocks which can be used to make that letter
|
||||
for b = 1 to Blocks.count do -- this loop finds all the possible blocks that can be used to make that letter
|
||||
(
|
||||
if occurs word[pos] blocks[b] do
|
||||
(
|
||||
appendifunique possibleBlocks b
|
||||
)
|
||||
)
|
||||
if possibleBlocks.count > 0 then -- if it found any blocks
|
||||
(
|
||||
if possibleBlocks.count == 1 then -- if it found one block, then continue
|
||||
(
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[1]
|
||||
pos += 1
|
||||
)
|
||||
else -- if it found more than one
|
||||
(
|
||||
for b = 1 to possibleBlocks.count do -- loop through every possible block
|
||||
(
|
||||
local possibleBlock = blocks[possibleBlocks[b]]
|
||||
local blockFirstLetter = possibleBlock[1]
|
||||
local blockSecondLetter = possibleBlock[2]
|
||||
local matchingLetter = if blockFirstLetter == word[pos] then 1 else 2
|
||||
-- ^ this is the index of the matching letter on the block
|
||||
|
||||
local notMatchingIndex = if matchingLetter == 1 then 2 else 1
|
||||
local notMatchingLetter = possibleBlock[notMatchingIndex]
|
||||
-- ^ this is the other letter on the block
|
||||
|
||||
if occurs notMatchingLetter (substring word (pos+1) -1) then
|
||||
( -- if the other letter occurs in the rest of the word
|
||||
local removedBlocks = deepcopy blocks -- copy the current blocks array
|
||||
deleteitem removedBlocks possibleBlocks[b] -- remove the item from the copied array
|
||||
|
||||
-- recursively check if the word is possible if that block is taken away from the array:
|
||||
if (isWordPossible (substring word (pos+1) -1) blocks:removedBlocks) then
|
||||
( -- if it is, then remove the block and move to next character
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[1]
|
||||
pos += 1
|
||||
exit
|
||||
)
|
||||
else
|
||||
( -- if it isn't and it looped through every possible block, then the word is not possible
|
||||
if b == possibleBlocks.count do return false
|
||||
)
|
||||
)
|
||||
else
|
||||
( -- if the other letter on this block doesn't occur in the rest of the word, then the letter is solved, continue
|
||||
appendifunique solvedLetters pos
|
||||
deleteitem blocks possibleblocks[b]
|
||||
pos += 1
|
||||
exit
|
||||
)
|
||||
)
|
||||
)
|
||||
) else return false -- if it didn't find any blocks, then return false
|
||||
)
|
||||
|
||||
makeuniquearray solvedLetters -- make sure there are no duplicates in the solved array
|
||||
if solvedLetters.count != word.count then return false -- if number of solved letters is not equal to word length
|
||||
else
|
||||
( -- this checks if all the solved letters are the same as the word
|
||||
check = ""
|
||||
for bit in solvedLetters do append check word[bit]
|
||||
if check == word then return true else return false
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,30 +1,30 @@
|
|||
fn isWordPossible2 word =
|
||||
(
|
||||
Blocks = #("BO","XK","DQ","CP","NA", \
|
||||
"GT","RE","TG","QD","FS", \
|
||||
"JW","HU","VI","AN","OB", \
|
||||
"ER","FS","LY","PC","ZM")
|
||||
Blocks = #("BO","XK","DQ","CP","NA", \
|
||||
"GT","RE","TG","QD","FS", \
|
||||
"JW","HU","VI","AN","OB", \
|
||||
"ER","FS","LY","PC","ZM")
|
||||
word = toupper word
|
||||
local pos = 1
|
||||
local solvedLetters = #()
|
||||
while pos <= word.count do
|
||||
(
|
||||
for i = 1 to blocks.count do
|
||||
(
|
||||
if (matchpattern blocks[i] pattern:("*"+word[pos]+"*")) then
|
||||
(
|
||||
deleteitem blocks i
|
||||
appendifunique solvedLetters pos
|
||||
pos +=1
|
||||
exit
|
||||
)
|
||||
else if i == blocks.count do return false
|
||||
)
|
||||
)
|
||||
if solvedLetters.count == word.count then
|
||||
(
|
||||
local check = ""
|
||||
for bit in solvedLetters do append check word[bit]
|
||||
if check == word then return true else return false
|
||||
) else return false
|
||||
local pos = 1
|
||||
local solvedLetters = #()
|
||||
while pos <= word.count do
|
||||
(
|
||||
for i = 1 to blocks.count do
|
||||
(
|
||||
if (matchpattern blocks[i] pattern:("*"+word[pos]+"*")) then
|
||||
(
|
||||
deleteitem blocks i
|
||||
appendifunique solvedLetters pos
|
||||
pos +=1
|
||||
exit
|
||||
)
|
||||
else if i == blocks.count do return false
|
||||
)
|
||||
)
|
||||
if solvedLetters.count == word.count then
|
||||
(
|
||||
local check = ""
|
||||
for bit in solvedLetters do append check word[bit]
|
||||
if check == word then return true else return false
|
||||
) else return false
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,23 +1,23 @@
|
|||
canSpell := proc(w)
|
||||
local blocks, i, j, word, letterFound;
|
||||
blocks := Array([["B", "O"], ["X", "K"], ["D", "Q"], ["C", "P"], ["N", "A"], ["G", "T"], ["R", "E"], ["T", "G"],
|
||||
local blocks, i, j, word, letterFound;
|
||||
blocks := Array([["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)/2 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;
|
||||
word := StringTools[UpperCase](convert(w, string));
|
||||
for i to length(word) do
|
||||
letterFound := false;
|
||||
for j to numelems(blocks)/2 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]);
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
'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
|
||||
' A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE
|
||||
'-----------------------------------------------------------------------------
|
||||
' G l o b a l C o n s t a n t s
|
||||
'
|
||||
|
|
|
|||
|
|
@ -1,117 +0,0 @@
|
|||
<#
|
||||
.Synopsis
|
||||
ABC Problem
|
||||
.DESCRIPTION
|
||||
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
|
||||
blocks = "BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"
|
||||
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:
|
||||
>>> can_make_word("A")
|
||||
True
|
||||
>>> can_make_word("BARK")
|
||||
True
|
||||
>>> can_make_word("BOOK")
|
||||
False
|
||||
>>> can_make_word("TREAT")
|
||||
True
|
||||
>>> can_make_word("COMMON")
|
||||
False
|
||||
>>> can_make_word("SQUAD")
|
||||
True
|
||||
>>> can_make_word("CONFUSE")
|
||||
True
|
||||
|
||||
Using the examples below you can either see just the value or
|
||||
status and the values using the verbose switch
|
||||
|
||||
.EXAMPLE
|
||||
test-blocks -testword confuse
|
||||
|
||||
.EXAMPLE
|
||||
test-blocks -testword confuse -verbose
|
||||
|
||||
#>
|
||||
|
||||
function test-blocks
|
||||
{
|
||||
[CmdletBinding()]
|
||||
# [OutputType([int])]
|
||||
Param
|
||||
(
|
||||
# word to test against blocks
|
||||
[Parameter(Mandatory = $true,
|
||||
ValueFromPipelineByPropertyName = $true)]
|
||||
$testword
|
||||
|
||||
)
|
||||
|
||||
$word = $testword
|
||||
|
||||
#define array of blocks
|
||||
[System.Collections.ArrayList]$blockarray = "BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"
|
||||
|
||||
#send word to chararray
|
||||
$chararray = $word.ToCharArray()
|
||||
$chars = $chararray
|
||||
|
||||
#get the character count
|
||||
$charscount = $chars.count
|
||||
|
||||
#get the initial count of the blocks
|
||||
$blockcount = $blockarray.Count
|
||||
|
||||
#find out how many blocks should be left from the difference
|
||||
#of the blocks and characters in the word - 1 letter/1 block
|
||||
$correctblockcount = $blockcount - $charscount
|
||||
|
||||
#loop through the characters in the word
|
||||
foreach ($char in $chars)
|
||||
{
|
||||
|
||||
#loop through the blocks
|
||||
foreach ($block in $blockarray)
|
||||
{
|
||||
|
||||
#check the current character against each letter on the current block
|
||||
#and break if found so the array can reload
|
||||
if ($char -in $block[0] -or $char -in $block[1])
|
||||
{
|
||||
|
||||
write-verbose "match for letter - $char - removing block $block"
|
||||
$blockarray.Remove($block)
|
||||
break
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
#get final count of blocks left in array to determine if the word was
|
||||
#correctly made
|
||||
$finalblockcount = $blockarray.count
|
||||
if ($finalblockcount -ne $correctblockcount)
|
||||
{
|
||||
write-verbose "$word : $false "
|
||||
return $false
|
||||
}
|
||||
else
|
||||
{
|
||||
write-verbose "$word : $true "
|
||||
return $true
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#loop all the words and pass them to the function
|
||||
$wordlist = "a", "bark", "book", "treat", "common", "squad", "confuse"
|
||||
foreach ($word in $wordlist)
|
||||
{
|
||||
test-blocks -testword $word -Verbose
|
||||
}
|
||||
|
|
@ -1,22 +1,22 @@
|
|||
abc_problem :-
|
||||
maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).
|
||||
maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).
|
||||
|
||||
|
||||
abc_problem(Word) :-
|
||||
L = [[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]],
|
||||
L = [[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]],
|
||||
|
||||
( abc_problem(L, Word)
|
||||
-> format('~w OK~n', [Word])
|
||||
; format('~w KO~n', [Word])).
|
||||
( abc_problem(L, Word)
|
||||
-> format('~w OK~n', [Word])
|
||||
; format('~w KO~n', [Word])).
|
||||
|
||||
abc_problem(L, Word) :-
|
||||
atom_chars(Word, C_Words),
|
||||
maplist(downcase_atom, C_Words, D_Words),
|
||||
can_makeword(L, D_Words).
|
||||
atom_chars(Word, C_Words),
|
||||
maplist(downcase_atom, C_Words, D_Words),
|
||||
can_makeword(L, D_Words).
|
||||
|
||||
can_makeword(_L, []).
|
||||
|
||||
can_makeword(L, [H | T]) :-
|
||||
( select([H, _], L, L1); select([_, H], L, L1)),
|
||||
can_makeword(L1, T).
|
||||
( select([H, _], L, L1); select([_, H], L, L1)),
|
||||
can_makeword(L1, T).
|
||||
|
|
|
|||
|
|
@ -4,46 +4,46 @@
|
|||
|
||||
* Read in blocks to construct the blocks string
|
||||
in1
|
||||
line = replace(input,&lcase,&ucase) :f(in1end)
|
||||
line ? breakx(' ') . pre ' ' rem . post :f(in1end)
|
||||
blocks = blocks "," pre post
|
||||
:(in1)
|
||||
line = replace(input,&lcase,&ucase) :f(in1end)
|
||||
line ? breakx(' ') . pre ' ' rem . post :f(in1end)
|
||||
blocks = blocks "," pre post
|
||||
:(in1)
|
||||
in1end
|
||||
|
||||
* Function to determine if a word can be constructed with the given blocks
|
||||
define('abc(blocks,word)s,i,let')
|
||||
abcpat = (breakx(',') ',') . pre (*let len(1) | len(1) *let) rem . post
|
||||
:(abc_end)
|
||||
define('abc(blocks,word)s,i,let')
|
||||
abcpat = (breakx(',') ',') . pre (*let len(1) | len(1) *let) rem . post
|
||||
:(abc_end)
|
||||
abc
|
||||
eq(size(word),0) :s(abc3)
|
||||
s = replace(word,&lcase,&ucase)
|
||||
i = 0
|
||||
eq(size(word),0) :s(abc3)
|
||||
s = replace(word,&lcase,&ucase)
|
||||
i = 0
|
||||
abc2
|
||||
i = lt(i,size(s)) i + 1 :f(abc4)
|
||||
let = substr(s,i,1)
|
||||
blocks ? abcpat = pre post :f(abc3)
|
||||
:(abc2)
|
||||
i = lt(i,size(s)) i + 1 :f(abc4)
|
||||
let = substr(s,i,1)
|
||||
blocks ? abcpat = pre post :f(abc3)
|
||||
:(abc2)
|
||||
abc3
|
||||
abc = 'False' :(abc5)
|
||||
abc = 'False' :(abc5)
|
||||
abc4
|
||||
abc = 'True' :(abc5)
|
||||
abc = 'True' :(abc5)
|
||||
abc5
|
||||
output = lpad('can_make_word("' word '"): ',26) abc
|
||||
abc = ""
|
||||
:(return)
|
||||
output = lpad('can_make_word("' word '"): ',26) abc
|
||||
abc = ""
|
||||
:(return)
|
||||
abc_end
|
||||
|
||||
* Check words
|
||||
* output = abc(blocks,"")
|
||||
* output = abc(blocks," ")
|
||||
output = abc(blocks,'A')
|
||||
output = abc(blocks,'bark')
|
||||
output = abc(blocks,'BOOK')
|
||||
output = abc(blocks,'TrEAT')
|
||||
output = abc(blocks,'COMMON')
|
||||
output = abc(blocks,'SQUAD')
|
||||
output = abc(blocks,'CONFUSE')
|
||||
|
||||
* output = abc(blocks,"")
|
||||
* output = abc(blocks," ")
|
||||
output = abc(blocks,'A')
|
||||
output = abc(blocks,'bark')
|
||||
output = abc(blocks,'BOOK')
|
||||
output = abc(blocks,'TrEAT')
|
||||
output = abc(blocks,'COMMON')
|
||||
output = abc(blocks,'SQUAD')
|
||||
output = abc(blocks,'CONFUSE')
|
||||
|
||||
* The blocks are entered below, after the following END label
|
||||
END
|
||||
b o
|
||||
|
|
|
|||
|
|
@ -1,41 +1,41 @@
|
|||
function CanMakeWord word
|
||||
|
||||
put [
|
||||
("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")
|
||||
] into blocks
|
||||
|
||||
repeat with each character letter of word
|
||||
put False into found
|
||||
repeat with each item block of blocks by reference
|
||||
if item 1 of block is letter ignoring case or item 2 of block is letter ignoring case
|
||||
delete block
|
||||
put True into found
|
||||
exit repeat
|
||||
end if
|
||||
end repeat
|
||||
if found is False
|
||||
return False
|
||||
end if
|
||||
end repeat
|
||||
return True
|
||||
|
||||
put [
|
||||
("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")
|
||||
] into blocks
|
||||
|
||||
repeat with each character letter of word
|
||||
put False into found
|
||||
repeat with each item block of blocks by reference
|
||||
if item 1 of block is letter ignoring case or item 2 of block is letter ignoring case
|
||||
delete block
|
||||
put True into found
|
||||
exit repeat
|
||||
end if
|
||||
end repeat
|
||||
if found is False
|
||||
return False
|
||||
end if
|
||||
end repeat
|
||||
return True
|
||||
|
||||
end CanMakeWord
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
repeat with each item word in [
|
||||
"A",
|
||||
"BARK",
|
||||
"BOOK",
|
||||
"TREAT",
|
||||
"COMMON",
|
||||
"SQUAD",
|
||||
"CONFUSE"
|
||||
"A",
|
||||
"BARK",
|
||||
"BOOK",
|
||||
"TREAT",
|
||||
"COMMON",
|
||||
"SQUAD",
|
||||
"CONFUSE"
|
||||
]
|
||||
put CanMakeWord(word)
|
||||
put CanMakeWord(word)
|
||||
end repeat
|
||||
|
|
|
|||
|
|
@ -2,28 +2,28 @@ import <Utilities/Conversion.sl>;
|
|||
import <Utilities/Sequence.sl>;
|
||||
|
||||
main(args(2)) :=
|
||||
let
|
||||
result[i] := args[i] ++ ": " ++ boolToString(can_make_word(args[i], InitBlocks));
|
||||
in
|
||||
delimit(result, '\n');
|
||||
let
|
||||
result[i] := args[i] ++ ": " ++ boolToString(can_make_word(args[i], InitBlocks));
|
||||
in
|
||||
delimit(result, '\n');
|
||||
|
||||
InitBlocks := ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"];
|
||||
|
||||
|
||||
can_make_word(word(1), blocks(2)) :=
|
||||
let
|
||||
choices[i] := i when some(blocks[i] = toUpper(head(word)));
|
||||
blocksAfterChoice[i] := blocks[(1 ... (choices[i] - 1)) ++ ((choices[i] + 1) ... size(blocks))];
|
||||
in
|
||||
true when size(word) = 0
|
||||
else
|
||||
false when size(choices) = 0
|
||||
else
|
||||
some(can_make_word(tail(word), blocksAfterChoice));
|
||||
|
||||
let
|
||||
choices[i] := i when some(blocks[i] = toUpper(head(word)));
|
||||
blocksAfterChoice[i] := blocks[(1 ... (choices[i] - 1)) ++ ((choices[i] + 1) ... size(blocks))];
|
||||
in
|
||||
true when size(word) = 0
|
||||
else
|
||||
false when size(choices) = 0
|
||||
else
|
||||
some(can_make_word(tail(word), blocksAfterChoice));
|
||||
|
||||
toUpper(letter(0)) :=
|
||||
let
|
||||
ascii := asciiToInt(letter);
|
||||
in
|
||||
letter when ascii >= 65 and ascii <= 90
|
||||
else
|
||||
intToAscii(ascii - 32);
|
||||
let
|
||||
ascii := asciiToInt(letter);
|
||||
in
|
||||
letter when ascii >= 65 and ascii <= 90
|
||||
else
|
||||
intToAscii(ascii - 32);
|
||||
|
|
|
|||
|
|
@ -3,29 +3,29 @@ import <Utilities/Sequence.sl>;
|
|||
import <RegEx/RegEx.sl>;
|
||||
|
||||
main(args(2)) :=
|
||||
let
|
||||
result[i] := args[i] ++ ": " ++ boolToString(can_make_word(args[i], InitBlocks));
|
||||
in
|
||||
delimit(result, '\n');
|
||||
let
|
||||
result[i] := args[i] ++ ": " ++ boolToString(can_make_word(args[i], InitBlocks));
|
||||
in
|
||||
delimit(result, '\n');
|
||||
|
||||
InitBlocks := "BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM";
|
||||
|
||||
|
||||
can_make_word(word(1), blocks(1)) :=
|
||||
let
|
||||
regEx := "(\\a" ++ [toUpper(head(word))] ++ "|" ++ [toUpper(head(word))] ++ "\\a)";
|
||||
|
||||
newBlocks := replaceFirst(blocks, regEx, "");
|
||||
in
|
||||
true when size(word) = 0
|
||||
else
|
||||
false when size(newBlocks) = size(blocks)
|
||||
else
|
||||
can_make_word(tail(word), newBlocks);
|
||||
let
|
||||
regEx := "(\\a" ++ [toUpper(head(word))] ++ "|" ++ [toUpper(head(word))] ++ "\\a)";
|
||||
|
||||
newBlocks := replaceFirst(blocks, regEx, "");
|
||||
in
|
||||
true when size(word) = 0
|
||||
else
|
||||
false when size(newBlocks) = size(blocks)
|
||||
else
|
||||
can_make_word(tail(word), newBlocks);
|
||||
|
||||
toUpper(letter(0)) :=
|
||||
let
|
||||
ascii := asciiToInt(letter);
|
||||
in
|
||||
letter when ascii >= 65 and ascii <= 90
|
||||
else
|
||||
intToAscii(ascii - 32);
|
||||
let
|
||||
ascii := asciiToInt(letter);
|
||||
in
|
||||
letter when ascii >= 65 and ascii <= 90
|
||||
else
|
||||
intToAscii(ascii - 32);
|
||||
|
|
|
|||
|
|
@ -1,21 +1,21 @@
|
|||
ABCPuzzle>>test
|
||||
#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
|
||||
Transcript crShow: each, ': ', (self solveFor: each) asString ]
|
||||
#('A' 'BARK' 'BOOK' 'TreaT' 'COMMON' 'sQUAD' 'CONFuSE') do: [ :each |
|
||||
Transcript crShow: each, ': ', (self solveFor: each) asString ]
|
||||
|
||||
ABCPuzzle>>solveFor: letters
|
||||
| blocks |
|
||||
blocks := #('BO' 'XK' 'DQ' 'CP' 'NA' 'GT' 'RE' 'TG' 'QD' 'FS' 'JW' 'HU' 'VI' 'AN' 'OB' 'ER' 'FS' 'LY' 'PC' 'ZM').
|
||||
^ self solveFor: letters asUppercase with: blocks asOrderedCollection
|
||||
| blocks |
|
||||
blocks := #('BO' 'XK' 'DQ' 'CP' 'NA' 'GT' 'RE' 'TG' 'QD' 'FS' 'JW' 'HU' 'VI' 'AN' 'OB' 'ER' 'FS' 'LY' 'PC' 'ZM').
|
||||
^ self solveFor: letters asUppercase with: blocks asOrderedCollection
|
||||
|
||||
ABCPuzzle>>solveFor: letters with: blocks
|
||||
| l ldash matches |
|
||||
letters isEmpty ifTrue: [ ^ true ].
|
||||
l := letters first.
|
||||
ldash := letters allButFirst.
|
||||
matches := blocks select: [ :b | b includes: l ].
|
||||
matches isEmpty ifTrue: [ ^ false ].
|
||||
matches do: [ :m | | bdash |
|
||||
bdash := blocks copy.
|
||||
bdash remove: m.
|
||||
(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
|
||||
^ false
|
||||
| l ldash matches |
|
||||
letters isEmpty ifTrue: [ ^ true ].
|
||||
l := letters first.
|
||||
ldash := letters allButFirst.
|
||||
matches := blocks select: [ :b | b includes: l ].
|
||||
matches isEmpty ifTrue: [ ^ false ].
|
||||
matches do: [ :m | | bdash |
|
||||
bdash := blocks copy.
|
||||
bdash remove: m.
|
||||
(self solveFor: ldash with: bdash) ifTrue: [ ^ true ] ].
|
||||
^ false
|
||||
|
|
|
|||
|
|
@ -1,20 +1,20 @@
|
|||
import Swift
|
||||
|
||||
func canMake(word: String) -> Bool {
|
||||
var blocks = [
|
||||
"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"
|
||||
]
|
||||
|
||||
for letter in word.uppercased().characters {
|
||||
guard let index = blocks.index(where: { $0.characters.contains(letter) }) else {
|
||||
return false
|
||||
}
|
||||
|
||||
blocks.remove(at: index)
|
||||
}
|
||||
|
||||
return true
|
||||
var blocks = [
|
||||
"BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"
|
||||
]
|
||||
|
||||
for letter in word.uppercased().characters {
|
||||
guard let index = blocks.index(where: { $0.characters.contains(letter) }) else {
|
||||
return false
|
||||
}
|
||||
|
||||
blocks.remove(at: index)
|
||||
}
|
||||
|
||||
return true
|
||||
}
|
||||
|
||||
let words = ["a", "bARK", "boOK", "TreAt", "CoMmon", "SquAd", "CONFUse"]
|
||||
|
|
|
|||
|
|
@ -2,16 +2,16 @@ package require Tcl 8.6
|
|||
|
||||
proc abc {word {blocks {BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM}}} {
|
||||
set abc {{letters blocks abc} {
|
||||
set rest [lassign $letters ch]
|
||||
set i 0
|
||||
foreach blk $blocks {
|
||||
if {$ch in $blk && (![llength $rest]
|
||||
|| [apply $abc $rest [lreplace $blocks $i $i] $abc])} {
|
||||
return true
|
||||
}
|
||||
incr i
|
||||
}
|
||||
return false
|
||||
set rest [lassign $letters ch]
|
||||
set i 0
|
||||
foreach blk $blocks {
|
||||
if {$ch in $blk && (![llength $rest]
|
||||
|| [apply $abc $rest [lreplace $blocks $i $i] $abc])} {
|
||||
return true
|
||||
}
|
||||
incr i
|
||||
}
|
||||
return false
|
||||
}}
|
||||
return [apply $abc [split $word ""] [lmap b $blocks {split $b ""}] $abc]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
MainModule: {
|
||||
blocks: ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"],
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"],
|
||||
words: ["A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"],
|
||||
|
||||
testMake: Lambda<String Vector<String> Bool>(λ
|
||||
|
|
@ -16,7 +16,7 @@ MainModule: {
|
|||
)
|
||||
(ret false)
|
||||
),
|
||||
_start: (lambda
|
||||
_start: (lambda
|
||||
(for word in words do
|
||||
(lout :boolalpha word " : "
|
||||
(exec testMake word blocks))
|
||||
|
|
|
|||
|
|
@ -19,84 +19,84 @@ using namespace Upp;
|
|||
|
||||
int can_make_words(char **b, char *word)
|
||||
{
|
||||
int i, ret = 0, c = toupper(*word);
|
||||
|
||||
if (!c) return 1;
|
||||
if (!b[0]) return 0;
|
||||
|
||||
for (i = 0; b[i] && !ret; i++) {
|
||||
if (b[i][0] != c && b[i][1] != c) continue;
|
||||
Swap(b[i], b[0]); // It needs to be Swap and not SWAP
|
||||
ret = can_make_words(b + 1, word + 1);
|
||||
Swap(b[i], b[0]); // It needs to be Swap instead of SWAP
|
||||
}
|
||||
return ret;
|
||||
int i, ret = 0, c = toupper(*word);
|
||||
|
||||
if (!c) return 1;
|
||||
if (!b[0]) return 0;
|
||||
|
||||
for (i = 0; b[i] && !ret; i++) {
|
||||
if (b[i][0] != c && b[i][1] != c) continue;
|
||||
Swap(b[i], b[0]); // It needs to be Swap and not SWAP
|
||||
ret = can_make_words(b + 1, word + 1);
|
||||
Swap(b[i], b[0]); // It needs to be Swap instead of SWAP
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
//C++
|
||||
|
||||
bool can_create_word(const std::string& w, const list_t& vals) {
|
||||
std::set<uint32_t> used;
|
||||
while (used.size() < w.size()) {
|
||||
const char c = toupper(w[used.size()]);
|
||||
uint32_t x = used.size();
|
||||
for (uint32_t i = 0, ii = vals.size(); i < ii; ++i) {
|
||||
if (used.find(i) == used.end()) {
|
||||
if (toupper(vals[i].first) == c || toupper(vals[i].second) == c) {
|
||||
used.insert(i);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (x == used.size()) break;
|
||||
}
|
||||
return used.size() == w.size();
|
||||
std::set<uint32_t> used;
|
||||
while (used.size() < w.size()) {
|
||||
const char c = toupper(w[used.size()]);
|
||||
uint32_t x = used.size();
|
||||
for (uint32_t i = 0, ii = vals.size(); i < ii; ++i) {
|
||||
if (used.find(i) == used.end()) {
|
||||
if (toupper(vals[i].first) == c || toupper(vals[i].second) == c) {
|
||||
used.insert(i);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (x == used.size()) break;
|
||||
}
|
||||
return used.size() == w.size();
|
||||
}
|
||||
|
||||
|
||||
// U++
|
||||
CONSOLE_APP_MAIN
|
||||
{
|
||||
// C
|
||||
char* blocks[] =
|
||||
{
|
||||
(char*)"BO", (char*)"XK", (char*)"DQ", (char*)"CP",
|
||||
(char*)"NA", (char*)"GT", (char*)"RE", (char*)"TG",
|
||||
(char*)"QD", (char*)"FS", (char*)"JW", (char*)"HU",
|
||||
(char*)"VI", (char*)"AN", (char*)"OB", (char*)"ER",
|
||||
(char*)"FS", (char*)"LY", (char*)"PC", (char*)"ZM", 0
|
||||
};
|
||||
// C
|
||||
char* blocks[] =
|
||||
{
|
||||
(char*)"BO", (char*)"XK", (char*)"DQ", (char*)"CP",
|
||||
(char*)"NA", (char*)"GT", (char*)"RE", (char*)"TG",
|
||||
(char*)"QD", (char*)"FS", (char*)"JW", (char*)"HU",
|
||||
(char*)"VI", (char*)"AN", (char*)"OB", (char*)"ER",
|
||||
(char*)"FS", (char*)"LY", (char*)"PC", (char*)"ZM", 0
|
||||
};
|
||||
|
||||
char *words[] =
|
||||
{
|
||||
(char*)"", (char*)"A", (char*)"BARK", (char*)"BOOK",
|
||||
(char*)"TREAT", (char*)"COMMON", (char*)"SQUAD", (char*)"Confuse", 0
|
||||
};
|
||||
|
||||
char **w;
|
||||
for (w = words; *w; w++)
|
||||
printf("%s\t%d\n", *w, can_make_words(blocks, *w));
|
||||
|
||||
printf("\n");
|
||||
|
||||
// C++
|
||||
list_t vals{ {'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'}
|
||||
};
|
||||
std::vector<std::string> wordsb{"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
|
||||
for (const std::string& w : wordsb) {
|
||||
std::cout << w << ": " << std::boolalpha << can_create_word(w, vals) << ".\n";
|
||||
}
|
||||
std::cout << "\n";
|
||||
|
||||
char *words[] =
|
||||
{
|
||||
(char*)"", (char*)"A", (char*)"BARK", (char*)"BOOK",
|
||||
(char*)"TREAT", (char*)"COMMON", (char*)"SQUAD", (char*)"Confuse", 0
|
||||
};
|
||||
|
||||
|
||||
const Vector<String>& cmdline = CommandLine();
|
||||
for(int i = 0; i < cmdline.GetCount(); i++) {
|
||||
}
|
||||
char **w;
|
||||
for (w = words; *w; w++)
|
||||
printf("%s\t%d\n", *w, can_make_words(blocks, *w));
|
||||
|
||||
printf("\n");
|
||||
|
||||
// C++
|
||||
list_t vals{ {'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'}
|
||||
};
|
||||
std::vector<std::string> wordsb{"A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
|
||||
for (const std::string& w : wordsb) {
|
||||
std::cout << w << ": " << std::boolalpha << can_create_word(w, vals) << ".\n";
|
||||
}
|
||||
std::cout << "\n";
|
||||
|
||||
|
||||
|
||||
const Vector<String>& cmdline = CommandLine();
|
||||
for(int i = 0; i < cmdline.GetCount(); i++) {
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,29 +1,29 @@
|
|||
const
|
||||
(
|
||||
blocks = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
|
||||
words = ["A", BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
|
||||
blocks = ["BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS","JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"]
|
||||
words = ["A", BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"]
|
||||
)
|
||||
|
||||
fn main() {
|
||||
for word in words {
|
||||
println('>>> can_make_word("${word.to_upper()}"): ')
|
||||
if check_word(word, blocks) == true {println('True')} else {println('False')}
|
||||
}
|
||||
for word in words {
|
||||
println('>>> can_make_word("${word.to_upper()}"): ')
|
||||
if check_word(word, blocks) == true {println('True')} else {println('False')}
|
||||
}
|
||||
}
|
||||
|
||||
fn check_word(word string, blocks []string) bool {
|
||||
mut tblocks := blocks.clone()
|
||||
mut found := false
|
||||
for chr in word {
|
||||
found = false
|
||||
for idx, _ in tblocks {
|
||||
if tblocks[idx].contains(chr.ascii_str()) == true {
|
||||
tblocks[idx] =''
|
||||
found = true
|
||||
break
|
||||
}
|
||||
}
|
||||
if found == false {return found}
|
||||
}
|
||||
return found
|
||||
mut tblocks := blocks.clone()
|
||||
mut found := false
|
||||
for chr in word {
|
||||
found = false
|
||||
for idx, _ in tblocks {
|
||||
if tblocks[idx].contains(chr.ascii_str()) == true {
|
||||
tblocks[idx] =''
|
||||
found = true
|
||||
break
|
||||
}
|
||||
}
|
||||
if found == false {return found}
|
||||
}
|
||||
return found
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,28 +1,28 @@
|
|||
letters$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM"
|
||||
|
||||
sub canMake(letters$, word$)
|
||||
local i, j, p, n, pairs$(1)
|
||||
|
||||
n = token(letters$, pairs$(), ",")
|
||||
word$ = upper$(word$)
|
||||
|
||||
for i = 1 to len(word$)
|
||||
for j = 1 to n
|
||||
p = instr(pairs$(j), mid$(word$, i, 1))
|
||||
if p then
|
||||
pairs$(j) = ""
|
||||
break
|
||||
end if
|
||||
next j
|
||||
if not p return false
|
||||
next i
|
||||
return true
|
||||
local i, j, p, n, pairs$(1)
|
||||
|
||||
n = token(letters$, pairs$(), ",")
|
||||
word$ = upper$(word$)
|
||||
|
||||
for i = 1 to len(word$)
|
||||
for j = 1 to n
|
||||
p = instr(pairs$(j), mid$(word$, i, 1))
|
||||
if p then
|
||||
pairs$(j) = ""
|
||||
break
|
||||
end if
|
||||
next j
|
||||
if not p return false
|
||||
next i
|
||||
return true
|
||||
end sub
|
||||
|
||||
print "a = ", canMake(letters$, "a") // 1 = true
|
||||
print "bark = ", canMake(letters$, "Bark") // 1
|
||||
print "book = ", canMake(letters$, "BooK") // 0 = false
|
||||
print "treat = ", canMake(letters$, "TREAt") // 1
|
||||
print "common = ", canMake(letters$, "common") // 0
|
||||
print "squad = ", canMake(letters$, "squad") // 1
|
||||
print "confuse = ", canMake(letters$, "confuse") // 1
|
||||
print "a = ", canMake(letters$, "a") // 1 = true
|
||||
print "bark = ", canMake(letters$, "Bark") // 1
|
||||
print "book = ", canMake(letters$, "BooK") // 0 = false
|
||||
print "treat = ", canMake(letters$, "TREAt") // 1
|
||||
print "common = ", canMake(letters$, "common") // 0
|
||||
print "squad = ", canMake(letters$, "squad") // 1
|
||||
print "confuse = ", canMake(letters$, "confuse") // 1
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
var blocks=T("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS",
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM", );
|
||||
"JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM", );
|
||||
|
||||
fcn can_make_word(word){
|
||||
fcn(blks,word){
|
||||
if (not word) return(True); // bottom of recursion
|
||||
foreach b in (blks){ n:=__bWalker.idx;
|
||||
if(not b.holds(word[0])) continue; // letter not on this block
|
||||
blks.del(n); // remove this block from pile
|
||||
if (self.fcn(blks,word[1,*])) return(True); // try remaining blocks
|
||||
blks.insert(n,b); // put block back in pile: backtracking
|
||||
if(not b.holds(word[0])) continue; // letter not on this block
|
||||
blks.del(n); // remove this block from pile
|
||||
if (self.fcn(blks,word[1,*])) return(True); // try remaining blocks
|
||||
blks.insert(n,b); // put block back in pile: backtracking
|
||||
}
|
||||
False; // out of blocks but not out of word
|
||||
}(blocks.copy(),word.toUpper())
|
||||
|
|
|
|||
|
|
@ -1,87 +1,87 @@
|
|||
module Main;
|
||||
type
|
||||
Block = record
|
||||
l,r: char;
|
||||
used: boolean;
|
||||
end Block;
|
||||
Block = record
|
||||
l,r: char;
|
||||
used: boolean;
|
||||
end Block;
|
||||
|
||||
var
|
||||
blocks: array 20 of Block;
|
||||
blocks: array 20 of Block;
|
||||
|
||||
procedure Exists(c: char): boolean;
|
||||
var
|
||||
i: integer;
|
||||
r: boolean;
|
||||
i: integer;
|
||||
r: boolean;
|
||||
begin
|
||||
r := false;i := 0;
|
||||
while ~r & (i < len(blocks)) do
|
||||
if ~(blocks[i].used) then
|
||||
r := (blocks[i].l = cap(c)) or (blocks[i].r = cap(c));
|
||||
blocks[i].used := r;
|
||||
end;
|
||||
inc(i)
|
||||
end;
|
||||
return r
|
||||
r := false;i := 0;
|
||||
while ~r & (i < len(blocks)) do
|
||||
if ~(blocks[i].used) then
|
||||
r := (blocks[i].l = cap(c)) or (blocks[i].r = cap(c));
|
||||
blocks[i].used := r;
|
||||
end;
|
||||
inc(i)
|
||||
end;
|
||||
return r
|
||||
end Exists;
|
||||
|
||||
procedure CanMakeWord(s: string);
|
||||
var
|
||||
i: integer;
|
||||
made: boolean;
|
||||
i: integer;
|
||||
made: boolean;
|
||||
begin
|
||||
made := true;
|
||||
for i := 0 to len(s) - 1 do
|
||||
made := made & Exists(s[i])
|
||||
end;
|
||||
writeln(s:20,"?",made);
|
||||
Clean()
|
||||
made := true;
|
||||
for i := 0 to len(s) - 1 do
|
||||
made := made & Exists(s[i])
|
||||
end;
|
||||
writeln(s:20,"?",made);
|
||||
Clean()
|
||||
end CanMakeWord;
|
||||
|
||||
procedure Clean();
|
||||
var
|
||||
i: integer;
|
||||
i: integer;
|
||||
begin
|
||||
for i := 0 to len(blocks) - 1 do
|
||||
blocks[i].used := false
|
||||
end
|
||||
for i := 0 to len(blocks) - 1 do
|
||||
blocks[i].used := false
|
||||
end
|
||||
end Clean;
|
||||
|
||||
procedure InitBlock(i:integer;l,r:char);
|
||||
begin
|
||||
blocks[i].l := l;blocks[i].r := r;
|
||||
blocks[i].used := false;
|
||||
blocks[i].l := l;blocks[i].r := r;
|
||||
blocks[i].used := false;
|
||||
end InitBlock;
|
||||
|
||||
procedure Init;
|
||||
begin
|
||||
InitBlock(0,'B','O');
|
||||
InitBlock(1,'X','K');
|
||||
InitBlock(2,'D','Q');
|
||||
InitBlock(3,'C','Q');
|
||||
InitBlock(4,'N','A');
|
||||
InitBlock(5,'G','T');
|
||||
InitBlock(6,'R','E');
|
||||
InitBlock(7,'T','G');
|
||||
InitBlock(8,'Q','D');
|
||||
InitBlock(9,'F','S');
|
||||
InitBlock(10,'J','W');
|
||||
InitBlock(11,'H','U');
|
||||
InitBlock(12,'V','I');
|
||||
InitBlock(13,'A','N');
|
||||
InitBlock(14,'O','B');
|
||||
InitBlock(15,'E','R');
|
||||
InitBlock(16,'F','S');
|
||||
InitBlock(17,'L','Y');
|
||||
InitBlock(18,'P','C');
|
||||
InitBlock(19,'Z','M')
|
||||
InitBlock(0,'B','O');
|
||||
InitBlock(1,'X','K');
|
||||
InitBlock(2,'D','Q');
|
||||
InitBlock(3,'C','Q');
|
||||
InitBlock(4,'N','A');
|
||||
InitBlock(5,'G','T');
|
||||
InitBlock(6,'R','E');
|
||||
InitBlock(7,'T','G');
|
||||
InitBlock(8,'Q','D');
|
||||
InitBlock(9,'F','S');
|
||||
InitBlock(10,'J','W');
|
||||
InitBlock(11,'H','U');
|
||||
InitBlock(12,'V','I');
|
||||
InitBlock(13,'A','N');
|
||||
InitBlock(14,'O','B');
|
||||
InitBlock(15,'E','R');
|
||||
InitBlock(16,'F','S');
|
||||
InitBlock(17,'L','Y');
|
||||
InitBlock(18,'P','C');
|
||||
InitBlock(19,'Z','M')
|
||||
end Init;
|
||||
|
||||
begin
|
||||
Init();
|
||||
CanMakeWord("A");
|
||||
CanMakeWord("BARK");
|
||||
CanMakeWord("BOOK");
|
||||
CanMakeWord("TREAT");
|
||||
CanMakeWord("COMMON");
|
||||
CanMakeWord("confuse");
|
||||
Init();
|
||||
CanMakeWord("A");
|
||||
CanMakeWord("BARK");
|
||||
CanMakeWord("BOOK");
|
||||
CanMakeWord("TREAT");
|
||||
CanMakeWord("COMMON");
|
||||
CanMakeWord("confuse");
|
||||
end Main.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue