# Generate a network for the entropy values

Posted 3 months ago
1082 Views
|
12 Replies
|
14 Total Likes
|
 Dear all,I calculated the entropy values for the time series of 44 cities. Is it possible to define a simple or complex network for these values? I attached a related reference for getting more information. shannonEntropy[data_, binWidth_] := Module[{iter, n = Length[data], pi, pi1}, iter = {Min[data], Max[data] + binWidth, binWidth}; pi = N[BinCounts[data, iter]/n]; pi1 = DeleteCases[pi, 0.]; -pi1.Log[pi1]] entr = {1.21, 0.55, 0.84, 1.06, 1.33, 0.82, 1.51, 0.27, 1.21, 1.14, 0.92, 1.23, 1.37, 0.82, 0.69, 1.46, 0.1, 0.09, 1.63, 1.58, 0.89, 0.21, 0.93, 1.33, 1.31, 1.09, 0.46, 0.54, 0.94, 0.04, 0.88, 0.87, 1.24, 1.62, 0.96, 1.35, 1.43, 0.9, 0.72, 1.07, 1.02, 1.16, 1.38, 0.07}; lat = {36.37, 35.44, 35.44, 36.69, 37., 35.75, 36.69, 34.81, 36.06, 36.69, 35.13, 36.37, 36.37, 34.81, 33.56, 37., 33.25, 32.63, 36.37, 36.69, 35.44, 33.88, 35.44, 36.37, 36.37, 36.06, 35.75, 33.25, 35.75, 32., 35.73, 35.75, 34.81, 36.06, 35.13, 37., 36.37, 35.44, 35.13, 35.44, 36.69, 35.44, 36.69, 33.25}; lon = {1.875, 2.5, -0.9375, 3.125, 7.8125, 6.25, 5., 5.625, 4.6875, 3.4375, 4.0625, 0.9375, 6.5625, 3.125, 0.9375, 8.125, 6.875, 3.75, 7.5, 5.625, 7.1875, 2.8125, 0.3125, 2.8125, 6.25, 0., 4.6875, -0.3125, -0.3125, 5.625, 7.3693, 0.625, 0.3125, 5.3125, -0.625, 6.875, 7.8125, 7.8125, -1.875, 1.25, 2.5, 1.5625, 3.75, 5.9375};  Attachments:
12 Replies
Sort By:
Posted 3 months ago
 Hello Alex,Maybe I do not jet fully understand this seemingly interesting concept. Is it this you are having in mind? (I have no idea on how to use your position data ...) v4 = Partition[entr, 4, 1]; order4 = FromDigits@*Ordering /@ v4; rels = UndirectedEdge @@@ Partition[order4, 2, 1]; Graph[rels, VertexLabels -> Automatic] EDIT:I guess the partition of the data should be done differently and my code should rather read like so: v4 = Partition[entr, 4]; order4 = FromDigits@*Ordering /@ v4; rels = UndirectedEdge @@@ Partition[order4, 2, 1]; Graph[rels, VertexLabels -> Automatic] 
Posted 3 months ago
 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?
Posted 3 months ago
 Thank you Mohammad - but there is definitely no reason for any congratulations! I simply tried to follow the idea/concept in the above attached publication.
Posted 3 months ago
 Dear Henrik,I plotted for different orders and got interesting results. Thank you. Attachments:
Posted 2 months ago
 Hi Henrik,I found another paper. I thought it may be interesting to you, especially Fig3 and Fig4. Is it possible to investigate this approach to your city air temperature time series (for example).Thanks, Alex Attachments:
Posted 2 months ago
 Hi Alex, thank you for this publication! I will try to find time looking into it. Regards -- Henrik
Posted 2 months ago
 Hi Henrik, Did you have time to take a look at the paper that I sent you a few days ago? I got Oberpfaffenhofen Airport air temperature time series, may be it be useful for the method. Oberpfaffenhofen Airport ICAO code | EDMO tt0 = WeatherData["EDMO", "MeanTemperature", {{2000}, {2018}, "Day"}]; temp0 = Last[tt0\[Transpose]]; Normal[temp0]; DateListPlot[temp0]  Attachments:
Posted 2 months ago
 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
Posted 21 days ago
 Hi Henrik,Please take a look at the attached manuscript. Studying periodicity using the complex network is a novel approach in water engineering, so I decided to apply this concept for 44 rain stations in the northern region of Algeria.If you remember, you have extracted a graph for one of the stations about two months ago (Figure 6). I need your help in providing graphs for all stations. We will write the section related to complex network and also the results and other details. May I send you data from all the stations?It's my pleasure and honor to work with you.Regards, Mohammad Attachments:
Posted 16 days ago
 Dear Prof. Ghorbani,oops - I nearly missed that post, sorry! I will try to contact you via ResearchGate.netRegards -- Henrik