dharr

Dr. David Harrington

8235 Reputation

22 Badges

20 years, 340 days
University of Victoria
Professor or university staff
Victoria, British Columbia, Canada

Social Networks and Content at Maplesoft.com

Maple Application Center
I am a retired professor of chemistry at the University of Victoria, BC, Canada. My research areas are electrochemistry and surface science. I have been a user of Maple since about 1990.

MaplePrimes Activity


These are answers submitted by dharr

There seems to be some theory about fundamental cutsets being used to generate cutsets and a relationship to spanning trees, which I didn't try to follow.  I also found the description of structure graphs in your reference confusing. The following just uses all partitions of the vertices into two sets and then collects the cutsets for those partitions that give two-component graphs. Your graph can be done in about 20 min on my laptop.

Edit: This new version uses a single iterator (Iterator:-SetPartitions), and is slightly faster. 

Edit: A new method involving fundamental cutsets is given in this post

Find all minimal edge sets. Brute force - just generates all bipartitions of the vertices.

https://www.mapleprimes.com/questions/235430-Find-All-Minimal-Edge-Cuts-Of-A-Graph

restart

MinimalEdgeCuts:=proc(G::GRAPHLN)
  local mincutsets,n,edges,partitions,
    vertset,verts,vertices,i,j,G1,G2;
  uses GraphTheory;
  if not IsConnected(G) then return Vector([]) end if;
  n:=NumberOfVertices(G);
  edges:=Edges(G);
  vertices:={Vertices(G)[]};
  mincutsets:=table();
  j:=0;
  partitions:=Iterator:-SetPartitions(n,parts=2);
  for verts in partitions do
    vertset:={seq(ifelse(verts[i]=1,vertices[i],NULL),i=1..n)};
    G1:=InducedSubgraph(G,vertset);
    G2:=InducedSubgraph(G,vertices minus vertset);
    if IsConnected(G1) and IsConnected(G2) then
       j:=j+1;
       mincutsets[j]:=edges minus Edges(G1) minus Edges(G2)
    end if
  end do;
  Vector(j,mincutsets)
end proc:

with(GraphTheory)

G1 := Graph({{a, b}, {a, c}, {a, h}, {a, i}, {b, c}, {c, d}, {d, e}, {d, f}, {e, f}, {h, i}}); DrawGraph(G1, size = [200, 200]); mincutset1 := CodeTools:-Usage(MinimalEdgeCuts(G1)); numelems(mincutset1)

G1 := `Graph 4: an undirected unweighted graph with 8 vertices and 10 edge(s)`

memory used=4.28MiB, alloc change=0 bytes, cpu time=141.00ms, real time=201.00ms, gc time=0ns

Vector[column](%id = 36893490719163192972)

10

G2 := Graph({{1, 2}, {1, 4}, {1, 5}, {2, 3}, {2, 5}, {3, 5}, {3, 6}, {4, 5}, {4, 7}, {5, 6}, {5, 7}, {5, 8}, {5, 9}, {6, 9}, {7, 8}, {8, 9}}); SetVertexPositions(G2, [[1, 3], [2, 3], [3, 3], [1, 2], [2, 2], [3, 2], [1, 1], [2, 1], [3, 1]])

GRAPHLN(undirected, unweighted, [1, 2, 3, 4, 5, 6, 7, 8, 9], Array(1..9, {(1) = {2, 4, 5}, (2) = {1, 3, 5}, (3) = {2, 5, 6}, (4) = {1, 5, 7}, (5) = {1, 2, 3, 4, 6, 7, 8, 9}, (6) = {3, 5, 9}, (7) = {4, 5, 8}, (8) = {5, 7, 9}, (9) = {5, 6, 8}}), `GRAPHLN/table/1049604`, 0)

DrawGraph(G2, size = [200, 200]); mincutsets2 := CodeTools:-Usage(MinimalEdgeCuts(G2)); numelems(mincutsets2)

memory used=9.63MiB, alloc change=0 bytes, cpu time=281.00ms, real time=338.00ms, gc time=0ns

57

g := "S~tIID@OI?{@n~V?goYEDOWd?qI?sJ?[C"; G := GraphTheory:-ConvertGraph(g); GraphTheory:-DrawGraph(G)

