Message Boards Message Boards

GROUPS:

Generate a network for the entropy values

Posted 7 months ago
1775 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

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]

enter image description here

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?

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.

Dear Henrik,

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

Attachments:
Posted 7 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:

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

Posted 7 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:

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]

enter image description here

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

CommunityGraphPlot[gr, ImageSize -> Large]

enter image description here

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]

enter image description here

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

<strong>enter image description here

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

Dear Prof. Ghorbani,

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

Regards -- Henrik

Posted 7 months ago

Thank you so much, Henrik. Good job!

I tried to run the code again and got a different kind of graphs (I use Mathematica 11.3).

Where am I wrong?

Attachments:

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

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract