Хабрахабр

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

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

Взаимоотношения персонажей
— Кто кого родил
— Кто кому брат или сестра
— Кто кого убил
— Кто кому служит
— Кто с кем женат или помолвлен
— У кого с кем был секс
— Все отношения на одном графе
Связь персонажей по сценам
Кто самый «популярный» персонаж Игры престолов?
— Количество экранного времени у персонажей
— Сколько персонажей было в сериях?
— Кто из персонажей был самом большом количестве серий «Игры престолов»?
Самые популярные локации «Игры престолов»
— Карта локаций «Игры престолов»
— Перемещения персонажей «Игры престолов» от серии к серии
— Кто больше всего «путешествовал» из персонажей «Игры престолов»?
— Самые популярные локации «Игры престолов» (по экранному времени)
В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?
— Фильмы, в которых играли самые «востребованные» актёры «Игры престолов»:
— Актёры «Игры престолов» в «Гарри Поттере»
— Актёры «Игры престолов» в «Звёздных войнах»
— Актёры «Игры престолов» в «Пиратах карибского моря»
— В каких фильмах/сериалах много актёров «Игры престолов»
— Как тесно связаны между собой актёры «Игры престолов»
Разговоры в «Игре престолов»
Пол персонажей «Игры престолов»: кого больше, мужчин или женщин? В этом посте я расскажу о том, как применять язык Wolfram Languge в анализе и визуализации данных на примере базы данных по «Игре престолов». В этой статье не уделяется особого внимания парсингу данных, об этом я расскажу отдельно. Вместо этого пост целиком посвящен интересной инфографике и её созданию.

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

Созданная для поста инфографика интерактивна в документе Mathematica, который можно скачать по ссылке в шапке.

Набор рёбер графа взаимоотношений персонажей по типам:

$GOTCharacterLinks= Module[, 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]& ]|> ];

Функция GOTCharacterLinksGraph для построения графов взаимосвязей персонажей «Игры престолов».

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], (* else *) 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"] ] ];

Узнаем кто кого родил в «Игре престолов»:

GOTInfographicsPoster[ #, "Родители и их дети в \"Игре престолов\"", "ImageSize" -> 1500 ] &@ GOTCharacterLinksGraph[ Property[ #, { EdgeStyle -> Directive[ { AbsoluteThickness[2], Blue, Arrowheads[{0, {0.01, 0.5}}] } ] } ] & /@ $GOTCharacterLinks["РодительИРебёнок"], "VertexSize" -> 3 ]

image

Теперь посмотрим, кто кому является братом или сестрой в «Игре престолов»:

GOTInfographicsPoster[ #,"Братья и сёстры в \"Игре престолов\"","ImageSize"->1500
]&@ GOTCharacterLinksGraph[ Property[ #, {EdgeStyle->Directive[{AbsoluteThickness[2],Darker@Green}]} ]&/@ $GOTCharacterLinks["БратьяИСёстры"], "VertexSize"->0.7, "GraphLayout"->Automatic ]

image

Одно из самых интересных: граф убийств в «Игре престолов»:

GOTInfographicsPoster[ #,"Кто кого убил в \"Игре престолов\"","ImageSize"->2500
]&@ GOTCharacterLinksGraph[ Property[ #, { EdgeStyle-> Directive[ { AbsoluteThickness[2], Black, Arrowheads[{0,{0.0075,0.5}}] } ] } ]&/@ $GOTCharacterLinks["Убил"], "VertexSize"->1.1, "ImageSize"->2500 ]

image
(оригинал)

Не так интересно, но тем не менее — кто кому служит в «Игре престолов»:

GOTInfographicsPoster[ #,"Кто кому служит в \"Игре престолов\"","ImageSize"->1000
]&@ GOTCharacterLinksGraph[ Property[ #, { EdgeStyle-> Directive[ { AbsoluteThickness[2], Magenta, Arrowheads[{0,{0.02,0.5}}] } ] } ]&/@ $GOTCharacterLinks["Служит"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic ]

image

Помолвленные и женатые персонажи «Игры престолов»:

GOTInfographicsPoster[ #, "Кто с кем женат или обручен в \"Игре престолов\"", "ImageSize"->1000
]&@ GOTCharacterLinksGraph[ Property[ #,{EdgeStyle->Directive[{AbsoluteThickness[2],Orange}]} ]&/@ $GOTCharacterLinks["ЖенатыОбручены"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic ]

image

Немного погорячее — кто с кем имел секс в «Игре престолов» (количество линий, думаю, не сложно догадаться, что означает ;)).

GOTInfographicsPoster[#, "Секс в \"Игре престолов\"", "ImageSize" -> 1300] &@ GOTCharacterLinksGraph[ Property[#, {EdgeStyle -> Directive[{AbsoluteThickness[2], Red}]}] & /@ $GOTCharacterLinks["Секс"], "VertexSize" -> 0.9, "ImageSize" -> 1300, "GraphLayout" -> "LayeredDigraphEmbedding" ]

image

Теперь сведем все графы в один большой граф взаимоотношений персонажей в «Игре престолов»:

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 ] ]

image
(оригинал)

Каждое ребро между персонажами означает, что они были в одной сцене. Посмотрим на то, какие персонажи появлялись в одной и той же сцене. Чем ребро толще и краснее, тем больше общих сцен.

Далее — 5, 10 и 20. Построим несколько графов: первый — показывает связи, с минимальным количеством сцен 2.

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}}
];

image
(оригинал)

image

image

image

Для ответа на этот вопрос, создадим переменную $GOTEpisodeData в которую поместим набор очищенных данных о сценах по каждому эпизоду «Игры престолов».

$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...}} ];

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

image

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

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

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 ]

