与えた条件を満たす候補 DouKaku?

['and', 'or', 'not', 'and']
のような入力が与えられた場合に、
式 x1 and x2 or not x3 and x4 の値が
Trueとなるような、x1～x4の組み合わせを全て
出力するプログラムを作成してください。
x1～x4には真と偽の2通りの値だけが入るものとします。

Pythonであれば上の入力に対し、
(True, True, True, True)
(True, True, False, True)
(True, False, False, True)
(False, True, False, True)
(False, False, False, True)
と出力します。

andとorの優先順位は同じで左結合性、
つまりa and b or c and dは
(((a and b) or c) and d)
という順番で評価されるものとします。

参考：
d.y.d.

キミならどう書く2.0の小町算問題と似てますが。

このお題はmorchinさんの投稿をもとに作成しました。ご投稿ありがとうございました。
元ネタの充足可能性問題 - Wikipedia は、同じリテラル(x1とかnot x2とか)が複数回出てくることを想定しているので、今回の問題のようにそれぞれ別の変数でだと乗法標準形 - Wikipediaにした場合に、答えが…と色々悩みどころでした。

すみません、サンプル出力が間違ってましたorz 修正しました

こんな感じ。prodloop のところはもう少しましにしたかったけど、うーん。

> solve(['and', 'or', 'not', 'and'])
[true, true, true, true]
[true, true, false, true]
[true, false, false, true]
[false, true, false, true]
[false, false, false, true]

def prodloop(count, arg=[])
  if count > 0
    (prodloop count-1, arg + [true]) + (prodloop count-1, arg + [false])
  else
    [arg]
  end
end

def solve(list)
  expression = ""
  idx = 0
  list.each do |op|
    if op == "not"
      expression += " not "
    else
      expression += " arg[#{idx}] #{op} "
      idx += 1
    end
  end
  expression += " arg[#{idx}] "
  prodloop(idx+1).each do |arg|
    p arg if eval(expression)
  end
end

Squeak Smalltalk で。

| input selStream |
input := #(and or not and).
input replaceAll: #and with: #&.
input replaceAll: #or with: #|.
selStream := input readStream.
World findATranscript: nil.
{true. false} asDigitsToPower: 4 do: [:xs |
    selStream reset.
    (xs allButFirst inject: xs first into: [:result :each |
        | selector |
        selector := selStream next.
        selStream peek = #not ifTrue: [each := each perform: selStream next].
        result perform: selector with: each]) ifTrue: [Transcript cr; show: xs]]

"=> #(true true true true)
   #(true true false true)
   #(true false false true)
   #(false true false true)
   #(false false false true) "

イマイチ。

#light
type ListBuilder () =
    member l.Bind (v,f) = List.concat (List.map f v)
    member l.Return x = [x]
    member l.Let(v,f) = f v

let guard c = if c then [()] else []

let doList = new ListBuilder()

let rec all_comb = function
    | 0 -> [[]]
    | n -> doList { let! rest = all_comb (n-1)
                    let! result = [(true::rest);(false::rest)]
                    return result }

let num_args cmds =
    List.filter ((<>) "not") cmds
    |> List.length
    |> (+) 1

let rec satisfy (cmds:string list) (bools:bool list) =
    match cmds,bools with
    | [],b::[]            -> b
    | "not"::[],b::[]     -> not b
    | "not"::cs,b::bs     -> satisfy cs ((not b)::bs)
    | "and"::"not"::cs,b::b'::bs -> satisfy cs ((b && (not b'))::bs)
    | "or"::"not"::cs,b::b'::bs  -> satisfy cs ((b || (not b'))::bs)
    | "and"::cs,b::b'::bs -> satisfy cs ((b && b')::bs)
    | "or"::cs,b::b'::bs  -> satisfy cs ((b || b')::bs)

let get_combs cmds =
    doList { let! cont = all_comb (num_args cmds)
             do! guard (satisfy cmds cont)
             return cont }

do get_combs ["and";"or";"not";"and"]
   |> (print_any >> print_newline)

こんな感じ。
*Main> f ["and","or","not","and"]
(True,True,True,True)
(True,True,False,True)
(True,False,False,True)
(False,True,False,True)
(False,False,False,True)

