2
$\begingroup$

Adopting kguler's answer to my previous question, I managed to get the simplified map by using Mathematica's build-in function BooleanMinimize. The tough job left is to produce the circles showing the grouping of the related terms as seen from most textbooks. Insight on how to accomplish this? Any help would be much appreciated.

labels = {"00", "01", "11", "10"};
lab = {"0", "1"};
Clear[a, b, c, x, y];
elem = {{! a && ! b && ! c, ! a && ! b && c }, {! a && b && ! c, ! a && 
     b && c }, { a && b && ! c, a && b && c }, { a && ! b && ! c, 
    a && ! b && c } };
res = {};
RES = {};
frame = Graphics[{
    Line@Table[{{i, 0}, {i, 4}}, {i, 0, 2, 1}],
    Line@Table[{{0, i}, {2, i}}, {i, 0, 4, 1}], 
    Table[Text[
      labels[[3 - i + 1]], {-0.3, i + 0.3}], {i, {0, 1, 3, 2}}], 
    Table[Text[lab [[i + 1]], {i + 0.75, 4.25}], {i, {0, 1, 0, 1}}], 
    Line[{{0, 4}, {-0.75, 4.75}}], 
    Text[Style[ "A B" , 12], {-0.5, 4.}], 
    Text[Style["C", 12], {0., 4.5}]}, ImageSize -> {100, 200}];

Row[{Manipulate[
   arrX = ConstantArray[0, {2, 4}];

   EventHandler[Dynamic[mat = Reverse[Transpose[arrX]];
     Show[
      frame,
      MatrixPlot[
       mat,
       Mesh -> All,
       ImageSize -> {100, 200},
       PlotRangePadding -> 0,
       FrameTicks -> None,
       ColorRules -> {1 -> None, 0 -> None}], 
      Epilog -> {MapIndexed[
         If[#1 == 1, Text[Style[#1, Bold, 20, Red], #2 - {.5, .5}], 
           Text[""]] &, arrX, {2}
         ]}
      ](* Show *)
     ],  (* Dynamic *)
    {"MouseClicked" :> (
       pos = Ceiling[MousePosition["Graphics"]];
       arrX = ReplacePart[arrX, pos -> 1 - arrX[[Sequence @@ pos]]];
       arrY = Reverse[Transpose[arrX]];
       res = Flatten[Pick[elem, arrY, 1]];
       RES = BooleanMinimize[ Or @@ res ];
       map = RES /. {! a -> "\!\(\*OverscriptBox[\(A\), \(_\)]\)", 
           a -> "A", ! b -> "\!\(\*OverscriptBox[\(B\), \(_\)]\)", b -> "B",
           ! c -> "\!\(\*OverscriptBox[\(C\), \(_\)]\)", c -> "C" };
       map = map /. { x__ && y__ -> x y  };
       map = map /. { x__ || y__ -> x + y };
       )
     }
    ],
   Paneled -> False,
   AppearanceElements -> None,
   FrameMargins -> 0
   ] ,
  Dynamic@map}  ]

enter image description here

This page details the rules for the grouping together adjacent cells containing ones.

Improve this question
$\endgroup$
2

1 Answer 1

Reset to default
1
$\begingroup$

Here I figured out a rough, primitive solution to get the work done, still looking forward a smarter solution.

labels = {"00", "01", "11", "10"};
lab = {"0", "1"};
Clear[a, b, c, x, y, A, B];
elem = {{! a && ! b && ! c, ! a && ! b && c}, {! a && b && ! c, ! a &&
      b && c}, {a && b && ! c, a && b && c}, {a && ! b && ! c, 
    a && ! b && c}};
res = {};
RES = {};
mapG = {};
circles={};
frame = Graphics[{Line@Table[{{i, 0}, {i, 4}}, {i, 0, 2, 1}], 
    Line@Table[{{0, i}, {2, i}}, {i, 0, 4, 1}], 
    Table[Text[
      labels[[3 - i + 1]], {-0.3, i + 0.3}], {i, {0, 1, 3, 2}}], 
    Table[Text[lab[[i + 1]], {i + 0.75, 4.25}], {i, {0, 1, 0, 1}}], 
    Line[{{0, 4}, {-0.75, 4.75}}], Text[Style["A B", 12], {-0.5, 4.}],
     Text[Style["C", 12], {0., 4.5}]}, ImageSize -> {100, 200}];

