Coloring edges on graph in Wolfram Mathematica - graph

Is it possible to color an edge of graph in Wolfram Mathematica using color function, that depends on coordinate on the edge? Like using ColorFunction option in Plot[].
I have a function specified on the edge of the graph, depending on coordinate at the edge.
Is it possible to paint a dencity of this function on the edge?
Thanks for responce.
PS: The first idea - to use Inset[] to plug in graphical colored object in EdgeRenderingFunction, but it seems to be quite unnatural. Is there any simpliar ways?

One way to use ColorFunction to color edges in a Graph is:
ClearAll[colorededge];
colorededge[pts_, colorfunc_: Function[{x, y}, ColorData["TemperatureMap"][y]]] :=
ListPlot[pts, Joined -> True, PlotStyle -> Thick, Axes -> False,
ColorFunction -> colorfunc, ColorFunctionScaling -> True];
edgshpfnc = (If[Last[#2] == "B", First#colorededge[#1],
First#colorededge[#1, Function[{x, y}, Blend[{Yellow, Red}, x]]]] &);
Graph[{"A" -> "B", "B" -> "C", "C" -> "A"},
VertexCoordinates -> {"A" -> {0, 0}, "B" -> {1, 1}, "C" -> {2, 0}},
EdgeShapeFunction -> edgshpfnc, VertexLabels -> "Name", ImagePadding -> 10]
gives
and
GraphPlot[{"A" -> "B", "B" -> "C", "C" -> "A"},
EdgeRenderingFunction -> edgshpfnc, VertexLabeling -> True]
gives

Related

Module caution: In 'Show' occurs where it is probably not going to be evaluated before going out of scope

I have tried to make my own Manipulate module that draws numerical trajectories in 2D space depending on 1 parameter.
The problem is that I have this caution in title for every variable in Show.
I understand that it is related to some dynamic functionality, but I still don't know how to get rid of it.
Also, it will be great if I can get rid of the local variable name (k$8245) in output of this module.
MyManipulatePlot2D[list_, opts : OptionsPattern[]] :=
Module[{mv, pr, rt, constPlots, k},
{rt, mv, pr} = Dimensions[list];
constPlots = Table[ListPlot[list[[i,;;, 1 ;; 2]], opts], {i, rt}];
Manipulate[
Show[constPlots[[k]]], {k, 1, rt, 1}]
]
P.S. I don't want to take Manipulate out of the Module, because in my code this function is way more complex and it actually draws trajectories depending on 2 parameters.
Right here if someone is interested
MyManipulatePlot2D[list_, opts : OptionsPattern[]] :=
Module[{rt, mv1, pr, constPlots, k1, mv2, i, k2, pointsPlot},
{rt, mv1, mv2, pr} = Dimensions[list];
constPlots =
Table[ListPlot[
ArrayReshape[list[[;; , i, ;; , ;;]], {rt*mv2, pr}][[;; ,
1 ;; 2]], PlotStyle -> ColorData[97, "ColorList"][[2]],
opts], {i, mv1}];
pointsPlot = list[[;; , ;; , ;; , 1 ;; 2]];
pointsPlot = ArrayReshape[pointsPlot, {rt, mv1, mv2, 1, 2}];
Manipulate[
Show[{constPlots[[k1]],
ListPlot[pointsPlot[[;; , k1, k2]],
PlotLegends ->
Placed[ToString[{list[[1, k1, k2, 3]], list[[1, k1, k2, 4]]}],
Top]]}], {k1, 1, mv1, 1}, {k2, 1, mv2, 1}]
]
I have tried experementing with Evaluate funtion but it didn't work out.
You can fix the k$8245 problem by using Block instead of Module, or you can use a label "k" as below. k$8245 is the module's local variable name so it is showing as expected, even though not what you want. No other problems observed.
MyManipulatePlot2D[list_, opts : OptionsPattern[]] :=
Module[{mv, pr, rt, constPlots, k}, {rt, mv, pr} = Dimensions[list];
constPlots = Table[ListPlot[list[[i, ;; , 1 ;; 2]], opts], {i, rt}];
Manipulate[Show[constPlots[[k]]], {{k, 1, "k"}, 1, rt, 1}]]
The second manipulate just errors disasterously.

"Double loop" set comprehension

I know I am missing something obvious, but I am lost in how to make this one work. I am trying to write the set comprehension for a kind of "Cartesian product". Given a finite set S of finite sets, I would like to
build a sets of sets of pairs, where each pair is given by one of the sets in S and one value v in that set; and each set has exactly one pair for each of set sets in S.
Basically, given the (simplistic) example
definition s1 :: "nat set" where
"s1 = {1, 2}"
definition s2 :: "nat set" where
"s2 = {4, 5}"
definition S :: "nat set set" where
"S = {s1, s2}"
value "{{(s, v) | s. s ∈ S} | v. v ∈ s}"
I would like the evaluation to become {{({1, 2}, 1), ({4, 5}, 4)}, {({1, 2}, 1), ({4, 5}, 5)}, {({1, 2}, 2), ({4, 5}, 4)}, {({1, 2}, 2), ({4, 5}, 5)}}
Instead, it does evaluate to (what it is supposed to, I realize that)
"(λu. {({1, 2}, u), ({4, 5}, u)}) ` s"
:: "(nat set × 'a) set set"
The u variable is bound to a free variable "s", I don't know how to have different "u"s and bound each u to its "associated"
s ∈ S
Thank you for any points or directions.
The simple way is to avoid the problem and express everything as image over the set:
value "(λv. (Pair v) ` S) ` S"
In general, there are two ways to do this kind of things: make the code generator work or the better way, namely adapt the definition to make them easier to fit the evaluation model.

How to use reverse Scaling function with error bars in mathematica?

I have data which I would like to plot along with the corresponding error bars:
{{{54927.7, -1.91044}, ErrorBar[38.2664, 0.0538982]},
{{55320.9, -1.97673}, ErrorBar[45.3592, 0.101486]},
{{55671.4, -2.15716}, ErrorBar[41.2234, 0.0258249]},
{{56032.9, -2.15957}, ErrorBar[38.8805, 0.0191277]},
{{56410.6, -2.14289}, ErrorBar[41.5501, 0.0189911]},
{{56787.2, -2.19703}, ErrorBar[38.1972, 0.00632055]},
{{57137.5, -2.1839}, ErrorBar[35.6098, 0.0084108]},
{{57493.3, -2.19994}, ErrorBar[38.0298, 0.00651633]},
{{57859.5, -2.19687}, ErrorBar[40.9682, 0.00658857]}}
I can use the "ErrorListPlot" function in *Mathematica just fine, however if I would like to reverse the y axis scale with the function "ScalingFunctions->"Reverse" " the error bars do not get plotted along with the data.....any suggestions on how to fix this?
Similar to this question. Some messing around to get the ticks looking right.
Needs["ErrorBarPlots`"]
data = {
{{54927.7, -1.91044}, ErrorBar[38.2664, 0.0538982]},
{{55320.9, -1.97673}, ErrorBar[45.3592, 0.101486]},
{{55671.4, -2.15716}, ErrorBar[41.2234, 0.0258249]},
{{56032.9, -2.15957}, ErrorBar[38.8805, 0.0191277]},
{{56410.6, -2.14289}, ErrorBar[41.5501, 0.0189911]},
{{56787.2, -2.19703}, ErrorBar[38.1972, 0.00632055]},
{{57137.5, -2.18390}, ErrorBar[35.6098, 0.0084108]},
{{57493.3, -2.19994}, ErrorBar[38.0298, 0.00651633]},
{{57859.5, -2.19687}, ErrorBar[40.9682, 0.00658857]}};
data[[All, 1, 2]] = -data[[All, 1, 2]];
ep = ErrorListPlot[data];
newTicks = AbsoluteOptions[ep, Ticks][[1, 2, 2]] /.
{x1_, x2_, x3_, x4_} :> If[x1 == x2,
{x1, NumberForm[-x2, {3, 2}], {0.014, 0}, x4},
{x1, x2, {0.007, 0}, x4}];
newTicks = newTicks /. {
GrayLevel[0.] -> GrayLevel[0.5],
AbsoluteThickness[0.25] -> AbsoluteThickness[0.18],
AbsoluteThickness[0.125] -> AbsoluteThickness[0.08]};
ErrorListPlot[data, Ticks -> {Automatic, newTicks}]
Needs["ErrorBarPlots`"]
data = {
{{54927.7, -1.91044}, ErrorBar[38.2664, 0.0538982]},
{{55320.9, -1.97673}, ErrorBar[45.3592, 0.101486]},
{{55671.4, -2.15716}, ErrorBar[41.2234, 0.0258249]},
{{56032.9, -2.15957}, ErrorBar[38.8805, 0.0191277]},
{{56410.6, -2.14289}, ErrorBar[41.5501, 0.0189911]},
{{56787.2, -2.19703}, ErrorBar[38.1972, 0.00632055]},
{{57137.5, -2.18390}, ErrorBar[35.6098, 0.0084108]},
{{57493.3, -2.19994}, ErrorBar[38.0298, 0.00651633]},
{{57859.5, -2.19687}, ErrorBar[40.9682, 0.00658857]}};
(* Invert the error bars, visible in InputForm *)
ep = InputForm[ErrorListPlot[data]] /.
{Line[{{a_, b_}, {c_, d_}}] :> Line[{{a, -b}, {c, -d}}],
Line[{Offset[e_, {f_, g_}], Offset[h_, {i_, j_}]}] :>
Line[{Offset[e, {f, -g}], Offset[h, {i, -j}]}]};
(* Discard the InputForm wrapper *)
ep2 = First[ep];
Show[ErrorListPlot[data, ScalingFunctions -> "Reverse"],
Delete[ep2, Most#First#Position[ep2, Point]]]

Using Mathematica Manipulate function to plot a transfer function

It's my first time asking for help here, I hope someone respond. I was hoping to post images to show the problem I had but I need at least 10 reps to do it. But I hope everyone understand what I'm asking for.
I'm trying to create a manipulate box to plot a transfer function with type in boxes so that I can type in the the transfer function and specify the x and y axis. But the plot itself is not appearing only the axis are
but if i type the code outside of "manipulate" it works.
If you try running this on Mathematica you could probably see the problem I'm having.
My mathematica code is below.
Manipulate[tfplot,
{{tfplot1, 0, "Transfer Function="}},
Delimiter,
{{fmin1, 10, "fmin = "}},
{{fmax1, 10^7, "fmax = "}},
{{ymin1, 1, "ymin = "}},
{{ymax1, 2*10^2, "ymax = "}},
Delimiter,
Row[{
Button["Plot", tfplot = LogLogPlot[Abs[tfplot2[2*Pi*I*f] /. {tfplot2[s_] -> tfplot1}], {f, fmin1, fmax1}, PlotPoints -> 1000, PlotRange -> {{fmin1, fmax1}, {ymin1, ymax1}}, PlotLabel -> "tf Plot"], ImageSize -> 80]
}]
, ControlPlacement -> {Left, Left, Left, Left, Left, Left, Left, Top}]
tfplot3 = (3.333321894500285`*^6 (4.611679331492357`*^6 - 72057.48955456808` s - 4.138291871540356`*^9 s^3 - 3.889993968666704`*^9 s^4 + s^5))/(s^2 (2.606152799059127`*^18 + 4.6278171788297256`*^16 s + 1.0779994813998577`*^14 s^2 + 1.5235290577558628`*^8 s^3 + s^4))
LogLogPlot[Abs[tfplot4[2*Pi*I*f] /. {tfplot4[s_] -> tfplot3}], {f, 10, 10^7}, PlotPoints -> 1000, PlotRange -> {{10, 10^7}, {1, 2*10^2}}, PlotLabel -> "tf Plot"]
Thank you.
Spiderfiq
Edit .. take 2..
Manipulate[
fplot = LogLogPlot[Abs[tfplotf /. s -> 2*Pi*I*f], {f, fmin1, fmax1},
PlotPoints -> 1000, PlotRange -> {{fmin1, fmax1}, {ymin1, ymax1}},
PlotLabel -> "tf Plot"],
{{tfplotf, (3.333321894500285`*^6 (4.611679331492357`*^6 -
72057.48955456808` s - 4.138291871540356`*^9 s^3 -
3.889993968666704`*^9 s^4 +
s^5))/(s^2 (2.606152799059127`*^18 +
4.6278171788297256`*^16 s + 1.0779994813998577`*^14 s^2 +
1.5235290577558628`*^8 s^3 + s^4))
, "Transfer Function="}},
Delimiter,
{{fmin1, 10, "fmin = "}},
{{fmax1, 10^7, "fmax = "}},
{{ymin1, 1, "ymin = "}},
{{ymax1, 2*10^2, "ymax = "}},
Delimiter,
ControlPlacement -> {Left, Left, Left, Left, Left, Left, Left, Top}]
This is some old code I had lying around from my System Dynamics and Controls class.
Manipulate[tf = TransferFunctionModel[eq, s];
BodePlot[tf, GridLines -> Automatic, ImageSize -> 500,
FrameLabel -> {{{"magnitude (db)", None}, {None,
"Bode plot"}}, {{"phase(deg)", None}, {"Frequency (rad/sec)",
None}}},
ScalingFunctions -> {{"Log10", "dB"}, {"Log10", "Degree"}},
PlotRange -> {{{0.1, 100}, Automatic}, {{0.1, 100},
Automatic}}], {eq, (5 s)/(s^2 + 4 s + 25)}]
-Brian

Handling Ticks in Mathematica`s Charts

Please consider :
dalist = {{379, 219, 228, 401}, {387, 239, 230, 393},
{403, 238, 217, 429}, {377, 233, 225, 432}}
BarChart[dalist,
Frame -> True,
FrameTicks -> {{None, None}, {None, None}}]
I can`t figure out the way to deal with the ticks themselves and the range (the numbers). I would like to see the Range but not the ticks like the below :
EDIT :
Having solved some problem, it seems I created new ones.
To Summarize, I would like to see :
TicksLabel but not the Ticks (solved)
FrameLabel but not the Frame.
The Below shall illustrate the problem. FrameStyle control the Frame Label.
So applying opacity[0] to FrameStyle to hide the frame hides the frame Label.
BarChart[Range[10],
ChartStyle -> Black,
PlotRangePadding -> 0,
Frame -> {{True, False}, {True, False}},
FrameLabel -> {{"Why?", None}, {"Because !", None}},
FrameTicksStyle -> Opacity[1],
FrameStyle -> Opacity[0],
PlotLabel -> Style["Bonjour", Bold, 16, Opacity[1]],
LabelStyle -> Directive[Black, Bold, 12, Opacity[1]],
ImageSize -> 400]
Ticks and FrameTicks have optional more complex syntax, where each tick can be specified as {x,label,{length_inside,length_outside}}
So to have ticks labels without ticks, specify the second pair of numbers as two zeros.
To replicate the ticks in your example, you would use
FrameTicks->{{Table[{j,j,{0,0}},{j,0,300000,50000}],None},
{Table[{k,k,{0,0}},{k,2010,2015}],None}}
For BarCharts, the bars are at 1, 2, 3... x-positions, so this needs to be:
FrameTicks->{{Table[{j,j,{0,0}},{j,0,300000,50000}],None},
{Table[{k,k+2009,{0,0}},{k,1,6}],None}}
As requested in comments, if you want numbers but no ticks and no frame, add:
FrameTicksStyle -> Opacity[1], FrameStyle -> Opacity[0]
EDIT And use Style on any frame labels.
End result:
data = RandomReal[{0, 300000}, {10}]
BarChart[data,
FrameTicks -> {{Table[{j, j, {0, 0}}, {j, 0, 300000, 50000}],
None}, {Table[{k, k + 2009, {0, 0}}, {k, 1, 10}], None}},
Frame -> True, FrameTicksStyle -> Opacity[1], FrameStyle -> Opacity[0],
FrameLabel -> {{Style["Why?", Opacity[1]], None},
{Style["Axes", Opacity[1]], None}}]
My answer to this question might help illuminate.
Perhaps you are looking for ChartLabels:
BarChart[dalist, ChartLabels -> Placed[Flatten#dalist, Below],
FrameTicks -> {{Automatic, None}, {None, None}},
Frame -> True,
Ticks -> None]

Resources