Hot answers tagged

10

I have done a similar thing for transport in porous media using the image processing functions. It may be different to what you are after but here's the code: First I create a dictionary of nodes ClearAll[dictionary, im, seep]; dictionary[dimensions_Integer, size_Integer] /; (size < dimensions) := dictionary[dimensions, size] = Module[{cross, ...


9

I think you're looking for RelationGraph. It takes a list of objects to treat as vertices and a test function which determines whether two given vertices should be connected by an edge: pts = {{0, 0}, {0, 1}, {4, 4}, {0, 2}, {1, 2}, {1, 1}}; d = 1; RelationGraph[EuclideanDistance[#, #2] == 1 &, pts] As of 10.3 a more idiomatic way to implement the ...


8

I've taken Graph based road. Let me leave the styling to you: gr = GridGraph[{10, 10}]; The top row is the one with Range[10]*10 vertices and the bottom one with 10*Range[0,9]+1. Don't know how to shortly transpose this so will leave it so. topRow = 10 Range[10]; bottomRow = 10 Range[0, 9] + 1; Manipulate[ deleted = RandomSample[ (*the top and ...


7

Below you'll find the method I wrote myself, but it is terribly slow compared to this one, adapted from halmir's code here, so I will give the fast version first and post my own code below. See halmir's post for an explanation, ClearAll@graphToMesh graphToMesh[graph_?PlanarGraphQ] := Module[{nextCandidate, m, orderings, pAdj, rightF, s, t, initial, ...


7

Yes, use GraphEmbedding. Graph is atomic and you should not try to extract any information from it by looking at its input form. It is not reliable, can change between versions, undocumented, etc. Nor is the input form directly accessible with things like Part.


7

The following should be fast enough: myList = ReadList["infile.txt", Number, RecordLists -> True]; // AbsoluteTiming {4.64517, Null}


6

Kuba beat me to this, but I'll post it anyway since it's slightly different. This gives control over the initial and final positions within the graph, and attempts to keep some of the styling elements, n = 10; g = SetProperty[GridGraph[{n, n}], VertexCoordinates -> Flatten[Array[{#2, #1} &, {n, n}], 1]]; Manipulate[ g2 = EdgeDelete[g, # ...


6

For version 9 ngF = With[{v = #, d = #2}, AdjacencyGraph[v, Outer[Boole[EuclideanDistance@## == d] &, v, v, 1], ##3]] &; Using Martin's example, pts = {{0, 0}, {0, 1}, {4, 4}, {0, 2}, {1, 2}, {1, 1}} ngF[pts, 1, VertexLabels -> "Name", ImagePadding -> 10]


6

This answer is a wild stab in the dark, but here it goes... I assume run times of individual runners to follow normal distribution. Product of all PDFs of individual results is maximized (mean run time of runner at vertex 1 is anchored at 0 to choose a reference point), and resulting distributions are used to compute mean, standard deviation and chance of ...


6

As it was mentioned in the question and in the comments this is fairly easy to program. eqs = {Y == a + b X, Z == 1/X + Y}; edges = Flatten@ Map[Outer[Rule, Cases[{#[[2]]}, s_Symbol /; Not@NumericQ[s], \[Infinity]], Cases[{#[[1]]}, s_Symbol /; Not@NumericQ[s], \[Infinity]]] &, eqs] (* {a -> Y, b -> Y, X -> Y, X -> Z, Y ...


5

There is a duplicated vertex causing this issue: idiom[[;; 1665]] // Length 1665 idiom[[;; 1665]] // Union // Length 1664 As a workaround, you could take Union over the vertex set: g = RelationGraph[StringTake[#1, -1] == StringTake[#2, 1] &, Union@idiom[[;; 1665]]]; GraphQ[g] True but the output shouldn't be that. You should ...


5

eqsToGraph = Block[{Equal = Rule @@@ Tuples[{Variables@#2, Variables@#1}] &}, Graph[Join @@ #, VertexShapeFunction -> "Name"]] &; Example: eqsToGraph@{Y == a + b X, Z == 1/X + Y} eqsToGraph@{Y == a + b X, Z + W == 1/X + Y}


4

No, this is not a bug. GraphData is a non-exhaustive collection of useful and common graphs. It does not and could not possibly include all graphs. GraphData["Connected", n] will return all connected n-vertex graphs from this particular database, but it does not return all connected n-vertex graphs.


3

proc = DiscreteMarkovProcess[3, {{1/4, 3/4, 0, 0}, {1/3, 1/3, 1/3, 0}, {1/4, 1/4, 1/4, 1/4}, {0, 0, 0, 1}}]; labels = Table[RandomGraph[{5, 6}, ImageSize -> 30, EdgeStyle -> Thick], {4}]; g = Graph[proc, EdgeShapeFunction -> edgefunction, VertexSize -> .25, VertexLabels -> Thread[Range[4] -> (Placed[#, Center] & /@ ...


2

$Version (* "10.4.1 for Mac OS X x86 (64-bit) (April 11, 2016)" *) Hex[exp_] := FromDigits[exp, 16]; LByte[exp_] := BitAnd[exp, Hex@"00ff"]; HByte[exp_] := BitAnd[exp, Hex@"ff00"]~BitShiftRight~8; PRNG[v_] := Module[{L5, H5, v1, v2, carry}, L5 = LByte@v*5; H5 = HByte@v*5; v1 = LByte@H5 + HByte@L5 + 1; carry = HByte@v1~BitGet~0; v2 = ...


2

The answer proposed by halmir is very efficient and will give a list featuring all the internal faces along with one face that represents the outer perimeter, but the outer face is not always at the same point in the list, and plotting the polygons sometimes results in obscuring some internal faces. Consider the following graph, g1 = AdjacencyGraph[{{0, 1, ...


2

There's (almost certainly) no way to do this efficiently, except for small graphs. According to Wikipedia: The number of matchings in a graph is known as the Hosoya index of the graph. It is #P-complete to compute this quantity, even for bipartite graphs.[13] It is also #P-complete to count perfect matchings, even in bipartite graphs [...] Where ...


2

GraphData[{"CubicTransitive", 20}] sets VertexCoordinates and VertexCoordinates has higher priority than GraphLayout (options section in Graph documentation). g = GraphData[{"CubicTransitive", 20}]; Options[g] {VertexCoordinates -> {{1., 0.}, {0.5, 0.866}, {-0.5, 0.866}, {-1., 0.}, {-0.5, -0.866}, {0.5, -0.866}, {1.5, 0.}, {0.75, 1.299}, ...


2

I'd go ahead and call it a bug, but I don't know what is causing it (sadly, I'm not a kernel developer). I can verify it's a bug below and I can offer a workaround to create the desired graph easily. Here is a function that should create a RelationGraph but without the vertex labels, although I think that could be added easily enough, ...


1

sources = Select[VertexList[g], VertexOutDegree[g, #] >= 1 &]; SetProperty[g, {VertexLabels -> (Thread[ sources -> Placed["Name", Center]]), VertexSize -> (Thread[sources -> 3/2])}]



Only top voted, non community-wiki answers of a minimum length are eligible