Wolfram Research corporate blog
Entertaining tasks
Programming
Infographics

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



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

Оглавление


Взаимоотношения персонажей
Кто кого родил
Кто кому брат или сестра
Кто кого убил
Кто кому служит
Кто с кем женат или помолвлен
У кого с кем был секс
Все отношения на одном графе
Связь персонажей по сценам
Кто самый «популярный» персонаж Игры престолов?
Количество экранного времени у персонажей
Сколько персонажей было в сериях?
Кто из персонажей был в самом большом количестве серий «Игры престолов»?
Самые популярные локации «Игры престолов»
Карта локаций «Игры престолов»
Перемещения персонажей «Игры престолов» от серии к серии
Кто больше всего «путешествовал» из персонажей «Игры престолов»?
Самые популярные локации «Игры престолов» (по экранному времени)
В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?
Фильмы, в которых играли самые «востребованные» актёры «Игры престолов»:
Актёры «Игры престолов» в «Гарри Поттере»
Актёры «Игры престолов» в «Звёздных войнах»
Актёры «Игры престолов» в «Пиратах карибского моря»
В каких фильмах/сериалах много актёров «Игры престолов»
Как тесно связаны между собой актёры «Игры престолов»
Разговоры в «Игре престолов»
Пол персонажей «Игры престолов»: кого больше, мужчин или женщин?
В этом посте я расскажу о том, как применять язык 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
      ]


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
(оригинал)

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



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

Построим несколько графов: первый — показывает связи, с минимальным количеством сцен 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}}
];


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

Напоминаю, что здесь вы можете скачать оригинал поста со всеми вспомогательными функциями и исходными данными.
+120
69.4k 220
Support the author
Comments 77