Hi Alex,

Yes, strange, on Mathematica 11.3 I get the same results/graphs as in your notebook. For the above Mathematica 12.0 was used - maybe some algorithm for calculating graph communities has changed (i.e. improved).

Henrik you did an incredible job. Congratulations!

Is there any concept behind the this network.? What does this network give us from the mathematical or application view?

Dear Henrik,

I plotted for different orders and got interesting results. Thank you.

Attachments:

Henrik Entropy.nb

Hi Alex, thank you for this publication! I will try to find time looking into it. Regards -- Henrik

Hello Alex. sorry for the delay!

I finally found some time to look into this problem. But as a word of caution: I am not sure whether I am understanding the respective publication correctly, and I do not have any experiences with graphs !!!

Here is what I tried:

ClearAll["Global`*"]
(* function for calculating the edge weight between two vertices v1,v2: *)
getEdgeWeight[v1_List, v2_List] := Module[{trans1, trans2},
  If[v1 == v2, Return[{Null, 0}]];
  {trans1, trans2} = Partition[#, 2, 1] & /@ {v1, v2};
  {UndirectedEdge[v1, v2], Total[Count[trans1, #] & /@ trans2]}
  ]

tt0 = WeatherData[Entity["City", {"Munich", "Bavaria", "Germany"}], 
   "MeanTemperature", {{2008}, {2018}, "Day"}];
temperatures = First@Normal@tt0["ValueList"];
temperatNums = Round@QuantityMagnitude[temperatures];
lenght = tt0["PathLength"];
vertexNameLength = Round[N@Sqrt[lenght]]; (* according to Ferreira et al *)
vertexList = Partition[temperatNums, vertexNameLength];
combs = Select[Flatten[Outer[getEdgeWeight, vertexList, vertexList, 1], 1], Last[#] != 0 &];
{conns, weigth} = Transpose[combs];
gr = Graph[conns, EdgeWeight -> weigth, ImageSize -> Large]

The resulting graph is highly connected, but the connections/edges are weighted; Mathematica can easily disentangle this:

CommunityGraphPlot[gr, ImageSize -> Large]

One still has to convince oneself of the fact that this has something to do with the periodicity of the data. So I plot the data with a colored background according to the graph communities:

grcomms = FindGraphCommunities[gr];
indx = Flatten /@ Map[Position[vertexList, #] &, grcomms, {2}];
colr = {Red, Yellow, Magenta};
prolog = MapIndexed[{colr[[First[#2]]], Rectangle[{1 + (#1 - 1) vertexNameLength, -14}, {#1 vertexNameLength, 30}]} &, indx, {2}];
ListLinePlot[temperatNums, Prolog -> prolog, ImageSize -> Large]

Does that help? In any case: You should check carefully what I did! Regards -- Henrik

Dear Prof. Ghorbani,

oops - I nearly missed that post, sorry! I will try to contact you via ResearchGate.net

Regards -- Henrik