Data commit

Task/ABC-problem/Factor/abc-problem.factor

@@ -0,0 +1,45 @@
+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