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$ 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
    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$ 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$ 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
    Mar 22, 2012 at 17:36

This site is temporarily in read-only mode and not accepting new answers.

Not the answer you're looking for? Browse other questions tagged .