«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Статьи

В этом посте я расскажу о том, как применять язык Wolfram Languge в анализе и визуализации данных на примере базы данных по "Игре престолов". В этой статье не уделяется особого внимания парсингу данных, об этом я расскажу отдельно. Вместо этого пост целиком посвящен интересной инфографике и её созданию.

Надеюсь, что построенные визуализации заинтересуют тех, кому нравится этот замечательный сериал)

Пол персонажей

Пол по имени персонажа:

In[1]:=
$gender=Association[Flatten[KeyValueMap[Thread[#2->#1]&, GOTRawData["characters-gender-all.json"]]]~Join~{"Aegon Targaryen"->"male", "Aerys II Targaryen"->"male", "Archmaester Marwyn"->"male", "Baratheon Guard"->"male", "Brandon Stark"->"male", "Child of the Forest"->"male", "Elia Martell"->"female", "Eon Hunter"->"male", "Goldcloak #1"->"male", "Goldcloak #2"->"male", "Knight of House Frey"->"male", "Knight of House Lynderly"->"male", "Kurleket"->"male", "Lannister Guardsman"->"male", "Lord Galbart Glover"->"male", "Male Prostitute"->"male", "Masha Heddle"->"female", "Meereen Slave Master"->"male", "Mikken"->"male", "Night's Watch Deserter"->"male", "Night's Watch Messenger"->"male", "Night's Watch Officer"->"male", "Pentoshi Servant"->"male", "Rhaella Targaryen"->"female", "Rhaenys Targaryen"->"female", "Stark Bannerman"->"male", "Stark Guard"->"male", "Wedding Band"->"male", "White Walker #2"->"male", "Willis Wode"->"male", "Young Ned"->"male"}];

Соотношение персонажей "Игры престолов" по полу — видно, что на одну женщину приходится по 3 мужчины. Создается ощущение иногда, что мужские персонажи лишь антураж для мощных женских)

In[2]:=
GOTInfographicsPoster[#, "Соотношение мужских и женских персонажей в Игре престолов"]&@Module[{labels, counts, percents}, 
{labels, counts}=Transpose[Tally[Values[$gender]]];

percents=PercentForm/@N[counts/Total[counts]];

PieChart[counts, ChartLabels->Map[Style[Row[#, "\n"], 20, Bold, Black, FontFamily->"Open Sans"]&, Transpose[{labels, counts, percents}]], ChartStyle->{LightRed, LightBlue}, ImageSize->600, Background->GrayLevel[0.95]]]
Out[2]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Дом персонажа

Дом персонажа по его имени:

In[3]:=
$GOTCharacterHouse=Association[Rule@@@Reverse/@Flatten[Thread/@Values[GOTRawData["characters-houses.json"]["house"]], 1]];

Эмблема дома по его названию:

In[4]:=
$GOTHouseSignData=AssociationThread[{"Arryn", "Baratheon", "Frey", "Greyjoy", "Lannister", "Martell", "Stark", "Targaryen", "Tully", "Tyrell", "White Walkers", "Night's Watch", "Dothraki", "Wildlings", "Include", "Mormont", "Umber", "Bolton", "Tarly"}->(ImagePad[#, 10, White]&/@ConformImages[(ImageCrop/@Flatten[ImagePartition[#, ImageDimensions[#]*{1/5, 1/2}]&[Import["https://7kingdoms.ru/wp-content/uploads/2012/04/GOT_Sigils_01.png"]]])~Join~Map[Import, {"https://i.pinimg.com/originals/5f/35/cb/5f35cb4d592cf7d2cbb4c1103ce31bf8.jpg", "https://i.pinimg.com/originals/4b/de/19/4bde1957b20e0f68a1566b39b408cb38.jpg", "https://i.pinimg.com/originals/4a/1b/59/4a1b59348d3f502bcc3c85340e092edc.jpg", "https://ih1.redbubble.net/image.516956392.1541/raf, 750x1000, 075, t, fafafa:ca443f4786.jpg", "https://ae01.alicdn.com/kf/HTB19O9dNXXXXXcpaXXXq6xXFXXXS/Iron-Throne-GOT-Toilet-Vinyl-Wall-Sticker-Game-of-thrones-Wall-Decals-For-Bathroom-Decoration.jpg", 
"https://oyster.ignimgs.com/mediawiki/apis.ign.com/game-of-thrones/7/7a/300px-GoT_sigils_08.jpg", "https://i.etsystatic.com/5840482/r/il/88beca/854713479/il_794xN.854713479_4t7z.jpg", 
"https://vignette.wikia.nocookie.net/gameofthrones/images/d/dd/House-Bolton-Main-Shield.PNG", "https://vignette.wikia.nocookie.net/gameofthrones/images/2/2d/House-Tarly-Main-Shield.PNG"}], {150, Automatic}, "Fit", Padding->White])];
In[5]:=
SetAttributes[$GOTHouseSign, Listable];
In[6]:=
$GOTHouseSign[name_String]:=$GOTHouseSignData[name];

Эмблема дома Старков:

In[7]:=
$GOTHouseSign["Stark"]
Out[7]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Несколько персонажей с эмблемами их домов:

In[8]:=
{#, Image[$GOTHouseSign[$GOTCharacterHouse[#]], ImageSize->100]}&/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister"}
Out[8]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Карточка персонажа — потребуется для всевозможных графов и таблиц

Иконка пола (для персонажей без изображения):

In[9]:=
$GenderIcon=AssociationThread[{"male", "female"}->(ImagePad[ImageResize[ColorConvert[#, "GrayScale"], 150], 100, White]&/@(ImageCrop/@({ImageTake[#, All, {1, 450}], ImageTake[#, All, {-450, -1}]}&@Import["http://clipart-library.com/images/kc85Mg5zi.jpg"])))];

Иконка персонажа по его имени (в оригинальном размере):

In[10]:=
If[FileExistsQ[#], Get@#, $characterImageRaw=Association@Quiet[Rule[#[[1]], If[Head[#[[2]]]===Missing, $GenderIcon[$gender[#[[1]]]], Check[Import[#[[2]]], $GenderIcon[$gender[#[[1]]]]]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName", "characterImageFull"}]];

DumpSave[#, $characterImageRaw]]&@FileNameJoin[{NotebookDirectory[], "$characterImageRaw.mx"}];

Несколько персонажей с их изображениями:

In[11]:=
{#, Image[$characterImageRaw[#], ImageSize->100]}&/@RandomSample[Keys[$characterImageRaw], 10]
Out[11]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Стандартизация изображений:

In[12]:=
$characterImage=With[{alphaChannel=ImageResize[ColorNegate[Rasterize[Graphics[Disk[]]]], 300]}, 
Map[SetAlphaChannel[ImageResize[ImageCrop[#, {1, 1}Min[ImageDimensions[#]]], 300], alphaChannel]&, $characterImageRaw]];
In[13]:=
{#, Image[$characterImage[#], ImageSize->100]}&/@RandomSample[Keys[$characterImage], 10]
Out[13]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Карточка персонажа:

In[14]:=
$characterCardFull=Association[#[[1]]->Framed[Style[#, 14, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Row[{Image[$characterImage[#[[1]]], ImageSize->100], " ", If[Head[#[[4]]]===Missing, "", Row[Flatten@List[$GOTHouseSign[#[[4]]]/.image_Image:>Image[image, ImageSize->{Automatic, 100}]], " "]]}], "\n", #[[1]], If[Head[#[[2]]]===Missing, Nothing, Row[{"\nАктёр: ", If[Head[#[[3]]]===Missing, #[[2]], Hyperlink[#[[2]], "https://www.imdb.com"<>#[[3]]]]}]]}], RoundingRadius->10, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName", "actorName", "actorLink", "houseName"}]];
In[15]:=
$characterCardShort=Association[#[[1]]->Framed[Style[#, 14, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Image[$characterImage[#[[1]]], ImageSize->40], " ", #[[1]]}], RoundingRadius->10, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName"}]];
In[16]:=
$characterCardShortSmall=Association[#[[1]]->Framed[Style[#, 12, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Image[$characterImage[#[[1]]], ImageSize->30], "  ", #[[1]]}], RoundingRadius->6, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]], FrameMargins->2]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName"}]];
In[17]:=
$characterCardFull/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}
Out[17]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[18]:=
$characterCardFull/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}
Out[18]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[19]:=
$characterCardShortSmall/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}
Out[19]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Взаимоотношения персонажей

In[20]:=
$GOTCharacterLinks=Module[{parser}, 
parser=Flatten[Thread/@DeleteCases[Lookup[GOTRawData["characters.json"]["characters"], {"characterName", #}], {_, _Missing}], 1]&;

<|"РодительИРебёнок"->Union[DirectedEdge[#[[2]], #[[1]]]&/@parser["parents"], DirectedEdge[#[[1]], #[[2]]]&/@parser["parentOf"]], 
"БратьяИСёстры"->DeleteDuplicates[UndirectedEdge[#[[2]], #[[1]]]&/@parser["siblings"], #1===Reverse[#2]&], 
"Убил"->Union[DirectedEdge[#[[2]], #[[1]]]&/@parser["killedBy"], 
DirectedEdge[#[[1]], #[[2]]]&/@parser["killed"]], 
"Служит"->(DirectedEdge[#[[1]], #[[2]]]&/@parser["serves"]), 
"ЖенатыОбручены"->DeleteDuplicates[UndirectedEdge[#[[1]], #[[2]]]&/@parser["marriedEngaged"], #1===Reverse[#2]&], 
"Секс"->DeleteDuplicates[Flatten[Map[Thread@UndirectedEdge[#[[1]], #[[2]]["with"]]&, Lookup[#, {"name", "sex"}]&/@Select[Select[Flatten[Lookup[Flatten[GOTRawData["episodes.json"]["episodes"][[;;, "scenes"]], 1], "characters"]], Keys[#]=!={"name"}&], MemberQ[Keys[#], "sex"]&]]], #1===Reverse[#2]&]|>];
In[21]:=
ClearAll[GOTCharacterLinksGraph];

GOTCharacterLinksGraph[data_, OptionsPattern[{"ImageSize"->1500, "VertexSize"->Automatic, "GraphLayout"->"GravityEmbedding"}]]:=Module[{vertexList}, 
vertexList=DeleteDuplicates[Flatten[data[[;;, 1]]/._[x_, y_]:>{x, y}]];

Graph[
data, 
VertexLabels->Map[Rule[#, Placed[Tooltip[If[Head[#]===Image, Image[#, ImageSize->60], Style[StringReplace[#, " "->"\n"], LineSpacing->{0.8, 0, 0}, FontFamily->"Open Sans Light", Bold, 12]]&[#/.$characterImage], #/.$characterCardFull], {1/2, 1/2}]]&, vertexList], 
VertexShapeFunction->"Circle", VertexSize->OptionValue["VertexSize"], VertexStyle->Directive[{White, EdgeForm[{LightGray, AbsoluteThickness[2]}]}], 
ImageSize->OptionValue["ImageSize"], Background->GrayLevel[0.95], AspectRatio->1, GraphLayout->OptionValue["GraphLayout"]]]
In[22]:=
GOTInfographicsPoster[#, "Родители и их дети в \"Игре престолов\"", "ImageSize"->1500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Blue, Arrowheads[{0, {0.01, 0.5}}]}]}]&/@$GOTCharacterLinks["РодительИРебёнок"], "VertexSize"->3]
Out[22]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[23]:=
GOTInfographicsPoster[#, "Братья и сёстры в \"Игре престолов\"", "ImageSize"->1500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Darker@Green}]}]&/@$GOTCharacterLinks["БратьяИСёстры"], "VertexSize"->0.7, "GraphLayout"->Automatic]
Out[23]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[24]:=
GOTInfographicsPoster[#, "Кто кого убил в \"Игре престолов\"", "ImageSize"->2500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Black, Arrowheads[{0, {0.0075, 0.5}}]}]}]&/@$GOTCharacterLinks["Убил"], "VertexSize"->1.1, "ImageSize"->2500]
Out[24]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[25]:=
GOTInfographicsPoster[#, "Кто кому служит в \"Игре престолов\"", "ImageSize"->1000]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Magenta, Arrowheads[{0, {0.02, 0.5}}]}]}]&/@$GOTCharacterLinks["Служит"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic]
Out[25]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[26]:=
GOTInfographicsPoster[#, "Кто с кем женат или обручен в \"Игре престолов\"", "ImageSize"->1000]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Orange}]}]&/@$GOTCharacterLinks["ЖенатыОбручены"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic]
Out[26]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[27]:=
GOTInfographicsPoster[#, "Секс в \"Игре престолов\"", "ImageSize"->1300]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Red}]}]&/@$GOTCharacterLinks["Секс"], "VertexSize"->0.9, "ImageSize"->1300, "GraphLayout"->"LayeredDigraphEmbedding"]
Out[27]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[28]:=
GOTInfographicsPoster[#, "Взаимоотношения персонажей в \"Игре престолов\"", "ImageSize"->3000]&@Legended[GOTCharacterLinksGraph[
Join[
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Blue, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["РодительИРебёнок"], 

Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Darker@Green}]}]&/@$GOTCharacterLinks["БратьяИСёстры"], 

Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Black, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["Убил"], 

Property[#, {EdgeStyle->Directive[{AbsoluteThickness[1], Magenta, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["Служит"], 

Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Orange}]}]&/@$GOTCharacterLinks["ЖенатыОбручены"], 

Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Red}]}]&/@DeleteDuplicates[$GOTCharacterLinks["Секс"]]
], "ImageSize"->3000, "VertexSize"->0.9], Placed[LineLegend[{Blue, Darker@Green, Black, Magenta, Orange, Red}, {"Родители и дети", "Братья и сёстры", "Убил", "Служит", "Женаты или обручены", "Секс"}, LegendLayout->"Row"], Top]]
Out[28]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Связь персонажей по сценам

In[29]:=
Table[Print[GOTInfographicsPoster[GOTGraphPlot[#, min, "ImageSize"->Which[min==1, 5000, min==4, 3000, True, 2000], "MaxThickness"->25], "Появление персонажей \"Игры престолов\" в одной сцене не менее "<>ToString[min+1]<>" раз", "ImageSize"->Which[min==1, 5000, min==4, 3000, True, 2000]]&@Tally[UndirectedEdge@@@Map[Sort, Flatten[Map[Subsets[#, {2}]&, Map[#[[;;, "name"]]&, Flatten[Lookup[GOTRawData["episodes.json"]["episodes"], "scenes"]][[;;, "characters"]]]], 1]]]], {min, {1, 4, 9, 19}}];

Кто самый "популярный" персонаж Игры престолов?

Информация по эпизодам Игры престолов:

In[30]:=
$GOTEpisodeData=With[{data=#}, <|"EpisodeN"->#[[1]], "ScreenTime"->SortBy[GroupBy[Flatten[ReplaceAll[Thread/@Transpose[{Map[Lookup[#[[1]], "name"]&, #[[2]]], Round@Map[QuantityMagnitude[UnitConvert[Subtract@@(TimeObject/@#[[{3, 2}]]), "Seconds"]]&, #[[2]]]}], {Missing["KeyAbsent", "name"], x_}:>{{"БезПерсонажей", x}}]&@data, 1], First, #[[;;, 2]]&], -Total[#]&], "LocationTime"->SortBy[GroupBy[Flatten[ReplaceAll[Thread/@Transpose[{Map[{#[[{4, 5}]]}&, #[[2]]]/.Missing["KeyAbsent", "subLocation"]->Nothing, Round@Map[QuantityMagnitude[UnitConvert[Subtract@@(TimeObject/@#[[{3, 2}]]), "Seconds"]]&, #[[2]]]}], {Missing["KeyAbsent", "name"], x_}:>{{"БезПерсонажей", x}}]&@data, 1], First, #[[;;, 2]]&], -Total[#]&], 
"CharacterLocations"->GroupBy[DeleteCases[#/.Missing["KeyAbsent", "subLocation"]->Nothing, _Missing]&@Flatten[Map[With[{location=#[[2]]}, {#, location}&/@#[[1]]]&, Transpose[{Map[Lookup[#[[1]], "name"]&, #[[2]]], #[[2, ;;, {4, 5}]]}]], 1], First, #[[;;, 2]]&]|>]&/@DeleteCases[Map[{#[[{1, 2}]], Lookup[#[[3]], {"characters", "sceneStart", "sceneEnd", "location", "subLocation"}]}&, Lookup[GOTRawData["episodes.json"]["episodes"], {"seasonNum", "episodeNum", "scenes"}]], {_, {_Missing...}}];

Пример данных по первой серии первого сезона:

In[31]:=
Style[$GOTEpisodeData[[1]], 10]
Out[31]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Количество экранного времени у персонажей

30 персонажей Игры престолов с самым большим количеством экранного времени:

In[32]:=
GOTInfographicsPoster[#, "30 персонажей,  которых мы видим больше всего на экране", "ImageSize"->1500]&@circleInfographics[{Tooltip[Row[{#[[1]]/.$characterImage, Style[#[[1]], 14, White, Bold], Style[UnitConvert[Quantity[#[[2]], "Seconds"], MixedUnit[{"Hours", "Minutes", "Seconds"}]], 14, White]}, "\n"], #[[1]]/.$characterCardFull], #[[2]]}&/@KeyValueMap[{#1, #2}&, SortBy[Merge[$GOTEpisodeData[[All, "ScreenTime"]], Total[Flatten[#]]&], -#&]][[1;;30]], "Precision"->10^-6, "StepDecrease"->0.99, "ShapeFunction"->Disk, "ColorFunction"->ColorData["Rainbow"], "ImageSize"->1500]
Out[32]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[33]:=
GOTInfographicsPoster[#, "550+ персонажей и их экранное время", "ImageSize"->1500, "ImageResolution"->150]&@Multicolumn[Style[Row[{#[[1]], " — ", #[[2]], " c"}], FontFamily->"Myriad Pro", 8]&/@KeyValueMap[{#1, #2}&, SortBy[Merge[$GOTEpisodeData[[All, "ScreenTime"]], Total[Flatten[#]]&], -#&]], 6]
Out[33]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Сколько персонажей было в сериях?

In[34]:=
$GOTEpisodeN=Association[Thread[Rule[#, Range[Length[#]]]&@$GOTEpisodeData[[All, "EpisodeN"]]]];
In[35]:=
$GOTEpisodeID=Association[Thread[Rule[Range[Length[#]], #]&@$GOTEpisodeData[[All, "EpisodeN"]]]];
In[36]:=
GOTInfographicsPoster[#, "Количество персонажей в сериях \"Игры престолов\"", "ImageSize"->1000]&@BarChart[#, BarSpacing->{0.05, 2}, AspectRatio->1/2, ImageSize->1000, ChartLabels->{Keys[#], Range[10]}, ColorFunction->Function[{x}, ColorData["Rainbow"][x]], GridLines->{None, Range[0, 100, 5]}, FrameLabel->Map[Style[#, FontFamily->"Open Sans", 20, Bold]&, {"Сезон и серия в нём", "Число задействованных персонажей"}], Frame->True, Background->GrayLevel[0.95]]&@GroupBy[Map[{#["EpisodeN"], Length[#["ScreenTime"]]}&, $GOTEpisodeData[[All, {"EpisodeN", "ScreenTime"}]]], #[[1, 1]]&, #[[;;, 2]]&]
Out[36]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Кто из персонажей был самом большом количестве серий "Игры престолов"?

Список персонажей Игры престолов, отсортированный по количеству серий, в который они встречались:

In[37]:=
$GOTCharacters=DeleteCases[Reverse[SortBy[Tally[Flatten[Keys@$GOTEpisodeData[[All, "ScreenTime"]]]], Last]][[;;, 1]], "БезПерсонажей"];
In[38]:=
$GOTSeriesInSeason=Association[KeyValueMap[#1->Length@#2&, GroupBy[$GOTEpisodeData[[;;, 1]], First]]];
In[39]:=
$GOTSeasonsMask=KeyValueMap[ConstantArray[#1, #2]&, $GOTSeriesInSeason];
In[40]:=
GOTCharacterBySeason[name_]:=Module[{initialData, empty}, initialData=Map[#[[;;, 2]]&, GroupBy[Cases[{#[[1]], Keys[#[[2]]]}&/@Lookup[$GOTEpisodeData, {"EpisodeN", "ScreenTime"}], {number_, episode_/;

Not[FreeQ[episode, name]]}:>number], First]];

empty=Complement[Range[1, 8], Keys[initialData]];

If[Length[empty]===0, initialData, KeySort@Association[initialData, Association[#->{}&/@empty]]]
]
In[41]:=
GOTCharacterBySeasonPlot[name_]:=Flatten@KeyValueMap[ReplacePart[$GOTSeasonsMask[[#1]], Thread[Complement[Range[1, $GOTSeriesInSeason[#1]], #2]->0]]&, GOTCharacterBySeason[name]]
In[42]:=
$GOTSeasonColors={0->White}~Join~Thread[Range[1, 8]->ColorData[54, "ColorList"][[1;;8]]];
In[43]:=
GOTInfographicsPoster[#, "100 персонажей \"Игры престолов\",  присутствовавших в наибольшем количестве серий", "ImageSize"->2500]&@Grid[{{"Персонаж \\ Сезон и серия", SpanFromLeft, Style["% серий\nс участием\nперсонажа", 12]}~Join~Map[Style["S"<>ToString[#[[1]]]<>"\nE"<>ToString[#[[2]]], 10]&, Keys[$GOTEpisodeN]]}~Join~(({ImageResize[#/.$characterImage, {Automatic, 25}], #, PercentForm[N@Total[Length/@GOTCharacterBySeason[#]]/Last[$GOTEpisodeN]]}~Join~ReplaceAll[GOTCharacterBySeasonPlot[#], x_Integer:>Item["", Background->x/.$GOTSeasonColors]]&/@DeleteCases[$GOTCharacters[[1;;100]], "БезПерсонажей"])), ItemSize->{{2, 10, 5, {1.2}}, {4, {1}}}, Background->White, Dividers->Gray, ItemStyle->Directive[FontFamily -> "Open Sans", 14, Bold, LineSpacing->{0.8, 0, 0}], Alignment->{Center, Center}]
Out[43]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Самые популярные локации Игры престолов

Карта локаций "Игры престолов"

In[44]:=
index=1;
In[45]:=
$GOTLakesIDs={11, 8, 9, 10, 2, 529, 530, 522, 523, 533, 532, 526, 521, 525, 531, 524, 528, 527, 7, 3, 4, 5, 6};
In[46]:=
$GOTMapPolygons={FaceForm@If[MemberQ[$GOTLakesIDs, index], LightBlue, LightOrange], EdgeForm[AbsoluteThickness[1]], index++;

Polygon[Accumulate[#]]}&/@GOTRawData["lands-of-ice-and-fire.json"]["arcs"];
In[47]:=
$GOTMapPlaces=Lookup[GOTRawData["lands-of-ice-and-fire.json"]["objects"]["places"]["geometries"], {"coordinates", "properties"}];
In[48]:=
$GOTMapPlaceCoordinates=Map[#[[2, "name"]]->#[[1]]&, $GOTMapPlaces];
In[49]:=
GOTMap[additinals_,  OptionsPattern[{"ImageSize" -> 1500}]] := Legended[Graphics[{$GOTMapPolygons,  ({{AbsolutePointSize[10],  Black,  Point[#1[[1]]],  AbsolutePointSize[5],  White,  Point[#1[[1]]]},  Inset[With[{placeType = #1[[2]]["type"]},  (Framed[#1,  Background -> (placeType /. Thread[{"city",  "castle",  "ruin",  "town"} -> (Lighter[RGBColor[#1/255],  0.5] & ) /@ {{254,  92,  7},  {254,  252,  9},  {138,  182,  7},  {2,  130,  237}}]),  RoundingRadius -> 6,  FrameStyle -> None,  FrameMargins -> 2] & )[Style[#1[[2]]["name"],  LineSpacing -> {0.8,  0,  0},  FontFamily -> "Open Sans",  Bold,  12]]],  #1[[1]],  If[MemberQ[{"Eastwatch",  "The Dreadfort",  "White Harbor",  "Storm's End",  "Ghoyan Drohe",  "Qohor"},  #1[[2]]["name"]],  Scaled[{-0.1,  1/2}],  Scaled[{1.1,  1/2}]]]} & ) /@ $GOTMapPlaces,  additinals},  ImageSize -> OptionValue["ImageSize"],  Background -> LightBlue,  PlotRangePadding -> 0],  (Placed[#1,  "Bottom"] & )[SwatchLegend[(RGBColor[#1/255] & ) /@ {{254,  92,  7},  {254,  252,  9},  {138,  182,  7},  {2,  130,  237}},  {"city",  "castle",  "ruin",  "town"},  LegendLayout -> "Row"]]]
In[50]:=
GOTInfographicsPoster[#, "Карта расположения локаций \"Игры престолов\"", "ImageSize"->1500]&@GOTMap[{}]
Out[50]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Перемещения персонажей "Игры престолов" от серии к серии

In[51]:=
GOTCharacterLocationNamesSequence[name_]:=Merge[$GOTEpisodeData[[;;, "CharacterLocations"]], Identity][name];
In[52]:=
GOTCharacterLocationSequence[name_]:=DeleteCases[Partition[Flatten[DeleteCases[GOTCharacterLocationNamesSequence[name]/.{{x_String, y_String}:>y, {x_String}:>x}/.$GOTMapPlaceCoordinates, _String, Infinity], 1], 2, 1], {x_, x_}];
In[53]:=
ClearAll[GOTMapTraectory];
In[54]:=
GOTMapTraectory[path_, colorFunction_:ColorData["Rainbow"]]:=Module[{kol}, 
kol=Length[path];

Table[{Opacity[0.5], colorFunction[(i-1)/(kol-1)], AbsoluteThickness[10i/kol+1], CapForm["Round"], Arrow[BSplineCurve[{path[[i, 1]], Mean[path[[i]]]+RandomInteger[{5000, 20000}]Function[#/Norm[#]][RandomChoice[{1, 1}]{-1, 1}*Reverse[path[[i, 2]]-path[[i, 1]]]], path[[i, 2]]}]]}, {i, 1, kol}]];
In[55]:=
(Print[With[{track = #1,  name = #1[[1]]},  (GOTInfographicsPoster[#1,  Row[{"Перемещения ",  Style[name,  Bold],  " в \"Игре престолов\"",  "\n",  Style["(линия перемещения утолщается от начала к концу)",  25]}],  "ImageSize" -> 1500] & )[GOTMap[{Arrowheads[{0,  0.01}],  (With[{color = #1[[2]]},  GOTMapTraectory[GOTCharacterLocationSequence[name]]] & )[track],  Inset[track[[1]] /. $characterCardFull,  Scaled[{0.99,  0.99}],  Scaled[{1,  1}]]}]]]] & ) /@ ({#1,  RGBColor[{200,  42,  102}/255]} & ) /@ $GOTCharacters[[1 ;; 10]];
In[56]:=
(Export[FileNameJoin[{NotebookDirectory[],  "Перемещения",  StringJoin[#1[[1]],  ".png"]}],  With[{track = #1,  name = #1[[1]]},  (GOTInfographicsPoster[#1,  Row[{"Перемещения ",  Style[name,  Bold],  " в \"Игре престолов\"",  "\n",  Style["(линия перемещения утолщается от начала к концу)",  25]}],  "ImageSize" -> 1500] & )[GOTMap[{Arrowheads[{0,  0.01}],  (With[{color = #1[[2]]},  GOTMapTraectory[GOTCharacterLocationSequence[name]]] & )[track],  Inset[track[[1]] /. $characterCardFull,  Scaled[{0.99,  0.99}],  Scaled[{1,  1}]]}]]]] & ) /@ ({#1,  RGBColor[{200,  42,  102}/255]} & ) /@ DeleteCases[$GOTCharacters[[1 ;; 101]],  "БезПерсонажей"]
Out[56]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Кто больше всего "путешествовал" из персонажей "Игры престолов"?

In[57]:=
GOTInfographicsPoster[#1,  "Кто больше всего \"путешествовал\" в \"Игре престолов\"?",  "ImageSize" -> 1500]&@((BarChart[#1[[1 ;; All, 1]], PlotRangePadding->0,  BarSpacing -> 0.25,  BarOrigin -> Left,  AspectRatio -> 1.8,  ImageSize -> 1500,  ChartLabels -> #1[[1 ;; All, 2]],  Frame -> True,  GridLines -> {Range[0,  10^6,  10^4],  None},  ColorFunction -> ColorData["Rainbow"], FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Длина пути в условных единицах", "Длина пути в условных единицах"}}, Background->GrayLevel[0.95]] & )[Cases[SortBy[({Total[(Norm[Subtract @@ #1] & ) /@ GOTCharacterLocationSequence[#1]], #1 /. $characterCardShortSmall } & ) /@ DeleteCases[$GOTCharacters,  Alternatives @@ {"БезПерсонажей",  "Musician #1",  "Musician #2",  "Musician #3"}],  First[#1] & ],  {x_ /;

 x > 0,  _}][[-50;;-1]]])
Out[57]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Самые популярные локации "Игры престолов" (по экранному времени)

Данные в виде столбчатой гистограммы:

In[58]:=
GOTInfographicsPoster[#1,  "Локации \"Игры престолов\" по экранному времени (вид 1)",  "ImageSize" -> 2000]&@(BarChart[#[[;;, 1]], PlotRangePadding->0, BarSpacing->{0.5, 3}, BarOrigin->Left, AspectRatio->1.5, ImageSize->2000, ChartLabels->{#[[;;, 2]], None}, ColorFunction->Function[{x}, If[x>4000, Red, ColorData["Rainbow"][x/4000]]], ColorFunctionScaling->False, PlotRange->{0, 61000}, Frame->True, GridLines->{Range[0, 60000, 1000], None}, GridLinesStyle->LightGray, FrameTicks->{All, Automatic}, FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Экранное время,  секунды", "Экранное время,  секунды"}}, Background->GrayLevel[0.95]]&@KeyValueMap[{Callout[#[[1]], #[[2]], If[#[[1]]>20000, Bottom, Right], If[#[[1]]>4000, Scaled[1/2], Automatic]]&/@Transpose[{#2[[;;, 2]], #2[[;;, 1]]}], #1}&, SortBy[GroupBy[KeyValueMap[{#1, #2}&, Merge[$GOTEpisodeData[[All, "LocationTime"]], Total[Flatten[#]]&]], #[[1, 1]]&, SortBy[Transpose[{#[[;;, 1]]/.{{x_String, y_String}:>y, {x_String}:>x}, #[[;;, 2]]}]/.{"", _}:>Nothing, Last[#]&]&], Total[#[[;;, 2]]]&]])
Out[58]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Данные в виде круговой парной диаграммы:

In[59]:=
{Print[GOTInfographicsPoster[#1,  "Локации \"Игры престолов\" по экранному времени (вид 2)",  "ImageSize" -> 1500]&@stripLineInfographics[#, "Reverse"->False, "Gaps"->{75, 50}, "ColorFunctionRight"->ColorData["Rainbow"]]], Print[GOTInfographicsPoster[#1,  "Локации \"Игры престолов\" по экранному времени\n(отсортированы по географическим областям)",  "ImageSize" -> 1500]&@stripLineInfographics[#, "Reverse"->True, "Gaps"->{50, 75}, "ColorFunctionRight"->ColorData["Rainbow"]]]}&@SortBy[GroupBy[KeyValueMap[{#1, #2}&, Merge[$GOTEpisodeData[[All, "LocationTime"]], Total[Flatten[#]]&]], #[[1, 1]]&, SortBy[Transpose[{#[[;;, 1]]/.{{x_String, y_String}:>y, {x_String}:>x}, #[[;;, 2]]}]/.{"", _}:>Nothing, Last[#]&]&], -Total[#[[;;, 2]]]&];

В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?

In[60]:=
$GOTCharactersInAnotherFilms=SortBy[Map[{#[[1]], #[[2]][[;;, "characterName"]], If[Head[#[[3]]]===Missing, 0, StringCases[#[[3]], DigitCharacter..]/.x_/;

Length[x]>0:>ToExpression[x]]/.{{x_}:>x, {}->0}}&, Lookup[Values[GOTRawData["costars.json"]], {"title", "actors", "year"}]], -Length[#[[2]]]&];
In[61]:=
$GOTCharactersFilmography=Association@SortBy[Select[#->SortBy[Cases[$GOTCharactersInAnotherFilms, {film_, list_/;

MemberQ[list, #], year_}:>{film, year}], -Last[#]&]&/@$GOTCharacters, Length[#[[2]]]>0&], -Length[#[[2]]]&];

Выясним в фильмах каких годов выпуска играли актёры "Игры престолов":

In[62]:=
GOTInfographicsPoster[#1,  "Количество фильмов в зависимости от года выпуска,  в которых играли актёры \"Игры престолов\"",  "ImageSize" -> 800]&@DateHistogram[DeleteMissing@Lookup[Values[GOTRawData["costars.json"]], "year"], ColorFunction->"Rainbow", ImageSize->800, Background->GrayLevel[0.95]]
Out[62]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Фильмы, в которых играли самые "востребованные" актёры "Игры престолов":

In[63]:=
GOTInfographicsPoster[#1,  "Фильмы в которых играли 20 самых \"востребованных\" актёров \"Игры престолов\"",  "ImageSize" -> 1500]&@Grid[{#/.$characterCardFull, TextCell[Grid[KeyValueMap[{#1/.{0->"неизв."}, Row[#2, " - "]}&, GroupBy[#, Last, #[[;;, 1]]&]], Alignment->{{Center, Left}, {Top, Top}}], FontFamily->"Open Sans Light", FontSize->14, TextAlignment->Left, LineSpacing->{0.9, 0, 0}]&@$GOTCharactersFilmography[#]}&/@$GOTCharacters[[1;;20]], Alignment->{{Center, Left}, Center}, ItemSize->{{20, 70}, Automatic}, Background->GrayLevel[0.95], Dividers->{None, {None, {Gray}, None}}]
Out[63]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Актёры "Игры престолов" в "Гарри Поттере"

In[64]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Гарри Поттере\"", "ImageSize"->1500]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), "  "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"harry potter"~~___]&], -Last[#]&][[{1, -1, 2, 3, 4, 5, 6, 7}]], Background->GrayLevel[0.95], ItemSize->{{25, 70}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]
Out[64]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Актёры "Игры престолов" в "Звёздных войнах"

In[65]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Звёздных войнах\"", "ImageSize"->1100]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), "  "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"star wars"~~___]&], -Last[#]&], Background->GrayLevel[0.95], ItemSize->{{25, 45}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]
Out[65]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Актёры "Игры престолов" в "Пиратах карибского моря"

In[66]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Пиратах карибского моря\"", "ImageSize"->1300]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), "  "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"pirates of the"~~___]&], -Last[#]&], Background->GrayLevel[0.95], ItemSize->{{25, 50}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]
Out[66]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

В каких фильмах/сериалах много актёров "Игры престолов"

In[67]:=
GOTInfographicsPoster[#, "Фильмы (сериалы) в которых играет больше всего актёров \"Игры престолов\"", "ImageSize"->2000]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), "  "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, Length[#[[2]]]>5&], -Length[#[[2]]]&], Background->GrayLevel[0.95], ItemSize->{{20, 100}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]
Out[67]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Как тесно связаны между собой актёры "Игры престолов"

In[68]:=
GOTInfographicsPoster[#, "Как тесно связаны между собой актёры \"Игры престолов\"", "ImageSize"->2500]&@(ConnectedGraphComponents[GOTGraphPlot[#, 1, "ImageSize"->2500, "MaxThickness"->20]][[1]]&@Tally[UndirectedEdge@@@Map[Sort, Flatten[Map[Subsets[#, {2}]&, Select[Values[GOTRawData["costars.json"]][[;;, "actors", All, "characterName"]], Length[#]>1&]], 1]]])
Out[68]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Разговоры в "Игре престолов"

In[69]:=
GOTInfographicsPoster[#, "Количество слов,  сказанных в сериях \"Игры престолов\"", "ImageSize"->1000]&@BarChart[#, BarSpacing->{0.05, 1}, AspectRatio->1/2, ImageSize->1000, ChartLabels->{Keys[#], Range[10]}, ColorFunction->Function[{x}, ColorData["Rainbow"][x]], GridLines->{None, Range[0, 10000, 500]}, FrameLabel->Map[Style[#, FontFamily->"Open Sans", 20, Bold]&, {"Сезон и серия в нём", "Количество сказанных слов"}], Frame->True, Background->GrayLevel[0.95], PlotRangePadding->0, PlotRange->All]&@GroupBy[Map[{#[[1;;2]], Total[#[[3]][[;;, "count"]]]}&, Lookup[GOTRawData["wordcount.json"]["count"], {"seasonNum", "episodeNum", "text"}]], #[[1, 1]]&, #[[;;, 2]]&]
Out[69]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[70]:=
GOTInfographicsPoster[#1,  "Кто больше всего говорит в \"Игре престолов\"?",  "ImageSize" -> 1500]&@((BarChart[#1[[1 ;; All, 1]], PlotRangePadding->0,  BarSpacing -> 0.25,  BarOrigin -> Left,  AspectRatio -> 1.9,  ImageSize -> 1500,  ChartLabels -> #1[[1 ;; All, 2]],  Frame -> True,  GridLines -> {Range[0,  10^5,  10^3],  None},  ColorFunction -> ColorData["Rainbow"], FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Количество сказанных слов", "Количество сказанных слов"}}, FrameTicks->{Automatic, {All, All}}, Background->GrayLevel[0.95]] & )[KeyValueMap[{#2, #1/.$characterCardShortSmall}&, Select[SortBy[GroupBy[Flatten[GOTRawData["wordcount.json"]["count"][[;;, "text"]]], #[["name"]]&, Total[#[[;;, "count"]]]&], #&], #>1000&]]])
Out[70]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое
In[71]:=
GOTInfographicsPoster[#1,  "Соотношение количества экранного времени и сказанных слов у персонажей \"Игры престолов\"\n(масштаб логарифмический)",  "ImageSize" -> 2000]&@Module[{data1, data2, intersection}, 
data1=Merge[$GOTEpisodeData[[;;, "ScreenTime"]], Total[Flatten[#]]&];

data2=GroupBy[Flatten[GOTRawData["wordcount.json"]["count"][[;;, "text"]]], #[["name"]]&, Total[#[[;;, "count"]]]&];

intersection=Intersection[Keys@data1, Keys@data2];

ListPlot[Callout[{data1[#], data2[#]}, #/.$characterCardShortSmall]&/@intersection, AspectRatio->1, ImageSize->2000, PlotRange->All, ScalingFunctions->{"Log10", "Log10"}, GridLines->{{10, 100}~Join~Range[0, 10^5, 1000], {10, 100}~Join~Range[0, 10^5, 1000]}, Frame->True, FrameTicks->All, FrameLabel->ReplaceAll[{{1, 1}"Количество сказанных слов", {1, 1}"Время на экране,  с"}, x_String:>Style[x, FontFamily->"Open Sans", 20, Bold]], Background->GrayLevel[0.95], PlotMarkers->{Automatic, Small}, GridLinesStyle->GrayLevel[0.85]]
]
Out[71]=
«Игра престолов»: строим инфографику об убийствах, сексе, путешествиях по Вестеросу и многое другое

Вспомогательные функции для инфографики

GOTRawData

Функция импорта данных из JSON в виде ассоциации Association.

In[72]:=
ClearAll[GOTRawData];
In[73]:=
GOTRawData[name_String/;

FileExtension[name]==="json"]:=GOTRawData[name]=Import[FileNameJoin[{NotebookDirectory[], name}], "RawJSON"];

circleInfographics, circleInfographicsPositions

circleInfographics создает бабл-диаграмму из кругов, пропорциональных величинам данных, при этом поверх самих кругов можно отображать произвольную информацию.

In[74]:=
ClearAll[circleInfographics, circleInfographicsPositions];
In[75]:=
circleInfographicsPositions[data_, OptionsPattern[{"Precision"->10^-3, "StepDecrease"->N[1-1/100], "MaxSteps"->10000}]]:=
Module[{radii, names, kol, translate, subsets, pos, valValue, colorDataLength, colorData, mean, index, colorScale, tol, mult, shapeF, colorFunction, 
xmin, xmax, ymin, ymax}, 
radii=N[Sqrt[#/Max[#]]]&@data;

kol=Length[radii];

pos=RandomReal[{-10, 10}, {kol, 2}];

translate[{p1_, p2_}, dir_]:=dir Normalize[p2-p1];

subsets=Subsets[Range[kol], {2}];

tol=OptionValue["Precision"];

mult=OptionValue["StepDecrease"];

valValue=1.;

index=1;

While[valValue > tol&&index<OptionValue["MaxSteps"], 
mean={0, 0};

pos=pos+Map[Mean, GatherBy[
Thread[{
Flatten[subsets, 1], 
Flatten[
Map[If[
Norm[Subtract@@pos[[#]]]>=Total[radii[[#]]], 
translate[{#, mean}, valValue]&/@pos[[#]], 
With[{delta=(Total[radii[[#]]]-Norm[Subtract@@pos[[#]]])/2}, {translate[pos[[#]], -delta], 
translate[Reverse[pos[[#]]], -delta]}]]&, subsets], 1]}], First][[;;, ;;, 2]]];

index++;

valValue=mult*valValue ];

pos];
In[76]:=
circleInfographics[data_, OptionsPattern[{"Precision"->10^-3, "StepDecrease"->N[1-1/100], "MaxSteps"->10000, "ShapeFunction"->Disk, "Background"->GrayLevel[0.95], "ColorFunction"->ColorData["TemperatureMap"], "ImageSize"->1000}]]:=Module[{radii, names, kol, pos, colorDataLength, colorData, colorScale, shapeF, colorFunction, xmin, xmax, ymin, ymax}, 
names=data[[;;, 1]];

radii=N[Sqrt[#/Max[#]]]&@data[[;;, 2]];

kol=Length[radii];

pos=circleInfographicsPositions[data[[;;, 2]], "Precision"->OptionValue["Precision"], "StepDecrease"->OptionValue["StepDecrease"], "MaxSteps"->OptionValue["MaxSteps"]];

colorScale=Evaluate[Rescale[#, MinMax[radii], {0, 1}]]&;

colorFunction=OptionValue["ColorFunction"];

{{xmin, xmax}, {ymin, ymax}}=RegionBounds[RegionUnion[Disk@@#&/@Transpose@{pos, radii}]];

shapeF=Which[OptionValue["ShapeFunction"]===Disk, {{colorFunction[colorScale[#2]], Disk[#1, #2]}, Inset[#3, #1, Scaled[{1/2, 1/2}], 1.75#2]}&, 
OptionValue["ShapeFunction"]===Circle, 
{{colorFunction[colorScale[#2]], Disk[#1, #2], White, Disk[#1, 0.9#2]}, Inset[#3, #1, Scaled[{1/2, 1/2}], 1.75#2]}&];

Graphics[Array[shapeF[pos[[#]], radii[[#]], names[[#]]]&, kol], ImageSize->{1, 1}OptionValue["ImageSize"], PlotRange->1.05{{xmin, xmax}, {ymin, ymax}}, Background->OptionValue["Background"]]]circleInfographicsPositions

$GOTLogo, GOTInfographicsPoster

GOTInfographicsPoster служит для создания стилизованного постера с инфографикой из данной статьи.

In[77]:=
$GOTLogo=ImageResize[Import["https://7kingdoms.ru/wp-content/uploads/2011/01/got-logo.png"], 500];
In[78]:=
ClearAll[GOTInfographicsPoster];
In[79]:=
GOTInfographicsPoster[imageInitial_, title_, OptionsPattern[{"Background"->GrayLevel[0.95], "ImageResolution"->150, "ImageSize"->800}]]:=Module[{image=ImageResize[Rasterize[imageInitial, ImageResolution->OptionValue["ImageResolution"]], OptionValue["ImageSize"]], readyImage}, 
readyImage=
Image[#, ImageSize->All]&@ImageResize[Rasterize[Framed[Pane[Grid[{{Image[$GOTLogo, ImageSize->{Automatic, 30}], Item[Style[title, FontFamily->"Myriad Pro", 30, LineSpacing->{0.8, 0, 0}, TextAlignment->Center], Alignment->Center]}, {"", ""}, {Image[image, ImageSize->OptionValue["ImageSize"]], SpanFromLeft}, {"", ""}, {Item[Style[Row[{"Вся инфографика по \"Игре престолов\" — wolframmathematica.ru/blog/got\nКороткая ссылка — ", Style["bit.ly/2GNk5Gw", Bold]}], FontFamily->"Myriad Pro", 20, GrayLevel[0.4], TextAlignment->Center]], SpanFromLeft}}, Alignment->{Center, Center}], ImageSize->(ImageDimensions[image]+{0, 100}), ImageSizeAction->"ShrinkToFit"], Background->OptionValue["Background"], FrameMargins->20, FrameStyle->OptionValue["Background"]], ImageResolution->OptionValue["ImageResolution"]], ImageDimensions[image][[1]]];

Export[FileNameJoin[{NotebookDirectory[], "GOTInfographics", StringReplace[StringReplace[StringReplace[ToLowerCase[ToString@title], {"\""->"", ", "->" ", "."->"", "\n"->" ", "("->"", ")"->"", "?"->""}], " "..->" "], " "->"-"]<>".png"}], readyImage];

readyImage];

stripLineInfographics

stripLineInfographics служит для создания круговой парной диаграммы.

In[80]:=
ClearAll[stripLineInfographics];
In[81]:=
stripLineInfographics[dataInitial_, OptionsPattern[{"Ordering"->True, "Reverse"->False, "Gaps"->{50, 50}, "ColorFunctionLeft"->ColorData["Rainbow"], "ColorFunctionRight"->Function[Blend[ColorData[3, "ColorList"], #]], "ImageSize"->1500, "Background"->GrayLevel[0.95]}]]:=Module[{circle, zeroElement, countSegmentPartition, ordering, data, totalsForRows, rowsMainSegments, rowsColsSegments, totalForCols, colsMainSegments, colsRowsSegments, segmentMaker, $colorizationMax, 
rightLabels, leftLabels, preData, dataOriginal}, 

If[Head[dataInitial]===Association, 

{rightLabels, leftLabels, preData}=Transpose[KeyValueMap[{#1, #2[[;;, 1]], #2[[;;, 2]]}&, dataInitial]];

leftLabels=Flatten@leftLabels;

dataOriginal=Module[{n=Length[Flatten[preData]], k=Length[preData], acc}, 
acc={0}~Join~Accumulate[Length/@preData];

Transpose@Table[ConstantArray[0, {acc[[i]]}]~Join~preData[[i]]~Join~ConstantArray[0, {n-acc[[i+1]]}], {i, 1, k}]]];

If[OptionValue["Reverse"], {rightLabels, leftLabels}={leftLabels, rightLabels};

dataOriginal=Transpose[dataOriginal], Nothing];

circle[pos_, radius_, {min_, max_}, numberOfCirclePartition_:50]:=If[min==max, zeroElement[pos+radius{Cos[min], Sin[min]}+0{Cos[min], Sin[min]}], Table[pos+radius{Cos[a], Sin[a]}+0{Cos[(min+max)/2], Sin[(min+max)/2]}, {a, min, max, (max-min)/numberOfCirclePartition}]];

countSegmentPartition[data_List, {startOfSegment_, endOfSegment_}, gapPercent_:0]:=Module[
{segmentLength=endOfSegment-startOfSegment, segmentLengh, segments, segmentActialLength, delta}, 
segmentActialLength=(1-gapPercent/100)segmentLength;

delta=(gapPercent/100) segmentLength/(Length[data]+1);

If[Total[data]==0, ConstantArray[zeroElement[{startOfSegment, endOfSegment}], Length[data]], 
segments=N[startOfSegment+segmentActialLength*Partition[Prepend[Accumulate[data], 0], 2, 1]/Total[data]];

(*#+0.01{1, -1}(-Subtract@@#)*gapPercent/2&/@segments*)Map[delta+#&, Table[(i-1)delta+ segments[[i]], {i, 1, Length[data]}]]]
];

ordering=If[OptionValue["Ordering"], Ordering[dataOriginal, All, Total[#1]>Total[#2]&], Range[1, Length[dataOriginal]]];

data=dataOriginal[[ordering]];

totalsForRows=Total/@data;

rowsMainSegments=countSegmentPartition[totalsForRows, {Pi/2, 3Pi/2}, OptionValue["Gaps"][[1]]];

rowsColsSegments=Apply[countSegmentPartition[#1, #2, 0]&, Transpose[{data, rowsMainSegments}], {1}];

totalForCols=Total/@Transpose[data];

colsMainSegments=countSegmentPartition[totalForCols, {Pi/2, -Pi/2}, OptionValue["Gaps"][[2]]];

colsRowsSegments=Apply[countSegmentPartition[#1, #2, 0]&, Transpose[{Transpose@data, colsMainSegments}], {1}];

segmentMaker[{{segmentFirst_, segmentSecond_}, {colorization_}}, colorizationMax_]:=Module[{splineFragmentFirst, splineFragmentSecond}, 
If[Head[segmentFirst]===zeroElement||Head[segmentSecond]===zeroElement, 
Nothing, 
{splineFragmentFirst, splineFragmentSecond}=Map[circle[{0, 0}, 1, #]&, {segmentFirst, segmentSecond}];

If[FreeQ[{splineFragmentFirst, splineFragmentSecond}, zeroElement], 
{Opacity[0.8], OptionValue["ColorFunctionLeft"][1-(colorization-1)/(colorizationMax-1)](*;

Blend[ColorData[$colorScheme, "ColorList"], (colorization-1)/(colorizationMax-1)]*), 
With[{reversedSplineFragmentSecond=Reverse[splineFragmentSecond]}, 
FilledCurve[BezierCurve[Join[splineFragmentFirst, {Mean[{splineFragmentFirst[[-1]], {0, 0}, reversedSplineFragmentSecond[[1]]}]}, reversedSplineFragmentSecond, {Mean[{reversedSplineFragmentSecond[[-1]], {0, 0}, splineFragmentFirst[[1]]}], splineFragmentFirst[[1]]}], SplineDegree->2]]]}, Nothing]]];

$colorizationMax=Length[rowsColsSegments];

Graphics[{SortBy[MapIndexed[Map[segmentMaker[#, $colorizationMax]&, Outer[Sequence, Transpose[#1], {#2}, 1]]&, Transpose[{rowsColsSegments, Transpose@colsRowsSegments}]], ByteCount], 

Table[(circle[{0, 0}, 1, #]&@rowsMainSegments[[i]])/.{zeroElement[point_]:>Point[point], line:{_List..}:>{CapForm["Round"], AbsoluteThickness[5], (*Blend[ColorData[$colorScheme, "ColorList"], (i-1)/($colorizationMax-1)];

*)OptionValue["ColorFunctionLeft"][1-(i-1)/($colorizationMax-1)], Line[line]}}, {i, 1, Length[rowsMainSegments]}], 

Table[(circle[{0, 0}, 1, #]&@colsMainSegments[[i]])/.{zeroElement[point_]:>Point[point], line:{_List..}:>{AbsoluteThickness[5], CapForm["Round"], OptionValue["ColorFunctionRight"][1-(i-1)/(Length[colsMainSegments]-1)], Line[line]}}, {i, 1, Length[colsMainSegments]}], 

Text[Style[#1, FontFamily->"Open Sans", 14], 1.025{Cos[#], Sin[#]}&[Mean@#2], {1, 0}, {Cos[#+Pi], Sin[#+Pi]}&[Mean@#2]]&@@@Transpose[{leftLabels[[ordering]], rowsMainSegments}], 

Text[Style[#1, FontFamily->"Open Sans", 14], 1.025{Cos[#], Sin[#]}&[Mean@#2], {-1, 0}, {Cos[#], Sin[#]}&[Mean@#2]]&@@@Transpose[{rightLabels, colsMainSegments}]
}, ImageSize->OptionValue["ImageSize"], Background->OptionValue["Background"]]]

GOTGraphPlot

GOTGraphPlot служит для создания специализированных графов.

In[82]:=
Clear[GOTGraphPlot];
In[83]:=
GOTGraphPlot[data_, minData_, OptionsPattern[{"ImageSize"->1500, "Background"->GrayLevel[0.95], "ColorFunction":>ColorData["Rainbow"], "MaxThickness"->10, "Opacity"->True, "VertexF"->(Function[Tooltip[If[Head[#]===Image, Image[#, ImageSize->60], Style[StringReplace[#, " "->"\n"], LineSpacing->{0.8, 0, 0}, FontFamily->"Open Sans Light", Bold, 12]]&@(#/.$characterImage), #/.$characterCardFull]]), "GraphLayout"->"GravityEmbedding"}]]:=Module[{min, max, rescaleF, normF, clearedData, preGraph, vertexList, edgeList}, 
clearedData=Select[data, #[[2]]>minData&];

{min, max}=MinMax[clearedData[[;;, 2]]];

rescaleF=Evaluate[Rescale[#, {min, max}, {1, OptionValue["MaxThickness"]}]]&;

normF=Evaluate[Rescale[#, {min, max}, {0, 1}]]&;

preGraph=Graph[clearedData[[;;, 1]]];

vertexList=VertexList[preGraph];

edgeList=EdgeList[preGraph];

Graph[Map[Property[#[[1]], {EdgeStyle->Directive[{AbsoluteThickness[rescaleF[#[[2]]]], If[OptionValue["Opacity"], Opacity[0.3+0.7normF[#[[2]]]], Nothing], OptionValue["ColorFunction"][normF[#[[2]]]], CapForm["Round"]}]}]&, clearedData], 

VertexLabels->Map[Rule[#, Placed[OptionValue["VertexF"][#], {1/2, 1/2}]]&, vertexList], 
ImageSize->OptionValue["ImageSize"], Background->OptionValue["Background"], GraphLayout->OptionValue["GraphLayout"], AspectRatio->1, VertexShapeFunction->None]];

Оценить статью
Блог о Wolfram Mathematica

Оставить комментарий

avatar
  Подписаться  
Уведомление о