Twelve statements

Revision as of 17:20, 20 September 2012 by rosettacode>Gaaijz (added J)

This puzzle is borrowed from here.

Twelve statements is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Given the following twelve statements, which of them are true?

1.  This is a numbered list of twelve statements.
2.  Exactly 3 of the last 6 statements are true.
3.  Exactly 2 of the even-numbered statements are true.
4.  If statement 5 is true, then statements 6 and 7 are both true.
5.  The 3 preceding statements are all false.
6.  Exactly 4 of the odd-numbered statements are true.
7.  Either statement 2 or 3 is true, but not both.
8.  If statement 7 is true, then 5 and 6 are both true.
9.  Exactly 3 of the first 6 statements are true.
10.  The next two statements are both true.
11.  Exactly 1 of statements 7, 8 and 9 are true.
12.  Exactly 4 of the preceding statements are true.

When you get tired of trying to figure it out in your head, write a program to solve it, and print the correct answer or answers.

Extra credit: also print out a table of near misses, that is, solutions that are contradicted by only a single statement.

Haskell

Shows answers with 1 for true, followed by list of indices of incorrect elements each set of 1/0s (index is 0-based).

<lang haskell>import Data.List (findIndices)

tf = mapM (\_ -> [1,0])

wrongness b = findIndices id . zipWith (/=) b . map (fromEnum . ($ b))

statements = [ (==12) . length, 3 ⊂ [length statements-6..], 2 ⊂ [1,3..], 4 → [4..6], 0 ⊂ [1..3], 4 ⊂ [0,2..], 1 ⊂ [1,2], 6 → [4..6], 3 ⊂ [0..5], 2 ⊂ [10,11], 1 ⊂ [6,7,8], 4 ⊂ [0..10] ] where (s ⊂ x) b = s == (sum . map (b!!) . takeWhile (< length b)) x (a → x) b = (b!!a == 0) || all ((==1).(b!!)) x

testall s n = [(b, w) | b <- tf s, w <- [wrongness b s], length w == n]

main = let t = testall statements in do putStrLn "Answer" mapM_ print $ t 0 putStrLn "Near misses" mapM_ print $ t 1</lang>

Output:
Answer
([1,0,1,1,0,1,1,0,0,0,1,0],[])
Near misses
([1,1,0,1,0,0,1,1,1,0,0,0],[7])
([1,1,0,1,0,0,1,0,1,1,0,0],[9])
([1,1,0,1,0,0,1,0,1,0,0,1],[11])
([1,0,1,1,0,1,1,0,1,0,0,0],[8])
([1,0,1,1,0,0,0,1,1,0,0,0],[6])
([1,0,0,1,0,1,0,1,1,0,0,0],[5])
([1,0,0,1,0,0,0,1,0,1,1,1],[11])
([1,0,0,1,0,0,0,0,0,0,0,0],[7])
([1,0,0,0,1,1,0,0,1,0,1,0],[7])
([1,0,0,0,1,0,0,1,0,1,1,1],[11])
([1,0,0,0,1,0,0,1,0,0,1,0],[11])
([1,0,0,0,1,0,0,1,0,0,0,0],[10])
([1,0,0,0,1,0,0,0,0,0,0,0],[7])
([0,0,0,1,0,0,0,1,0,1,1,1],[0])
([0,0,0,0,1,0,0,1,0,1,1,1],[0])
([0,0,0,0,1,0,0,1,0,0,1,0],[0])

J

Follows the Haskell solution.

In the following 'apply' is a foreign conjunction: <lang j> apply 128!:2

NB. example

  '*:' apply 1 2 3

1 4 9</lang> This enables us to apply strings (left argument) being verbs to the right argument, mostly a noun. <lang j>S=: <;._2 (0 :0) 12&=@# 3=+/@:{.~&_6 2= +/@:{~&1 3 5 7 9 11 4&{=*./@:{~&4 5 6 0=+/@:{~&1 2 3 4=+/@:{~&0 2 4 6 8 10 1=+/@:{~&1 2 6&{=*./@:{~&4 5 6 3=+/@:{.~&6 2=+/@:{~&10 11 1=+/@:{~&6 7 8 4=+/@:{.~&11 )

testall=: (];"1 0<@I.@:(]~:(apply&><))"1) #:@i.@(2&^)@#</lang>

