# Edge problems in a directed graph

I want to create the following two graphs.

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

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?

-

## 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:

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}]]


-
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

To wave the Bezier arrow follow those steps:

a.

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


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}]}]


Of course that is an hint.

-
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