(******** MAPPING *********)
bCol = Blue;
bCol2 = Brown;
bCol3 = Darker@Green;

(********* single element **********)
AnBnC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {0.1, 0.1}, {0.9, 0.9}, RoundingRadius -> 0.3 ]   }];
ABnC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {0.1, 1.1}, {0.9, 1.9}, RoundingRadius -> 0.3 ]   }];
nABnC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {0.1, 2.1}, {0.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nAnBnC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {0.1, 3.1}, {0.9, 3.9}, RoundingRadius -> 0.3 ]   }];

AnBC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {1.1, 0.1}, {1.9, 0.9}, RoundingRadius -> 0.3 ]   }];
ABC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {1.1, 1.1}, {1.9, 1.9}, RoundingRadius -> 0.3 ]   }];
nABC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {1.1, 2.1}, {1.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nAnBC = Graphics[   {  Opacity[0], EdgeForm[bCol], 
    Rectangle[ {1.1, 3.1}, {1.9, 3.9}, RoundingRadius -> 0.3 ]   }];

(********** Double elements ************)
AnB = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 0.1}, {1.9, 0.9}, RoundingRadius -> 0.3 ]   }];
AB = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 1.1}, {1.9, 1.9}, RoundingRadius -> 0.3 ]   }];
nAB = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 2.1}, {1.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nAnB = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 3.1}, {1.9, 3.9}, RoundingRadius -> 0.3 ]   }];

AnC  = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 0.1}, {0.9, 1.9}, RoundingRadius -> 0.3 ]   }];
BnC = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 1.1}, {0.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nAnC = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {0.1, 2.1}, {0.9, 3.9}, RoundingRadius -> 0.3 ]   }];

