How to draw the classic state diagram using Mathematica? - wolfram-mathematica

Is it possible and practical for Mathematica to draw something like this (being created by Graphviz):
This is the best that I can get (but the shape and style are not satisfying):
Code:
GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D,
"went"}, {C -> C, "loop"}}, VertexLabeling -> True,
DirectedEdges -> True]

You can do something like this using VertexRenderingFunction.
GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}},
DirectedEdges -> True,
VertexRenderingFunction -> ({{White, Disk[#, 0.15]},
AbsoluteThickness[2], Circle[#, 0.15],
If[MatchQ[#2, A | B], Circle[#, 0.12], {}], Text[#2, #]} &)]
Method Updated February 2015
To preserve the ability to interactively rearrange the graph with the drawing tools (double click) one must keep the vertex graphics inside of GraphicsComplex, with indexes rather than coordinates. I believe one could do this from VertexRenderingFunction using an incrementing variable but it seems easier an possibly more robust to do it with post-processing. This works in versions 7 and 10 of Mathematica, presumably 8 and 9 as well:
GraphPlot[
{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}},
DirectedEdges -> True
] /.
Tooltip[Point[n_Integer], label_] :>
{{White, Disk[n, 0.15]},
Black, AbsoluteThickness[2], Circle[n, 0.15],
If[MatchQ[label, A | B], Circle[n, 0.12], {}], Text[label, n]}

There's no need for interactive placement to get your vertices at the desired location as mr.Wizard suggests in his answer. You can use VertexCoordinateRules for that:
GraphPlot[{{A -> C, "go"}, {C -> B, "gone"}, {C -> D, "went"}, {C -> C, "loop"}},
DirectedEdges -> True,
VertexRenderingFunction ->
({{White, Disk[#, 0.15]}, AbsoluteThickness[2], Circle[#, 0.15],
If[MatchQ[#2, A | B], Circle[#, 0.12], {}], Text[#2, #]} &),
VertexCoordinateRules ->
{A -> {0, 0}, C -> {0.75, 0},B -> {1.5, 0.25}, D -> {1.5, -0.25}}
]

Related

Plot shows different answer for the similar arguments

I've just started to learn mathematica so forgive me if it's a simple question. I'm trying to find out why Plot that contains expression with ReplaceAll works different from Plot with Set . I have:
Clear["Global`*"]
I0[t_] = HeavisidePi[(t - 1/2 10^-9)/10^-9];
sol = DSolve[{D[I2[t], t]*R == I1[t]/C0, I0[t] == I1[t] + I2[t],
I2[0] == 0}, {I1[t], I2[t]}, t];
I2 = I2[t] /. sol[[1]];
Plot[I2 /. {C0 -> 5*10^-12, R -> 500}, {t, -2 10^-9, 10^-8}]
C0 = 5*10^-12;
R = 500;
Plot[I2, {t, -2 10^-9, 10^-8}]
For some reason first Plot gives the right answer and the second one wrong. I expected same answers. What is the reason for the difference?
Yes, that's interesting. If t is set first the value at t = 0.5* 10^-9 is 0.181269 but if it stays symbolic till later the result is 0.402672
a = Plot[
I2 /. {C0 -> 5*10^-12, R -> 500}, {t, -2 10^-9, 10^-8}];
b = Plot[Evaluate[
I2 /. {C0 -> 5*10^-12, R -> 500}], {t, -2 10^-9, 10^-8}];
x = 0.5* 10^-9;
c = I2 /. t -> x /. {C0 -> 5*10^-12, R -> 500}
0.181269
d = I2 /. {t -> x, C0 -> 5*10^-12, R -> 500}
0.402672
Show[{a, b, ListPlot[{{x, c}, {x, d}}]}, PlotRange -> All]

catch badarg error in the supervisor function

Here I have a program that does some simple mathematical operations. The program is running with a supervisor.
However sometimes the program would crash as I run it. Especially when I first time run calc_sup_start_link() and then some times with calc_test(). Anyone has any idea ? The program is as follows:
calc_sup_start_link() ->
spawn_link(fun calc_sup/0).
calc_sup() ->
process_flag(trap_exit, true),
{ok, _Pid} = calc_start_link(),
receive
{'EXIT', _From, normal} ->
ok;
{'EXIT', _From, _Reason} ->
calc_sup() % Crash: restart
end.
calc_start_link() ->
S = spawn_link(fun calc_loop/0),
register(calc, S),
{ok, S}
calc_loop() ->
receive
{add, P, A, B} ->
P ! {add_reply, A + B},
calc_loop();
{mul, P, A, B} ->
{_, _, N} = now(),
if N rem 5 =/= 0 -> ok end,
P ! {mul_reply, A * B},
calc_loop()
end.
calc_add(A, B) ->
calc ! {add, self(), A, B},
receive
{add_reply, C} -> C
end.
calc_mul(A, B) ->
calc ! {mul, self(), A, B},
receive
{mul_reply, C} -> C
end.
calc_client(X, Y, Z) ->
Q = calc_mul(X, Y),
timer:sleep(500),
R = calc_add(Q, 3),
timer:sleep(500),
calc_mul(R, Z).
calc_test() ->
io:format("Running calc_client(2, 4, 5)~n"),
R = calc_client(2, 4, 5),
io:format("calc_client(2, 4, 5) returned ~p~n", [R]).
I think it crash in this bloc:
calc_loop() ->
receive
{add, P, A, B} ->
P ! {add_reply, A + B},
calc_loop();
{mul, P, A, B} ->
{_, _, N} = now(),
if N rem 5 =/= 0 -> ok end, %% if doesn't work as in C or java !!!
P ! {mul_reply, A * B},
calc_loop()
end.
in fact if N is a multiple of 5, (N rem 5) == 0 and there is no branch to evaluate the result of if, and in erlang all the statement have to return a value. You can verify in the shell:
1> if ((11 rem 5) =/= 0) -> ok end.
ok
2> if ((10 rem 5) =/= 0) -> ok end.
** exception error: no true branch found when evaluating an if expression
3> if ((10 rem 5) =/= 0) -> ok; true -> false end.
false
4>
In your case you should write:
calc_loop() ->
receive
{add, P, A, B} ->
P ! {add_reply, A + B},
calc_loop();
{mul, P, A, B} ->
{_, _, N} = now(),
case (N rem 5) of
0 -> P ! {mul_reply, A * B},
calc_loop();
_ -> ok
end
end.
this will perform the multiplication and loop if N is multiple of 5; and it will terminate with reason normal in other cases (I am not sure it is what you want to do since the if expression is not complete)
if your write tail recursion all by yourself,
the better way is always call external functions(for the code only save two version in memory).
like this :
change calc_loop() to ?MODULE:calc_loop().
it will always call the newest version of code.
http://www.erlang.org/doc/reference_manual/code_loading.html#id88331

Mathematica function with multiple IF[] conditionals

I have here a complicated bit of code that is not pretty nor easy to follow, but it represents a simplification of a larger body of code I am working with. I am a Mathematica novice and have already received some help on this issue from stackoverflow but it is still not solving my problem. Here is the code for which I hope you can follow along and assume what I am trying to get it to do. Thanks to you programming whizzes for the help.
a[b_, c_] = -3*b + 2*c + d + e + f;
g[b_, c_] := If[a[b, c] < 0, -3*a[b, c], a[b, c]];
h[T_, b_, c_] = (T/g[b, c]);
i[h_, T_, b_, c_] := If[h[T, b, c] > 0, 4*h[T, b, c], -5*h[T, b, c]];
j[b_, c_] := If[a[b, c] < 0, 5*a[b, c], 20*a[b, c]];
XYZ[h_, T_, i_, g_, j_, b_, c_] = T*i[h, T, b, c]*g[b, c] + j[b, c]
rules = {a -> 1, b -> 2, c -> 3, d -> 4, e -> 5, f -> 6, T -> 10};
XYZ[h, T, i, g, j, b, c] //. rules
Preserving as much of your code as possible, it will work with just a few changes:
a[b_, c_] := -3*b + 2*c + d + e + f;
g[b_, c_] := If[# < 0, -3 #, #] & # a[b, c]
h[T_, b_, c_] := T / g[b, c]
i[h_, T_, b_, c_] := If[# > 0, 4 #, -5 #] & # h[T, b, c]
j[b_, c_] := If[# < 0, 5 #, 20 #] & # a[b, c]
XYZ[h_, T_, i_, g_, j_, b_, c_] := T*i[h, T, b, c]*g[b, c] + j[b, c]
rules = {a -> 1, b -> 2, c -> 3, d -> 4, e -> 5, f -> 6, T -> 10};
XYZ[h, T, i, g, j, b, c] /. rules
(* Out= 700 *)
If statements are again externalized, as in the last problem.
all definitions are made with SetDelayed (:=), as a matter of good practice.
The presumed error T - 10 in your rules is corrected to T -> 10
Notice that again ReplaceRepeated (//.) is not needed, and is changed to /.
We still have a nonsensical rule a -> 1 but it does not cause a failure.

Using `With` with a list of `Rules` - but without affecting the normal behaviour of `With`

Say I have a list of Rules
rules = {a -> b, c -> d};
which I use throughout a notebook. Then, at one point, it makes sense to want the rules to apply before any other evaluations take place in an expression. Normally if you want something like this you would use
In[2]:= With[{a=b,c=d}, expr[a,b,c,d]]
Out[2]= expr[b, b, d, d]
How can I take rules and insert it into the first argument of With?
Edit
BothSome solutions fail do all that I was looking for - but I should have emphasised this point a little more. See the bold part above.
For example, let's look at
rules = {a -> {1, 2}, c -> 1};
If I use these vaules in With, I get
In[10]:= With[{a={1,2},c=1}, Head/#{a,c}]
Out[10]= {List,Integer}
Some versions of WithRules yield
In[11]:= WithRules[rules, Head/#{a,c}]
Out[11]= {Symbol, Symbol}
(Actually, I didn't notice that Andrew's answer had the Attribute HoldRest - so it works just like I wanted.)
You want to use Hold to build up your With statement. Here is one way; there may be a simpler:
In[1]:= SetAttributes[WithRules, HoldRest]
In[2]:= WithRules[rules_, expr_] :=
With ## Append[Apply[Set, Hold#rules, {2}], Unevaluated[expr]]
Test it out:
In[3]:= f[args___] := Print[{args}]
In[4]:= rules = {a -> b, c -> d};
In[5]:= WithRules[rules, f[a, c]]
During evaluation of In[5]:= {b,d}
(I used Print so that any bug involving me accidentally evaluating expr too early would be made obvious.)
I have been using the following form of WithRules for a long time. Compared to the one posted by Andrew Moylan, it binds sequentially so that you can say e.g. WithRules[{a->b+1, b->2},expr] and get a expanded to 3:
SetAttributes[WithRules, HoldRest]
WithRules[rules_, expr_] := ReleaseHold#Module[{notSet}, Quiet[
With[{args = Reverse[rules /. Rule[a_, b_] -> notSet[a, b]]},
Fold[With[{#2}, #1] &, Hold#expr, args]] /. notSet -> Set,
With::lvw]]
This was also posted as an answer to an unrelated question, and as noted there, it has been discussed (at least) a couple of times on usenet:
A version of With that binds variables sequentially
Add syntax highlighting to own command
HTH
EDIT: Added a ReleaseHold, Hold pair to keep expr unevaluated until the rules have been applied.
One problem with Andrew's solution is that it maps the problem back to With, and that does not accept subscripted variables. So the following generates messages.
WithRules[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Power[Subscript[x, 1], Subscript[x, 2]]]
Given that With performs syntactic replacement on its body, we can set WithRules alternatively as follows:
ClearAll[WithRules]; SetAttributes[WithRules, HoldRest];
WithRules[r : {(_Rule | _RuleDelayed) ..}, body_] :=
ReleaseHold[Hold[body] /. r]
Then
In[113]:= WithRules[{Subscript[x, 1] -> 2,
Subscript[x, 2] -> 3}, Subscript[x, 1]^Subscript[x, 2]]
Out[113]= 8
Edit: Addressing valid concerns raised by Leonid, the following version would be safe:
ClearAll[WithRules3]; SetAttributes[WithRules3, HoldRest];
WithRules3[r : {(_Rule | _RuleDelayed) ..}, body_] :=
Developer`ReplaceAllUnheld[Unevaluated[body], r]
Then
In[194]:= WithRules3[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Subscript[x, 1]^Subscript[x, 2]]
Out[194]= 8
In[195]:= WithRules3[{x -> y}, f[y_] :> Function[x, x + y]]
Out[195]= f[y_] :> Function[x, x + y]
Edit 2: Even WithRules3 is not completely equivalent to Andrew's version:
In[206]:= WithRules3[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[206]= f[y_] :> Function[x, x + y + z]
In[207]:= WithRules[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[207]= f[y$_] :> Function[x$, x$ + y$ + 2]

Pattern matching Inequality

I'd like to extract arguments from instances of Inequality. Following doesn't work, any idea why and how to fix it?
Inequality[1, Less, x, Less, 2] /. Inequality[a_, _, c_, _, e_] -> {a, c, e}
Inequality[1,Less,x,Less,2] /. HoldPattern[Inequality[a_,_,b_,_,c_]] -> {a, b, c}
Out: {1, x, 2}
Also, you can do this:
Inequality[1, Less, x, Less, 2] /.
Literal # Inequality[ a_ , _ , c_ , _ , e_ ] -> {a, c, e}
ADL
Why don't you use standard access to subexpression?
expr = Inequality[1, Less, x, Less, 2];
{a,c,e} = {expr[[1]], expr[[3]], expr[[5]]};

Resources