(
    ( number
    =   n done ntest oldFT
      .   !arg:(?done.(=?ntest).?oldFT)
        & 0:?n
        & (   !done
            :   ?
                ( !ntest
                . !oldFT&1+!n:?n&~
                )
                ?
          | !n
          )
    )
  & ( STATEMENTS
    =   ( (1."This is a numbered list of twelve statements.")
        . 1
        . (
          =   n nr done toDo
            .   !arg:(?done.?toDo)
              & 0:?n
              &   whl
                ' ( !done:(?nr.?) ?done
                  & 1+!n:!nr:?n
                  )
              &   whl
                ' ( !toDo:((?nr.?).?) ?toDo
                  & 1+!n:!nr:?n
                  )
              & (!n:12&true|false)
          )
        )
        ( (2."Exactly 3 of the last 6 statements are true.")
        . end
        . (
          =   done toDo lastSix
            .   !arg:(?done.?toDo)
              & !done:? [-7 ?lastSix
              & (   number$(!lastSix.(=?).true):3
                  & true
                | false
                )
          )
        )
        ( (3."Exactly 2 of the even-numbered statements are true.")
        . end
        . (
          =   done toDo ii
            .   !arg:(?done.?toDo)
              & (       number
                      $ ( !done
                        . (=?ii&!ii*1/2:~/)
                        . true
                        )
                    : 2
                  & true
                | false
                )
          )
        )
        ( (4."If statement 5 is true, then statements 6 and 7 are both true.")
        . 7
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (     !done
                    : ( ? (5.false) ?
                      |   ? (6.true) ?
                        : ? (7.true) ?
                      )
                  & true
                | false
                )
          )
        )
        ( (5."The 3 preceding statements are all false.")
        . 5
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (     !done
                    :   ?
                        (?.false)
                        (?.false)
                        (?.false)
                        (?.?)
                  & true
                | false
                )
          )
        )
        ( (6."Exactly 4 of the odd-numbered statements are true.")
        . end
        . (
          =   done toDo i
            .   !arg:(?done.?toDo)
              & (       number
                      $ ( !done
                        . (=?i&!i*1/2:/)
                        . true
                        )
                    : 4
                  & true
                | false
                )
          )
        )
        ( (7."Either statement 2 or 3 is true, but not both.")
        . 7
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (       number
                      $ (!done.(=2|3).true)
                    : 1
                  & true
                | false
                )
          )
        )
        ( (8."If statement 7 is true, then 5 and 6 are both true.")
        . 8
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (     !done
                    : ( ? (7.false) ?
                      |   ? (5.true) ?
                        : ? (6.true) ?
                      )
                  & true
                | false
                )
          )
        )
        ( (9."Exactly 3 of the first 6 statements are true.")
        . 9
        . (
          =   done toDo firstSix
            .   !arg:(?done.?toDo)
              & !done:?firstSix [6 ?
              & (   number$(!firstSix.(=?).true):3
                  & true
                | false
                )
          )
        )
        ( (10."The next two statements are both true.")
        . 12
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (   !done:? (?.true) (?.true)
                  & true
                | false
                )
          )
        )
        ( (11."Exactly 1 of statements 7, 8 and 9 are true.")
        . 11
        . (
          =   done toDo
            .   !arg:(?done.?toDo)
              & (       number
                      $ ( !done
                        . (=7|8|9)
                        . true
                        )
                    : 1
                  & true
                | false
                )
          )
        )
        ( (12."Exactly 4 of the preceding statements are true.")
        . 12
        . (
          =   done toDo preceding
            .   !arg:(?done.?toDo)
              & !done:?preceding (?.?)
              & (   number$(!preceding.(=?).true):4
                  & true
                | false
                )
          )
        )
    )
  & ( TestTruth
    =     done toDo postponedTests testToBePostponed
        , n when test FT oldFT A Z text
        , postponedTest testNow
      .   !arg:(?done.?toDo.?postponedTests)
        & (   !toDo:
            & "We have come to the end of the list of tests.
               Perform any tests that had to be postponed until now."
            &   whl
              ' (   !postponedTests
                  : (?.?oldFT.(=?postponedTest)) ?A
                & postponedTest$(!done.):!oldFT
                & !A:?postponedTests
                )
            & !postponedTests:
            & out$("Solution:" !done)
            & ~
          |     !toDo
              : ((?n.?text).?when.(=?test)) ?toDo
            & "'false' and 'true' are just two symbols, not 'boolean values'.
                You can choose other symbols if you like.
                The program first guesses the first symbol and assigns it to the variable FT.
                After backtracking, the second symbol is guessed and assigned to FT.
                This is done for each statement."
            &   false true
              :   ?
                  %@?FT
                  ( ?
                  & 1+!guesses:?guesses
                  & (!n.!FT):?testNow
                  & "Do all tests that had to be postponed until now, unless one of those tests
                    fails. Remove the successful tests from the list of postponed tests."
                  &   whl
                    ' (   !postponedTests
                        :   ?A
                            (!n.?oldFT.(=?postponedTest))
                            ?Z
                      &   postponedTest$(!done !testNow.!toDo)
                        : !oldFT
                      & !A !Z:?postponedTests
                      )
                  & "Check that all tests that had to be postponed until now are removed from
                     the list of postponed tests. Only then go on with looking at testing
                     the current statement. Backtrack if a test failed."
                  & !postponedTests:~(? (!n.?) ?)
                  & (   !when:>!n
                      & "The current statement cannot be tested right now. Postpone it to
                         the earliest coming statement where the current statement can be
                         tested.
                         (The earliest statement, denoted by 'when', is computed manually.)"
                      & (!when.!FT.'$test):?testToBePostponed
                    |   "No need to postpone. Test the current statement now."
                      & :?testToBePostponed
                      & "If the test fails, backtrack. If it succeeds, go on to the next
                         statement."
                      & test$(!done !testNow.!toDo):!FT
                    )
                  & "So far so good. Test the next statements. (recursively)"
                  &   TestTruth
                    $ ( !done !testNow
                      . !toDo
                      . !testToBePostponed !postponedTests
                      )
                  )
          )
    )
  & 0:?guesses
  & TestTruth$(.!STATEMENTS.)
|   out
  $ ( str
    $ ( "That's it. I made "
        !guesses
        " true/false guesses in all. (A brute force method needs 2^12="
        2^12
        " guesses."
      )
    )
);


using System;
using System.Collections.Generic;
using System.Linq;

public static class TwelveStatements
{
    public static void Main() {
        Func<Statements, bool>[] checks = {
            st => st[1],
            st => st[2] == (7.To(12).Count(i => st[i]) == 3),
            st => st[3] == (2.To(12, by: 2).Count(i => st[i]) == 2),
            st => st[4] == st[5].Implies(st[6] && st[7]),
            st => st[5] == (!st[2] && !st[3] && !st[4]),
            st => st[6] == (1.To(12, by: 2).Count(i => st[i]) == 4),
            st => st[7] == (st[2] != st[3]),
            st => st[8] == st[7].Implies(st[5] && st[6]),
            st => st[9] == (1.To(6).Count(i => st[i]) == 3),
            st => st[10] == (st[11] && st[12]),
            st => st[11] == (7.To(9).Count(i => st[i]) == 1),
            st => st[12] == (1.To(11).Count(i => st[i]) == 4)
        };

        for (Statements statements = new Statements(0); statements.Value < 4096; statements++) {
            int count = 0;
            int falseIndex = 0;
            for (int i = 0; i < checks.Length; i++) {
                if (checks[i](statements)) count++;
                else falseIndex = i;
            }
            if (count == 0) Console.WriteLine($"{"All wrong:", -13}{statements}");
            else if (count == 11) Console.WriteLine($"{$"Wrong at {falseIndex + 1}:", -13}{statements}");
            else if (count == 12) Console.WriteLine($"{"All correct:", -13}{statements}");
        }
    }

    struct Statements
    {
        public Statements(int value) : this() { Value = value; }

        public int Value { get; }

        public bool this[int index] => (Value & (1 << index - 1)) != 0;

        public static Statements operator ++(Statements statements) => new Statements(statements.Value + 1);

        public override string ToString() {
            Statements copy = this; //Cannot access 'this' in anonymous method...
            return string.Join(" ", from i in 1.To(12) select copy[i] ? "T" : "F");
        }

    }

    //Extension methods
    static bool Implies(this bool x, bool y) => !x || y;

    static IEnumerable<int> To(this int start, int end, int by = 1) {
        while (start <= end) {
            yield return start;
            start += by;
        }
    }

}


#include <iostream>
#include <vector>
#include <string>
#include <cmath>

using namespace std;

// convert int (0 or 1) to string (F or T)
inline
string str(int n)
{
    return  n ? "T": "F";
}

int main(void)
{
    int solution_list_number = 1;
    vector<string> st;
    st = {
        " 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."
    };  //  Good solution is: 1 3 4 6 7 11 are true

    int n = 12; // Number of statements.
    int nTemp = (int)pow(2, n); // Number of solutions to check.
    for (int counter = 0; counter < nTemp; counter++)
    {
        vector<int> s;
        for (int k = 0; k < n; k++)
        {
            s.push_back((counter >> k) & 0x1);
        }
        vector<int> test(12);
        int sum = 0;
        // check each of the nTemp solutions for match.
        // 1. This is a numbered list of twelve statements.
        test[0] = s[0];

        // 2. Exactly 3 of the last 6 statements are true.
        sum = s[6]+ s[7]+s[8]+s[9]+s[10]+s[11];
        test[1] = ((sum == 3) == s[1]);

        // 3. Exactly 2 of the even-numbered statements are true.
        sum = s[1]+s[3]+s[5]+s[7]+s[9]+s[11];
        test[2] = ((sum == 2) == s[2]);

        // 4. If statement 5 is true, then statements 6 and 7 are both true.
        test[3] = ((s[4] ? (s[5] && s[6]) : true) == s[3]);

        // 5. The 3 preceding statements are all false.
        test[4] = (((s[1] + s[2] + s[3]) == 0) == s[4]);

        // 6. Exactly 4 of the odd-numbered statements are true.
        sum = s[0] + s[2] + s[4] + s[6] + s[8] + s[10];
        test[5] = ((sum == 4) == s[5]);

        // 7. Either statement 2 or 3 is true, but not both.
        test[6] = (((s[1] + s[2]) == 1) == s[6]);

        // 8. If statement 7 is true, then 5 and 6 are both true.
        test[7] = ((s[6] ? (s[4] && s[5]) : true) == s[7]);

        // 9. Exactly 3 of the first 6 statements are true.
        sum = s[0]+s[1]+s[2]+s[3]+s[4]+s[5];
        test[8] = ((sum == 3) == s[8]);

        // 10. The next two statements are both true.
        test[9] = ((s[10] && s[11]) == s[9]);

        // 11. Exactly 1 of statements 7, 8 and 9 are true.
        sum = s[6]+ s[7] + s[8];
        test[10] = ((sum == 1) == s[10]);

        // 12. Exactly 4 of the preceding statements are true.
        sum = s[0]+s[1]+s[2]+s[3]+s[4]+s[5]+s[6]+s[7]+s[8]+s[9]+s[10];
        test[11] = ((sum == 4) == s[11]);

        // Check test results and print solution if 11 or 12 are true
        int resultsTrue = 0;
        for(unsigned int i = 0; i < test.size(); i++){
            resultsTrue += test[i];
        }
        if(resultsTrue == 11 || resultsTrue == 12){
            cout << solution_list_number++ << ". " ;
            string output = "1:"+str(s[0])+"  2:"+str(s[1])+"  3:"+str(s[2])
                        +"  4:"+str(s[3])+"  5:"+str(s[4])+"  6:"+ str(s[5])
                        +"  7:"+str(s[6])+"  8:"+str(s[7])+"  9:"+str(s[8])
                        +"  10:"+str(s[9])+"  11:"+str(s[10])+"  12:"+ str(s[11]);

            if (resultsTrue == 12) {
                cout << "Full Match, good solution!" << endl;
                cout << "\t" << output << endl;
            }
            else if(resultsTrue == 11){
                int i;
                for(i = 0; i < 12; i++){
                    if(test[i] == 0){
                        break;
                    }
                }
                cout << "Missed by one statement: " << st[i] << endl;
                cout << "\t" << output << endl;
            }
        }
    }
}