image
(оригинал)

Остальных тоже не будем обделять и построим большую таблицу:

GOTInfographicsPoster[ #, "550+ персонажей и их экранное время", "ImageSize"->1500, "ImageResolution"->150
]&@ Multicolumn[ Style[ Row[{#[[1]]," \[LongDash] ",#[[2]]," c"}],FontFamily->"Myriad Pro",8 ]&/@ KeyValueMap[ {#1,#2}&, SortBy[ Merge[ $GOTEpisodeData[[All,"ScreenTime"]], Total[Flatten[#]]& ], -#& ] ], 6 ]

image
(оригинал)

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

$GOTEpisodeN — переводит серию из формата {сезон, порядновый номер серии в сезоне} к просто порядковому номеру серии во всём сериале.

$GOTEpisodeN= <| Thread[ Rule[#,Range[Length[#]]]&@$GOTEpisodeData[[All,"EpisodeN"]] ]|>;

$GOTEpisodeID — операция, обратная к $GOTEpisodeN.

$GOTEpisodeID= <| Thread[ Rule[Range[Length[#]],#]&@$GOTEpisodeData[[All,"EpisodeN"]] ]|>;

Построим гистрограмму количества персонажей, задействованных в каждой из серий «Игры престолов»

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]]& ]

image

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

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

$GOTCharacters= DeleteCases[ Reverse[ SortBy[ Tally[ Flatten[Keys@$GOTEpisodeData[[All,"ScreenTime"]]] ], Last ] ][ [;;,1] ], "БезПерсонажей" ];

Количество серий в сезоне:

$GOTSeriesInSeason= <| KeyValueMap[#1->Length@#2&,GroupBy[$GOTEpisodeData[[;;,1]],First]]|>;

«Маска» сезона (служебный символ):

$GOTSeasonsMask=KeyValueMap[ConstantArray[#1,#2]&,$GOTSeriesInSeason];

GOTCharacterBySeason вычисляет в каких сериях каких сезонов был задействован персонаж «Игры престолов»:

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, (* else *) KeySort@<|initialData,<|#->{}&/@empty|>|> ] ]

GOTCharacterBySeasonPlot визуализирует данные, полученные GOTCharacterBySeason.

GOTCharacterBySeasonPlot[name_]:= Flatten@ KeyValueMap[ ReplacePart[ $GOTSeasonsMask[[#1]], Thread[ Complement[Range[1,$GOTSeriesInSeason[#1]],#2]->0 ] ]&, GOTCharacterBySeason[name] ]

$GOTSeasonColors набор цветов, для того, чтобы наглядно отображать набор серий сезона.

$GOTSeasonColors= {0->White} ~ Join ~ Thread[Range[1,8]->ColorData[54,"ColorList"][[1;;8]]];

Наконец, построим таблицу, в которой наглядно видно, кто из персонажей в какой серии «Игры престолов» был, а в какой не был)

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} ]

image
(оригинал)

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

Создадим их набор: Построим карту из геометрических примитивов.

index=1;
$GOTLakesIDs= { 11, 8, 9, 10, 2, 529, 530, 522, 523, 533, 532, 526, 521, 525, 531, 524, 528, 527, 7, 3, 4, 5, 6 };

$GOTMapPolygons= { FaceForm@If[MemberQ[$GOTLakesIDs,index],LightBlue,LightOrange], EdgeForm[AbsoluteThickness[1]], index++;Polygon[Accumulate[#]] }&/@ GOTRawData["lands-of-ice-and-fire.json"]["arcs"];

Создадим набор мест на карте «Игры престолов»:

$GOTMapPlaces= Lookup[ GOTRawData["lands-of-ice-and-fire.json"]["objects"]["places"][ "geometries" ], {"coordinates","properties"} ];

$GOTMapPlaceCoordinates=Map[#[[2,"name"]]->#[[1]]&,$GOTMapPlaces];

Функция GOTMap служит для построения всевозможных «географических» мест и траекторий на карте «Игры престолов»:

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}], (* else *) 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" ] ] ]

Построим саму карту:

GOTInfographicsPoster[ #,"Карта расположения локаций \"Игры престолов\"","ImageSize"->1500
]&@ GOTMap[{}]

image

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

Функция GOTCharacterLocationNamesSequence вычисляет перемещения персонажа между локациями «Игры престолов»:

GOTCharacterLocationNamesSequence[name_]:= Merge[$GOTEpisodeData[[;;,"CharacterLocations"]],Identity][name];

Функция GOTCharacterLocationSequence переводит названия мест в их «географические» координаты:

GOTCharacterLocationSequence[name_]:= DeleteCases[ Partition[ Flatten[ DeleteCases[ GOTCharacterLocationNamesSequence[name] /. {{x_String,y_String}:>y,{x_String}:>x} /. $GOTMapPlaceCoordinates, _String, Infinity ], 1 ], 2, 1 ], {x_,x_} ];

Функция GOTMapTraectory строит траекторию на карте «Игры престолов»:

ClearAll[GOTMapTraectory];
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} ] ];

Построим их для 10 самых популярных героев. Наконец, мы можем построить карту перемещения любого персонажа «Игры престолов».

( 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]];

image

здесь) image
(другие карты см.

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

Найдем длину пути, пройденного каждым персонажем «Игры престолов» в условных единицах и посмотрим, кто больше всех поколесил по Вестеросу:

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

image

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

Сразу будет видно самые популярные локации. Вычислим для каждой локации (и региона) на карте «Игры престолов» общее экранное время и отобразим результат в нескольких формах.

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

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,55000}, 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]]]& ] ] )

image
(оригинал)

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

{ 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]]]& ];

