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?

Improve this question
$\endgroup$
0

2 Answers 2

Reset to default
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

Improve this answer
$\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$ 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.

Improve this answer
$\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$ Commented Mar 22, 2012 at 17:36

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.