GRAPHLN(undirected, unweighted, [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20], Array(1..20, {(1) = {2, 3, 4, 5, 12, 13}, (2) = {1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20}, (3) = {1, 2, 4, 12, 13, 20}, (4) = {1, 2, 3, 5, 13, 14}, (5) = {1, 2, 4, 6, 13, 14}, (6) = {2, 5, 7, 13, 14, 15}, (7) = {2, 6, 8, 13, 15, 16}, (8) = {2, 7, 9, 13, 16, 17}, (9) = {2, 8, 10, 13, 17, 18}, (10) = {2, 9, 11, 13, 18, 19}, (11) = {2, 10, 12, 13, 19, 20}, (12) = {1, 2, 3, 11, 13, 20}, (13) = {1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20}, (14) = {2, 4, 5, 6, 13, 15}, (15) = {2, 6, 7, 13, 14, 16}, (16) = {2, 7, 8, 13, 15, 17}, (17) = {2, 8, 9, 13, 16, 18}, (18) = {2, 9, 10, 13, 17, 19}, (19) = {2, 10, 11, 13, 18, 20}, (20) = {2, 3, 11, 12, 13, 19}}), `GRAPHLN/table/770`, 0)

mincutsets := CodeTools:-Usage(MinimalEdgeCuts(G)); numelems(mincutsets)

memory used=38.90GiB, alloc change=6.19GiB, cpu time=16.98m, real time=11.14m, gc time=9.53m

314415

NULL

 

Download MinEdgeCutsPartition.mw

 

Older edit: The earlier version below used the Combination iterator multiple times. In the first version the rank option of the Iterator was not working as advertised, so there was 1 duplicate in the last example, now fixed; see reply for more details.

Download MinEdgeCuts2.mw

Interesting. This difference is already present in the example (a,b,c)||2, which works in 2-D and not in 1-D. The parsers are not the same. The help suggests that the left hand side of || should be a name or string, and in1-D it doesn't seem to distribute like (a,b,c)*2 does. I would code this as

seq(seq(cat(i,j),i in [$("A".."C"),$("d".."f")]),j in [$("G".."I"),$("j".."l")]);

which seems a little more readable to me.

I agree with @tomleslie that there is something wrong here with Maple's processing, since this is a straightforward first order system. Another way to work around this is to solve exactly using laplace transforms (method=laplace). Then you can just plot the answers, which are sums of exponential decays.

Edit: I submitted an SCR about this.

restart

sys := {diff(a[0](t), t)-(diff(a[1](t), t))+diff(a[2](t), t)-(diff(a[3](t), t))+diff(a[4](t), t)-(diff(a[5](t), t)) = 0, diff(b[0](t), t)+diff(b[1](t), t)+diff(b[2](t), t)+diff(b[3](t), t)+diff(b[4](t), t)+diff(b[5](t), t) = 0, diff(a[0](t), t)-.8090169943*(diff(a[1](t), t))+.309016994*(diff(a[2](t), t))-16*a[2](t)+.3090169950*(diff(a[3](t), t))+77.66563145*a[3](t)-.809016994*(diff(a[4](t), t))-187.3312629*a[4](t)+1.000000002*(diff(a[5](t), t))+289.4427191*a[5](t) = 0, diff(a[0](t), t)-.3090169938*(diff(a[1](t), t))-.8090169951*(diff(a[2](t), t))-16*a[2](t)+.8090169933*(diff(a[3](t), t))+29.66563140*a[3](t)+.3090169967*(diff(a[4](t), t))+27.33126306*a[4](t)-1.000000000*(diff(a[5](t), t))-110.5572808*a[5](t) = 0, diff(a[0](t), t)+.3090169938*(diff(a[1](t), t))-.8090169951*(diff(a[2](t), t))-16*a[2](t)-.8090169933*(diff(a[3](t), t))-29.66563140*a[3](t)+.3090169967*(diff(a[4](t), t))+27.33126306*a[4](t)+1.000000000*(diff(a[5](t), t))+110.5572808*a[5](t) = 0, diff(a[0](t), t)+.8090169943*(diff(a[1](t), t))+.309016994*(diff(a[2](t), t))-16*a[2](t)-.3090169950*(diff(a[3](t), t))-77.66563145*a[3](t)-.809016994*(diff(a[4](t), t))-187.3312629*a[4](t)-1.000000002*(diff(a[5](t), t))-289.4427191*a[5](t) = 0, diff(a[1](t), t)+4*(diff(a[2](t), t))+9*(diff(a[3](t), t))+16*(diff(a[4](t), t))+25*(diff(a[5](t), t))-3*(diff(b[1](t), t))+12*(diff(b[2](t), t))-27*(diff(b[3](t), t))+48*(diff(b[4](t), t))-75*(diff(b[5](t), t)) = 0, diff(b[0](t), t)-.8090169943*(diff(b[1](t), t))+.309016994*(diff(b[2](t), t))-48*b[2](t)+.3090169950*(diff(b[3](t), t))+232.9968944*b[3](t)-.809016994*(diff(b[4](t), t))-561.9937886*b[4](t)+1.000000002*(diff(b[5](t), t))+868.3281572*b[5](t) = 0, diff(b[0](t), t)-.3090169938*(diff(b[1](t), t))-.8090169951*(diff(b[2](t), t))-48*b[2](t)+.8090169933*(diff(b[3](t), t))+88.99689421*b[3](t)+.3090169967*(diff(b[4](t), t))+81.99378917*b[4](t)-1.000000000*(diff(b[5](t), t))-331.6718425*b[5](t) = 0, diff(b[0](t), t)+.3090169938*(diff(b[1](t), t))-.8090169951*(diff(b[2](t), t))-48*b[2](t)-.8090169933*(diff(b[3](t), t))-88.99689421*b[3](t)+.3090169967*(diff(b[4](t), t))+81.99378917*b[4](t)+1.000000000*(diff(b[5](t), t))+331.6718425*b[5](t) = 0, diff(b[0](t), t)+.8090169943*(diff(b[1](t), t))+.309016994*(diff(b[2](t), t))-48*b[2](t)-.3090169950*(diff(b[3](t), t))-232.9968944*b[3](t)-.809016994*(diff(b[4](t), t))-561.9937886*b[4](t)-1.000000002*(diff(b[5](t), t))-868.3281572*b[5](t) = 0, diff(a[0](t), t)+diff(a[1](t), t)+diff(a[2](t), t)+diff(a[3](t), t)+diff(a[4](t), t)+diff(a[5](t), t)-(diff(b[0](t), t))+diff(b[1](t), t)-(diff(b[2](t), t))+diff(b[3](t), t)-(diff(b[4](t), t))+diff(b[5](t), t) = 0}