image
(оригинал)

image
(оригинал)

Вычислим и поместим в переменную $GOTCharactersInAnotherFilms данные о том, в каких фильмах кто из актёров играл. Конечно, актёры из «Игры престолов» ещё много где играли.

$GOTCharactersInAnotherFilms= SortBy[ Map[ { #[[1]], #[[2]][[;;,"characterName"]], If[ Head[#[[3]]]===Missing, 0, (* else *) StringCases[#[[3]],DigitCharacter..] /. x_/;Length[x]>0:>ToExpression[x] ] /. {{x_}:>x,{}->0} }&, Lookup[ Values[GOTRawData["costars.json"]], {"title","actors","year"} ] ], -Length[#[[2]]]& ];

Теперь вычислим для каждого актера, в каких фильмах он играл и поместим результат в переменную $GOTCharactersFilmography.

$GOTCharactersFilmography= Association@ SortBy[ Select[ #-> SortBy[ Cases[ $GOTCharactersInAnotherFilms, {film_,list_/;MemberQ[list,#],year_}:> {film,year} ], -Last[#]& ]&/@ $GOTCharacters, Length[#[[2]]]>0& ], -Length[#[[2]]]& ];

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

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

image

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

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}} ]

image
(оригинал)

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

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} ]

image

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

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} ]

image

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

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} ]

image

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

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} ]

image
(оригинал)

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

Чем толще и краснее линия, тем больше общих картин у данной пары актёров. Построим граф, показывающий в скольких картинах (фильмах, сериалах и пр.) актёры «Игры престолов» играли вместе. (Оригинал)

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

image

Посмотрим, в какой серии их больше всего: Многие любят «Игру престолов» за диалоги.

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]]& ]

image

Выясним, кто больше всего «болтает» в «Игре престолов» — ответ довольно предсказуем, но удивляет отрыв Тириона почти в 2 раза от ближайшего к нему персонажа.

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& ] ] ] )

image

Наконец, построим диаграмму, показывающую количество экранного времени и количество сказанным персонажем слов вместе:

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] ] ]

image
(оригинал)

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

$gender= <| 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 мужчины.

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] ] ]

image

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

Теги
Показать больше

Похожие статьи

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *

Кнопка «Наверх»
Закрыть