Utilice un enfoque multiparadigmático para programar gráficos 

Utilice un enfoque multiparadigmático para programar gráficos con marcos de matriz, optimización y booleanos.

In[1]:=

X g = \!\(\* GraphicsBox[ NamespaceBox["NetworkGraphics", DynamicModuleBox[{Typeset`graph = HoldComplete[ Graph[{2, 3, 1, 4, 5, 7, 8, 6, 9, 10}, {{{1, 2}, {2, 3}, {2, 4}, {4, 3}, {4, 5}, {4, 6}, {4, 7}, {8, 3}, {8, 9}, {7, 3}, {7, 10}, {9, 3}, {9, 1}, {9, 10}, {10, 9}}, Null}, {EdgeStyle -> { Arrowheads[0.06]}, ImageSize -> 120, PerformanceGoal -> "Quality"}]], Typeset`boxes, Typeset`boxes$s2d = GraphicsGroupBox[{{ Arrowheads[0.027557679514756052`], Directive[ Opacity[0.7], Hue[0.6, 0.7, 0.5]], Arrowheads[0.06], ArrowBox[{ DynamicLocation["VertexID$1", Automatic, Center], DynamicLocation["VertexID$2", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$2", Automatic, Center], DynamicLocation["VertexID$3", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$2", Automatic, Center], DynamicLocation["VertexID$4", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$4", Automatic, Center], DynamicLocation["VertexID$3", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$4", Automatic, Center], DynamicLocation["VertexID$5", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$4", Automatic, Center], DynamicLocation["VertexID$6", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$4", Automatic, Center], DynamicLocation["VertexID$7", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$7", Automatic, Center], DynamicLocation["VertexID$3", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$7", Automatic, Center], DynamicLocation["VertexID$10", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$8", Automatic, Center], DynamicLocation["VertexID$3", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$8", Automatic, Center], DynamicLocation["VertexID$9", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$9", Automatic, Center], DynamicLocation["VertexID$1", Automatic, Center]}], ArrowBox[{ DynamicLocation["VertexID$9", Automatic, Center], DynamicLocation["VertexID$3", Automatic, Center]}], ArrowBox[ BezierCurveBox[{ DynamicLocation["VertexID$9", Automatic, Center], {0.7308395626536534, 0.5282228657692112}, DynamicLocation["VertexID$10", Automatic, Center]}]], ArrowBox[ BezierCurveBox[{ DynamicLocation["VertexID$10", Automatic, Center], { 0.41059435103558733`, 0.44551757601287606`}, DynamicLocation["VertexID$9", Automatic, Center]}]]}, { Directive[ Hue[0.6, 0.2, 0.8], EdgeForm[ Directive[ GrayLevel[0], Opacity[0.7]]]], TagBox[ DiskBox[{0.6826993823276208, 2.023780937065023}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$1"], TagBox[ DiskBox[{1.619658067166264, 1.8235816784316954`}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$2"], TagBox[ DiskBox[{1.2059053823417645`, 1.1212523575685285`}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$3"], TagBox[ DiskBox[{2.380054579532232, 1.101041702945713}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$4"], TagBox[ DiskBox[{3.3672346895409793`, 0.5672588034601881}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$5"], TagBox[ DiskBox[{3.3598596261921987`, 1.6495568300534234`}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$6"], TagBox[ DiskBox[{1.6076061591533763`, 0.35906995124773267`}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$7"], TagBox[ DiskBox[{0., 1.2960348999753026`}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$8"], TagBox[ DiskBox[{0.4449797366404249, 0.9737404417818881}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$9"], TagBox[ DiskBox[{0.6964541770488158, 0.}, 0.03281640017374192], "DynamicName", BoxID -> "VertexID$10"]}}], $CellContext`flag}, TagBox[ DynamicBox[GraphComputation`NetworkGraphicsBox[ 3, Typeset`graph, Typeset`boxes, $CellContext`flag], { CachedValue :> Typeset`boxes, SingleEvaluation -> True, SynchronousUpdating -> False, TrackedSymbols :> {$CellContext`flag}}, ImageSizeCache->{{1.38, 117.61999999999998`}, {-38.715199999999975`, 32.816940714746956`}}], MouseAppearanceTag["NetworkGraphics"]], AllowKernelInitialization->False, UnsavedVariables:>{$CellContext`flag}]], DefaultBaseStyle->{ "NetworkGraphics", FrontEnd`GraphicsHighlightColor -> Hue[0.8, 1., 0.6]}, FrameTicks->None, GridLinesStyle->Directive[ GrayLevel[0.5, 0.4]], ImageSize->120]\);

Reducción transitiva usando un marco booleano.

In[2]:=

X r = BooleanMinimize[And @@ Implies @@@ EdgeList[g], "CNF"];

In[3]:=

X e = r /. {(! a_ || b_ ) :> (a \[DirectedEdge] b), (b_ || ! a_) :> (a \[DirectedEdge] b)};

In[4]:=

X {Graph[List @@ e], TransitiveReductionGraph[g]}

Out[4]=

Clausura transitiva usando un marco de matriz.

In[5]:=

X m = Normal[AdjacencyMatrix[g]];

In[6]:=

X a = FixedPoint[Unitize[m + m.#] &, m];

In[7]:=

X {AdjacencyGraph[a - DiagonalMatrix[Diagonal[a]]], TransitiveClosureGraph[g]}

Out[7]=