nBnC1 = Plot[-Sec[2 (x - 0.5)] + 1.9 , {x, 0, 1}, PlotRange -> {0, 1}];
nBnC2 = Plot[ Sec[2 (x - 0.5)] + 2.1 , {x, 0, 1}, PlotRange -> {0, 4}];
nBnC = {nBnC1, nBnC2};
AC = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {1.1, 0.1}, {1.9, 1.9}, RoundingRadius -> 0.3 ]   }];
BC = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {1.1, 1.1}, {1.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nAC = Graphics[   {  Opacity[0], EdgeForm[bCol2], 
    Rectangle[ {1.1, 2.1}, {1.9, 3.9}, RoundingRadius -> 0.3 ]   }];

nBC1 = Plot[-Sec[2 (x - 1.5)] + 1.9 , {x, 1, 2}, PlotRange -> {0, 1}];
nBC2 = Plot[ Sec[2 (x - 1.5)] + 2.1 , {x, 1, 2}, PlotRange -> {0, 4}];
nBC = {nBC1, nBC2};

(********** Quad elements ************)
A  = Graphics[   {  Opacity[0], EdgeForm[bCol3], 
    Rectangle[ {0.1, 0.1}, {1.9, 1.9}, RoundingRadius -> 0.3 ]   }];
B  = Graphics[   {  Opacity[0], EdgeForm[bCol3], 
    Rectangle[ {0.1, 1.1}, {1.9, 2.9}, RoundingRadius -> 0.3 ]   }];
nA  = Graphics[   {  Opacity[0], EdgeForm[bCol3], 
    Rectangle[ {0.1, 2.1}, {1.9, 3.9}, RoundingRadius -> 0.3 ]   }];

nB1 = Plot[-Sec[ (x - 1)] + 1.9 , {x, 0, 2}, PlotRange -> {0, 1}];
nB2 = Plot[ Sec[ (x - 1)] + 2.1 , {x, 0, 2}, PlotRange -> {0, 4}];
nB = {nB1, nB2};

nC  = Graphics[   {  Opacity[0], EdgeForm[bCol3], 
    Rectangle[ {0.1, 0.1}, {0.9, 3.9}, RoundingRadius -> 0.3 ]   }];
xC  = Graphics[   {  Opacity[0], EdgeForm[bCol3], 
    Rectangle[ {1.1, 0.1}, {1.9, 3.9}, RoundingRadius -> 0.3 ]   }];

 (****************************)

 conV1 = { 
    "B" "C" "\!\(\*OverscriptBox[\(A\), \(_\)]\)" -> nABC , 
   "B" "\!\(\*OverscriptBox[\(A\), \(_\)]\)" "\!\(\*OverscriptBox[\(C\
\), \(_\)]\)" -> nABnC  , 
   "C" "\!\(\*OverscriptBox[\(A\), \(_\)]\)" "\!\(\*OverscriptBox[\(B\
\), \(_\)]\)" -> nAnBC,
   "\!\(\*OverscriptBox[\(A\), \(_\)]\)" "\!\(\*OverscriptBox[\(B\), \
\(_\)]\)" "\!\(\*OverscriptBox[\(C\), \(_\)]\)" -> nAnBnC  , 
   "A" "B" "C" -> ABC , 
   "A" "B" "\!\(\*OverscriptBox[\(C\), \(_\)]\)" -> ABnC  ,
   "A" "C" "\!\(\*OverscriptBox[\(B\), \(_\)]\)" -> AnBC , 
   "A" "\!\(\*OverscriptBox[\(B\), \(_\)]\)" "\!\(\*OverscriptBox[\(C\
\), \(_\)]\)" -> AnBnC   
    };
 conV2 = {
   "A" "B" -> AB, "A" "\!\(\*OverscriptBox[\(B\), \(_\)]\)" -> AnB, 
   "B" "\!\(\*OverscriptBox[\(A\), \(_\)]\)" -> nAB, 
   "\!\(\*OverscriptBox[\(A\), \(_\)]\)" "\!\(\*OverscriptBox[\(B\), \
\(_\)]\)" -> nAnB, 
   "B" "C" -> BC, "B" "\!\(\*OverscriptBox[\(C\), \(_\)]\)" -> BnC, 
   "C" "\!\(\*OverscriptBox[\(B\), \(_\)]\)" -> nBC, 
   "\!\(\*OverscriptBox[\(B\), \(_\)]\)" "\!\(\*OverscriptBox[\(C\), \
\(_\)]\)" -> nBnC, 
   "A" "C" -> AC, "C" "\!\(\*OverscriptBox[\(A\), \(_\)]\)" -> nAC, 
   "A" "\!\(\*OverscriptBox[\(C\), \(_\)]\)" -> AnC, 
   "\!\(\*OverscriptBox[\(A\), \(_\)]\)" "\!\(\*OverscriptBox[\(C\), \
\(_\)]\)" -> nAnC
   };
 conV3 = {"A" -> A , "\!\(\*OverscriptBox[\(A\), \(_\)]\)" -> nA, 
   "B" -> B, "\!\(\*OverscriptBox[\(B\), \(_\)]\)" -> nB, "C" -> xC, 
   "\!\(\*OverscriptBox[\(C\), \(_\)]\)" -> nC };


(******** MAPPING *********)

Row[{Manipulate[arrX = ConstantArray[0, {2, 4}];
   EventHandler[Dynamic[mat = Reverse[Transpose[arrX]];
     Show[frame, circles, 
      MatrixPlot[mat, Mesh -> All, ImageSize -> {100, 200}, 
       PlotRangePadding -> 0, FrameTicks -> None, 
       ColorRules -> {1 -> None, 0 -> None}], 
      Epilog -> {MapIndexed[
         If[#1 == 1, Text[Style[#1, Bold, 20, Red], #2 - {.5, .5}], 
           Text[""]] &, arrX, {2}]} 

      ](*Show*)

     ],(*Dynamic*)
    {"MouseClicked" :> (pos = Ceiling[MousePosition["Graphics"]];
       arrX = ReplacePart[arrX, pos -> 1 - arrX[[Sequence @@ pos]]];
       arrY = Reverse[Transpose[arrX]];
       res = Flatten[Pick[elem, arrY, 1]];
       RES = BooleanMinimize[Or @@ res];
       map = 
        RES /. {! a -> "\!\(\*OverscriptBox[\(A\), \(_\)]\)", 
          a -> "A", ! b -> "\!\(\*OverscriptBox[\(B\), \(_\)]\)", 
          b -> "B", ! c -> "\!\(\*OverscriptBox[\(C\), \(_\)]\)", 
          c -> "C"};
       map = map /. {x__ && y__ -> x y};
       map = map /. {x__ || y__ -> x + y};

       map2 = map /. Plus -> List;
       mapG = map2 /. conV1;
       mapG = mapG /. conV2;
       mapG = mapG /. conV3;
       mapG = Sort /@ mapG;
       circles = mapG;
       )}

    ], Paneled -> False, AppearanceElements -> None, 
   FrameMargins -> 0], Dynamic@map}]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.