8
$\begingroup$

I want to create the following two graphs.

Two Feed-Forward Loops

So far I tried the following Code

GraphPlot[{"X" -> "Y", "Y" -> "Z", "X" -> "Z"}, 
 VertexCoordinateRules -> {"X" -> {0, 0}, "Y" -> {1, 0}, 
   "Z" -> {2, 0}}, 
 EdgeRenderingFunction -> (If[
     Last[#2] == "Z", {Red, Arrow[#1]}, {GrayLevel[0.5], 
      Arrow[#1]}] &), VertexLabeling -> True, DirectedEdges -> True]

The Output was the following Graphic

Try of an FFL

My Questions are:

  1. How do I get the arrow from X to Z as in the first Picture?

  2. How can I add the wavy arrows for $S_X$ and $S_Y$?

  3. How can I change the arrow head into an inhibitor sign as required for the Ic1-FFL?

$\endgroup$
0

2 Answers 2

11
$\begingroup$

Solution based on graphics primitives

You might consider using this approach:

h = Graphics[Line[{{0, 1/2}, {0, -1/2}}]];
Graphics[{
    {Thick, Arrow[{{.1, 0}, {.9, 0}}]},
    {Red, Thick, Arrow[{{.5, 0}, {.5, -.5}, {2, -.5}, {2, -.1}}]},
    Arrowheads[{{Automatic, Automatic, h}}],
    {Red, Thick, Arrow[{{1.1, 0}, {1.9, 0}}]},
    Style[{Text["X", {0, 0}], Text["Y", {1, 0}], Text["Z", {2, 0}]},
    FontFamily -> "Helvetica", FontSize -> 20]
}]

that produces this:

enter image description here

For the curved lines you can play with:

Graphics[{Arrow[BezierCurve[{{0, 0}, {1, 1}, {2, -1}}]]}]

Solution based on Graph

This solution is a bit more convoluted than the previous, but with some tweaking it works.

h = Graphics[Line[{{0, 1/2}, {0, -1/2}}]];
vlabel[lbl_] := Graphics[Text[Style[lbl, FontFamily -> "Helvetica", FontSize -> 20],
    Background -> White]];
verts = {"X", "Y", "Z"};
edges = {"X" -> "Y", "Y" -> "Z", "X" -> "Z"};
vcoords = {{0, 0}, {1, 0}, {2, 0}};
eshapef = {"X" \[DirectedEdge] "Y" ->
    ({Thick, Black, Arrow[{{0.1, 0}, {.9, 0}}]} &),
    "Y" \[DirectedEdge] "Z" ->
    ({Thick, Red, Arrowheads[{{Automatic, Automatic, h}}],
    Arrow[{{1.1, 0}, {1.9, 0}}]} &), "X" \[DirectedEdge] "Z" ->
    ({Thick, Red, Arrow[{{0.5, 0}, {0.5, -.5}, {2, -.5}, {2, -.1}}]} &)};
Graph[{"X", "Y", "Z"}, edges,EdgeShapeFunction -> eshapef,
    VertexCoordinates -> vcoords,
    VertexLabels -> Table[i -> Placed[i, Center, vlabel], {i, verts}]]

enter image description here

$\endgroup$
4
  • $\begingroup$ While this mimics the desired picture my interpretation of the question is that it should be done within MMA's Graph framework. Do you have ideas to achieve that as well? $\endgroup$ Commented Mar 22, 2012 at 20:27
  • $\begingroup$ I took a different approach, because I don't think is doable within the Graph framework, but I would be happy to see evidence of the contrary. $\endgroup$
    – VLC
    Commented Mar 23, 2012 at 7:35
  • $\begingroup$ @Sjoerd, you do know that although input is somewhat compatible, M8's Graph and old GraphPlot are different, right? If you are talking of just GraphPlot, there is a way, but it ain't pretty. Using Graph is almost impossible for now (it is quite tightly wrapped). $\endgroup$ Commented Mar 23, 2012 at 14:49
  • $\begingroup$ @Yu-SungChang I know. I intended to refer to MMA graph stuff, not to the Graph command itself. $\endgroup$ Commented Mar 27, 2012 at 20:13
4
$\begingroup$

To wave the Bezier arrow follow those steps:

a.

g0 = Graphics[{Arrow[BezierCurve[{{0, 0}, {1, 1}, {2, -1}}]]}]

Mathematica graphics

then take three points, thinking the arrow one as a parabola,

b.

p0 = {9.28*^-5, 0.0006533};
p1 = {1.991, -0.9784};
p2 = {0.6822, 0.3347};

then determine parameters

c.

Solve[{y == a x^2 + b x + c /. {x -> p0[[1]], y -> p0[[2]]},
       y == a x^2 + b x + c /. {x -> p1[[1]], y -> p1[[2]]},
       y == a x^2 + b x + c /. {x -> p2[[1]], y -> p2[[2]]}}, 
      {a , b , c}
]

(* ==> {{a -> -0.749916, b -> 1.00139, c -> 0.000560377}} *)

using the Fourier development

completaSerieF[f_, infinito_, {x_, a_, b_}] := 
      medFourier[f, {a, b}] + 
      Sum[aFourier[f, m, {a, b}]*Cos[(2*m*Pi*x)/(b - a)], {m, 1,infinito}] + 
      Sum[bFourier[f, n, {a, b}]*Sin[(2*n*Pi*x)/(b - a)], {n, 1,infinito}]

medFourier[f_, {a_, b_}] :=  Integrate[f /. x -> intVar1, {intVar1, a, b}]/(b - a)

d.

completaSerieF[0.0005603774841685596` + 1.001389805898968` x - 
  0.7499159278100052` x^2, 5, {x, 0, 2}]

(* ==> 0.00206228 - 0.303929 Cos[\[Pi] x] - 
 0.0759824 Cos[2 \[Pi] x] - 0.0337699 Cos[3 \[Pi] x] - 
 0.0189956 Cos[4 \[Pi] x] - 0.0121572 Cos[5 \[Pi] x] + 
 0.317318 Sin[\[Pi] x] + 0.158659 Sin[2 \[Pi] x] + 
 0.105773 Sin[3 \[Pi] x] + 0.0793295 Sin[4 \[Pi] x] + 
 0.0634636 Sin[5 \[Pi] x]  *)

finally

e.

Show[{g0, 
  Plot[{0.0005603774841685596` + 1.001389805898968` x - 
     0.7499159278100052` x^2, 
    0.0020622796364631046` - 0.3039294777518066` Cos[\[Pi] x] - 
     0.07598236943795166` Cos[2 \[Pi] x] - 
     0.03376994197242295` Cos[3 \[Pi] x] - 
     0.018995592359487914` Cos[4 \[Pi] x] - 
     0.012157179110072264` Cos[5 \[Pi] x] + 
     0.3173180642318406` Sin[\[Pi] x] + 
     0.1586590321159203` Sin[2 \[Pi] x] + 
     0.10577268807728021` Sin[3 \[Pi] x] + 
     0.07932951605796015` Sin[4 \[Pi] x] + 
     0.06346361284636812` Sin[5 \[Pi] x]}, {x, 0, 2}]}]

Mathematica graphics

Of course that is an hint.

$\endgroup$
1
  • $\begingroup$ Or, add these two lines to my example: {Thick, Arrow[ BezierCurve[{{.5, .5}, {.5, .2}, {.3, .4}, {.3, .1}}]]}, {Thick, Arrow[ BezierCurve[{{1.7, .5}, {1.7, .2}, {1.5, .4}, {1.5, .1}}]]} $\endgroup$
    – VLC
    Commented Mar 22, 2012 at 17:36

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.