t :: (Bool -> Bool) -> [Bool] -> [String] -> Bool
t prev (x:[]) _ = prev x
t prev (x:xs) (op:ops) | op == "not" = t prev (not x:xs) ops
                       | op == "and" = t ((&&) (prev x)) xs ops
                       | op == "or"  = t ((||) (prev x)) xs ops

f :: [String] -> IO ()
f ops = mapM_ print [(b1,b2,b3,b4) | bs@(b1:b2:b3:[b4]) <- bss, test bs ops]
  where bss = sequence $ replicate 4 [True,False]
        test = t id

nskj77さんのコードを参考に修正してみました。

see:

#light
type ListBuilder () =
    member l.Bind (v,f) = List.concat (List.map f v)
    member l.Return x = [x]
    member l.Let(v,f) = f v

let guard c = if c then [()] else []

let doList = new ListBuilder()

let rec satisfy prev bs cmds =
    match bs, cmds with
    | b::[], _     -> prev b
    | b::bs, cmd::cmds ->
            match cmd with
            | "not" -> satisfy prev ((not b)::bs) cmds
            | "and" -> satisfy ((&&) (prev b)) bs cmds
            | "or"  -> satisfy ((||) (prev b)) bs cmds

let rec all_comb = function
    | 0 -> [[]]
    | n -> doList { let! rest = all_comb (n-1)
                    let! result = [(true::rest);(false::rest)]
                    return result }

let get_combs cmds =
    let len = 1 + (List.length (List.filter ((<>) "not") cmds))
    doList { let! bs = all_comb len
             do! guard (satisfy (fun x -> x) bs cmds)
             return bs }

do get_combs ["and";"or";"not";"and"]
   |> (print_any >> print_newline)

{
#	and or not and --> x1&x2|!x3&x4
	s = ""
	cnt = 0

	for (i=1; i<=NF; i++) {
		op = $i
		if (op ‾ /not/) {
			s = s "!"
		} else if (op ‾ /and/) {
			s = s "x" ++cnt "&"
		} else if (op ‾ /or/) {
			s = s "x" ++cnt "|"
		}
	}
	s = s "x" ++cnt

	for (i=2^cnt-1; i>0; i--) {
		expr = make_expr(s,i,x,cnt)
		if (apply_expr(expr)) show(x,cnt)
	}
}

function make_expr(s,n,x,digits, i)
{
	for (i=digits; i>=1; i--) {
		x[i] = n % 2
		sub("x"i, x[i], s)
		n = (n - x[i]) / 2
	}
	return s
}

function apply_expr(expr, n,tmp,i,result)
{
	# not を先に処理
	gsub(/!1/,"0", expr)
	gsub(/!0/,"1", expr)
	# これで and と or だけ考えればよくなる
	n = split(expr,tmp,"")
	result = tmp[1]
	for (i=2; i<=n; i+=2) {
		if (tmp[i] ‾ /&/)
			result = result && tmp[i+1]
		else
			result = result || tmp[i+1]
	}
	return result
}

function show(x,cnt, i)
{
	printf "("
	for (i=1; i<=cnt; i++) {
		printf("%s", x[i] == 1 ? "True" : "False")
		if (i < cnt) printf ", "
	}
	printf ")¥n"
}

自己レスです。

使い方ですが
% awk -f and-or-not.awk
and
(True, True)
or
(True, True)
(True, False)
(False, True)
and or
(True, True, True)
(True, True, False)
(True, False, True)
(False, True, True)
(False, False, True)
and or not and
(True, True, True, True)
(True, True, False, True)
(True, False, False, True)
(False, True, False, True)
(False, False, False, True)

コード中のバックスラッシュやチルダが化けてしまうのはどうにかならないものでしょうか・・・

さらにモナドを使わずに書き直してみました。

#light
let rec satisfy prev bs cmds =
    match bs, cmds with
    | b::[], _     -> prev b
    | b::bs, cmd::cmds ->
            match cmd with
            | "not" -> satisfy prev ((not b)::bs) cmds
            | "and" -> satisfy ((&&) (prev b)) bs cmds
            | "or"  -> satisfy ((||) (prev b)) bs cmds

let rec all_comb = function
    | 0 -> [[]]
    | n -> [ for res in all_comb (n-1) ->> [true::res;false::res] ]

