Dear Prof. Ghorbani,

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

Regards -- Henrik

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).

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

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

Dear Henrik,

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

Attachments:

Henrik Entropy.nb