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.

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?

share|improve this question
add comment

2 Answers

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

share|improve this answer
    
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? –  Sjoerd C. de Vries Mar 22 '12 at 20:27
    
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. –  VLC Mar 23 '12 at 7:35
    
@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). –  Yu-Sung Chang Mar 23 '12 at 14:49
    
@Yu-SungChang I know. I intended to refer to MMA graph stuff, not to the Graph command itself. –  Sjoerd C. de Vries Mar 27 '12 at 20:13
add comment

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.

share|improve this answer
    
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}}]]} –  VLC Mar 22 '12 at 17:36
add comment

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.