let get_combs cmds =
    let len = 1 + (List.length (List.filter ((<>) "not") cmds))
    [for bs in all_comb len when satisfy (fun x -> x) bs cmds -> bs]

do get_combs ["and";"or";"not";"and"]
   |> (print_any >> print_newline)

S式に変換するところでめちゃくちゃ苦労した。

(defpackage doukaku43 (:use common-lisp))
(in-package :doukaku43)

(defun make-sexp (operators)
  "入力から式を生成。"
  (labels ((tmp (ops)
             (loop for op in ops
                with i = -1
                appending
                (if (eq op 'not)
                    (list 'not)
                    (list `(nth ,(incf i) l) op)) into lst
                finally
                (return `(,@lst (nth ,(incf i) l)))))
           (parse-not (ops)
             (let ((pos (position 'not ops :from-end t)))
               (if pos
                   (parse-not (replace ops `((not ,(nth (1+ pos) ops)) nil) :start1 pos))
                   (delete nil ops))))
           (infix2prefix (ops)
             (loop for (op x) on (cdr ops) by #'cddr with res = (car ops)
                do (setf res `(,op ,res ,x))
                finally (return res))))
    (infix2prefix (parse-not (tmp operators)))))

;; テスト
(make-sexp '(and or not and))           ; => (AND (OR (AND (NTH 0 L) (NTH 1 L)) (NOT (NTH 2 L))) (NTH 3 L))
(make-sexp '(not not not))              ; => (NOT (NOT (NOT (NTH 0 L))))

(defun func (operators)
  "入力から式を計算する関数を返す。"
  (let ((sexp (make-sexp operators)))
    (lambda (l)
      (declare (special l))
      (eval sexp))))

(defun boolean-combination (n)
  "[t,nil]のN個の全組み合わせ。"
  (cond ((= n 1)
         '((t) (nil)))
        (t
         (let ((it (boolean-combination (1- n))))
           (loop for c in it appending
                `((t ,@c) (nil ,@c)))))))

(defun arity (operators)
  (- (length operators) (count 'not operators) -1))

(defun solve (operators)
  (let ((expr (func operators)))
    (loop for bools in (boolean-combination (arity operators))
       when (funcall expr bools)
       collecting bools)))

(solve '(and or not and))               ; => ((T T T T) (T T NIL T) (NIL T NIL T) (T NIL NIL T) (NIL NIL NIL T))
(solve '(not not not))                  ; => ((NIL))
(solve '())                             ; => ((T))
(solve '(and and and and and and))      ; => ((T T T T T T T))
(solve '(and))                          ; => ((T T))
(solve '(or))                           ; => ((T T) (NIL T) (T NIL))
(solve '(and or))                       ; => ((T T T) (NIL T T) (T NIL T) (NIL NIL T) (T T NIL))

type bool = Boolean
type f2   = Function2[bool,bool,bool]

class Solver(lst:List[String]) {
  val fs = {
    def factory(t:String, f:bool=>bool)(v1:bool, v2:bool) = t match {
      case "and" => v1&&f(v2)
      case "or" =>  v1||f(v2)
    }
    def it(lst:List[String]):List[f2] = lst match {
      case n::"not"::xs => factory(n, !_) _::it(xs)
      case n::xs    =>     factory(n, x=>x) _::it(xs)
      case Nil      =>     Nil
    }
    it(lst)
  }

  def solve() = {
    val eachv = List(true, false).foreach _
    def apply(v1:bool, fs:List[f2], res:List[bool]):unit = fs match {
      case Nil if v1 => println(res.reverse)
      case f::fs   => eachv(x=> apply(f(v1,x),fs, x::res))
      case _ => ()
    }
    eachv(x=> apply(x,fs,List(x)))
  }
}

new Solver(List("and", "or", "not", "and")) solve

盆休みで生活リズム乱れまくり。

["not","not","not"]みたいなケースに対応してみた。

type bool = Boolean
type f2   = Function2[bool,bool,bool]
type pred = Function1[bool,bool]
type tokens = List[String]
class Solver(lst:tokens) {

  val nlst = { 
    def it(lst:tokens,i:int):tokens = lst match {
      case "not"::xs => it(xs, i+1)
      case n::xs     => it(xs, 0):::List(n, if(i%2==0){""}else{"not"})
      case Nil       => (if(i%2==0){""}else{"not"})::Nil
    }
    it(lst, 0).reverse.filter(_!="")
  }

  val fs = {
    def factory(t:String, f1:pred, f2:pred)(v1:bool, v2:bool) = t match {
      case "and" => f1(v1)&&f2(v2)
      case "or" =>  f1(v1)||f2(v2)
    }
    def it(lst:tokens, f:pred):List[f2] = lst match {
      case "not"::xs => it(xs, !_)
      case n::"not"::xs => factory(n, f, !_) _::it(xs, x=>x)
      case n::xs    =>     factory(n, f, x=>x) _::it(xs, x=>x)
      case Nil      =>     Nil
    }
    it(nlst, x=>x)
  }

  def solve() = nlst.length match{
    case 0 => println(List(true))
    case 1 if nlst.head == "not" => println(List(false))
    case _ => 
      val eachv = List(true, false).foreach _
      def apply(v1:bool, fs:List[f2], res:List[bool]):unit = fs match {
        case Nil if v1 => println(res.reverse)
        case f::fs   => eachv(x=> apply(f(v1,x),fs, x::res))
        case _ => ()
      }
      eachv(x=> apply(x,fs,List(x)))
  }
}

new Solver(List("and", "or","not", "and")) solve

身も蓋も無し。

function doukaku43(){
	var exp = "", result = [], x = 0, X, i, j, l;
	for(i = 0, l = arguments.length; i < l; i++) switch(arguments[i]){
	case "and": exp = "("+ exp + "X["+ x++ +"]) && "; break;
	case "or" : exp = "("+ exp + "X["+ x++ +"]) || "; break;
	case "not": exp += "!"; break;
	}
	exp += "X["+ x++ +"]";
	for(i = 0, l = 1 << x; i < l; i++){
		for(j = x, X = []; j--;) X.push(!!(i >> j & 1));
		if(eval(exp)) result.push(X);
	}
	return result;
}
(function(){
	for(var r, s = "", i = 0, j; i < arguments.length; i++){
		r = doukaku43.apply(this, arguments[i]);
		s += arguments[i].join(" ") +" :\n";
		for(j = 0; j < r.length; j++) s += "  "+ r[j] + "\n";
	}
	this.WSH ? WSH.echo(s) : alert(s);
})(['and', 'or', 'not', 'and'], ['not', 'or', 'and'], ['not', 'not']);

not だけの組合せが処理できないので改訂版。

% awk -f and-or-not-2.awk
not
(False)
not not
(True)
not not not
(False)
not and not
(False, False)
not not and not
(True, False)
not or not
(True, False)
(False, True)
(False, False)

{
#    and or not and --> x1&x2|!x3&x4
    s = ""
    cnt = 0

    for (i=1; i<=NF; i++) {
        op = $i
        if (op ~ /not/) {
            s = s "!"
        } else if (op ~ /and/) {
            s = s "x" ++cnt "&"
        } else if (op ~ /or/) {
            s = s "x" ++cnt "|"
        }
    }
    s = s "x" ++cnt

#    for (i=2^cnt-1; i>0; i--) {
    for (i=2^cnt-1; i>=0; i--) { # i=0は (False,False,...,False)
        expr = make_expr(s,i,x,cnt)
        if (apply_expr(expr)) show(x,cnt)
    }
}

function make_expr(s,n,x,digits, i)
{
    for (i=digits; i>=1; i--) {
        x[i] = n % 2
        sub("x"i, x[i], s)
        n = (n - x[i]) / 2
    }
    return s
}

function apply_expr(expr, n,tmp,i,result)
{
    # not を先に処理
#    gsub(/!1/,"0", expr)
#    gsub(/!0/,"1", expr)
	r = expr
	gsub(/[^!]/,"",r) # expr の中の ! だけを抽出した文字列を得る
	for (i=length(r); i>0; i--) {
		gsub(r 1, (i + 1) % 2, expr)
		gsub(r 0, i % 2, expr)
		r = substr(r,2) # １字短縮
	}

    # これで and と or だけ考えればよくなる
    n = split(expr,tmp,"")
    result = tmp[1]
    for (i=2; i<=n; i+=2) {
        if (tmp[i] ~ /&/)
            result = result && tmp[i+1]
        else
            result = result || tmp[i+1]
    }
    return result
}

function show(x,cnt, i)
{
    printf "("
    for (i=1; i<=cnt; i++) {
        printf("%s", x[i] == 1 ? "True" : "False")
        if (i < cnt) printf ", "
    }
    printf ")\n"
}

using System;
using System.Collections.Generic;
using System.Text.RegularExpressions;
class Program
{
  static void Main()
  {
    Show(new string[] { "and", "or", "not", "and" });
  }
  static void Show(string[] ss)
  {
    List<string> l = new List<string>();
    // 全組合わせ作成
    Get(ss, 0, "", l);
    foreach (string s in l) if (Check(s)) Show(s);
  }
  static string Rev(char c) { return c != 'F' ? "F" : "T"; }
  static bool Check(string s)
  {
    Match m;
    Regex r1 = new Regex("![TF]", RegexOptions.Compiled);
    Regex r2 = new Regex("^[TF]&[TF]", RegexOptions.Compiled);
    Regex r3 = new Regex("^[TF]|[TF]", RegexOptions.Compiled);
    while (s.Length > 1)
    {
      if ((m = r1.Match(s)).Success)
        s = s.Substring(0, m.Index) + Rev(m.Value[1]) + s.Substring(m.Index + 2);
      else if ((m = r2.Match(s)).Success)
        s = (s.StartsWith("T&T") ? "T" : "F") + s.Substring(3);
      else if ((m = r3.Match(s)).Success)
        s = (s.StartsWith("F|F") ? "F" : "T") + s.Substring(3);
    }
    return s != "F";
  }
  static void Show(string s)
  {
    Console.Write("(");
    bool bFirst = true;
    foreach (char c in s)
    {
      if ("&|!".IndexOf(c) >= 0) continue;
      if (!bFirst) Console.Write(", ");
      bFirst = false;
      Console.Write(c != 'F');
    }
    Console.WriteLine(")");
  }
  static void Get(string[] ss, int pos, string cur, List<string> l)
  {
    if (pos == ss.Length)
    {
      l.Add(cur + "T");
      l.Add(cur + "F");
      return;
    }
    switch (ss[pos])
    {
      case "and":
        Get(ss, pos + 1, cur + "T&", l);
        Get(ss, pos + 1, cur + "F&", l);
        break;
      case "or":
        Get(ss, pos + 1, cur + "T|", l);
        Get(ss, pos + 1, cur + "F|", l);
        break;
      case "not":
        Get(ss, pos + 1, cur + "!", l);
        break;
    }
  }
}

#(not not not) などに対応できる版を Squeak Smalltalk で。

| input numArgs |
input := #(& | not &).
numArgs := (input collect: [:sel | sel numArgs]) sum + 1.
World findATranscript: nil.
{true. false} asDigitsToPower: numArgs do: [:xs |
     | xsStream expression |
     xsStream := xs readStream.
     expression := input inject: xsStream next printString into: [:expStr :sel |
          expStr, ' ', sel, (sel == #not ifFalse: [xsStream next printString] ifTrue: [''])].
     (Compiler evaluate: expression) ifTrue: [Transcript cr; show: xs]]

むむ、化けますか？

お題の入力の条件を、'not'を削除すると3つの'or'または'and'からなるもの、と解釈しましたが違う？

'not'の処理のみ最初に済ませ、あとはカッコで優先順位をかえたevalで手抜きしました。

def f(a):
  for i in range(16):
    o = [i/8==0, (i%8)/4==0, (i%4)/2==0, i%2==0]
    b = list(a)
    x = list(o)
    while 'not' in b:
      i = b.index('not')
      x[i] = not x[i]
      b.pop(i)
    if eval('(((%s %s %s) %s %s) %s %s)' % (x[0], b[0], x[1], b[1], x[2], b[2], x[3])):
      print o

f(['and', 'or', 'not', 'and'])
f(['not', 'not', 'and', 'or', 'not', 'not', 'not', 'and'])

Main> f ["and","or","not","and"]
[True,True,True,True]
[True,True,False,True]
[False,True,False,True]
[True,False,False,True]
[False,False,False,True]

解を直接構成。"and"を100個並べて入力してもすぐ終わる(もちろん"or"だと無理です)。

f = mapM_ (print . reverse) . g . reverse
g [] = [[True]]
g ("not":ops) = [not b:bs | (b:bs)<-g ops]
g ("and":ops) = map (True:) (g ops) 
g ("or":ops) = map (False:) (g ops) ++ map (True:) anybs
 where anybs = sequence $ (replicate.length.head.g) ops [True,False]

総当たりがうまく思いつかなかったのでビット配列に変換してしまいました。。。

NOTの計算がやっつけぽくてあまり好ましくないですがまぁ、いっか(笑
gcc -std=c99 -Wall doukaku43.c -o a

#include <stdio.h>
#include <memory.h>

int dec2bin(char *buf, size_t bufsize, int n)
{
    memset(buf, '\0', bufsize);
    while( bufsize > 0 )
    {
        buf[bufsize-1] = n & 1;
        bufsize --;
        n >>= 1;
    }
    return 0;
}

int solver(const char *op[], size_t nop)
{
    int bits = nop + 1;
    int result ;
    int n,k,m;

    for( k=0; k<nop; k++ )
    {
        /* NOTは右辺のみなので値無し */
        if( strcmp(op[k], "not") == 0 ) bits --;
    }
    char x[bits];

    bits = 1 << bits;
    for( n=bits; n>0; n--)
    {
        dec2bin(x, sizeof(x), n); /* ビット配列に変換 */
        result  = x[0] ;
        if( strcmp(op[0], "not") == 0 ) result = (~x[0] & 1);
        for( m=0,k=0; k<nop; k++,m++ )
        {
            if( k<nop-1 )
            {
                /* NOTの場合は先に計算する */
                if( strcmp(op[k+1], "not") == 0 ) x[m+1] = (~x[m+1] & 1);
            }

            if( strcmp(op[k], "not") == 0 ) m--; /* 計算済みなので次も同じ値を使用する */
            else if( strcmp(op[k], "and") == 0 ) result &= x[m+1];
            else if( strcmp(op[k], "or") == 0 )  result |= x[m+1];
            else if( strcmp(op[k], "xor") == 0 ) result = (result ^ x[m+1]) & 1;
            else
            {
                printf("invalid opration:[%s]\n",op[k]);
                return -1;
            }
        }
        if( result == 1 )
        {
            /* 結果出力 */
            dec2bin(x, sizeof(x), n);
            printf("(");
            for( m=0; m<sizeof(x)-1; m++ )
            {
                printf("%s, ", (x[m])?"True":"False");
            }
            printf("%s)\n", (x[m])?"True":"False");
        }
    }
    return 0;
}

int main(int argc, char *argv[])
{
    solver( (const char *[]){"and","or","not","and"}, 4);
    return 0;
}

?- solve([and, or, not, and]).
[true, true, true, true]
[true, true, fail, true]
[true, fail, fail, true]
[fail, true, fail, true]
[fail, fail, fail, true]

と言う感じです。

solve(Ps) :-
	forall((tf(Ps, Pt, T, X), solve(Pt, T, Xs)),
	       writeln([X|Xs])).

solve([], T, []) :-
	T, !.
solve([P|Ps], T, [X|Xs]) :-
	tf(Ps, Pt, U, X),
	(   P = and -> solve(Pt, (T,U), Xs)
	;   P = or  -> solve(Pt, (T;U), Xs)
	).

tf([not|Ps], Pt, \+T, X) :-
	!, tf(Ps, Pt, T, X).
tf(Ps, Ps, X, X) :-
	member(X, [true, fail]).

guard をつかってみた

import Control.Monad

starling f g x = f x (g x)

f :: [String] -> [[Bool]]
f cs = sequence (replicate 4 [False,True])
   >>= starling ((>>) . guard . flip (t id) cs) return

t :: (Bool -> Bool) -> [Bool] -> [String] -> Bool
t prev [x]    _           = prev x
t prev (x:xs) ("not":ops) = t prev (not x:xs) ops
t prev (x:xs) ("and":ops) = t (prev x &&) xs  ops
t prev (x:xs) ("or" :ops) = t (prev x ||) xs  ops

{-
*Main> f ["and","or","not","and"]
[[False,False,False,True]
,[False,True,False,True]
,[True,False,False,True]
,[True,True,False,True]
,[True,True,True,True]]
-}

DouKaku?

与えた条件を満たす候補

Posted feedbacks - Flatten