Tag Info

New answers tagged

2

Yes. But don't assume that the vertex named 1 is the first one, etc. That is often not the case. You can get the order of vertices using VertexList. You can get the index of a certain vertex using VertexIndex.


7

Both are directed. The arrows are there but they're too small to be visible. This is because the arrowhead sizes are by default given as a fraction of the image width. Your image is very narrow (and would be even narrower for just Graph[{1 -> 2}]), so the arrowheads become tiny. Yes, this is not very good design and it's very annoying. Unfortunately ...


2

List @@@ PropertyValue[g, VertexLabels] {{1, "v1"}, {2, "v2"}, {3, "v3"}, {4, "v4"}, {5, "v5"}} or List @@@ Options[g, VertexLabels][[1, 2]] (* same output *)


2

Just for illustration (and not dealing with distance or other edge weighting): centerCoordinates = CountryData["Asia", "CenterCoordinates"]; asianames = CountryData["Asia", "Name"]; v = Length[centerCoordinates]; g = CompleteGraph[v, VertexCoordinates -> (Reverse /@ centerCoordinates), EdgeStyle -> Directive[LightGray, Opacity[0.2]], ...


0

We can extract the coordinates of the graph's vertices and rotate those. To wit: n = 5; (* I used a smaller example for demonstration; change if needed *) vlist = VertexCoordinates /. AbsoluteOptions[CompleteGraph[n], VertexCoordinates]; Prepare the frames of the animation (this might take a fair bit of time for large n): With[{frames = 30}, ...


1

I had interpreted the question a bit differently. The word "iterative" in the question led me to think that OP might want to see the graphs connecting the happy numbers and unhappy numbers in Mathematica. Here's how to get the two graphs: nums = Table[NestWhileList[Composition[#.# &, IntegerDigits], k, (FreeQ @@ Through[{Most, ...


2

Just to ensure this one isn't going to engross the unanswered internal bag. As I said in a comment the following might work for two "iterations": base = List /@ Range@100; base1 = {#, Tr[IntegerDigits[#]^2]} & /@ base[[All, -1]]; base2 = {#, Tr[IntegerDigits[#]^2]} & /@ base1[[All, -1]]; DirectedEdge @@@ Union[base1, base2]; Graph[%, GraphLayout ...


0

Actually, that only LOOKS like the answer, but it doesn't perform the correct operation. Specifically it fails to keep the properties associated with the correct nodes in the subgraph as you can see in the following example: SomeGraph = Graph[{1 <-> 2, 2 <-> 3, 3 <-> 1}, Properties -> {1 -> {"happiness" -> 1.1}, 2 -> ...


1

The answer is actually very simple. PartOfGraph = Subgraph[SomeGraph,{1, 2},Options[SomeGraph]]; Strangely Mathematica does not list "Options[]" as an option under "Details and Options" of the Subgraph function...as one would naturally expect. I found this on the right under "Related" questions even though I couldn't find it through searching. So this ...


1

Your edge functions: edgeFun[pts_, e__] := BezierCurve[{#, # - {-0.5, 0.5}, #2} & @@ pts[[{1, -1}]]]; function to define edge styles: estyle[edges_, weight_, color_, thickrange_] := Block[{}, Thread[edges -> (Directive[ ColorData[color][Rescale[#, thickrange, {0, 1}]], Thickness[#]] & /@ Rescale[weight, ...


4

First, let's generate some random words and graph nWords = 15; nEdges = 30; words = RandomSample[DictionaryLookup[___], nWords]; wordsWeight = RandomInteger[{1, 100}, nWords]; edgeList = Flatten[Table[ UndirectedEdge[words[[i]], words[[j]]], {i, nWords}, {j, nWords}], 1]; edgeList = RandomSample[edgeList, nEdges]; edgeWeight = RandomInteger[{1, ...


7

Preferential growth with an increasing number of vertices means that older vertices will have far more connections than the newer ones. So we know which vertices will probably be chosen, and we should try to use that in our algorithm. One way to do it is roulette wheel selection: randomChoice = Compile[{{list, _Real, 1}}, Module[{acc, i = 1, r1 = 0., r2 ...


3

I believe what you mean by "equivalence" is Automorphism. Your definitions (some of them changed a little): f4graph[omega_] := System`Graph[g[omega]] t = Table[f4graph[omega], {omega, 3}] h = CycleGraph[3]; s[delta_] := Subsets[Range[VertexCount[f4graph[delta]]], {VertexCount[h]}]; p[delta_] := Select[Subgraph[f4graph[delta], #]&/@ s[delta], ...


47

If you want to make several sequences of the Collatz function for turning it into a graph, you probably want to memorize, which parts you already calculated. What we try to do is to create a graph like this (image from xkcd) When we would calculate the whole chain for each number until it (hopefully) reaches the end sequence 8,4,1 we do a lot of work over ...


28

This is the Collatz function I know: Collatz[1] := {1} Collatz[n_Integer] := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0 Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0 Generating a graph from this is easy: Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[500] // Flatten // Union, ...


0

Thread is useful for converting this format to a simple edge list. Example: Thread[ 1 <-> {2,3,4} ] (* {1 <-> 2, 1 <-> 3, 1 <-> 4} *) Using this idea, you could do Graph@Catenate[Thread[First[#] <-> Rest[#]] & /@ e] For Mathematica versions earlier than 10, use Flatten[..., 1] in place of Catenate[...].


4

TreePlot predates Graph. Only in version 10 was it updated to handle Graph according to the documentation. Since Graph supports more advanced functionality than TreePlot it is unsurprising that only a subset is supported by the latter, and VertexLabels is not supported. If you convert the Graph to an older, more basic format TreePlot will work: ...


0

I'm assuming that your matrix is a weighted adjacency matrix. WeightedAdjacencyGraph[mywts = Table[RandomReal[], {4}, {4}], VertexLabels -> "Name", EdgeLabels -> Table[Rule[EdgeList[mygraph][[i]], Flatten[mywts][[i]]], {i, 16}]]


1

You can try HighlightGraph with "DehighlightHide" highlight style. One thing I modify in PowerGraph is changing vertex {} to string vertex "{}". PowerGraph[l_] := Module[ {count = 1, treelist, vmaplist, t, label, ncolor}, treelist = Reap[ Fold[#1~Join~(#1 /. (x_ \[DirectedEdge] y_) :> (y \[DirectedEdge] (Sow[{count, #2}]; count++))) &, ...


3

If you wanted to do this same kind of parsing for a website for which a built-in function was not available, you could read in the contents of the web page (using URLFetch) and then search this for links, which usually start with "href". For example str = "https://en.wikipedia.org/wiki/Main_Page"; q = URLFetch[str]; ind = ...


8

Yep, as @Sjoerd mentions in the comments, 10.1 includes the WikipediaData functionality. You can use like this: links = WikipediaData["Mathematica", "BacklinksRules", "MaxLevelItems" -> 10, "MaxLevel" -> 2] Graph[links, VertexLabels -> Placed["Name", Tooltip], VertexStyle -> {"Mathematica" -> Red}]



Top 50 recent answers are included