ics := {a[0](0) = 0.7499999990e-1, a[1](0) = .1500000001, a[2](0) = .1500000002, a[3](0) = .1500000000, a[4](0) = .1499999999, a[5](0) = 0.7499999987e-1, b[0](0) = .9750000000, b[1](0) = 0.5000000005e-1, b[2](0) = -0.5000000005e-1, b[3](0) = 0.5000000000e-1, b[4](0) = -0.4999999998e-1, b[5](0) = 0.2499999996e-1}

vars := [seq(a[i](t), i = 0 .. 5), seq(b[i](t), i = 0 .. 5)]

ans := evalf(dsolve(`union`(sys, ics), vars, method = laplace))

plot(eval(vars, ans), t = 0 .. 1)

ans[1]

a[0](t) = .3749999998+0.4751150840e-3*exp(-432.4166894*t)-0.2616281798e-2*exp(-245.9032514*t)+0.7402987796e-2*exp(-145.3319702*t)-0.4647601976e-1*exp(-119.1950503*t)-0.9154192475e-2*exp(-61.97921418*t)-0.5535077677e-2*exp(-36.29183506*t)-0.6820439432e-1*exp(-14.50379126*t)-.1758921368*exp(-4.519373969*t)

NULL

Download dsolve2.mw

In version 2022.2, your document looks and works as you say - the plot command is there, the plots are empty and the 1 seems to be the problem. So this seems to be a bug, and I have submitted an SCR.

select works on the operands that satisfy the condition, so can be tricky to use. In your case ee is an equation - whattype(ee) returns `=`, and the operands of an equation are the left and right sides - try op(ee) to see this. So you selected the sides of the equation that satisfied the condition. Since the left-hand side has dx you got the left-hand side back and since the right-hand side didn't you got back nothing for the right-hand side. It you want to extract terms, then you need to work on a sum - try expand(lhs(ee)) and you will see it is a sum of terms (lhs(ee) is a product of m and something else so won't work here).

So 

select(has, expand(lhs(ee)), dx) 

will work here.

The last two odes are the same, so when you put them into the set the duplicate is removed. Try nops(sys) and you will get 7, not 8. 

For future use, it is helpful to upload the worksheet - use the big green up-arrow.

The result you wanted wasn't achieved because you just put the statement Eq; which just displays the existing contents of Eq. Notice that in the second use..end use you did achieve what you wanted because there you were multiplying.

layout = network comes closest to what you want, and I think is intended for this purpose. The loops prevent using this layout option directly, but you can remove the loops, find the vertex positions and then apply them to the graph with loops. It does seem strange that there are backward arrows.

Download Graph.mw

Here it is working in 1-D, but when I change to 2-D it doesn't work.

restart

interface(version)

with(Physics[Vectors])

Physics:-Version()

Setup(mathematicalnotation = true)

with(Physics)
Setup(quantumoperators = {Omega, r})

