Для проекта "Абсолютный курс" - http://www.abscur.ru​
​​
​Исследование зависимостей по корреляциям для рублевых курсов акций (за разные периоды).​
​​
​Для начала расчитывается корреляционная матрица. Далее из нее выделяются наибольшие по модулю значения и для них строится граф. Узлы графа обозначают акции. Линии между ними обозначают сильные связи. Цвет линии обозначает знак связи (зеленый - это для однонаправленной зависимости, красный для разнонаправленной зависимости). Расчеты выполнены на языке WolframLang. ​
​​
​Источник данных по адресу https://docs.google.com/spreadsheets/d/1VBGp8VfbJUb2C-jslQRO83vo-v5GMQ19erPDrN_8MYw/edit#gid=1121754431​
​

(*загрузка данных*)​​ClearAll[rubData,rubList];​​rubData=Module[{sid,gid,range,url},​​sid="1VBGp8VfbJUb2C-jslQRO83vo-v5GMQ19erPDrN_8MYw";​​gid="1121754431";​​range=URLEncode["A:AY"];​​url="https://docs.google.com/spreadsheets/d/"<>sid<>"/export?format=xlsx&gid="<>gid<>"&range="<>range;​​Import[url,"XLSX"][[1]]​​];​​rubList=Drop[rubData//First,1];
In[]:=
(*граф зависимостей за весь период*)​​ClearAll[corr,rubGraph,datesList,rubVals,per];​​datesList=Table[rubData[[i,1]],{i,2,Length[rubData]}];​​rubVals=Table[rubData[[i,j]],{i,2,Length[rubData]},{j,2,Length[rubList]+1}];​​per=" с "<>First[datesList]<>" по "<>Last[datesList];​​corr=Correlation[rubVals];​​​​rubGraph=DeleteCases[​​Flatten[​​Table[​​If[(corr[[i,j]]<-0.8||corr[[i,j]]>0.9)&&(i<j)​​,{rubList[[i]]rubList[[j]],If[corr[[i,j]]>0,"+","-"]}​​,Null]​​,{i,Length[corr]},{j,Length[corr]}]​​,1]​​,Null];​​GraphPlotrubGraph,VertexLabelingAll,EdgeRenderingFunction({If[#3=="+",Green,Red],Line[#1,10]}&),PackingMethod"ClosestPackingCenter",PlotLabel"Граф зависимостей между курсами акций (за весь период)"<>per​​​​​​
In[]:=
Out[]=