Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
Would you describe the rules governing the grouping? –  Mr.Wizard Jul 24 at 16:20
2  
Yes, the simplification rule: ee.surrey.ac.uk/Projects/Labview/minimisation/karrules.html –  Putterboy Jul 24 at 21:35

1 Answer 1

up vote 1 down vote accepted

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

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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