`Standard Worksheet Interface, Maple 2022.2, Windows 10, October 23 2022 Build ID 1657361`

`The "Physics Updates" version in the MapleCloud is 1359 and is the same as the version installed in this computer, created 2022, December 23, 12:46 hours Pacific Time.`

m*Omega^2*r
lprint(m*Omega^2*r)

m*Physics:-`*`(Physics:-`^`(Omega, 2), r)

m*Physics:-`*`(Physics:-`^`(Omega,2),r)

use   `*`= :-`.` in
a := m*Omega^2*r
end use

`.`(m, Physics:-`^`(Omega, 2), r)

lprint(a)

m . Physics:-`^`(Omega,2) . r

NULL

Download PhysVec2.mw

TextAreas can be used for user numeric input - see attached. A Data Table can be used as well.

textarea.mw

Edit: GetProperty returns a string, but the Do command returns a value.

I found on 2022.2 and Windows 10 that it did time out after about 2 mins (using Windows clock), which the status bar said was 288 s, so much greater than the 60 s specified. Same without the try/catch. The stop icon worked up to that time. It didn't hang.

Then I tried 100 s and it timed out at 268 s, i.e., about the same time, which would be consistent with "the execution may not abort at exactly the time limit imposed, but will abort as soon as it can do so safely.  This can happen when execution is in critical sections of certain built-in routines."

Then I tried 200 s. I watched the status bar time, which is very uneven, and jumped more than 100 s at some point. It seemed to freeze at 671 s for a long time. I used the stop icon, end it changed to gray but did not give the "computation interrupted" message. I tried to exit the worksheet, it asked me if I wanted to save and I was able to save and then exit.

In my experience, that is common behavior of the stop icon (even without timelimit).

So the timings were not correct, but nothing pathological was happenning (in the sense I had to use task manager). Here's the 100 s one.

solve_hangs_different_timing_dec_23_2022.mw

Right-click on the plot and choose "component properties" and you will find the name. (I tried cutting and pasting a plot to within a table and it did not change name.)

I put the populations into tables, indexed by the vertex names. Otherwise, you probably need member to extract the positions of the vertices in the list, which is awkward. You could also store the populations in Vertex attributes.
 

restart

NULL

with(GraphTheory)

with(SpecialGraphs)

Vs := [x, y, z, w]

[x, y, z, w]

Popvs := table(`~`[`=`](Vs, [-2, 1, 6, 3]))

table( [( x ) = -2, ( w ) = 3, ( y ) = 1, ( z ) = 6 ] )

X := Graph(Vs)

GRAPHLN(undirected, unweighted, [x, y, z, w], Array(1..4, {(1) = {}, (2) = {}, (3) = {}, (4) = {}}), `GRAPHLN/table/1`, 0)

AddEdge(X, {{w, y}, {w, z}, {x, y}, {y, z}})

GRAPHLN(undirected, unweighted, [x, y, z, w], Array(1..4, {(1) = {2}, (2) = {1, 3, 4}, (3) = {2, 4}, (4) = {2, 3}}), `GRAPHLN/table/1`, 0)

Nbs := map2(Neighbors, X, Vs)

[[y], [x, z, w], [y, w], [y, z]]

NULL

vp := [[0, 0], [1, 0], [1.5, 1], [2, 0]]

[[0, 0], [1, 0], [1.5, 1], [2, 0]]

SetVertexPositions(X, vp)``

DrawGraphWithPops := proc (X::Graph, pops::table) options operator, arrow; DrawGraph(RelabelVertices(X, map(convert, `~`[`=`](Vertices(X), convert(pops, list)), string))) end proc

DrawGraphWithPops(X, Popvs)

newPopvs := table(); for vert in Vs do newPopvs[vert] := Popvs[vert]+add(Popvs[j], `in`(j, Neighbors(X, vert))) end do

NULL``

DrawGraphWithPops(X, newPopvs)

NULL

``

Download Q_23-12-22_Test_Graph_indices2.mw

restart

with(GroupTheory); with(GraphTheory); with(plots)

n := 6; elements := [seq(PermPower(Perm([[`$`(1 .. n)]]), i), i = 1 .. n)]; Gp := Group(elements); IsCyclic(Gp)

6

[_m2697776930016, _m2697776924416, _m2697776924800, _m2697776925184, _m2697776925568, _m2697776925952]

_m2697776026688

true

Find all minimum combinations of elements that can generate the group.

Successively check cases with one generator, two generators, etc,
In order to avoid redundant generators, once a generator set is found, don't allow supersets.

gens:={}:
for numgens to n do
  combs:=combinat:-choose({$(1..n)},numgens):
  for gen in combs do
    if not ormap(`subset`, gens, gen)
       and AreIsomorphic(Gp,Group([seq(elements[i], i in gen)],degree=n)) then
      gens:=gens union {gen};
    end if;
  end do;
end do:
gens;

{{1}, {5}, {2, 3}, {3, 4}}

Generate and display Cayley graphs

CGs := seq(CayleyGraph(Gp, generators = [seq(elements[i], `in`(i, j))]), `in`(j, gens))

display(Array([seq(display(DrawGraph(CGs[j], style = circle), textplot([0, 1.1, gens[j]])), j = 1 .. nops(gens))]))

 

 

 

 

 

NULL

Download Generators.mw

 


 

restart;

eq1 := x = (((72*5^(3/2)+270)*a^2-1344*5^(3/2)*a)*w+(9*5^(5/2)-1485)*a^2-2016*5^(3/2)*a-12544*5^(5/2))/(((288*sqrt(5)+216)*a^2-5376*sqrt(5)*a)*w+(36*5^(3/2)-1188)*a^2-8064*sqrt(5)*a+6272*5^(3/2)):
eq2:= a^3 = -(128*5^(5/2)*w)/9+(1600*w)/3+(544*5^(3/2))/9+15200/27:
eq3:=1+w+w*w = 0:##   or w = (sqrt(3)*%i)/2-1/2:

ans:=simplify([solve({eq1,eq2,eq3},allsolutions,explicit)]);

[{a = (1/3)*((5*I)*5^(1/2)+5*I)*3^(1/2)+5^(1/2)-25/3, w = -1/2-((1/2)*I)*3^(1/2), x = -35/2-(15/2)*5^(1/2)}, {a = (1/3)*(-(4*I)*5^(1/2)+10*I)*3^(1/2)+2*5^(1/2)+20/3, w = -1/2-((1/2)*I)*3^(1/2), x = 5}, {a = (1/3)*(-I*5^(1/2)-15*I)*3^(1/2)-3*5^(1/2)+5/3, w = -1/2-((1/2)*I)*3^(1/2), x = -35/2+(15/2)*5^(1/2)}, {a = (1/3)*((4*I)*5^(1/2)-10*I)*3^(1/2)+2*5^(1/2)+20/3, w = -1/2+((1/2)*I)*3^(1/2), x = 5}, {a = (1/3)*(-(5*I)*5^(1/2)-5*I)*3^(1/2)+5^(1/2)-25/3, w = -1/2+((1/2)*I)*3^(1/2), x = -35/2-(15/2)*5^(1/2)}, {a = (1/3)*(I*5^(1/2)+15*I)*3^(1/2)-3*5^(1/2)+5/3, w = -1/2+((1/2)*I)*3^(1/2), x = -35/2+(15/2)*5^(1/2)}]

n:=nops(ans);

6

xvals:=seq(eval(x,i),i in ans);

-35/2-(15/2)*5^(1/2), 5, -35/2+(15/2)*5^(1/2), 5, -35/2-(15/2)*5^(1/2), -35/2+(15/2)*5^(1/2)

alias(a__1=((5*I*sqrt(5) + 5*I)*sqrt(3))/3 + sqrt(5) - 25/3,
a__2=((-4*I*sqrt(5) + 10*I)*sqrt(3))/3 + 2*sqrt(5) + 20/3,
a__3=((-sqrt(5)*I - 15*I)*sqrt(3))/3 - 3*sqrt(5) + 5/3,
a__4=((-5*I*sqrt(5) - 5*I)*sqrt(3))/3 + sqrt(5) - 25/3,
a__5=((4*I*sqrt(5) - 10*I)*sqrt(3))/3 + 2*sqrt(5) + 20/3,
a__6=((sqrt(5)*I + 15*I)*sqrt(3))/3 - 3*sqrt(5) + 5/3,
x__1=-35/2 - (15*sqrt(5))/2,
x__2=-35/2 + (15*sqrt(5))/2,
w__1=-1/2 - sqrt(3)*I/2,
w__2=-1/2 + sqrt(3)*I/2);

a__1, a__2, a__3, a__4, a__5, a__6, x__1, x__2, w__1, w__2

ans;

[{a = a__1, w = w__1, x = x__1}, {a = a__2, w = w__1, x = 5}, {a = a__3, w = w__1, x = x__2}, {a = a__5, w = w__2, x = 5}, {a = a__4, w = w__2, x = x__1}, {a = a__6, w = w__2, x = x__2}]

NULL

Download solns.mw

First 35 36 37 38 39 40 41 Last Page 37 of 81