(use '[clojure.math.combinatorics]

(defn xor? [& args]
  (odd? (count (filter identity args))))

(defn twelve-statements []
  (for [[a b c d e f g h i j k l] (selections [true false] 12)
    :when (true? a)
    :when (if (= 3 (count (filter true? [g h i j k l]))) (true? b) (false? b))
    :when (if (= 2 (count (filter true? [b d f h j l]))) (true? c) (false? c))
    :when (if (or (false? e) (every? true? [e f g])) (true? d) (false? d))
    :when (if (every? false? [b c d]) (true? e) (false? e))
    :when (if (= 4 (count (filter true? [a c e g i k]))) (true? f) (false? f))
    :when (if (xor? (true? b) (true? c)) (true? g) (false? g))
    :when (if (or (false? g) (every? true? [e f g])) (true? h) (false? h))
    :when (if (= 3 (count (filter true? [a b c d e f]))) (true? i) (false? i))
    :when (if (every? true? [k l]) (true? j) (false? j))
    :when (if (= 1 (count (filter true? [g h i]))) (true? k) (false? k))
    :when (if (= 4 (count (filter true? [a b c d e f g h i j k]))) (true? l) (false? l))]
  [a b c d e f g h i j k l]))


(defparameter *state* (make-list 12))

(defparameter *statements* '(t                                                    ; 1
                             (= (count-true '(7 8 9 10 11 12)) 3)                 ; 2
                             (= (count-true '(2 4 6 8 10 12)) 2)                  ; 3
                             (or (not (p 5)) (and (p 6) (p 7)))                   ; 4
                             (and (not (p 2)) (not (p 3)) (not (p 4)))            ; 5
                             (= (count-true '(1 3 5 7 9 11)) 4)                   ; 6
                             (or (and (p 2) (not (p 3))) (and (not (p 2)) (p 3))) ; 7
                             (or (not (p 7)) (and (p 5) (p 6)))                   ; 8
                             (= (count-true '(1 2 3 4 5 6)) 3)                    ; 9
                             (and (p 11) (p 12))                                  ;10
                             (= (count-true '(7 8 9)) 1)                          ;11
                             (= (count-true '(1 2 3 4 5 6 7 8 9 10 11)) 4)))      ;12

(defun start ()
  (loop while (not (equal *state* '(t t t t t t t t t t t t)))
        do (progn (let ((true-stats (check)))
		       (cond ((= true-stats 11) (result nil))
			     ((= true-stats 12) (result t))))
		  (new-state))))

(defun check ()
  (loop for el in *state*
        for stat in *statements*
        counting (eq el (eval stat)) into true-stats
        finally (return true-stats)))

(defun count-true (lst)
  (loop for i in lst
    counting (nth (- i 1) *state*) into total
    finally (return total)))

(defun p (n)
  (nth (- n 1) *state*))

(defun new-state ()
  (let ((contr t))
       (loop for i from 0 to 11
         do (progn (setf (nth i *state*) (not (eq (nth i *state*) contr)))
                   (setq contr (and contr (not (nth i *state*))))))))

(defun result (?)
  (format t "~:[Missed by one~;Solution:~] ~%~{~:[F~;T~] ~}~%" ? *state*))


import std.stdio, std.algorithm, std.range, std.functional;

immutable texts = [
    "this is a numbered list of twelve statements",
    "exactly 3 of the last 6 statements are true",
    "exactly 2 of the even-numbered statements are true",
    "if statement 5 is true, then statements 6 and 7 are both true",
    "the 3 preceding statements are all false",
    "exactly 4 of the odd-numbered statements are true",
    "either statement 2 or 3 is true, but not both",
    "if statement 7 is true, then 5 and 6 are both true",
    "exactly 3 of the first 6 statements are true",
    "the next two statements are both true",
    "exactly 1 of statements 7, 8 and 9 are true",
    "exactly 4 of the preceding statements are true"];

immutable pure @safe @nogc bool function(in bool[])[12] predicates = [
    s => s.length == 12,
    s => s[$ - 6 .. $].sum == 3,
    s => s.dropOne.stride(2).sum == 2,
    s => s[4] ? (s[5] && s[6]) : true,
    s => s[1 .. 4].sum == 0,
    s => s.stride(2).sum == 4,
    s => s[1 .. 3].sum == 1,
    s => s[6] ? (s[4] && s[5]) : true,
    s => s[0 .. 6].sum == 3,
    s => s[10] && s[11],
    s => s[6 .. 9].sum == 1,
    s => s[0 .. 11].sum == 4];

void main() @safe {
    enum nStats = predicates.length;

    foreach (immutable n; 0 .. 2 ^^ nStats) {
        bool[nStats] st, matches;
        nStats.iota.map!(i => !!(n & (2 ^^ i))).copy(st[]);
        st[].zip(predicates[].map!(f => f(st)))
            .map!(s_t => s_t[0] == s_t[1]).copy(matches[]);
        if (matches[].sum >= nStats - 1) {
            if (matches[].all)
                ">>> Solution:".writeln;
            else
                writefln("Missed by statement: %d",
                         matches[].countUntil(false) + 1);
            writefln("%-(%s %)", st[].map!q{ "FT"[a] });
        }
    }
}


class
	APPLICATION

create
	make

feature

	make
			-- Possible solutions.
		do
			create s.make_filled (False, 1, 12)
			s [1] := True
			recurseAll (2)
			io.put_string (counter.out + " solution found. ")
		end

feature {NONE}

	s: ARRAY [BOOLEAN]

	check2: BOOLEAN
			-- Is statement 2 fulfilled?
		local
			count: INTEGER
		do
			across
				7 |..| 12 as c
			loop
				if s [c.item] then
					count := count + 1
				end
			end
			Result := s [2] = (count = 3)
		end

	check3: BOOLEAN
			-- Is statement 3 fulfilled?
		local
			count, i: INTEGER
		do
			from
				i := 2
			until
				i > 12
			loop
				if s [i] then
					count := count + 1
				end
				i := i + 2
			end
			Result := s [3] = (count = 2)
		end

	check4: BOOLEAN
			-- Is statement 4 fulfilled?
		do
			Result := s [4] = ((not s [5]) or (s [6] and s [7]))
		end

	check5: BOOLEAN
			-- Is statement 5 fulfilled?
		do
			Result := s [5] = ((not s [2]) and (not s [3]) and (not s [4]))
		end

	check6: BOOLEAN
			-- Is statement 6 fulfilled?
		local
			count, i: INTEGER
		do
			from
				i := 1
			until
				i > 11
			loop
				if s [i] then
					count := count + 1
				end
				i := i + 2
			end
			Result := s [6] = (count = 4)
		end

	check7: BOOLEAN
			-- Is statement 7 fulfilled?
		do
			Result := s [7] = ((s [2] or s [3]) and not (s [2] and s [3]))
		end

	check8: BOOLEAN
			-- Is statement 8 fulfilled?
		do
			Result := s [8] = (not s [7] or (s [5] and s [6]))
		end

	check9: BOOLEAN
			-- Is statement 9 fulfilled?
		local
			count: INTEGER
		do
			across
				1 |..| 6 as c
			loop
				if s [c.item] then
					count := count + 1
				end
			end
			Result := s [9] = (count = 3)
		end

	check10: BOOLEAN
			-- Is statement 10 fulfilled?
		do
			Result := s [10] = (s [11] and s [12])
		end

	check11: BOOLEAN
			-- Is statement 11 fulfilled?
		local
			count: INTEGER
		do
			across
				7 |..| 9 as c
			loop
				if s [c.item] then
					count := count + 1
				end
			end
			Result := s [11] = (count = 1)
		end

	check12: BOOLEAN
			-- Is statement 12 fulfilled?
		local
			count: INTEGER
		do
			across
				1 |..| 11 as c
			loop
				if s [c.item] then
					count := count + 1
				end
			end
			Result := (s [12] = (count = 4))
		end

	counter: INTEGER

	checkit
			-- Check if all statements are correctly solved.
		do
			if check2 and check3 and check4 and check5 and check6 and check7 and check8 and check9 and check10 and check11 and check12 then
				across
					1 |..| 12 as c
				loop
					if s [c.item] then
						io.put_string (c.item.out + "%T")
					end
				end
				io.new_line
				counter := counter + 1
			end
		end

	recurseAll (k: INTEGER)
			-- All possible True and False combinations to check for a solution.
		do
			if k = 13 then
				checkit
			else
				s [k] := False
				recurseAll (k + 1)
				s [k] := True
				recurseAll (k + 1)
			end
		end

end


import system'routines;
import extensions;
import extensions'text;

extension op
{
    printSolution(bits)
        = self.zipBy(bits,
            (s,b => s.iif("T","F") + (s.xor:b).iif("* ","  "))).summarize(new StringWriter());

    toBit()
        = self.iif(1,0);
}

puzzle = new Func1[]
{
    (bits => bits.Length == 12),

    (bits => bits.last(6).selectBy:(x => x.toBit()).summarize() == 3 ),

    (bits => bits.zipBy(new Range(1, 12),
                        (x,i => (i.toInt().isEven()).and:x.toBit())).summarize() == 2 ),

    (bits => bits[4].iif(bits[5] && bits[6],true) ),

    (bits => ((bits[1] || bits[2]) || bits[3]).Inverted ),

    (bits => bits.zipBy(new Range(1, 12),
                        (x,i => (i.toInt().isOdd()).and:x.toBit() )).summarize() == 4 ),

    (bits => bits[1].xor(bits[2]) ),

    (bits => bits[6].iif(bits[5] && bits[4],true) ),

    (bits => bits.top(6).selectBy:(x => x.toBit() ).summarize() == 3 ),

    (bits => bits[10] && bits[11] ),

    (bits => (bits[6].toBit() + bits[7].toBit() + bits[8].toBit())==1 ),

    (bits => bits.top(11).selectBy:(x => x.toBit()).summarize() == 4 )
};

public program()
{
    console.writeLine();

    for(int n := 0, n < 2.power(12), n += 1)
    {
        var bits := BitArray32.load(n).top(12).toArray();
        var results := puzzle.selectBy:(r => r(bits)).toArray();

        var counts := bits.zipBy(results, (b,r => b.xor:r.toBit() )).summarize();

        counts =>
            0  { console.printLine("Total hit :",results.printSolution:bits) }
            1  { console.printLine("Near miss :",results.printSolution:bits) }
            12 { console.printLine("Total miss:",results.printSolution:bits) };
    };

    console.readChar()
}


PROGRAM TWELVE_STMS

!$DYNAMIC
DIM PASS%[0],T%[0]

FUNCTION EOR(X,Y)
    EOR=(X AND NOT(Y)) OR (NOT(X) AND Y)
END FUNCTION

BEGIN
      NSTATEMENTS%=12
      !$DIM PASS%[NSTATEMENTS%],T%[NSTATEMENTS%]

      FOR TRY%=0 TO 2^NSTATEMENTS%-1 DO

        ! Postulate answer:
        FOR STMT%=1 TO 12 DO
          T%[STMT%]=(TRY% AND 2^(STMT%-1))<>0
        END FOR

        ! Test consistency:
        PASS%[1]=T%[1]=(NSTATEMENTS%=12)
        PASS%[2]=T%[2]=((T%[7]+T%[8]+T%[9]+T%[10]+T%[11]+T%[12])=-3)
        PASS%[3]=T%[3]=((T%[2]+T%[4]+T%[6]+T%[8]+T%[10]+T%[12])=-2)
        PASS%[4]=T%[4]=((NOT T%[5] OR (T%[6] AND T%[7])))
        PASS%[5]=T%[5]=(NOT T%[2] AND NOT T%[3] AND NOT T%[4])
        PASS%[6]=T%[6]=((T%[1]+T%[3]+T%[5]+T%[7]+T%[9]+T%[11])=-4)
        PASS%[7]=T%[7]=(EOR(T%[2],T%[3]))
        PASS%[8]=T%[8]=((NOT T%[7] OR (T%[5] AND T%[6])))
        PASS%[9]=T%[9]=((T%[1]+T%[2]+T%[3]+T%[4]+T%[5]+T%[6])=-3)
        PASS%[10]=T%[10]=(T%[11] AND T%[12])
        PASS%[11]=T%[11]=((T%[7]+T%[8]+T%[9])=-1)
        PASS%[12]=T%[12]=((T%[1]+T%[2]+T%[3]+T%[4]+T%[5]+T%[6]+T%[7]+T%[8]+T%[9]+T%[10]+T%[11])=-4)

        SUM=0
        FOR I%=1 TO 12 DO
           SUM=SUM+PASS%[I%]
        END FOR

        CASE SUM OF
          -11->
            PRINT("Near miss with statements ";)
            FOR STMT%=1 TO 12 DO
              IF T%[STMT%] THEN PRINT(STMT%;) END IF
              IF NOT PASS%[STMT%] THEN MISS%=STMT% END IF
            END FOR
            PRINT("true (failed ";MISS%;").")
          END ->
          -12->
            PRINT("Solution! with statements ";)
            FOR STMT%=1 TO 12 DO
              IF T%[STMT%] THEN PRINT(STMT%;) END IF
            END FOR
            PRINT("true.")
          END ->
        END CASE

      END FOR ! TRY%
END PROGRAM


: lastbit                              ( n1 -- n2)
  dup if 1 swap begin dup 1 <> while swap 1+ swap 1 rshift repeat drop then
;

: bit 1 swap lshift and 0<> ;          ( n1 n2 -- f)
: bitcount 0 swap begin dup while dup 1- and swap 1+ swap repeat drop ;

12 constant #stat                      \ number of statements
                                       \ encoding of the statements
: s1 >r #stat 12 = r> 0 bit = ;        \ heavy use of binary
: s2 >r [email protected] 4032 and bitcount 3 = r> 1 bit = ;
: s3 >r [email protected] 2730 and bitcount 2 = r> 2 bit = ;
: s4 >r [email protected] 4 bit 0= 96 [email protected] over and = or r> 3 bit = ;
: s5 >r [email protected] 14 and 0= r> 4 bit = ;
: s6 >r [email protected] 1365 and bitcount 4 = r> 5 bit = ;
: s7 >r [email protected] 1 bit [email protected] 2 bit xor r> 6 bit = ;
: s8 >r [email protected] 6 bit 0= 48 [email protected] over and = or r> 7 bit = ;
: s9 >r [email protected] 63 and bitcount 3 = r> 8 bit = ;
: s10 >r 3072 [email protected] over and = r> 9 bit = ;
: s11 >r [email protected] 448 and bitcount 1 = r> 10 bit = ;
: s12 >r [email protected] 2047 and bitcount 4 = r> 11 bit = ;
: list #stat 0 do dup i bit if i 1+ . then loop drop ;

: nearmiss?                            \ do we have a near miss?
  over #stat 1- = if                   ( true-pattern #true stat-pattern)
    ." Near miss with statements " dup list ." true (failed "
    >r over invert 1 #stat lshift 1- and lastbit 0 .r ." )" cr r>
  then                                 \ extract the failed statement
;
                                       \ have we found a solution?
: solution?                            ( true-pattern #true stat-pattern)
  over #stat = if ." Solution! with statements " dup list ." true." cr then
;

: 12statements                         \ test the twelve patterns
  1 #stat lshift 0 do                  \ create another bit pattern
    i s12   2* i s11 + 2* i s10 + 2* i s9 + 2* i s8 + 2* i s7 + 2*
    i s6  + 2* i s5  + 2* i s4  + 2* i s3 + 2* i s2 + 2* i s1 +
    abs dup bitcount i solution? nearmiss? drop drop drop
  loop                                 \ count number of bytes and evaluate
;

12statements


Dim As Integer nEnunciados = 12, intento, enun, errado
Dim As Integer Afirm(nEnunciados), T(nEnunciados)

For intento = 0 To 2^nEnunciados-1
    REM Postular respuesta:
    For enun = 1 To 12
        T(enun) = (intento And 2^(enun-1)) <> 0
    Next enum

    REM Prueba de consistencia:
    Afirm(1)  = T(1) = (nEnunciados = 12)
    Afirm(2)  = T(2) = ((T(7)+T(8)+T(9)+T(10)+T(11)+T(12)) = -3)
    Afirm(3)  = T(3) = ((T(2)+T(4)+T(6)+T(8)+T(10)+T(12)) = -2)
    Afirm(4)  = T(4) = ((Not T(5) Or (T(6) And T(7))))
    Afirm(5)  = T(5) = (Not T(2) And Not T(3) And Not T(4))
    Afirm(6)  = T(6) = ((T(1)+T(3)+T(5)+T(7)+T(9)+T(11)) = -4)
    Afirm(7)  = T(7) = ((T(2) Or T(3)))
    Afirm(8)  = T(8) = ((Not T(7) Or (T(5) And T(6))))
    Afirm(9)  = T(9) = ((T(1)+T(2)+T(3)+T(4)+T(5)+T(6)) = -3)
    Afirm(10) = T(10) = (T(11) And T(12))
    Afirm(11) = T(11) = ((T(7)+T(8)+T(9)) = -1)
    Afirm(12) = T(12) = ((T(1)+T(2)+T(3)+T(4)+T(5)+T(6) + T(7)+T(8)+T(9)+T(10)+T(11)) = -4)

    Dim As Integer suma = 0
    For cont As Integer = 1 To 12
        suma += Afirm(cont)
    Next cont

    Select Case suma
    Case -11
        Color 7: Print "Casi resuelto, con los enunciados ";
        For enun = 1 To 12
            If T(enun) Then Print ; enun; " ";
            If Not Afirm(enun) Then errado = enun
        Next enun
        Print "verdaderos (falsos"; errado; ")."
    Case -12
        Color 10: Print "Resuelto! con los enunciados ";
        For enun = 1 To 12
            If T(enun) Then Print ; enun; " ";
        Next enun
        Print "verdaderos."
    End Select
Next intento
Sleep


package main

import "fmt"

// its' not too much more work to check all the permutations concurrently
var solution = make(chan int)
var nearMiss = make(chan int)
var done = make(chan bool)

func main() {
    // iterate and use the bits as the permutation
    for i := 0; i < 4096; i++ {
        go checkPerm(i)
    }
    // collect the misses and list them after the complete solution(s)
    var ms []int
    for i := 0; i < 4096; {
        select {
        case <-done:
            i++
        case s := <-solution:
            print12("solution", s)
        case m := <-nearMiss:
            ms = append(ms, m)
        }
    }
    for _, m := range ms {
        print12("near miss", m)
    }
}

func print12(label string, bits int) {
    fmt.Print(label, ":")
    for i := 1; i <= 12; i++ {
        if bits&1 == 1 {
            fmt.Print(" ", i)
        }
        bits >>= 1
    }
    fmt.Println()
}

func checkPerm(tz int) {
    // closure returns true if tz bit corresponding to
    // 1-based statement number is 1.
    ts := func(n uint) bool {
        return tz>>(n-1)&1 == 1
    }
    // variadic closure returns number of statements listed as arguments
    // which have corresponding tz bit == 1.
    ntrue := func(xs ...uint) int {
        nt := 0
        for _, x := range xs {
            if ts(x) {
                nt++
            }
        }
        return nt
    }
    // a flag used on repeated calls to test.
    // set to true when first contradiction is found.
    // if another is found, this function (checkPerm) can "short circuit"
    // and return immediately without checking additional statements.
    var con bool
    // closure called to test each statement
    test := func(statement uint, b bool) {
        switch {
        case ts(statement) == b:
        case con:
            panic("bail")
        default:
            con = true
        }
    }
    // short circuit mechanism
    defer func() {
        if x := recover(); x != nil {
            if msg, ok := x.(string); !ok && msg != "bail" {
                panic(x)
            }
        }
        done <- true
    }()

    // 1. This is a numbered list of twelve statements.
    test(1, true)

    // 2. Exactly 3 of the last 6 statements are true.
    test(2, ntrue(7, 8, 9, 10, 11, 12) == 3)

    // 3. Exactly 2 of the even-numbered statements are true.
    test(3, ntrue(2, 4, 6, 8, 10, 12) == 2)

    // 4. If statement 5 is true, then statements 6 and 7 are both true.
    test(4, !ts(5) || ts(6) && ts(7))

    // 5. The 3 preceding statements are all false.
    test(5, !ts(4) && !ts(3) && !ts(2))

    // 6. Exactly 4 of the odd-numbered statements are true.
    test(6, ntrue(1, 3, 5, 7, 9, 11) == 4)

    // 7. Either statement 2 or 3 is true, but not both.
    test(7, ts(2) != ts(3))

    // 8. If statement 7 is true, then 5 and 6 are both true.
    test(8, !ts(7) || ts(5) && ts(6))

    // 9. Exactly 3 of the first 6 statements are true.
    test(9, ntrue(1, 2, 3, 4, 5, 6) == 3)

    // 10. The next two statements are both true.
    test(10, ts(11) && ts(12))

    // 11. Exactly 1 of statements 7, 8 and 9 are true.
    test(11, ntrue(7, 8, 9) == 1)

    // 12. Exactly 4 of the preceding statements are true.
    test(12, ntrue(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) == 4)

    // no short circuit? send permutation as either near miss or solution
    if con {
        nearMiss <- tz
    } else {
        solution <- tz
    }
}


enum Rule {
    r01( 1, { r()*.num == (1..12) }),
    r02( 2, { r(7..12).count { it.truth } == 3 }),
    r03( 3, { r(2..12, 2).count { it.truth } == 2 }),
    r04( 4, { r(5).truth ? r(6).truth && r(7).truth : true }),
    r05( 5, { r(2..4).count { it.truth } == 0 }),
    r06( 6, { r(1..11, 2).count { it.truth } == 4 }),
    r07( 7, { r(2).truth != r(3).truth }),
    r08( 8, { r(7).truth ? r(5).truth && r(6).truth : true }),
    r09( 9, { r(1..6).count { it.truth } == 3 }),
    r10(10, { r(11).truth && r(12).truth }),
    r11(11, { r(7..9).count { it.truth } == 1 }),
    r12(12, { r(1..11).count { it.truth } == 4 });

    final int num
    final Closure statement
    boolean truth

    static final List<Rule> rules = [ null, r01, r02, r03, r04, r05, r06, r07, r08, r09, r10, r11, r12]

    private Rule(num, statement) {
        this.num = num
        this.statement = statement
    }

    public static Rule       r(int index) { rules[index] }
    public static List<Rule> r() { rules[1..12] }
    public static List<Rule> r(List<Integer> indices) { rules[indices] }
    public static List<Rule> r(IntRange indices) { rules[indices] }
    public static List<Rule> r(IntRange indices, int step) { r(indices.step(step)) }

    public static void setAllTruth(int bits) {
        (1..12).each { r(it).truth = !(bits & (1 << (12 - it))) }
    }

    public static void evaluate() {
        def nearMisses = [:]
        (0..<(2**12)).each { i ->
            setAllTruth(i)
            def truthCandidates = r().findAll { it.truth }
            def truthMatchCount = r().count { it.statement() == it.truth }
            if (truthMatchCount == 12) {
                println ">Solution< ${truthCandidates*.num}"
            } else if (truthMatchCount == 11) {
                def miss = (1..12).find { r(it).statement() != r(it).truth }
                nearMisses << [(truthCandidates): miss]
            }
        }
        nearMisses.each { truths, miss ->
            printf ("Near Miss: %-21s (failed %2d)\n", "${truths*.num}", miss)
        }
    }
}

Rule.evaluate()


import Data.List (findIndices)

tf :: [[Int] -> Bool] -> [[Int]]
tf = traverse (const [1, 0])

wrongness :: [Int] -> [[Int] -> Bool] -> [Int]
wrongness ns ps = findIndices id (zipWith (/=) ns (map (fromEnum . ($ ns)) ps))

statements :: [[Int] -> Bool]
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
    (⊂), (→)  :: Int -> [Int] -> [Int] -> Bool
    (s ⊂ x) b = s == (sum . map (b !!) . takeWhile (< length b)) x
    (a → x) b = (b !! a == 0) || all ((== 1) . (b !!)) x

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

main :: IO ()
main =
  let t = testall statements
  in do putStrLn "Answer"
        mapM_ print $ t 0
        putStrLn "Near misses"
        mapM_ print $ t 1


   apply
128!:2

NB. example
   '*:' apply 1 2 3
1 4 9


public class LogicPuzzle
{
    boolean S[] = new boolean[13];
    int Count = 0;

    public boolean check2 ()
    {
        int count = 0;
        for (int k = 7; k <= 12; k++)
            if (S[k]) count++;
        return S[2] == (count == 3);
    }

    public boolean check3 ()
    {
        int count = 0;
        for (int k = 2; k <= 12; k += 2)
            if (S[k]) count++;
        return S[3] == (count == 2);
    }

    public boolean check4 ()
    {
        return S[4] == ( !S[5] || S[6] && S[7]);
    }

    public boolean check5 ()
    {
        return S[5] == ( !S[2] && !S[3] && !S[4]);
    }

    public boolean check6 ()
    {
        int count = 0;
        for (int k = 1; k <= 11; k += 2)
            if (S[k]) count++;
        return S[6] == (count == 4);
    }

    public boolean check7 ()
    {
        return S[7] == ((S[2] || S[3]) && !(S[2] && S[3]));
    }

    public boolean check8 ()
    {
        return S[8] == ( !S[7] || S[5] && S[6]);
    }

    public boolean check9 ()
    {
        int count = 0;
        for (int k = 1; k <= 6; k++)
            if (S[k]) count++;
        return S[9] == (count == 3);
    }

    public boolean check10 ()
    {
        return S[10] == (S[11] && S[12]);
    }

    public boolean check11 ()
    {
        int count = 0;
        for (int k = 7; k <= 9; k++)
            if (S[k]) count++;
        return S[11] == (count == 1);
    }

    public boolean check12 ()
    {
        int count = 0;
        for (int k = 1; k <= 11; k++)
            if (S[k]) count++;
        return S[12] == (count == 4);
    }

    public void check ()
    {
        if (check2() && check3() && check4() && check5() && check6()
            && check7() && check8() && check9() && check10() && check11()
            && check12())
        {
            for (int k = 1; k <= 12; k++)
                if (S[k]) System.out.print(k + " ");
            System.out.println();
            Count++;
        }
    }

    public void recurseAll (int k)
    {
        if (k == 13)
            check();
        else
        {
            S[k] = false;
            recurseAll(k + 1);
            S[k] = true;
            recurseAll(k + 1);
        }
    }

    public static void main (String args[])
    {
        LogicPuzzle P = new LogicPuzzle();
        P.S[1] = true;
        P.recurseAll(2);
        System.out.println();
        System.out.println(P.Count + " Solutions found.");
    }
}


def indexed(filter):
  . as $in
  | reduce range(0;length) as $i ([]; if ($i | filter) then . + [$in[$i]] else . end);

def count(value): map(select(. == value)) | length;

# The truth or falsity of the 12 statements can be captured in an array of size 12:
def generate(k):
  if k == 1 then [true], [false]
  else generate(1) + generate(k-1)
  end;

# Input: a boolean array
def evaluate:
  [ (length == 12),                                          #1
    ((.[6:] | count(true)) == 3),                            #2
    ((indexed(. % 2 == 1) | count(true)) == 2),              #3
    (if .[4] then .[5] and .[6] else true end),              #4
    ((.[1:4] | count(false)) == 3),                          #5
    ((indexed(. % 2 == 0) | count(true)) == 4),              #6
    (([.[1], .[2]] | count(true)) == 1),                     #7
    (if .[6] then .[4] and .[5] else true end),              #8
    ((.[0:6] | count(true)) == 3),                           #9
    (.[10] and .[11]),                                      #10
    ((.[6:9] | count(true)) == 1),                          #11
    ((.[0:11] | count(true)) == 4)                          #12
  ];

# The following query generates the solution to the problem:
# generate(12) | . as $vector | if evaluate == $vector then $vector else empty end

# Running "task" as defined next would generate
# both the general solution as well as the off-by-one solutions:

def task:

  # count agreements
  def agreed(x;y): reduce range(0;x|length) as $i (0; if x[$i] == y[$i] then .+1 else . end);

  reduce generate(12) as $vector
    ([]; ($vector | evaluate) as $e
         | agreed($vector; $e) as $agreed
         | if $agreed == 12 then [[12,$vector]] + .
           elif $agreed == 11 then . +  [[11, $vector]]
           else .
           end);

# Since the solutions have been given elsewhere, we simply count the
# number of exact and off-by-one solutions:

task | length


using Printf

function showflaggedbits{T<:BitArray{1}}(a::T, f::T)
    tf = map(x->x ? "T" : "F", a)
    flg = map(x->x ? "*" : " ", f)
    join(tf .* flg, " ")
end

const props = [s -> length(s) == 12,
               s -> sum(s[7:12]) == 3,
               s -> sum(s[2:2:end]) == 2,
               s -> !s[5] || (s[6] & s[7]),
               s -> !any(s[2:4]),
               s -> sum(s[1:2:end]) == 4,
               s -> s[2] $ s[3],
               s -> !s[7] || (s[5] & s[6]),
               s -> sum(s[1:6]) == 3,
               s -> s[11] & s[12],
               s -> sum(s[7:9]) == 1,
               s -> sum(s[1:end-1]) == 4]

const NDIG = length(props)
NDIG < WORD_SIZE || println("WARNING, too many propositions!")

mhist = zeros(Int, NDIG+1)

println("Checking the ", NDIG, " statements against all possibilities.\n")
print(" "^15)
for i in 1:NDIG
    print(@sprintf "%3d" i)
end
println()

for i in 0:(2^NDIG-1)
    s = bitpack(digits(i, 2, NDIG))
    t = bitpack([p(s) for p in props])
    misses = s$t
    mcnt = sum(misses)
    mhist[NDIG-mcnt+1] += 1
    mcnt < 2 || mcnt == NDIG || continue
    if mcnt == 0
        print("    Exact Match: ")
    elseif mcnt == NDIG
        print("     Total Miss: ")
    else
        print("      Near Miss: ")
    end
    println(showflaggedbits(t, misses))
end

println()
println("Distribution of matches")
println(" Matches  Cases")
for i in (NDIG+1):-1:1
    println(@sprintf "    %2d => %4d" i-1 mhist[i])
end


// version 1.1.3

typealias Predicate = (String) -> Boolean

val predicates = listOf<Predicate>(
    { it.length == 13 },  // indexing starts at 0 but first bit ignored
    { (7..12).count { i -> it[i] == '1' } == 3 },
    { (2..12 step 2).count { i -> it[i] == '1' } == 2 },
    { it[5] == '0' || (it[6] == '1' && it[7] == '1') },
    { it[2] == '0' && it[3]  == '0' && it[4] == '0' },
    { (1..11 step 2).count { i -> it[i] == '1' } == 4 },
    { (it[2] == '1') xor (it[3] == '1') },
    { it[7] == '0' || (it[5] == '1' && it[6] == '1') },
    { (1..6).count { i -> it[i] == '1' } == 3 },
    { it[11] == '1' && it[12] == '1' },
    { (7..9).count { i -> it[i] == '1' } == 1 },
    { (1..11).count { i -> it[i] == '1' } == 4 }
)

fun show(s: String, indent: Boolean) {
    if (indent) print("    ")
    for (i in s.indices) if (s[i] == '1') print("$i ")
    println()
}

fun main(args: Array<String>) {
    println("Exact hits:")
    for (i in 0..4095) {
        val s = i.toString(2).padStart(13, '0')
        var j = 1
        if (predicates.all { it(s) == (s[j++] == '1') }) show(s, true)
    }

    println("\nNear misses:")
    for (i in 0..4095) {
        val s = i.toString(2).padStart(13, '0')
        var j = 1
        if (predicates.count { it(s) == (s[j++] == '1') } == 11) {
            var k = 1
            val iof = predicates.indexOfFirst { it(s) != (s[k++] == '1') } + 1
            print("    (Fails at statement ${"%2d".format(iof)})  ")
            show(s, false)
        }
    }
}


import bitops, sequtils, strformat, strutils, sugar

type Bools = array[1..12, bool]

const Predicates = [1:  (b: Bools) => b.len == 12,
                    2:  (b: Bools) => b[7..12].count(true) == 3,
                    3:  (b: Bools) => toSeq(countup(2, 12, 2)).mapIt(b[it]).count(true) == 2,
                    4:  (b: Bools) => not b[5] or b[6] and b[7],
                    5:  (b: Bools) => not b[2] and not b[3] and not b[4],
                    6:  (b: Bools) => toSeq(countup(1, 12, 2)).mapIt(b[it]).count(true) == 4,
                    7:  (b: Bools) => b[2] xor b[3],
                    8:  (b: Bools) => not b[7] or b[5] and b[6],
                    9:  (b: Bools) => b[1..6].count(true) == 3,
                    10: (b: Bools) => b[11] and b[12],
                    11: (b: Bools) => b[7..9].count(true) == 1,
                    12: (b: Bools) => b[1..11].count(true) == 4]

proc `$`(b: Bools): string =
  toSeq(1..12).filterIt(b[it]).join(" ")

echo "Exacts hits:"
var bools: Bools
for n in 0..4095:
  block check:
    for i in 1..12: bools[i] = n.testBit(12 - i)
    for i, predicate in Predicates:
      if predicate(bools) != bools[i]:
        break check
    echo "    ", bools

echo "\nNear misses:"
for n in 0..4095:
  for i in 1..12: bools[i] = n.testBit(12 - i)
  var count = 0
  for i, predicate in Predicates:
    if predicate(bools) == bools[i]: inc count
  if count == 11:
    for i, predicate in Predicates:
      if predicate(bools) != bools[i]:
        echo &"    (Fails at statement {i:2})  {bools}"
        break


PROGRAM TwelveStatements;

{
  This program searches through the 4095 possible sets
  of 12 statements for any which may be self-consistent.
}

CONST
    max12b = 4095; { Largest 12 byte number. }

TYPE
    statnum = 1..12;  { statement numbers }
    statset = set of statnum; { sets of statements }

VAR { global variables for use in main algorithm }
    trialNumber: integer;
    trialSet, testResults: statset;

function Convert(n: integer): statset;
{
  Converts an integer into a set of statements.
  For each "1" in the last 12 bits of
  the integer's binary representation,
  a statement number is put into the set.
}
var
    i: statnum;
    s: statset;
begin
    s := []; { Empty set. }
    for i := 12 downto 1 do begin
        if (n mod 2) = 1 then s := s + [i];
        n := n div 2
    end;
    Convert := s
end;

procedure Express(truths: statset);
{
  Writes the statement number of each "truth",
  with at least one space in front,
  all on one line.
}
var n: statnum;
begin
    for n := 1 to 12 do
     if n in truths then write(n:3);
    writeln
end;

function Count(truths: statset): integer;
{ Counts the statement numbers in the set. }
var
    s: statnum;
    i: integer;
begin
    i := 0;
    for s := 1 to 12 do if s in truths then i := i + 1;
    Count := i
end;

function Test(truths: statset): statset;
{
  Starts with a set of supposedly true statements
  and checks which of the 12 statements can actually
  be confirmed about the set itself.
}
var
    evens, odds, confirmations: statset;
begin
    evens := [2, 4, 6, 8, 10, 12];
    odds := [1, 3, 5, 7, 9, 11];

    { Statement 1 is necessarily true. }
    confirmations := [1];

    { Statement 2 }
    if Count(truths * [7..12]) = 3
     then confirmations := confirmations + [2];

    { Statement 3 }
    if Count(truths * evens) = 2
     then confirmations := confirmations + [3];

    { Statement 4 is true if 6 and 7 are true, or if 5 is false. }
    if ([6, 7] <= truths) or not (5 in truths)
     then confirmations := confirmations + [4];

    { Statement 5 }
    if [2, 3, 4] <= truths
     then confirmations := confirmations + [5];

    { Statement 6 }
    if Count(truths * odds) = 4
     then confirmations := confirmations + [6];

    { Statement 7 }
    if (2 in truths) xor (3 in truths)
     then confirmations := confirmations + [7];

    { Statement 8 is true if 5 and 6 are true, or if 7 is false. }
    if ([5, 6] <= truths) or not (7 in truths)
     then confirmations := confirmations + [8];

    { Statement 9 }
    if Count(truths * [1..6]) = 3
     then confirmations := confirmations + [9];

    { Statement 10 }
    if [11, 12] <= truths
     then confirmations := confirmations + [10];

    { Statement 11 }
    if Count(truths * [7, 8, 9]) = 1
     then confirmations := confirmations + [11];

    { Statement 12 }
    if Count(truths - [12]) = 4
     then confirmations := confirmations + [12];

    Test := confirmations
end;

BEGIN  { Main algorithm. }
    for trialNumber := 1 to max12b do begin
        trialSet := Convert(trialNumber);
        testResults := Test(trialSet);
        if testResults = trialSet then Express(trialSet)
    end;
    writeln('Done. Press ENTER.');
    readln
END.


function s1(string s) return length(s)=12 end function
function s2(string s) return sum(sq_eq(s[7..12],'1'))=3 end function
function s3(string s) return sum(sq_eq(extract(s,tagset(12,2,2)),'1'))=2 end function
function s4(string s) return s[5]='0' or s[6..7]="11" end function
function s5(string s) return s[2..4]="000" end function
function s6(string s) return sum(sq_eq(extract(s,tagset(12,1,2)),'1'))=4 end function
function s7(string s) return s[2]!=s[3] end function
function s8(string s) return s[7]='0' or s[5..6]="11" end function
function s9(string s) return sum(sq_eq(s[1..6],'1'))=3 end function
function s10(string s) return s[11..12]="11" end function
function s11(string s) return sum(sq_eq(s[7..9],'1'))=1 end function
function s12(string s) return sum(sq_eq(s[1..11],'1'))=4 end function

sequence rtn = {s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12}
string misses = "\n"
for i=0 to power(2,12)-1 do
    string s = sprintf("%012b",i)
    sequence res = find_all('1',s)
    integer t = 0, pass, fail
    for b=1 to 12 do
        pass = call_func(rtn[b],{s})=(s[b]='1')
        if not pass then fail = b end if
        t += pass
        if b=12 and t=12 then printf(1,"Solution: %v\n",{res}) end if
    end for
    if t=11 then
        misses &= sprintf("Near miss: %v, fail on %d\n",{res,fail})
    end if
end for
puts(1,misses)


% {{trans|Prolog}}
go ?=>
  puzzle,
  fail, % check for more answers
  nl.
go => true.

puzzle =>
       % 1. This is a numbered list of twelve statements.
	L = [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12],
	L :: 0..1,
	element(1, L, 1),

        % 2.  Exactly 3 of the last 6 statements are true.
	A2 #<=>  sum(L[7..12]) #= 3,

        % 3.  Exactly 2 of the even-numbered statements are true.
	A3 #<=> sum([L[I]:I in 1..12,I mod 2 == 0]) #= 2,

        % 4.  If statement 5 is true, then statements 6 and 7 are both true.
	A4 #<=> (A5 #=> (A6 #/\ A7)),

        % 5.  The 3 preceding statements are all false.
	A5 #<=> sum(L[2..4]) #= 0,

        % 6.  Exactly 4 of the odd-numbered statements are true.
	A6 #<=> sum([L[I]:I in 1..12,I mod 2 == 1]) #= 4,

        % 7.  Either statement 2 or 3 is true, but not both.
	A7 #<=> (A2 + A3 #= 1),

        % 8.  If statement 7 is true, then 5 and 6 are both true.
	A8 #<=> (A7 #=>  A5 #/\ A6),

        % 9.  Exactly 3 of the first 6 statements are true.
	A9 #<=> sum(L[1..6]) #= 3,

        % 10.  The next two statements are both true.
	A10 #<=> (A11 #/\ A12),

        % 11.  Exactly 1 of statements 7, 8 and 9 are true.
	A11 #<=> (A7 + A8 + A9 #= 1),

        % 12.  Exactly 4 of the preceding statements are true.
        A12 #<=> sum(L[1..11]) #= 4,

	solve(L),

        println('L'=L),
	printf("Statements %w are true.\n", [I.to_string : I in 1..12, L[I] == 1].join(" ")),
	nl.


puzzle :-
        % 1. This is a numbered list of twelve statements.
	L = [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12],
	L ins 0..1,
	element(1, L, 1),

       % 2.  Exactly 3 of the last 6 statements are true.
	A2 #<==>  A7 + A8 + A9 + A10 + A11 + A12 #= 3,

       % 3.  Exactly 2 of the even-numbered statements are true.
	A3 #<==> A2 + A4 + A6 + A8 + A10 + A12 #= 2,

       % 4.  If statement 5 is true, then statements 6 and 7 are both true.
	A4 #<==> (A5 #==> (A6 #/\ A7)),

       % 5.  The 3 preceding statements are all false.
	A5 #<==> A2 + A3 + A4 #= 0,

       % 6.  Exactly 4 of the odd-numbered statements are true.
	A6 #==> A1 + A3 + A5 + A7 + A9 + A11 #= 4,

        % 7.  Either statement 2 or 3 is true, but not both.
	A7 #<==> A2 + A3 #= 1,

        % 8.  If statement 7 is true, then 5 and 6 are both true.
	A8 #<==> (A7 #==>  A5 #/\ A6),

        % 9.  Exactly 3 of the first 6 statements are true.
	A9 #<==> A1 + A2 + A3 + A4 + A5 + A6 #= 3,

        % 10.  The next two statements are both true.
	A10 #<==> A11 #/\ A12,

        % 11.  Exactly 1 of statements 7, 8 and 9 are true.
	A11 #<==> A7 + A8 + A9 #= 1,

        % 12.  Exactly 4 of the preceding statements are true.
	A12 #<==> A1 + A2 + A3 + A4 + A5 + A6 + A7 +A8 + A9 + A10 + A11 #= 4,

	label(L),
        numlist(1, 12, NL),
	write('Statements '),
	maplist(my_write, NL, L),
	writeln('are true').

my_write(N, 1) :-
	format('~w ', [N]).

my_write(_N, 0).


from itertools import product
#from pprint import pprint as pp

constraintinfo = (
  (lambda st: len(st) == 12                 ,(1, 'This is a numbered list of twelve statements')),
  (lambda st: sum(st[-6:]) == 3             ,(2, 'Exactly 3 of the last 6 statements are true')),
  (lambda st: sum(st[1::2]) == 2            ,(3, 'Exactly 2 of the even-numbered statements are true')),
  (lambda st: (st[5]&st[6]) if st[4] else 1 ,(4, 'If statement 5 is true, then statements 6 and 7 are both true')),
  (lambda st: sum(st[1:4]) == 0             ,(5, 'The 3 preceding statements are all false')),
  (lambda st: sum(st[0::2]) == 4            ,(6, 'Exactly 4 of the odd-numbered statements are true')),
  (lambda st: sum(st[1:3]) == 1             ,(7, 'Either statement 2 or 3 is true, but not both')),
  (lambda st: (st[4]&st[5]) if st[6] else 1 ,(8, 'If statement 7 is true, then 5 and 6 are both true')),
  (lambda st: sum(st[:6]) == 3              ,(9, 'Exactly 3 of the first 6 statements are true')),
  (lambda st: (st[10]&st[11])               ,(10, 'The next two statements are both true')),
  (lambda st: sum(st[6:9]) == 1             ,(11, 'Exactly 1 of statements 7, 8 and 9 are true')),
  (lambda st: sum(st[0:11]) == 4            ,(12, 'Exactly 4 of the preceding statements are true')),
)

def printer(st, matches):
    if False in matches:
        print('Missed by one statement: %i, %s' % docs[matches.index(False)])
    else:
        print('Full match:')
    print('  ' + ', '.join('%i:%s' % (i, 'T' if t else 'F') for i, t in enumerate(st, 1)))

funcs, docs = zip(*constraintinfo)

full, partial = [], []

for st in product( *([(False, True)] * 12) ):
    truths = [bool(func(st)) for func in funcs]
    matches = [s == t for s,t in zip(st, truths)]
    mcount = sum(matches)
    if mcount == 12:
        full.append((st, matches))
    elif mcount == 11:
        partial.append((st, matches))

for stm in full + partial:
    printer(*stm)


#lang racket

;; A quick `amb' implementation
(define failures null)
(define (fail)
  (if (pair? failures) ((first failures)) (error "no more choices!")))
(define (amb/thunks choices)
  (let/cc k (set! failures (cons k failures)))
  (if (pair? choices)
    (let ([choice (first choices)]) (set! choices (rest choices)) (choice))
    (begin (set! failures (rest failures)) (fail))))
(define-syntax-rule (amb E ...) (amb/thunks (list (lambda () E) ...)))
(define (assert condition) (unless condition (fail)))

;; just to make things more fun
(define (⇔ x y) (assert (eq? x y)))
(require (only-in racket [and ∧] [or ∨] [implies ⇒] [xor ⊻] [not ¬]))
(define (count xs)
  (let loop ([n 0] [xs xs])
    (if (null? xs) n (loop (if (car xs) (add1 n) n) (cdr xs)))))
;; even more fun, make []s infix
(require (only-in racket [#%app r:app]))
(define-syntax (#%app stx)
  (if (not (eq? #\[ (syntax-property stx 'paren-shape)))
    (syntax-case stx () [(_ x ...) #'(r:app x ...)])
    (syntax-case stx ()
      ;; extreme hack on next two cases, so it works for macros too.
      [(_ x op y) (syntax-property #'(op x y) 'paren-shape #f)]
      [(_ x op y op1 z) (free-identifier=? #'op #'op1)
       (syntax-property #'(op x y z) 'paren-shape #f)])))
;; might as well do more
(define-syntax-rule (define-booleans all x ...)
  (begin (define x (amb #t #f)) ...
         (define all (list x ...))))

(define (puzzle)
  (define-booleans all q1 q2 q3 q4 q5 q6 q7 q8 q9 q10 q11 q12)
  ;; 1.  This is a numbered list of twelve statements.
  [q1 ⇔ [12 = (length all)]]
  ;; 2.  Exactly 3 of the last 6 statements are true.
  [q2 ⇔ [3 = (count (take-right all 6))]]
  ;; 3.  Exactly 2 of the even-numbered statements are true.
  [q3 ⇔ [2 = (count (list q2 q4 q6 q8 q10 q12))]]
  ;; 4.  If statement 5 is true, then statements 6 and 7 are both true.
  [q4 ⇔ [q5 ⇒ [q6 ∧ q7]]]
  ;; 5.  The 3 preceding statements are all false.
  [q5 ⇔ (¬ [q2 ∨ q3 ∨ q4])]
  ;; 6.  Exactly 4 of the odd-numbered statements are true.
  [q6 ⇔ [4 = (count (list q1 q3 q5 q7 q9 q11))]]
  ;; 7.  Either statement 2 or 3 is true, but not both.
  [q7 ⇔ [q2 ⊻ q3]]
  ;; 8.  If statement 7 is true, then 5 and 6 are both true.
  [q8 ⇔ [q7 ⇒ (and q5 q6)]]
  ;; 9.  Exactly 3 of the first 6 statements are true.
  [q9 ⇔ [3 = (count (take all 3))]]
  ;; 10. The next two statements are both true.
  [q10 ⇔ [q11 ∧ q12]]
  ;; 11. Exactly 1 of statements 7, 8 and 9 are true.
  [q11 ⇔ [1 = (count (list q7 q8 q9))]]
  ;; 12. Exactly 4 of the preceding statements are true.
  [q12 ⇔ [4 = (count (drop-right all 1))]]
  ;; done
  (for/list ([i (in-naturals 1)] [q all] #:when q) i))

(puzzle)
;; -> '(1 3 4 6 7 11)


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

my @tests =
    { .end == 12 and 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 @solutions;
my @misses;

for [X] (True, False) xx 12 {
    my @assert = Nil, |$_;
    my @result = Nil, |@tests.map({ ?.(@assert) });
    my @true = @assert.grep(?*, :k);
    my @cons = (@assert Z=== @result).grep(!*, :k);
    given @cons {
        when 0 { push @solutions, "<{@true}> is consistent."; }
        when 1 { push @misses, "<{@true}> implies { "¬" if [email protected][~$_] }$_." }
    }
}

.say for @solutions;
say "";
say "Near misses:";
.say for @misses;


/*REXX program solves the  "Twelve Statement Puzzle".                                   */
q=12;      @stmt=right('statement',20)           /*number of statements in the puzzle.  */
m=0                                              /*[↓]  statement one is  TRUE  by fiat.*/
      do pass=1  for 2                           /*find the maximum number of  "trues". */
        do e=0   for 2**(q-1);    n = '1'right( x2b( d2x( e ) ),  q-1,  0)
              do b=1  for q                      /*define various bits in the number  Q.*/
              @.b=substr(n, b, 1)                /*define a particular  @  bit  (in  Q).*/
              end   /*b*/
        if @.1  then if yeses(1,  1)                        \==1  then iterate
        if @.2  then if yeses(7, 12)                        \==3  then iterate
        if @.3  then if yeses(2, 12,2)                      \==2  then iterate
        if @.4  then if yeses(5,  5)   then  if yeses(6, 7) \==2  then iterate
        if @.5  then if yeses(2,  4)                        \==0  then iterate
        if @.6  then if yeses(1, 12,2)                      \==4  then iterate
        if @.7  then if yeses(2,  3)                        \==1  then iterate
        if @.8  then if yeses(7,  7)   then  if yeses(5,6)  \==2  then iterate
        if @.9  then if yeses(1,  6)                        \==3  then iterate
        if @.10 then if yeses(11,12)                        \==2  then iterate
        if @.11 then if yeses(7,  9)                        \==1  then iterate
        if @.12 then if yeses(1, 11)                        \==4  then iterate
        g=yeses(1, 12)
        if pass==1  then do;  m=max(m,g);  iterate;  end
                    else if g\==m     then iterate
            do j=1  for q;             z=substr(n, j, 1)
            if z  then  say @stmt right(j, 2)    " is "    word('false true', 1 + z)
            end   /*tell*/
        end       /*e*/
      end         /*pass*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
yeses: parse arg L,H,B;  #=0;    do i=L  to H  by word(B 1, 1);  #=#[email protected].i;  end;   return #


constraints = [
  ->(st) { st.size == 12 },
  ->(st) { st.last(6).count(true) == 3 },
  ->(st) { st.each_slice(2).map(&:last).count(true) == 2 },
  ->(st) { st[4] ? (st[5] & st[6]) : true },
  ->(st) { st[1..3].none? },
  ->(st) { st.each_slice(2).map(&:first).count(true) == 4 },
  ->(st) { st[1] ^ st[2] },
  ->(st) { st[6] ? (st[4] & st[5]) : true  },
  ->(st) { st.first(6).count(true) == 3 },
  ->(st) { st[10] & st[11] },
  ->(st) { st[6..8].one? },
  ->(st) { st[0,11].count(true) == 4 },
]

Result = Struct.new(:truths, :consistency)

results = [true, false].repeated_permutation(12).map do |truths|
  Result.new(truths, constraints.zip(truths).map {|cn,truth| cn[truths] == truth })
end

puts "solution:",
  results.find {|r| r.consistency.all? }.truths.to_s

puts "\nnear misses: "
near_misses = results.select {|r| r.consistency.count(false) == 1 }
near_misses.each do |r|
  puts "missed by statement #{r.consistency.index(false) + 1}", r.truths.to_s
end


class LogicPuzzle {
  val s = new Array[Boolean](13)
  var count = 0

  def check2: Boolean = {
    var count = 0
    for (k <- 7 to 12) if (s(k)) count += 1

    s(2) == (count == 3)
  }

  def check3: Boolean = {
    var count = 0
    for (k <- 2 to 12 by 2) if (s(k)) count += 1

    s(3) == (count == 2)
  }

  def check4: Boolean = s(4) == (!s(5) || s(6) && s(7))

  def check5: Boolean = s(5) == (!s(2) && !s(3) && !s(4))

  def check6: Boolean = {
    var count = 0
    for (k <- 1 to 11 by 2) if (s(k)) count += 1
    s(6) == (count == 4)
  }

  def check7: Boolean = s(7) == ((s(2) || s(3)) && !(s(2) && s(3)))

  def check8: Boolean = s(8) == (!s(7) || s(5) && s(6))

  def check9: Boolean = {
    var count = 0
    for (k <- 1 to 6) if (s(k)) count += 1

    s(9) == (count == 3)
  }

  def check10: Boolean = s(10) == (s(11) && s(12))

  def check11: Boolean = {
    var count = 0
    for (k <- 7 to 9) if (s(k)) count += 1

    s(11) == (count == 1)
  }

  def check12: Boolean = {
    var count = 0
    for (k <- 1 to 11) if (s(k)) count += 1
    s(12) == (count == 4)
  }

  def check(): Unit = {
    if (check2 && check3 && check4 && check5 && check6 && check7 && check8 && check9 && check10 && check11 && check12) {
      for (k <- 1 to 12) if (s(k)) print(k + " ")
      println()
      count += 1
    }
  }

  def recurseAll(k: Int): Unit = {
    if (k == 13) check()
    else {
      s(k) = false
      recurseAll(k + 1)
      s(k) = true
      recurseAll(k + 1)
    }
  }
}

object LogicPuzzle extends App {
  val p = new LogicPuzzle
  p.s(1) = true
  p.recurseAll(2)
  println()
  println(s"${p.count} Solutions found.")

}


import UIKit
import Foundation

internal enum PaddingOption {
    case Left
    case Right
}

extension Array {
    func pad(element: Element, times: Int, toThe: PaddingOption) -> Array<Element> {

        let padded = [Element](repeating: element, count: times)
        switch(toThe) {
        case .Left:
            return padded + self
        case .Right:
            return self + padded
        }
    }

    func take(n: Int) -> Array<Element> {
        if n <= 0 {
            return []
        }
        return Array(self[0..<Swift.min(n, self.count)])
    }

    func drop(n: Int) -> Array<Element> {
        if n <= 0 {
            return self
        } else if n >= self.count {
            return []
        }
        return Array(self[n..<self.count])
    }

    func stride(n: Int) -> Array<Element> {
        var result:[Element] = []
        for i in Swift.stride(from: 0, to: self.count, by: n) {
            result.append(self[i])
        }
        return result
    }

    func zipWithIndex() -> Array<(Element, Int)> {
        let result = [(Element, Int)](zip(self, self.indices))
        return result
    }
}

extension Int {
    func binaryRepresentationOfLength(length: Int) -> [Int] {
        var binaryRepresentation:[Int] = []
        var value = self
        while (value != 0) {
            binaryRepresentation.append(value & 1)
            value /= 2
        }
        let result = binaryRepresentation.pad(element: 0, times: length-binaryRepresentation.count, toThe: .Right)
        return result
    }
}

let problem = [
    "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."]

let statements:[(([Bool]) -> Bool)] = [
    { s in s.count == 12 },
    { s in s.drop(n: 6).filter({ $0 }).count == 3 },
    { s in s.drop(n: 1).stride(n: 2).filter({ $0 }).count == 2 },
    { s in s[4] ? (s[5] && s[6]) : true },
    { s in s.drop(n: 1).take(n: 3).filter({ $0 }).count == 0 },
    { s in s.stride(n: 2).filter({ $0 }).count == 4 },
    { s in [s[1], s[2]].filter({ $0 }).count == 1 },
    { s in s[6] ? (s[4] && s[5]) : true },
    { s in s.take(n: 6).filter({ $0 }).count == 3 },
    { s in [s[10], s[11]].filter({ $0 }).count == 2 },
    { s in [s[6], s[7], s[8]].filter({ $0 }).count == 1 },
    { s in s.take(n: 11).filter({ $0 }).count == 4 }
]

for variant in 0..<(1<<statements.count) {
    let attempt = variant.binaryRepresentationOfLength(length: statements.count).map { $0 == 1 }

    if statements.map({ $0(attempt) }) == attempt {
        let trueAre = attempt.zipWithIndex().filter { $0.0 }.map { $0.1 + 1 }
        print("Solution found! True are: \(trueAre)")
    }
}


package require Tcl 8.6

# Function to evaluate the truth of a statement
proc tcl::mathfunc::S {idx} {
    upvar 1 state s
    apply [lindex $s [expr {$idx - 1}]] $s
}
# Procedure to count the number of statements which are true
proc S+ args {
    upvar 1 state state
    tcl::mathop::+ {*}[lmap i $args {expr {S($i)}}]
}
# Turn a list of expressions into a list of lambda terms
proc lambdas items {lmap x $items {list state [list expr $x]}}

# Find the truth assignment that produces consistency. And those that are
# near misses too.
proc findTruthMatch {statements} {
    set n [llength $statements]
    for {set i 0} {$i < 2**$n} {incr i} {
	set state [split [format %0.*b $n $i] ""]
	set truths [lmap f $statements {apply $f [lambdas $state]}]
	set counteq [tcl::mathop::+ {*}[lmap s $state t $truths {expr {
	    $s == $t
	}}]]
	if {$counteq == $n} {
	    lappend exact $state
	} elseif {$counteq == $n-1} {
	    set j 0
	    foreach s $state t $truths {
		incr j
		if {$s != $t} {
		    lappend differ $state $j
		    break
		}
	    }
	}
    }
    return [list $exact $differ]
}

# Rendering code
proc renderstate state {
    return ([join [lmap s $state {
	incr i
	expr {$s ? "S($i)" : "\u00acS($i)"}
    }] "\u22c0"])
}

# The statements, encoded as expressions
set statements {
    {[llength $state] == 12}
    {[S+ 7 8 9 10 11 12] == 3}
    {[S+ 2 4 6 8 10 12] == 2}
    {S(5) ? S(6) && S(7) : 1}
    {[S+ 2 3 4] == 0}
    {[S+ 1 3 5 7 9 11] == 4}
    {S(2) != S(3)}
    {S(7) ? S(5) && S(6) : 1}
    {[S+ 1 2 3 4 5 6] == 3}
    {S(11) && S(12)}
    {[S+ 7 8 9] == 1}
    {[S+ 1 2 3 4 5 6 7 8 9 10 11] == 4}
}
# Find the truth assignment(s) that give consistency
lassign [findTruthMatch [lambdas $statements]] exact differ
# Print the results
foreach state $exact {
    puts "exact match\t[renderstate $state ]"
}
foreach {state j} $differ {
    puts "almost found\t[renderstate $state] \u21d2 [expr {[lindex $state $j-1]?"\u00ac":{}}]S($j)"
}


(defmacro defconstraints (name size-name (var) . forms)
  ^(progn (defvar ,size-name ,(length forms))
          (defun ,name (,var)
            (list ,*forms))))

(defconstraints con con-count (s)
  (= (length s) con-count) ;; tautology
  (= (countq t [s -6..t]) 3)
  (= (countq t (mapcar (op if (evenp @1) @2) (range 1) s)) 2)
  (if [s 4] (and [s 5] [s 6]) t)
  (none [s 1..3])
  (= (countq t (mapcar (op if (oddp @1) @2) (range 1) s)) 4)
  (and (or [s 1] [s 2]) (not (and [s 1] [s 2])))
  (if [s 6] (and [s 4] [s 5]) t)
  (= (countq t [s 0..6]) 3)
  (and [s 10] [s 11])
  (= (countq t [s 6..9]) 1)
  (= (countq t [s 0..con-count]) 4))

(defun true-indices (truths)
  (mappend (do if @1 ^(,@2)) truths (range 1)))

(defvar results
  (append-each ((truths (rperm '(nil t) con-count)))
    (let* ((vals (con truths))
           (consist [mapcar eq truths vals])
           (wrong-count (countq nil consist))
           (pos-wrong (+ 1 (or (posq nil consist) -2))))
      (cond
        ((zerop wrong-count)
         ^((:----> ,*(true-indices truths))))
        ((= 1 wrong-count)
         ^((:close ,*(true-indices truths) (:wrong ,pos-wrong))))))))

(each ((r results))
  (put-line `@r`))


S = 12
For T = 0 To (2^S)-1

  For I = 1 To 12
      Push T, 2^(I-1) : Gosub 100
      @(I) = Pop() # 0
  Next

  REM Test consistency:

  @(101) = @(1)  = (S = 12)
  @(102) = @(2)  = ((@(7)[email protected](8)[email protected](9)[email protected](10)[email protected](11)[email protected](12)) = 3)
  @(103) = @(3)  = ((@(2)[email protected](4)[email protected](6)[email protected](8)[email protected](10)[email protected](12)) = 2)
  @(104) = @(4)  = ((@(5)=0) + (@(6) * @(7)) # 0)
  @(105) = @(5)  = ((@(2)=0) * (@(3)=0) * (@(4)=0))
  @(106) = @(6)  = ((@(1)[email protected](3)[email protected](5)[email protected](7)[email protected](9)[email protected](11)) = 4)
  @(107) = @(7)  = ((@(2) + @(3)) = 1)
  @(108) = @(8)  = ((@(7)=0) + (@(5) * @(6)) # 0)
  @(109) = @(9)  = ((@(1)[email protected](2)[email protected](3)[email protected](4)[email protected](5)[email protected](6)) = 3)
  @(110) = @(10) = (@(11) * @(12))
  @(111) = @(11) = ((@(7)[email protected](8)[email protected](9)) = 1)
  @(112) = @(12) = ((@(1)[email protected](2)[email protected](3)[email protected](4)[email protected](5)[email protected](6)[email protected](7)[email protected](8)[email protected](9)[email protected](10)[email protected](11)) = 4)

  Q = 0
  For I = 101 To 112
      Q = Q + @(I)
  Next

  If (Q = 11) Then
     Print "Near miss with statements ";
     For I = 1 To 12
       If @(I) Then
          Print I; " ";
       Endif
       If (@(I+100) = 0) Then
          M = I
       Endif
     Next
     Print "true (failed " ;M; ")."
  Endif

  If (Q = 12) Then
     Print "Solution! with statements ";
     For I = 1 TO 12
       If @(I) Then
          Print I; " ";
       Endif
     Next
     Print "true."
  Endif

Next
End

100 Rem a hard way to do a binary AND
    q = Pop() : p = Pop() : Push 0

    Do While (p * q) * (Tos() = 0)
       Push Pop() + (p % 2) * (q % 2)
       p = p / 2
       q = q / 2
    Loop

    Return


Public s As String    '-- (eg "101101100010")
Public t As Integer   '-- scratch

Function s1()
    s1 = Len(s) = 12
End Function
Function s2()
    t = 0
    For i = 7 To 12
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s2 = t = 3
End Function
Function s3()
    t = 0
    For i = 2 To 12 Step 2
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s3 = t = 2
End Function
Function s4()
    s4 = Mid(s, 5, 1) = "0" Or ((Mid(s, 6, 1) = "1" And Mid(s, 7, 1) = "1"))
End Function
Function s5()
    s5 = Mid(s, 2, 1) = "0" And Mid(s, 3, 1) = "0" And Mid(s, 4, 1) = "0"
End Function
Function s6()
    t = 0
    For i = 1 To 12 Step 2
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s6 = t = 4
End Function
Function s7()
    s7 = Mid(s, 2, 1) <> Mid(s, 3, 1)
End Function
Function s8()
    s8 = Mid(s, 7, 1) = "0" Or (Mid(s, 5, 1) = "1" And Mid(s, 6, 1) = "1")
End Function
Function s9()
    t = 0
    For i = 1 To 6
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s9 = t = 3
End Function
Function s10()
    s10 = Mid(s, 11, 1) = "1" And Mid(s, 12, 1) = "1"
End Function
Function s11()
    t = 0
    For i = 7 To 9
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s11 = t = 1
End Function
Function s12()
    t = 0
    For i = 1 To 11
        t = t - (Mid(s, i, 1) = "1")
    Next i
    s12 = t = 4
End Function

Public Sub twelve_statements()
    For i = 0 To 2 ^ 12 - 1
        s = Right(CStr(WorksheetFunction.Dec2Bin(64 + i \ 128)), 5) _
            & Right(CStr(WorksheetFunction.Dec2Bin(256 + i Mod 128)), 7)
        For b = 1 To 12
            Select Case b
                Case 1: If s1 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 2: If s2 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 3: If s3 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 4: If s4 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 5: If s5 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 6: If s6 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 7: If s7 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 8: If s8 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 9: If s9 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 10: If s10 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 11: If s11 <> (Mid(s, b, 1) = "1") Then Exit For
                Case 12: If s12 <> (Mid(s, b, 1) = "1") Then Exit For
            End Select
            If b = 12 Then Debug.Print s
        Next
    Next
End Sub


import "/fmt" for Conv, Fmt

var predicates = [
    Fn.new { |s| s.count == 13 },  // indexing starts at 0 but first bit ignored
    Fn.new { |s| (7..12).count { |i| s[i] == "1" } == 3 },
    Fn.new { |s| [2, 4, 6, 8, 10, 12].count { |i| s[i] == "1" } == 2 },
    Fn.new { |s| s[5] == "0" || (s[6] == "1" && s[7] == "1") },
    Fn.new { |s| s[2] == "0" && s[3]  == "0" && s[4] == "0" },
    Fn.new { |s| [1, 3, 5, 7, 9, 11].count { |i| s[i] == "1" } == 4 },
    Fn.new { |s| Conv.itob(Conv.btoi(s[2] == "1") ^ Conv.btoi(s[3] == "1")) },
    Fn.new { |s| s[7] == "0" || (s[5] == "1" && s[6] == "1") },
    Fn.new { |s| (1..6).count { |i| s[i] == "1" } == 3 },
    Fn.new { |s| s[11] == "1" && s[12] == "1" },
    Fn.new { |s| (7..9).count { |i| s[i] == "1" } == 1 },
    Fn.new { |s| (1..11).count { |i| s[i] == "1" } == 4 }
]

var show = Fn.new { |s, indent|
    if (indent) System.write("    ")
    for (i in 0...s.count) if (s[i] == "1") System.write("%(i) ")
    System.print()
}

System.print("Exact hits:")
for (i in 0..4095) {
    var s = Fmt.swrite("$013b", i)
    var j = 1
    if (predicates.all { |pred|
       var res = pred.call(s) == (s[j] == "1")
       j = j + 1
       return res
    }) show.call(s, true)
}

System.print("\nNear misses:")
for (i in 0..4095) {
    var s = Fmt.swrite("$013b", i)
    var j = 1
    var c = predicates.count { |pred|
        var res = pred.call(s) == (s[j] == "1")
        j = j + 1
        return res
    }
    if (c == 11) {
        var k = 1
        for (pred in predicates) {
            if (pred.call(s) != (s[k] == "1") ) break
            k = k + 1
        }
        Fmt.write("    (Fails at statement $2d)  ", k)
        show.call(s, false)
    }
}


sub s1() return len(s$)=12 end sub
sub s2() local t, i : t=0 : for i=7 to 12 : t = t + (mid$(s$, i, 1) <> "0") : next : return t=3 end sub
sub s3() local t, i : t=0 : for i=2 to 12 step 2 : t = t + (mid$(s$, i, 1) <> "0") : next : return t=2 end sub
sub s4() return mid$(s$, 5, 1) = "0" or (mid$(s$, 6, 1) <> "0" and mid$(s$, 7, 1) <> "0") end sub
sub s5() return mid$(s$, 2, 1) = "0" and mid$(s$, 3, 1) = "0" and mid$(s$, 4, 1) = "0" end sub
sub s6() local t, i : t=0 : for i=1 to 12 step 2 : t = t + mid$(s$, i, 1) <> "0" : next : return t=4 end sub
sub s7() return mid$(s$, 2, 1) <> mid$(s$, 3, 1) end sub
sub s8() return mid$(s$, 7, 1) = "0" or (mid$(s$, 5, 1) <> "0" and mid$(s$, 6, 1) <> "0") end sub
sub s9() local t, i : t=0 : for i=1 to 6 : t = t + mid$(s$, i, 1) <> "0" : next : return t=3 end sub
sub s10() return mid$(s$, 11, 1) <> "0" and mid$(s$, 12, 1) <> "0" end sub
sub s11() local t, i : t=0 : for i=7 to 9 : t = t + mid$(s$, i, 1) <> "0" : next : return t=1 end sub
sub s12() local t, i : t=0 : for i=1 to 11 : t = t + mid$(s$, i, 1) <> "0" : next : return t=4 end sub

dim r$(12)

for b=1 to 12
    r$(b) = "s"+str$(b)
next
for i=0 to 2^12-1
    s$ = right$("000000000000" + bin$(i), 12)
    for b=1 to 12
        if execute(r$(b)) <> (mid$(s$, b, 1) <> "0") break
        if b=12 print s$
    next
next


var statements; // list of 13 Bools, statements[0] is garbage to make 1 based
fcn s0 { False }  // dummy for padding
fcn s1 { True }
fcn s2 { statements[-6,*].filter().len()==3 }
fcn s3 { [2..12,2].apply(statements.get).filter().len()==2 }
fcn s4 { if(statements[5]) statements[6]==statements[7]==True else True }
fcn s5 { statements[2,3].filter().len()==0 }
fcn s6 { [1..12,2].apply(statements.get).filter().len()==4 }
fcn s7 { statements[2]!=statements[3] }
fcn s8 { if(statements[7]) statements[5]==statements[6]==True else True }
fcn s9 { statements[1,6].filter().len()==3 }
fcn s10{ statements[11]==statements[12]==True }
fcn s11{ statements[7,3].filter().len()==1 }
fcn s12{ statements[1,11].filter().len()==4 }

filters:=T(s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12);
foreach n in ((2).pow(12)){  // 4k
   // 5-->"0000000000101"-->("0","0"..."1")-->(F,F,...T)
   statements="%013.2B".fmt(n).split("").apply('==("1"));
   r:=filters.run(True);  // and return list of results
   if(r==statements) print("<<<<<<<<<<<<<<<<Solution");
   else{
      diff:=r.zipWith('!=,statements);
      if(diff.sum(0)==1) print("Diff @",diff.filter1n());
   }
}
fcn print(msg){
   (12).pump(List,'wrap(n){ statements[n] and n or Void.Skip })
   .concat(",").println(" : ",vm.pasteArgs());
}


F run_utm(halt, state, Char blank; rules_in, [Char] &tape = [Char](); =pos = 0)
   V st = state
   I tape.empty
      tape.append(blank)
   I pos < 0
      pos += tape.len
   V rules = Dict(rules_in, r -> ((r[0], Char(r[1])), (Char(r[2]), r[3], r[4])))

   L
      print(st.ljust(4), end' ‘ ’)
      L(v) tape
         V i = L.index
         I i == pos
            print(‘[’v‘]’, end' ‘ ’)
         E
            print(v, end' ‘ ’)
      print()

      I st == halt
         L.break
      I (st, tape[pos]) !C rules
         L.break

      V (v1, dr, s1) = rules[(st, tape[pos])]
      tape[pos] = v1
      I dr == ‘left’
         I pos > 0
            pos--
         E
            tape.insert(0, blank)
      I dr == ‘right’
         pos++
         I pos >= tape.len
            tape.append(blank)
      st = s1

print("incr machine\n")
run_utm(
   halt' ‘qf’,
   state' ‘q0’,
   blank' Char(‘B’),
   rules_in' [‘q0 1 1 right q0’.split(‘ ’, group_delimiters' 1B),
              ‘q0 B 1 stay  qf’.split(‘ ’, group_delimiters' 1B)],
   tape' &[‘1’, ‘1’, ‘1’]
   )

print("\nbusy beaver\n")
run_utm(
   halt' ‘halt’,
   state' ‘a’,
   blank' Char(‘0’),
   rules_in'
      [‘a 0 1 right b’.split(‘ ’, group_delimiters' 1B),
       ‘a 1 1 left  c’.split(‘ ’, group_delimiters' 1B),
       ‘b 0 1 left  a’.split(‘ ’, group_delimiters' 1B),
       ‘b 1 1 right b’.split(‘ ’, group_delimiters' 1B),
       ‘c 0 1 left  b’.split(‘ ’, group_delimiters' 1B),
       ‘c 1 1 stay  halt’.split(‘ ’, group_delimiters' 1B)]
   )

print("\nsorting test\n")
run_utm(
   halt' ‘STOP’,
   state' ‘A’,
   blank' Char(‘0’),
   rules_in'
      [‘A 1 1 right A’.split(‘ ’, group_delimiters' 1B),
       ‘A 2 3 right B’.split(‘ ’, group_delimiters' 1B),
       ‘A 0 0 left  E’.split(‘ ’, group_delimiters' 1B),
       ‘B 1 1 right B’.split(‘ ’, group_delimiters' 1B),
       ‘B 2 2 right B’.split(‘ ’, group_delimiters' 1B),
       ‘B 0 0 left  C’.split(‘ ’, group_delimiters' 1B),
       ‘C 1 2 left  D’.split(‘ ’, group_delimiters' 1B),
       ‘C 2 2 left  C’.split(‘ ’, group_delimiters' 1B),
       ‘C 3 2 left  E’.split(‘ ’, group_delimiters' 1B),
       ‘D 1 1 left  D’.split(‘ ’, group_delimiters' 1B),
       ‘D 2 2 left  D’.split(‘ ’, group_delimiters' 1B),
       ‘D 3 1 right A’.split(‘ ’, group_delimiters' 1B),
       ‘E 1 1 left  E’.split(‘ ’, group_delimiters' 1B),
       ‘E 0 0 right STOP’.split(‘ ’, group_delimiters' 1B)],
   tape' &‘2 2 2 1 2 2 1 2 1 2 1 2 1 2’.split(‘ ’).map(Char)
   )


private with Ada.Containers.Doubly_Linked_Lists;

generic
   type State is (<>);   -- State'First is starting state
   type Symbol is (<>);  -- Symbol'First is blank
package Turing is

   Start: constant State := State'First;
   Halt:  constant State := State'Last;
   subtype Action_State is State range Start .. State'Pred(Halt);

   Blank: constant Symbol := Symbol'First;

   type Movement is (Left, Stay, Right);

   type Action is record
      New_State: State;
      Move_To: Movement;
      New_Symbol: Symbol;
   end record;

   type Rules_Type is array(Action_State, Symbol) of Action;

   type Tape_Type is limited private;

   type Symbol_Map is array(Symbol) of Character;

   function To_String(Tape: Tape_Type; Map: Symbol_Map) return String;
   function Position_To_String(Tape: Tape_Type; Marker: Character := '^')
                              return String;
   function To_Tape(Str: String; Map: Symbol_Map) return Tape_Type;

   procedure Single_Step(Current: in out State;
                         Tape: in out Tape_Type;
                         Rules: Rules_Type);

   procedure Run(The_Tape: in out Tape_Type;
                 Rules: Rules_Type;
                 Max_Steps: Natural := Natural'Last;
                 Print: access procedure(Tape: Tape_Type; Current: State));
   -- runs from Start State until either Halt or # Steps exceeds Max_Steps
   -- if # of steps exceeds Max_Steps, Constrained_Error is raised;
   -- if Print is not null, Print is called at the beginning of each step

private
   package Symbol_Lists is new Ada.Containers.Doubly_Linked_Lists(Symbol);
   subtype List is Symbol_Lists.List;

   type Tape_Type is record
      Left:  List;
      Here:  Symbol;
      Right: List;
   end record;
end Turing;


#include <hopper.h>
#proto UniversalTuringMachine(_X_)

main:
  .ctrlc

   stbegin=0,stEnd=0,state=0,ptr=0
   tape=0,states=0,rules=0,long=0,tapeSize=0
   file="turing/prg03.tm"

  // load program, rules & states:
   jsub(load Archive)

 // RUN Universal Turing Machine program:
  i=1
  __TURING_RUN__:
      _Universal Turing Machine ([i,1:end]get(rules))
      ++i,{long,i}gt? do{  i=1  }
      jt(__TURING_RUN__)
  println
exit(0)

.locals

printTape:
#hl{
  print(tape[1:(ptr-1)],"\R",tape[ptr],"\OFF",tape[(ptr+1):end],"\n")
  //sleep(0.1)
  }
  up(1)
  clear mark
back

Universal Turing Machine(rules)
  cont=1
  clear mark

  #hl{
     if( rules[1] == state )
        if( tape[ptr] == rules[2] )
           tape[ptr] = rules[3]
           ptr += rules[4]
           if(ptr==0)
  }
              ++tapeSize
              {0,1,tape}, array(INSERT), ++ptr
  #hl{
           else if(ptr>tapeSize)
  }
              ++tapeSize
              {tapeSize,tape},array(RESIZE),
              [tapeSize]{0},put(tape),clear mark
  #hl{
           endif
           state = rules[5]
           if(state == stEnd)
              cont=0
           endif
  }
           jsub(print Tape)
  #hl{
        endif
     endif
  }, {cont}
back

load Archive:
  {","}tok sep
  {file} stats file
  [1,1:end],{file},!(5),load, mov(tape)
  [2,1:3],         !(5),load, mov(states)
  [3:end,1:5],          load, mov(rules)
  clear mark
  [1:end,4]get(rules),colMoving=0,   mov(colMoving)
  {"1","RIGHT",colMoving} transform, mov(colMoving)
  {"-1","LEFT",colMoving} transform, mov(colMoving)
  {"0","STAY",colMoving}  transform, xtonum, put(rules)
  clear mark
  {0}reshape(tape)
  size(tape),lengthTape=0,mov(lengthTape),[2]get(lengthTape),mov(tapeSize)
  #hl{
     stbegin=states[1,1]
     stEnd=states[1,2]
     ptr=states[1,3]
     state=stbegin
  }
  data rules=0, size(rules), mov(datarules), [2]get(data rules), mov(long)
  {""}tok sep
back


:Namespace Turing
    ⍝ Run Turing machine until it halts
    ∇r←RunTuring (rules init halts blank itape);state;rt;lt;next
        state←init
        lt←⍬
        rt←,blank
        :If 0≠≢itape ⋄ rt←itape ⋄ :EndIf
        :While ~(⊂state)∊halts
            next←((⊂state(⊃rt))≡¨↓rules[;⍳2])⌿rules
            'No rule applies!'⎕SIGNAL(0=≢next)/11
            (⊃rt)←⊃next[1;3]
            state←⊃next[1;5]
            :Select ⊃next[1;4]
            :Case 'stay' ⋄ ⍝nothing
            :Case 'right'
                lt,⍨←⊃rt
                rt←1↓rt
                :If 0=≢rt ⋄ rt←,blank ⋄ :EndIf
            :Case 'left'
                :If 0=≢lt ⋄ lt←,blank ⋄ :EndIf
                rt,⍨←⊃lt
                lt←1↓lt
            :Else
                'Invalid action'⎕SIGNAL 11
            :EndSelect
        :EndWhile
        r←(⌽lt),rt
    ∇

    ⍝ Display the resulting tape neatly
    ∇r←len Display t
        r←(len⌊≢t)↑t
        →(len≥≢t)/0
        r,←'... (total length: ',(⍕≢t),')'
    ∇

    ⍝ Simple incrementer
    ∇t←∆1_SimpleIncrementer
        t ←⊂'q0' '1' '1' 'right' 'q0'
        t,←⊂'q0' 'B' '1' 'stay'  'qf'
        t←(↑t) 'q0' (,⊂'qf') 'B' '111'
    ∇

    ⍝ Three state beaver
    ∇t←∆2_ThreeStateBeaver
        t ←⊂'a' '0' '1' 'right' 'b'
        t,←⊂'a' '1' '1' 'left'  'c'
        t,←⊂'b' '0' '1' 'left'  'a'
        t,←⊂'b' '1' '1' 'right' 'b'
        t,←⊂'c' '0' '1' 'left'  'b'
        t,←⊂'c' '1' '1' 'stay'  'halt'
        t←(↑t) 'a' (,⊂'halt') '0' ''
    ∇

    ⍝ Five state beaver
    ∇t←∆3_FiveStateBeaver
        t ←⊂'A' '0' '1' 'right' 'B'
        t,←⊂'A' '1' '1' 'left'  'C'
        t,←⊂'B' '0' '1' 'right' 'C'
        t,←⊂'B' '1' '1' 'right' 'B'
        t,←⊂'C' '0' '1' 'right' 'D'
        t,←⊂'C' '1' '0' 'left'  'E'
        t,←⊂'D' '0' '1' 'left'  'A'
        t,←⊂'D' '1' '1' 'left'  'D'
        t,←⊂'E' '0' '1' 'stay'  'H'
        t,←⊂'E' '1' '0' 'left'  'A'
        t←(↑t) 'A' (,⊂'H') '0' ''
    ∇

    ⍝ Run all of them and display the results
    ∇RunAll;m;ms
        ms←('∆'=⊃¨ms)/ms←⎕NL¯3
        :For m :In ms
            ⎕←(1↓m),': ',(32 Display RunTuring ⍎m)
        :EndFor
    ∇
:EndNamespace


; By Uberi, http://www.autohotkey.com/board/topic/58599-turing-machine/
SetBatchLines, -1
OnExit, Exit
SaveFilePath := A_ScriptFullPath ".ini"
; Defaults are for a 2-state_3-symbol turning machine. Format:
; machine state symbol on tape, symbol on tape | tape shift (- is left, + is right, 0 is halt) | machine state
, Rule1 := "A0,1|1|B"
, Rule2 := "A1,2|-1|A"
, Rule3 := "A2,1|-1|A"
, Rule4 := "B0,2|-1|A"
, Rule5 := "B1,2|1|B"
, Rule6 := "B2,0|1|A"
; no error check is run on this input, so be sure states and symbols align with actions
IniRead, UseSaveFile, %SaveFilePath%, Global, UseSaveFile, 1 ; on exit, save state to text file so I can resume on next run
IniRead, MaxIterations, %SaveFilePath%, Global, MaxIterations, 100000 ; set as %A_Space% to run indefinitely
IniRead, Section, %SaveFilePath%, Global, Section, 2-state_3-symbol ; The name of the machine to run. Options defined:
; 2-state_3-symbol
; Simple_incrementer
; Three-state_busy_beaver
; Probable_busy_beaver_Wikipedia

IniRead, States, %SaveFilePath%, %Section%, States, A|B ; valid states
IniRead, InitialState, %SaveFilePath%, %Section%, InitialState, A ; start state
IniRead, TerminalState, %SaveFilePath%, %Section%, TerminalState, C ; end state
IniRead, Symbols, %SaveFilePath%, %Section%, Symbols, 0,1,2 ; valid symbols
IniRead, DefaultCell, %SaveFilePath%, %Section%, DefaultCell, 0 ; the default symbol of any cell not defined on input tape
IniRead, ProgramCode, %SaveFilePath%, %Section%, ProgramCode, 10101|01010 ; start tape
Iniread, RuleCount, %SaveFilePath%, %Section%, RuleCount, 6 ; number of actions to read
Loop, %RuleCount%
{
	IniRead, Temp1, %SaveFilePath%, %Section%, Rule%A_Index%, % Rule%A_Index%
	StringSplit, Temp, Temp1, `,
	Action%Temp1% := Temp2
}

IniRead, Index, %SaveFilePath%, SavedState, Index, 0
IniRead, IterationCount, %SaveFilePath%, SavedState, IterationCount, 0
IniRead, State, %SaveFilePath%, SavedState, State, %InitialState%
If IterationCount > 0
	IniRead, ProgramCode, %SaveFilePath%, SavedState, ProgramCode, %ProgramCode%

IfNotInString, ProgramCode, |
	ProgramCode := "|" ProgramCode
StringSplit, Temp, ProgramCode, |
NegativeCells := Temp1, PositiveCells := Temp2

Loop, Parse, Symbols, |
	Color%A_LoopField% := hex(mod((A_Index+1/(2**((A_Index-1)//7))-1)/7,1)*16777215) ; unlimited number of unique colors
Color%DefaultCell% := "White"

Gui, Color, Black
Gui, +ToolWindow +AlwaysOnTop +LastFound -Caption
WindowID := WinExist()
OnMessage(0x201, "WM_LBUTTONDOWN")
Gui, Font, s6 cWhite, Arial
Loop, 61 ; display 30 cell symbols on each side of current index
{
	Temp1 := ((A_Index - 1) * 15) + 1
	Gui, Add, Progress, x%Temp1% y1 w14 h40 vCell%A_Index% BackgroundWhite
	Gui, Add, Text, x%Temp1% y42 w15 h10 vLabel%A_Index% Center
}
Gui, Add, Text, x2 y54 w26 h10 vState
Gui, Add, Text, x35 y54 w50 h10 vCurrentCell
Gui, Add, Text, x350 y54 w158 h10 vActions
Gui, Add, Text, x844 y54 w33 h10, Iterations:
Gui, Add, Text, x884 y54 w29 h10 vIterations Right
Gui, Font, s4 cWhite Bold, Arial
Gui, Add, Text, x450 y1 w15 h10 Center, V
GuiControl, Move, Cell31, x451 y8 w14 h33
Gui, Show, y20 w916 h64, Wolfram's 2-State 3-Symbol Turing Machine ;'

;MaxIndex := ProgramOffset + StrLen(ProgramCode), MinIndex := ProgramOffset ; not implemented
While, ((MaxIterations = "") || IterationCount <= MaxIterations) ; process until limit is reached, if any
{
	Loop, 61 ; color each cell per its current symbol
	{ ; must run for all displayed cells because they are not directly mapped to shifting tape
		TempIndex := (Index + A_Index) - 31
		GuiControl, , Label%A_Index%, %TempIndex%
		CellColor := CellGet(TempIndex)
		, CellColor := Color%CellColor%
		GuiControl, +Background%CellColor%, Cell%A_Index%
	}
	CurrentCell := CellGet(Index)
	GuiControl, , State, State: %State%
	GuiControl, , CurrentCell, Current Cell: %CurrentCell%
	GuiControl, , Iterations, %IterationCount%
	If (State = TerminalState)
		Break

	StringSplit, Temp, Action%State%%CurrentCell%, |
	GuiControl, , Actions, % "Actions: Print " . Temp1 . ", Move " . ((Temp2 = -1) ? "left" : "right") . ", " . ((State <> Temp3) ? "Switch to state " . Temp3 : "Do not switch state")

	IterationCount++
	, CellPut(Index,Temp1)
	, Index += Temp2
	, State := Temp3
	;, (Index > MaxIndex) ? MaxIndex := Index : ""
	;, (Index < MinIndex) ? MinIndex := Index : ""

	Sleep, 0.1*1000
}
MsgBox, 64, Complete, Completed %IterationCount% iterations of the Turing machine.
Return

; Hotkeys and functions:
~Pause::Pause

GuiEscape:
GuiClose:
	ExitApp

Exit:
	If UseSaveFile
	{
		IniWrite, %Index%, %SaveFilePath%, %Section%, Index
		IniWrite, %IterationCount%, %SaveFilePath%, %Section%, IterationCount
		IniWrite, %State%, %SaveFilePath%, %Section%, State
		IniWrite, %NegativeCells%|%PositiveCells%, %SaveFilePath%, %Section%, ProgramCode
	}
	ExitApp

CellGet(Index)
{
	global NegativeCells, PositiveCells, DefaultCell
	Temp1 := (Index < 0) ? SubStr(NegativeCells,Abs(Index),1) : SubStr(PositiveCells,Index + 1,1)
	Return, (Temp1 = "") ? DefaultCell : Temp1
}

CellPut(Index,Char)
{
	global NegativeCells, PositiveCells, DefaultCell
	static StrGetFunc := "StrGet" ; workaround to hide function from AHK Basic (which does not have or require it)
	CharType := A_IsUnicode ? "UShort" : "UChar"
	, (Index < 0)
		? (Index := 0 - Index
		, Temp1 := Index - StrLen(NegativeCells)
		, (Temp1 > 0)
			? (VarSetCapacity(Pad,64) ; these three functions are quirks in AHK's memory management (not required)
			, VarSetCapacity(Pad,0)
			, VarSetCapacity(Pad,Temp1,Asc(DefaultCell))
			, NegativeCells .= A_IsUnicode ? %StrGetFunc%(&Pad,Temp1,"CP0") : Pad)
			: ""
		, NumPut(Asc(Char),NegativeCells,(Index - 1) << !!A_IsUnicode,CharType)		)
		: (Temp1 := Index - StrLen(PositiveCells) + 1
		, (Temp1 > 0)
			? (VarSetCapacity(Pad,64) ; these three functions are quirks in AHK's memory management (not required)
			, VarSetCapacity(Pad,0)
			, VarSetCapacity(Pad,Temp1,Asc(DefaultCell))
			, PositiveCells .= A_IsUnicode ? %StrGetFunc%(&Pad,Temp1,"CP0") : Pad)
			: ""
		, NumPut(Asc(Char),PositiveCells,Index << !!A_IsUnicode,CharType)		)
}

Hex(p_Integer)
{
	PtrType:=(A_PtrSize=8) ? "Ptr":"UInt"
	l_Format:="`%0" . 6 . "I64X"
	VarSetCapacity(l_Argument,8)
	NumPut(p_Integer,l_Argument,0,"Int64")
	VarSetCapacity(l_Buffer,A_IsUnicode ? 12:6,0)
	DllCall(A_IsUnicode ? "msvcrt\_vsnwprintf":"msvcrt\_vsnprintf"
		,"Str",l_Buffer ;-- Storage location for output
		,"UInt",6 ;-- Maximum number of characters to write
		,"Str",l_Format ;-- Format specification
		,PtrType,&l_Argument) ;-- Argument
	Return l_Buffer
}

WM_LBUTTONDOWN()
{
	If (A_Gui = 1)
	PostMessage, 0xA1, 2
}


   • R$(), an array of rules;
   • T$, an input tape (where an empty string stands for a blank tape);
   • B$, a character to use as a blank;
   • S$, an initial state;
   • H$, a halting state.


#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#include <string.h>

enum {
    LEFT,
    RIGHT,
    STAY
};

typedef struct {
    int state1;
    int symbol1;
    int symbol2;
    int dir;
    int state2;
} transition_t;

typedef struct tape_t tape_t;
struct tape_t {
    int symbol;
    tape_t *left;
    tape_t *right;
};

typedef struct {
    int states_len;
    char **states;
    int final_states_len;
    int *final_states;
    int symbols_len;
    char *symbols;
    int blank;
    int state;
    int tape_len;
    tape_t *tape;
    int transitions_len;
    transition_t ***transitions;
} turing_t;

int state_index (turing_t *t, char *state) {
    int i;
    for (i = 0; i < t->states_len; i++) {
        if (!strcmp(t->states[i], state)) {
            return i;
        }
    }
    return 0;
}

int symbol_index (turing_t *t, char symbol) {
    int i;
    for (i = 0; i < t->symbols_len; i++) {
        if (t->symbols[i] == symbol) {
            return i;
        }
    }
    return 0;
}

void move (turing_t *t, int dir) {
    tape_t *orig = t->tape;
    if (dir == RIGHT) {
        if (orig && orig->right) {
            t->tape = orig->right;
        }
        else {
            t->tape = calloc(1, sizeof (tape_t));
            t->tape->symbol = t->blank;
            if (orig) {
                t->tape->left = orig;
                orig->right = t->tape;
            }
        }
    }
    else if (dir == LEFT) {
        if (orig && orig->left) {
            t->tape = orig->left;
        }
        else {
            t->tape = calloc(1, sizeof (tape_t));
            t->tape->symbol = t->blank;
            if (orig) {
                t->tape->right = orig;
                orig->left = t->tape;
            }
        }
    }
}

turing_t *create (int states_len, ...) {
    va_list args;
    va_start(args, states_len);
    turing_t *t = malloc(sizeof (turing_t));
    t->states_len = states_len;
    t->states = malloc(states_len * sizeof (char *));
    int i;
    for (i = 0; i < states_len; i++) {
        t->states[i] = va_arg(args, char *);
    }
    t->final_states_len = va_arg(args, int);
    t->final_states = malloc(t->final_states_len * sizeof (int));
    for (i = 0; i < t->final_states_len; i++) {
        t->final_states[i] = state_index(t, va_arg(args, char *));
    }
    t->symbols_len = va_arg(args, int);
    t->symbols = malloc(t->symbols_len);
    for (i = 0; i < t->symbols_len; i++) {
        t->symbols[i] = va_arg(args, int);
    }
    t->blank = symbol_index(t, va_arg(args, int));
    t->state = state_index(t, va_arg(args, char *));
    t->tape_len = va_arg(args, int);
    t->tape = NULL;
    for (i = 0; i < t->tape_len; i++) {
        move(t, RIGHT);
        t->tape->symbol = symbol_index(t, va_arg(args, int));
    }
    if (!t->tape_len) {
        move(t, RIGHT);
    }
    while (t->tape->left) {
        t->tape = t->tape->left;
    }
    t->transitions_len = va_arg(args, int);
    t->transitions = malloc(t->states_len * sizeof (transition_t **));
    for (i = 0; i < t->states_len; i++) {
        t->transitions[i] = malloc(t->symbols_len * sizeof (transition_t *));
    }
    for (i = 0; i < t->transitions_len; i++) {
        transition_t *tran = malloc(sizeof (transition_t));
        tran->state1 = state_index(t, va_arg(args, char *));
        tran->symbol1 = symbol_index(t, va_arg(args, int));
        tran->symbol2 = symbol_index(t, va_arg(args, int));
        tran->dir = va_arg(args, int);
        tran->state2 = state_index(t, va_arg(args, char *));
        t->transitions[tran->state1][tran->symbol1] = tran;
    }
    va_end(args);
    return t;
}

void print_state (turing_t *t) {
    printf("%-10s ", t->states[t->state]);
    tape_t *tape = t->tape;
    while (tape->left) {
        tape = tape->left;
    }
    while (tape) {
        if (tape == t->tape) {
            printf("[%c]", t->symbols[tape->symbol]);
        }
        else {
            printf(" %c ", t->symbols[tape->symbol]);
        }
        tape = tape->right;
    }
    printf("\n");
}

void run (turing_t *t) {
    int i;
    while (1) {
        print_state(t);
        for (i = 0; i < t->final_states_len; i++) {
            if (t->final_states[i] == t->state) {
                return;
            }
        }
        transition_t *tran = t->transitions[t->state][t->tape->symbol];
        t->tape->symbol = tran->symbol2;
        move(t, tran->dir);
        t->state = tran->state2;
    }
}

int main () {
    printf("Simple incrementer\n");
    turing_t *t = create(
        /* states */        2, "q0", "qf",
        /* final_states */  1, "qf",
        /* symbols */       2, 'B', '1',
        /* blank */         'B',
        /* initial_state */ "q0",
        /* initial_tape */  3, '1', '1', '1',
        /* transitions */   2,
                            "q0", '1', '1', RIGHT, "q0",
                            "q0", 'B', '1', STAY, "qf"
    );
    run(t);
    printf("\nThree-state busy beaver\n");
    t = create(
        /* states */        4, "a", "b", "c", "halt",
        /* final_states */  1, "halt",
        /* symbols */       2, '0', '1',
        /* blank */         '0',
        /* initial_state */ "a",
        /* initial_tape */  0,
        /* transitions */   6,
                            "a", '0', '1', RIGHT, "b",
                            "a", '1', '1', LEFT, "c",
                            "b", '0', '1', LEFT, "a",
                            "b", '1', '1', RIGHT, "b",
                            "c", '0', '1', LEFT, "b",
                            "c", '1', '1', STAY, "halt"
    );
    run(t);
    return 0;
    printf("\nFive-state two-symbol probable busy beaver\n");
    t = create(
        /* states */        6, "A", "B", "C", "D", "E", "H",
        /* final_states */  1, "H",
        /* symbols */       2, '0', '1',
        /* blank */         '0',
        /* initial_state */ "A",
        /* initial_tape */  0,
        /* transitions */   10,
                            "A", '0', '1', RIGHT, "B",
                            "A", '1', '1', LEFT, "C",
                            "B", '0', '1', RIGHT, "C",
                            "B", '1', '1', RIGHT, "B",
                            "C", '0', '1', RIGHT, "D",
                            "C", '1', '0', LEFT, "E",
                            "D", '0', '1', LEFT, "A",
                            "D", '1', '1', LEFT, "D",
                            "E", '0', '1', STAY, "H",
                            "E", '1', '0', LEFT, "A"
    );
    run(t);
}