46 lines
1.3 KiB
Factor
46 lines
1.3 KiB
Factor
USING: assocs combinators.short-circuit formatting grouping io
|
|
kernel math math.statistics qw sequences sets unicode ;
|
|
IN: rosetta-code.abc-problem
|
|
|
|
! === CONSTANTS ================================================
|
|
|
|
CONSTANT: blocks qw{
|
|
BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM
|
|
}
|
|
|
|
CONSTANT: input qw{ A BARK BOOK TREAT COMMON SQUAD CONFUSE }
|
|
|
|
! === PROGRAM LOGIC ============================================
|
|
|
|
: pare ( str -- seq )
|
|
[ blocks ] dip [ intersects? ] curry filter ;
|
|
|
|
: enough-blocks? ( str -- ? ) dup pare [ length ] bi@ <= ;
|
|
|
|
: enough-letters? ( str -- ? )
|
|
[ blocks concat ] dip dup [ within ] dip
|
|
[ histogram values ] bi@ [ - ] 2map [ neg? ] any? not ;
|
|
|
|
: can-make-word? ( str -- ? )
|
|
>upper { [ enough-blocks? ] [ enough-letters? ] } 1&& ;
|
|
|
|
! === OUTPUT ===================================================
|
|
|
|
: show-blocks ( -- )
|
|
"Available blocks:" print blocks [ 1 cut "(%s %s)" sprintf ]
|
|
map 5 group [ [ write bl ] each nl ] each nl ;
|
|
|
|
: header ( -- )
|
|
"Word" "Can make word from blocks?" "%-7s %s\n" printf
|
|
"======= ==========================" print ;
|
|
|
|
: result ( str -- )
|
|
dup can-make-word? "Yes" "No" ? "%-7s %s\n" printf ;
|
|
|
|
! === MAIN =====================================================
|
|
|
|
: abc-problem ( -- )
|
|
show-blocks header input [ result ] each ;
|
|
|
|
MAIN: abc-problem
|