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



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

    Оглавление


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

    Напоминаю, что здесь вы можете скачать оригинал поста со всеми вспомогательными функциями и исходными данными.
    Wolfram Research
    80.99
    Wolfram Language, Mathematica, Wolfram Alpha и др.
    Support the author
    Share post

    Comments 77

      +12
      Тут даже нечего писать, «масштаб» поражает.

      Только если спасибо за крутую работу!
        0
        Рад, что вам понравилось)
        +6
        Даже не читая статью и теги, я догадался, что речь пойдет о Wolfram.
          +2
          Да, некий «стиль» публикаций у нас выработался :)
        • UFO just landed and posted this here
            +2
            Классно! А слабо «Направляющий свет» также? .)
              +2
              В бесплатном режиме я не готов точно)))
                0
                Ну у него у большой части серий даже копии не сохранились, не говоря уж о данных об экранном времени и актерах, так что даже при желании полностью его так рассчитать нельзя.
                  0
                  Ну тогда можно выбрать что-нибудь отсюда .)
                    0
                    Да… можно бесконечно этим заниматься, столько наснимали)
                      0
                      Почему бесконечно, есть же системы распознавания, ИИ.) Неужели обычные люди до секунды считали время появления актеров в кадре?
                0
                посмотрел табличку "Кто из персонажей был самом большом количестве серий «Игры престолов»" — даа, несложно догадаться в какой серии персонаж окончил свой путь.
                  +14
                  А откуда исходные данные-то?
                  Неужели вы все это вручную вычленяли?
                    0
                    Есть достаточно подробные вики-статьи по всем персонажам. Возможно, оттуда.
                      0
                      Возможно, парсинг субтитров.
                      –21

                      Мем про буханку хлеба и троллейбус. Осталось еще Санта-Барбару аналогично проанализировать. Надо только данные из серий оцифровать.

                        +3
                        Люди в блоге Вольфрама пишут о возможностях Вольфрама. Где же тут «буханка хлеба и троллейбус»? Мне вот интересно было посмотреть на разные графики, может и себе какой-то использую
                        0
                        Я тоже хочу такого покурить ;-)
                          +3
                          Данные есть, можете покурить)
                          +2
                          Ссылка на оригинал под картинкой про секс ведет на картинку про то, кто чей родитель. Связанные конечно вещи но не настолько )

                          А так да, весьма основательно.
                            0
                            Похожая история и с убийствами, оригинал не в туда ведёт :(
                              0
                              Поправил, спасибо за внимательность!
                            +3
                            Тянет на дипломную работу.
                              0
                              Жаль не студент давно уже)
                              +8
                              Масштабно! Если не секрет — откуда исходные данные взялись?
                                0
                                Вот это работа!!!
                                  +9
                                  В разделе про болтунов не хватает Ходора
                                    0
                                    Да) С вашего комментария просто до слез посмеялся)
                                    0
                                    Задротство 80lvl!!!
                                    плюсанул статью и карму, это же надо было так упороться!
                                      0
                                      Да, люблю я это дело) Спасибо!
                                      0

                                      Вы — маньяки! В хорошем смысле этого слова.

                                        0
                                        Стараемся) Главное тему придумать интересную, что не так просто часто.
                                        +2
                                        Особая прелесть данного исследования состоит в его абсолютной бесполезности. Освоение методов всегда проще определения цели.
                                          +1
                                          Почему? Можно ввести себя в курс дела о том, что происходит в сериале, если его не смотрел.
                                          Теперь знаю, кто кого убил (и даже когда!), и кто вообще остался в живых, не читая аннотации к сериям, которых там небось уже на небольшой рассказ наберется.
                                            0
                                            Эм, а если не смотрели и не планируете смотреть, то зачем входить в курс дела?
                                              0
                                              На всякий случай! Ртутью я тоже не травился и не планирую, но про нее почитал!
                                            0
                                            Филологам очень, даже, может пригодится.
                                            +6
                                            Интересно, откуда у Короля Ночи появились сказанные слова в графике слова/время, он разве говорил?
                                              0
                                              Вероятнее всего ошибка при условии что исходные данные брались из субтитров
                                              –17
                                              В инфографике про секс как то «печально». Моногамность не в моде? Культивируются измены под видом «полигамии»? Или много случаев когда партнер погиб и персонажу «пришлось» искать нового?
                                              Кто смотрел сериал — поделитесь своим мнением, пожалуйста.
                                                +10
                                                А инфографика про убийства у вас вопросов не вызвала?
                                                  +2
                                                  А что конкретно не так в полигамности, если это не вызывает возражений и психологического дискомфорта у непосредственных участников событий?
                                                  Не, я понимаю, почему был смысл осуждать промискуитет в древние времена — низкий уровень медицины и гигиены, отсутствие средств контрацепции, что вело к нежелательным беременностям, распространению ЗППП, и т.д.
                                                  Но это, в первую очередь, фильм, вымышленная история, поэтому не вижу смысла расстраиваться, а если вы все-таки говорите с проекцией на наше время, то мне решительно непонятно, что же конкретно в этом плохого при соблюдении вышеперечисленных условий.
                                                    0
                                                    что же конкретно в этом плохого

                                                    Морально страдают ревнивцы и романтики! ))))))
                                                    Вот кстати насчет картинки про секс — там разное количество красных линий между персонажами. Обычно одна, но есть и две, и три, и даже, ой, пять! Это э… сколькикратно или что-то еще означает?
                                                    0
                                                    «Как-то», написанное не через дефис, печалит намного сильнее.
                                                    Если смотреть в разрезе сериалов, то, напротив, моногамность — гегемон. Мыльных сериалов про «настоящую любовь» и её субпродукты снято на порядки больше.
                                                      0
                                                      Вы совершенно правы! Данный сериал снят массонами-рептилоидами с Нибиру по плану Далласа с целью развала духовных скреп.
                                                      +7
                                                      Реквестирую аналогичную инфографику по акционерам и советам директоров топ500 крупнейших компаний мира. Данные открыты. По интригам как минимум не уступит «Игре престолов».
                                                        +1
                                                        Или компаний России — еще веселее будет.
                                                          0
                                                          Дадите данные? Может тоже что-то поделаю?)
                                                          +6
                                                          "Child of the Forest"->"male",
                                                          "Wedding Band"->"male",
                                                          "Young Ned"->"male"


                                                          Разбивка по полам с натяжкой. Я не берусь утверждать, но Child of the Forest больше похоже на female, юного Неда стоит ли считать отдельно от взрослого, а Wedding Band это вообще анекдот про Славу КПСС
                                                            0
                                                            Ну это я волюнтаристически добавил к распарсенным данным. Стоит, конечно, некоторую чистку сделать, хотя что-то вроде «Young Ned» в данных по сути ничего не меняет, так как на уровне стат. погрешности.
                                                            +1
                                                            Роман, поздравляю с юбилейной статьёй!
                                                              0
                                                              Спасибо! Да, 100 статей)
                                                              Я даже как-то не заметил сразу.
                                                              –1
                                                              Мне это напомнило работы Марка Ломбарди
                                                              Рекомендую посмотреть о нём кино «Mark Lombardi: Death-Defying Acts Of Art And Conspiracy», на нашем телеке (был такой канал 24doc, хороший был канал, да сплыл) его обозвали «Тайна Марка Ломбарди».

                                                              А где диаграммы и графики по темам:
                                                              Список героев совершивших наибольшее количество тупых поступков.
                                                              Список самый тупых героев по убыванию.
                                                              График повышения общего кретинизма и идиократии с первого эпизода по последний.
                                                              Диаграмма взаимодействия и влияния тупых поступков одних персонажей на тупые поступки других персонажей.

                                                              P.S.
                                                              По мне, так идиальным завершением сего эпоса, будет либо сталкновение с другой планетой, чтобы их всех разметало к чертям или чтобы по итогу их этот огненный бог или кто там у них самый крутой бог нарайоне, оказался школьником троешником в школе программистов, который настолько бездарно исполнил задание по моделированию развития цивилизации, что препод увидев сию работу, потребовал немедленно стереть это позорище и поставил за неё кол.
                                                                +1
                                                                Спойлер
                                                                А где же кирпич, убивший Джейме и Серсею?

                                                                  0
                                                                  5 и 6 серию учту на сл. неделе, когда 6-я выйдет)
                                                                  0
                                                                  Начал смотреть, но примерно на половине графиков просто прокрутил вниз, чтобы поставить плюс
                                                                    +1
                                                                    Не хило так. Респект!
                                                                    –6
                                                                    Вся эта суета вокруг Игры Престолов, сериалу лишь повезло оказаться в нужное время, в нужном месте. Просмотрев все серии, я его не вижу таким крутым, кроме конечно сексуальных сцен где есть секс, изнасилование. Только лишь из-за него и смотрел. К примеру сериал с того же HBO WestWorld куда круче. Да а если про тематики, Викинги намного лучше сериал, имхо
                                                                      0
                                                                      Заметно, благодаря этой статье, что исходники этого сериала также рассчитаны на компьютере. соотношение жен/муж — чёткое 1 к 3, соотношение разговоров — не случайное и не по велению авторского сердца, а чотко рассчитано.
                                                                      Особенно поражает табличка — присутствие персонаже в сериях. — Всё чотко рассчитано компом и тщательно равномерно раскидано с учётом псевдо-случайности… Бездушный сериал какой-то. ))
                                                                        0
                                                                        Феноменальная работа! Но визуализация и предаставление, увы и ах… Не думали создать интерактивные страницы, чтобы все фанаты могли перетаскивать иконки/свзязи и т.д. для более удобного «погружения»?
                                                                          0
                                                                          Ну это следующий этап. Пишу парсер из Wolfram в D3.js

                                                                          В документе Wolfram все интерактивно.
                                                                          0
                                                                          Нужна такая же, только интерактивная — по сериям или сезонам. Для тех, для кого это — спойлеры)
                                                                            +1
                                                                            У безупречных нет полового органа. Червь не мог переспать с Миссандей
                                                                              +1
                                                                              Ну может он спал нетрадиционно) Петтинг или ещё чего никто не отменял)
                                                                              0
                                                                              Секс в «Игре престолов» — не нашел Тайвин Ланнистер (Tywin Lannister) + Шая (Shae)
                                                                                0
                                                                                Да… ребро в графе надобно добавить)
                                                                                  +1
                                                                                  Выражение «Ребро Адама» заиграло новым смыслом)
                                                                                –4
                                                                                image
                                                                                  0
                                                                                  Статья интересная и полученные результаты весьма любопытны.

                                                                                  Жаль, что автор не знаком с тэгом «спойлер» и не в курсе, что объемные изображения и куски кода удобнее для читателей прятать в нём.
                                                                                    0
                                                                                    «Создается ощущение иногда, что мужские персонажи лишь антураж для мощных женских.» Valar Morghulis — Все мужи, смертны. (перевод Дейнерис Таргариен в беседе с Миссандей)
                                                                                      –1
                                                                                      «перевод Дейнерис Таргариен» — очевидно у вас перевод Википедии.
                                                                                      а между тем, это явно латинское имя

                                                                                      Daenerys Targaryen — где AE — читается как Э, ryen — читается как РЬЕН или как во французских и части немецких слов — РЬЕ или Рьа.
                                                                                      то есть
                                                                                      Дэнерис Таргарьен (но никак не «дЕЙЕнерис» )))
                                                                                      или, возможно,
                                                                                      ДэнерИ ТагАрьа.

                                                                                      А слово Дэнери отсылает нас к Денарию (десятчик) — изначально золотой монете, а позже серебряной римской монете.
                                                                                        0
                                                                                        Да, её имя, я там и взял.)) Это, уже народное))
                                                                                      0
                                                                                      Масштаб действительно поражает.
                                                                                      Но всё таки, откуда raw data? Особенно необычно что в «другие роли актёров» У Эмилии не указан Терминатор (про него, конечно, лучше забыть, но всё-же), а у Софи — Люди Хэ.
                                                                                        +1
                                                                                        граф «кто с кем имел секс в «сериал» » — не полносвязный? => сериал неинтересный
                                                                                          +1
                                                                                          Отличная работа, в разделе секса, забыли великого и могучего Роберта.
                                                                                            0
                                                                                            Там отдельный граф нужен.

                                                                                          Only users with full accounts can post comments. Log in, please.