All true <lang j> (#~0=#@{::~&_1"1) testall S ┌───────────────────────┬┐ │1 0 1 1 0 1 1 0 0 0 1 0││ └───────────────────────┴┘</lang> Near misses <lang j> (#~1=#@{::~&_1"1) testall S ┌───────────────────────┬──┐ │0 0 0 0 1 0 0 1 0 0 1 0│0 │ ├───────────────────────┼──┤ │0 0 0 0 1 0 0 1 0 1 1 1│0 │ ├───────────────────────┼──┤ │0 0 0 1 0 0 0 1 0 1 1 1│0 │ ├───────────────────────┼──┤ │1 0 0 0 1 0 0 0 0 0 0 0│7 │ ├───────────────────────┼──┤ │1 0 0 0 1 0 0 1 0 0 0 0│10│ ├───────────────────────┼──┤ │1 0 0 0 1 0 0 1 0 0 1 0│11│ ├───────────────────────┼──┤ │1 0 0 0 1 0 0 1 0 1 1 1│11│ ├───────────────────────┼──┤ │1 0 0 0 1 1 0 0 1 0 1 0│7 │ ├───────────────────────┼──┤ │1 0 0 1 0 0 0 0 0 0 0 0│7 │ ├───────────────────────┼──┤ │1 0 0 1 0 0 0 1 0 1 1 1│11│ ├───────────────────────┼──┤ │1 0 0 1 0 1 0 1 1 0 0 0│5 │ ├───────────────────────┼──┤ │1 0 1 1 0 0 0 1 1 0 0 0│6 │ ├───────────────────────┼──┤ │1 0 1 1 0 1 1 0 1 0 0 0│8 │ ├───────────────────────┼──┤ │1 1 0 1 0 0 1 0 1 0 0 1│11│ ├───────────────────────┼──┤ │1 1 0 1 0 0 1 0 1 1 0 0│9 │ ├───────────────────────┼──┤ │1 1 0 1 0 0 1 1 1 0 0 0│7 │ └───────────────────────┴──┘</lang>

Iterative for all true <lang j> (-N)&{. #: S <:@]^:((]-.@-:(apply&><)"1) (-N)&{.@#:@])^:(_) 2^N=.#S 1 0 1 1 0 1 1 0 0 0 1 0</lang>

Perl 6

<lang perl6>sub infix:<→> ($protasis,$apodosis) { !$protasis or $apodosis }

my @tests = { True }, # (there's no 0th statement)

   { all(.[1..12]) === any(True, False) },
   { 3 == [+] .[7..12] },
   { 2 == [+] .[2,4...12] },
   { .[5] → all .[6,7] },
   { none .[2,3,4] },
   { 4 == [+] .[1,3...11] },
   { one .[2,3] },
   { .[7] → all .[5,6] },
   { 3 == [+] .[1..6] },
   { all .[11,12] },
   { one .[7,8,9] },
   { 4 == [+] .[1..11] };

my @good; my @bad; my @ugly;

for reverse 0 ..^ 2**12 -> $i {

   my @b = $i.fmt("%012b").comb;
   my @assert = True, @b.map: { .so }
   my @result = @tests.map: { .(@assert).so }
   my @s = ( $_ if $_ and @assert[$_] for 1..12 );
   if @result eqv @assert {

push @good, "<{@s}> is consistent.";

   }
   else {

my @cons = gather for 1..12 { if @assert[$_] !eqv @result[$_] { take @result[$_] ?? $_ !! "¬$_"; } } my $mess = "<{@s}> implies {@cons}."; if @cons == 1 { push @bad, $mess } else { push @ugly, $mess }

   }

}

.say for @good; say "\nNear misses:"; .say for @bad;</lang>

Output:
<1 3 4 6 7 11> is consistent.

Near misses:
<1 2 4 7 8 9> implies ¬8.
<1 2 4 7 9 10> implies ¬10.
<1 2 4 7 9 12> implies ¬12.
<1 3 4 6 7 9> implies ¬9.
<1 3 4 8 9> implies 7.
<1 4 6 8 9> implies ¬6.
<1 4 8 10 11 12> implies ¬12.
<1 4> implies 8.
<1 5 6 9 11> implies 8.
<1 5 8 10 11 12> implies ¬12.
<1 5 8 11> implies 12.
<1 5 8> implies 11.
<1 5> implies 8.
<4 8 10 11 12> implies 1.
<5 8 10 11 12> implies 1.
<5 8 11> implies 1.