Оригинал поста + Вспомогательные функции и исходные данные
Оглавление
Взаимоотношения персонажей
— Кто кого родил
— Кто кому брат или сестра
— Кто кого убил
— Кто кому служит
— Кто с кем женат или помолвлен
— У кого с кем был секс
— Все отношения на одном графе
Связь персонажей по сценам
Кто самый «популярный» персонаж Игры престолов?
— Количество экранного времени у персонажей
— Сколько персонажей было в сериях?
— Кто из персонажей был самом большом количестве серий «Игры престолов»?
Самые популярные локации «Игры престолов»
— Карта локаций «Игры престолов»
— Перемещения персонажей «Игры престолов» от серии к серии
— Кто больше всего «путешествовал» из персонажей «Игры престолов»?
— Самые популярные локации «Игры престолов» (по экранному времени)
В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?
— Фильмы, в которых играли самые «востребованные» актёры «Игры престолов»:
— Актёры «Игры престолов» в «Гарри Поттере»
— Актёры «Игры престолов» в «Звёздных войнах»
— Актёры «Игры престолов» в «Пиратах карибского моря»
— В каких фильмах/сериалах много актёров «Игры престолов»
— Как тесно связаны между собой актёры «Игры престолов»
Разговоры в «Игре престолов»
Пол персонажей «Игры престолов»: кого больше, мужчин или женщин?
В этом посте я расскажу о том, как применять язык Wolfram Languge в анализе и визуализации данных на примере базы данных по «Игре престолов». В этой статье не уделяется особого внимания парсингу данных, об этом я расскажу отдельно. Вместо этого пост целиком посвящен интересной инфографике и её созданию.
Надеюсь, что построенные визуализации заинтересуют тех, кому нравится этот замечательный сериал).
Созданная для поста инфографика интерактивна в документе Mathematica, который можно скачать по ссылке в шапке.
Взаимоотношения персонажей
Набор рёбер графа взаимоотношений персонажей по типам:
$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]&
]|>
];
Функция 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
]
Теперь посмотрим, кто кому является братом или сестрой в «Игре престолов»:
GOTInfographicsPoster[
#,"Братья и сёстры в "Игре престолов"","ImageSize"->1500
]&@
GOTCharacterLinksGraph[
Property[
#,
{EdgeStyle->Directive[{AbsoluteThickness[2],Darker@Green}]}
]&/@
$GOTCharacterLinks["БратьяИСёстры"],
"VertexSize"->0.7,
"GraphLayout"->Automatic
]
Одно из самых интересных: граф убийств в «Игре престолов»:
GOTInfographicsPoster[
#,"Кто кого убил в "Игре престолов"","ImageSize"->2500
]&@
GOTCharacterLinksGraph[
Property[
#,
{
EdgeStyle->
Directive[
{
AbsoluteThickness[2],
Black,
Arrowheads[{0,{0.0075,0.5}}]
}
]
}
]&/@
$GOTCharacterLinks["Убил"],
"VertexSize"->1.1,
"ImageSize"->2500
]
(оригинал)
Не так интересно, но тем не менее — кто кому служит в «Игре престолов»:
GOTInfographicsPoster[
#,"Кто кому служит в "Игре престолов"","ImageSize"->1000
]&@
GOTCharacterLinksGraph[
Property[
#,
{
EdgeStyle->
Directive[
{
AbsoluteThickness[2],
Magenta,
Arrowheads[{0,{0.02,0.5}}]
}
]
}
]&/@
$GOTCharacterLinks["Служит"],
"VertexSize"->0.5,
"ImageSize"->1000,
"GraphLayout"->Automatic
]
Помолвленные и женатые персонажи «Игры престолов»:
GOTInfographicsPoster[
#,
"Кто с кем женат или обручен в "Игре престолов"",
"ImageSize"->1000
]&@
GOTCharacterLinksGraph[
Property[
#,{EdgeStyle->Directive[{AbsoluteThickness[2],Orange}]}
]&/@
$GOTCharacterLinks["ЖенатыОбручены"],
"VertexSize"->0.5,
"ImageSize"->1000,
"GraphLayout"->Automatic
]
Немного погорячее — кто с кем имел секс в «Игре престолов» (количество линий, думаю, не сложно догадаться, что означает ;)).
GOTInfographicsPoster[#, "Секс в "Игре престолов"",
"ImageSize" -> 1300] &@
GOTCharacterLinksGraph[
Property[#, {EdgeStyle ->
Directive[{AbsoluteThickness[2], Red}]}] & /@
$GOTCharacterLinks["Секс"],
"VertexSize" -> 0.9,
"ImageSize" -> 1300,
"GraphLayout" -> "LayeredDigraphEmbedding"
]
Теперь сведем все графы в один большой граф взаимоотношений персонажей в «Игре престолов»:
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
]
]
(оригинал)
Связь персонажей по сценам
Посмотрим на то, какие персонажи появлялись в одной и той же сцене. Каждое ребро между персонажами означает, что они были в одной сцене. Чем ребро толще и краснее, тем больше общих сцен.
Построим несколько графов: первый — показывает связи, с минимальным количеством сцен 2. Далее — 5, 10 и 20.
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}}
];
(оригинал)
Кто самый «популярный» персонаж Игры престолов?
Для ответа на этот вопрос, создадим переменную $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...}}
];
Пример данных по первой серии первого сезона:
Количество экранного времени у персонажей
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
]
(оригинал)
Остальных тоже не будем обделять и построим большую таблицу:
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
]
(оригинал)
Сколько персонажей было в сериях?
$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]]&
]
Кто из персонажей был самом большом количестве серий «Игры престолов»?
Список персонажей «Игры престолов», отсортированный по количеству серий, в который они встречались:
$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}
]
(оригинал)
Самые популярные локации «Игры престолов»
Карта локаций «Игры престолов»
Построим карту из геометрических примитивов. Создадим их набор:
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[{}]
Перемещения персонажей «Игры престолов» от серии к серии
Функция 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]];
(другие карты см. здесь)
Кто больше всего «путешествовал» из персонажей «Игры престолов»?
Найдем длину пути, пройденного каждым персонажем «Игры престолов» в условных единицах и посмотрим, кто больше всех поколесил по Вестеросу:
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]
]
]
)
Самые популярные локации «Игры престолов» (по экранному времени)
Вычислим для каждой локации (и региона) на карте «Игры престолов» общее экранное время и отобразим результат в нескольких формах. Сразу будет видно самые популярные локации.
Данные в виде столбчатой гистограммы:
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]]]&
]
]
)
(оригинал)
Данные в виде круговой парной диаграммы:
{
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]]]&
];
(оригинал)
(оригинал)
В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?
Конечно, актёры из «Игры престолов» ещё много где играли. Вычислим и поместим в переменную $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]
]
Фильмы, в которых играли самые «востребованные» актёры «Игры престолов»:
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}}
]
(оригинал)
Актёры «Игры престолов» в «Гарри Поттере»
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}
]
Актёры «Игры престолов» в «Звёздных войнах»
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}
]
Актёры «Игры престолов» в «Пиратах карибского моря»
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}
]
В каких фильмах/сериалах много актёров «Игры престолов»
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}
]
(оригинал)
Как тесно связаны между собой актёры «Игры престолов»
Построим граф, показывающий в скольких картинах (фильмах, сериалах и пр.) актёры «Игры престолов» играли вместе. Чем толще и краснее линия, тем больше общих картин у данной пары актёров. (Оригинал)
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
]
]
]
)
Разговоры в «Игре престолов»
Многие любят «Игру престолов» за диалоги. Посмотрим, в какой серии их больше всего:
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]]&
]
Выясним, кто больше всего «болтает» в «Игре престолов» — ответ довольно предсказуем, но удивляет отрыв Тириона почти в 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&
]
]
]
)
Наконец, построим диаграмму, показывающую количество экранного времени и количество сказанным персонажем слов вместе:
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]
]
]
(оригинал)
Пол персонажей «Игры престолов»: кого больше, мужчин или женщин?
Пол по имени персонажа:
$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]
]
]
Напоминаю, что здесь вы можете скачать оригинал поста со всеми вспомогательными функциями и исходными данными.
Автор: Осипов Роман Алексеевич