В этом посте я расскажу о том, как применять язык Wolfram Languge в анализе и визуализации данных на примере базы данных по "Игре престолов". В этой статье не уделяется особого внимания парсингу данных, об этом я расскажу отдельно. Вместо этого пост целиком посвящен интересной инфографике и её созданию.
Надеюсь, что построенные визуализации заинтересуют тех, кому нравится этот замечательный сериал)
Пол персонажей
Пол по имени персонажа:
In[1]:=
$gender=Association[Flatten[KeyValueMap[Thread[#2->#1]&, GOTRawData["characters-gender-all.json"]]]~Join~{"Aegon Targaryen"->"male", "Aerys II Targaryen"->"male", "Archmaester Marwyn"->"male", "Baratheon Guard"->"male", "Brandon Stark"->"male", "Child of the Forest"->"male", "Elia Martell"->"female", "Eon Hunter"->"male", "Goldcloak #1"->"male", "Goldcloak #2"->"male", "Knight of House Frey"->"male", "Knight of House Lynderly"->"male", "Kurleket"->"male", "Lannister Guardsman"->"male", "Lord Galbart Glover"->"male", "Male Prostitute"->"male", "Masha Heddle"->"female", "Meereen Slave Master"->"male", "Mikken"->"male", "Night's Watch Deserter"->"male", "Night's Watch Messenger"->"male", "Night's Watch Officer"->"male", "Pentoshi Servant"->"male", "Rhaella Targaryen"->"female", "Rhaenys Targaryen"->"female", "Stark Bannerman"->"male", "Stark Guard"->"male", "Wedding Band"->"male", "White Walker #2"->"male", "Willis Wode"->"male", "Young Ned"->"male"}];Соотношение персонажей "Игры престолов" по полу — видно, что на одну женщину приходится по 3 мужчины. Создается ощущение иногда, что мужские персонажи лишь антураж для мощных женских)
In[2]:=
GOTInfographicsPoster[#, "Соотношение мужских и женских персонажей в Игре престолов"]&@Module[{labels, counts, percents},
{labels, counts}=Transpose[Tally[Values[$gender]]];
percents=PercentForm/@N[counts/Total[counts]];
PieChart[counts, ChartLabels->Map[Style[Row[#, "\n"], 20, Bold, Black, FontFamily->"Open Sans"]&, Transpose[{labels, counts, percents}]], ChartStyle->{LightRed, LightBlue}, ImageSize->600, Background->GrayLevel[0.95]]]Out[2]=
Дом персонажа
Дом персонажа по его имени:
In[3]:=
$GOTCharacterHouse=Association[Rule@@@Reverse/@Flatten[Thread/@Values[GOTRawData["characters-houses.json"]["house"]], 1]];
Эмблема дома по его названию:
In[4]:=
$GOTHouseSignData=AssociationThread[{"Arryn", "Baratheon", "Frey", "Greyjoy", "Lannister", "Martell", "Stark", "Targaryen", "Tully", "Tyrell", "White Walkers", "Night's Watch", "Dothraki", "Wildlings", "Include", "Mormont", "Umber", "Bolton", "Tarly"}->(ImagePad[#, 10, White]&/@ConformImages[(ImageCrop/@Flatten[ImagePartition[#, ImageDimensions[#]*{1/5, 1/2}]&[Import["https://7kingdoms.ru/wp-content/uploads/2012/04/GOT_Sigils_01.png"]]])~Join~Map[Import, {"https://i.pinimg.com/originals/5f/35/cb/5f35cb4d592cf7d2cbb4c1103ce31bf8.jpg", "https://i.pinimg.com/originals/4b/de/19/4bde1957b20e0f68a1566b39b408cb38.jpg", "https://i.pinimg.com/originals/4a/1b/59/4a1b59348d3f502bcc3c85340e092edc.jpg", "https://ih1.redbubble.net/image.516956392.1541/raf, 750x1000, 075, t, fafafa:ca443f4786.jpg", "https://ae01.alicdn.com/kf/HTB19O9dNXXXXXcpaXXXq6xXFXXXS/Iron-Throne-GOT-Toilet-Vinyl-Wall-Sticker-Game-of-thrones-Wall-Decals-For-Bathroom-Decoration.jpg",
"https://oyster.ignimgs.com/mediawiki/apis.ign.com/game-of-thrones/7/7a/300px-GoT_sigils_08.jpg", "https://i.etsystatic.com/5840482/r/il/88beca/854713479/il_794xN.854713479_4t7z.jpg",
"https://vignette.wikia.nocookie.net/gameofthrones/images/d/dd/House-Bolton-Main-Shield.PNG", "https://vignette.wikia.nocookie.net/gameofthrones/images/2/2d/House-Tarly-Main-Shield.PNG"}], {150, Automatic}, "Fit", Padding->White])];In[5]:=
SetAttributes[$GOTHouseSign, Listable];
In[6]:=
$GOTHouseSign[name_String]:=$GOTHouseSignData[name];
Эмблема дома Старков:
In[7]:=
$GOTHouseSign["Stark"]
Out[7]=
Несколько персонажей с эмблемами их домов:
In[8]:=
{#, Image[$GOTHouseSign[$GOTCharacterHouse[#]], ImageSize->100]}&/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister"}Out[8]=
Карточка персонажа — потребуется для всевозможных графов и таблиц
Иконка пола (для персонажей без изображения):
In[9]:=
$GenderIcon=AssociationThread[{"male", "female"}->(ImagePad[ImageResize[ColorConvert[#, "GrayScale"], 150], 100, White]&/@(ImageCrop/@({ImageTake[#, All, {1, 450}], ImageTake[#, All, {-450, -1}]}&@Import["http://clipart-library.com/images/kc85Mg5zi.jpg"])))];Иконка персонажа по его имени (в оригинальном размере):
In[10]:=
If[FileExistsQ[#], Get@#, $characterImageRaw=Association@Quiet[Rule[#[[1]], If[Head[#[[2]]]===Missing, $GenderIcon[$gender[#[[1]]]], Check[Import[#[[2]]], $GenderIcon[$gender[#[[1]]]]]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName", "characterImageFull"}]];
DumpSave[#, $characterImageRaw]]&@FileNameJoin[{NotebookDirectory[], "$characterImageRaw.mx"}];Несколько персонажей с их изображениями:
In[11]:=
{#, Image[$characterImageRaw[#], ImageSize->100]}&/@RandomSample[Keys[$characterImageRaw], 10]Out[11]=
Стандартизация изображений:
In[12]:=
$characterImage=With[{alphaChannel=ImageResize[ColorNegate[Rasterize[Graphics[Disk[]]]], 300]},
Map[SetAlphaChannel[ImageResize[ImageCrop[#, {1, 1}Min[ImageDimensions[#]]], 300], alphaChannel]&, $characterImageRaw]];In[13]:=
{#, Image[$characterImage[#], ImageSize->100]}&/@RandomSample[Keys[$characterImage], 10]Out[13]=
Карточка персонажа:
In[14]:=
$characterCardFull=Association[#[[1]]->Framed[Style[#, 14, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Row[{Image[$characterImage[#[[1]]], ImageSize->100], " ", If[Head[#[[4]]]===Missing, "", Row[Flatten@List[$GOTHouseSign[#[[4]]]/.image_Image:>Image[image, ImageSize->{Automatic, 100}]], " "]]}], "\n", #[[1]], If[Head[#[[2]]]===Missing, Nothing, Row[{"\nАктёр: ", If[Head[#[[3]]]===Missing, #[[2]], Hyperlink[#[[2]], "https://www.imdb.com"<>#[[3]]]]}]]}], RoundingRadius->10, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName", "actorName", "actorLink", "houseName"}]];In[15]:=
$characterCardShort=Association[#[[1]]->Framed[Style[#, 14, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Image[$characterImage[#[[1]]], ImageSize->40], " ", #[[1]]}], RoundingRadius->10, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]]]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName"}]];In[16]:=
$characterCardShortSmall=Association[#[[1]]->Framed[Style[#, 12, FontFamily->"Open Sans Light", Bold, TextAlignment->Center]&@Row[{Image[$characterImage[#[[1]]], ImageSize->30], " ", #[[1]]}], RoundingRadius->6, Background->White, FrameStyle->Directive[LightGray, AbsoluteThickness[2]], FrameMargins->2]&/@Lookup[GOTRawData["characters.json"]["characters"], {"characterName"}]];In[17]:=
$characterCardFull/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}Out[17]=
In[18]:=
$characterCardFull/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}Out[18]=
In[19]:=
$characterCardShortSmall/@{"Arya Stark", "Walder Frey", "Yara Greyjoy", "Tyrion Lannister", "Jon Snow"}Out[19]=
Взаимоотношения персонажей
In[20]:=
$GOTCharacterLinks=Module[{parser},
parser=Flatten[Thread/@DeleteCases[Lookup[GOTRawData["characters.json"]["characters"], {"characterName", #}], {_, _Missing}], 1]&;
<|"РодительИРебёнок"->Union[DirectedEdge[#[[2]], #[[1]]]&/@parser["parents"], DirectedEdge[#[[1]], #[[2]]]&/@parser["parentOf"]],
"БратьяИСёстры"->DeleteDuplicates[UndirectedEdge[#[[2]], #[[1]]]&/@parser["siblings"], #1===Reverse[#2]&],
"Убил"->Union[DirectedEdge[#[[2]], #[[1]]]&/@parser["killedBy"],
DirectedEdge[#[[1]], #[[2]]]&/@parser["killed"]],
"Служит"->(DirectedEdge[#[[1]], #[[2]]]&/@parser["serves"]),
"ЖенатыОбручены"->DeleteDuplicates[UndirectedEdge[#[[1]], #[[2]]]&/@parser["marriedEngaged"], #1===Reverse[#2]&],
"Секс"->DeleteDuplicates[Flatten[Map[Thread@UndirectedEdge[#[[1]], #[[2]]["with"]]&, Lookup[#, {"name", "sex"}]&/@Select[Select[Flatten[Lookup[Flatten[GOTRawData["episodes.json"]["episodes"][[;;, "scenes"]], 1], "characters"]], Keys[#]=!={"name"}&], MemberQ[Keys[#], "sex"]&]]], #1===Reverse[#2]&]|>];In[21]:=
ClearAll[GOTCharacterLinksGraph];
GOTCharacterLinksGraph[data_, OptionsPattern[{"ImageSize"->1500, "VertexSize"->Automatic, "GraphLayout"->"GravityEmbedding"}]]:=Module[{vertexList},
vertexList=DeleteDuplicates[Flatten[data[[;;, 1]]/._[x_, y_]:>{x, y}]];
Graph[
data,
VertexLabels->Map[Rule[#, Placed[Tooltip[If[Head[#]===Image, Image[#, ImageSize->60], Style[StringReplace[#, " "->"\n"], LineSpacing->{0.8, 0, 0}, FontFamily->"Open Sans Light", Bold, 12]]&[#/.$characterImage], #/.$characterCardFull], {1/2, 1/2}]]&, vertexList],
VertexShapeFunction->"Circle", VertexSize->OptionValue["VertexSize"], VertexStyle->Directive[{White, EdgeForm[{LightGray, AbsoluteThickness[2]}]}],
ImageSize->OptionValue["ImageSize"], Background->GrayLevel[0.95], AspectRatio->1, GraphLayout->OptionValue["GraphLayout"]]]In[22]:=
GOTInfographicsPoster[#, "Родители и их дети в \"Игре престолов\"", "ImageSize"->1500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Blue, Arrowheads[{0, {0.01, 0.5}}]}]}]&/@$GOTCharacterLinks["РодительИРебёнок"], "VertexSize"->3]Out[22]=
In[23]:=
GOTInfographicsPoster[#, "Братья и сёстры в \"Игре престолов\"", "ImageSize"->1500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Darker@Green}]}]&/@$GOTCharacterLinks["БратьяИСёстры"], "VertexSize"->0.7, "GraphLayout"->Automatic]Out[23]=
In[24]:=
GOTInfographicsPoster[#, "Кто кого убил в \"Игре престолов\"", "ImageSize"->2500]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Black, Arrowheads[{0, {0.0075, 0.5}}]}]}]&/@$GOTCharacterLinks["Убил"], "VertexSize"->1.1, "ImageSize"->2500]Out[24]=
In[25]:=
GOTInfographicsPoster[#, "Кто кому служит в \"Игре престолов\"", "ImageSize"->1000]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Magenta, Arrowheads[{0, {0.02, 0.5}}]}]}]&/@$GOTCharacterLinks["Служит"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic]Out[25]=
In[26]:=
GOTInfographicsPoster[#, "Кто с кем женат или обручен в \"Игре престолов\"", "ImageSize"->1000]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Orange}]}]&/@$GOTCharacterLinks["ЖенатыОбручены"], "VertexSize"->0.5, "ImageSize"->1000, "GraphLayout"->Automatic]Out[26]=
In[27]:=
GOTInfographicsPoster[#, "Секс в \"Игре престолов\"", "ImageSize"->1300]&@GOTCharacterLinksGraph[Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Red}]}]&/@$GOTCharacterLinks["Секс"], "VertexSize"->0.9, "ImageSize"->1300, "GraphLayout"->"LayeredDigraphEmbedding"]Out[27]=
In[28]:=
GOTInfographicsPoster[#, "Взаимоотношения персонажей в \"Игре престолов\"", "ImageSize"->3000]&@Legended[GOTCharacterLinksGraph[
Join[
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Blue, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["РодительИРебёнок"],
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Darker@Green}]}]&/@$GOTCharacterLinks["БратьяИСёстры"],
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Black, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["Убил"],
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[1], Magenta, Arrowheads[{0, {0.005, 0.5}}]}]}]&/@$GOTCharacterLinks["Служит"],
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[2], Orange}]}]&/@$GOTCharacterLinks["ЖенатыОбручены"],
Property[#, {EdgeStyle->Directive[{AbsoluteThickness[3], Red}]}]&/@DeleteDuplicates[$GOTCharacterLinks["Секс"]]
], "ImageSize"->3000, "VertexSize"->0.9], Placed[LineLegend[{Blue, Darker@Green, Black, Magenta, Orange, Red}, {"Родители и дети", "Братья и сёстры", "Убил", "Служит", "Женаты или обручены", "Секс"}, LegendLayout->"Row"], Top]]Out[28]=
Связь персонажей по сценам
In[29]:=
Table[Print[GOTInfographicsPoster[GOTGraphPlot[#, min, "ImageSize"->Which[min==1, 5000, min==4, 3000, True, 2000], "MaxThickness"->25], "Появление персонажей \"Игры престолов\" в одной сцене не менее "<>ToString[min+1]<>" раз", "ImageSize"->Which[min==1, 5000, min==4, 3000, True, 2000]]&@Tally[UndirectedEdge@@@Map[Sort, Flatten[Map[Subsets[#, {2}]&, Map[#[[;;, "name"]]&, Flatten[Lookup[GOTRawData["episodes.json"]["episodes"], "scenes"]][[;;, "characters"]]]], 1]]]], {min, {1, 4, 9, 19}}];Кто самый "популярный" персонаж Игры престолов?
Информация по эпизодам Игры престолов:
In[30]:=
$GOTEpisodeData=With[{data=#}, <|"EpisodeN"->#[[1]], "ScreenTime"->SortBy[GroupBy[Flatten[ReplaceAll[Thread/@Transpose[{Map[Lookup[#[[1]], "name"]&, #[[2]]], Round@Map[QuantityMagnitude[UnitConvert[Subtract@@(TimeObject/@#[[{3, 2}]]), "Seconds"]]&, #[[2]]]}], {Missing["KeyAbsent", "name"], x_}:>{{"БезПерсонажей", x}}]&@data, 1], First, #[[;;, 2]]&], -Total[#]&], "LocationTime"->SortBy[GroupBy[Flatten[ReplaceAll[Thread/@Transpose[{Map[{#[[{4, 5}]]}&, #[[2]]]/.Missing["KeyAbsent", "subLocation"]->Nothing, Round@Map[QuantityMagnitude[UnitConvert[Subtract@@(TimeObject/@#[[{3, 2}]]), "Seconds"]]&, #[[2]]]}], {Missing["KeyAbsent", "name"], x_}:>{{"БезПерсонажей", x}}]&@data, 1], First, #[[;;, 2]]&], -Total[#]&],
"CharacterLocations"->GroupBy[DeleteCases[#/.Missing["KeyAbsent", "subLocation"]->Nothing, _Missing]&@Flatten[Map[With[{location=#[[2]]}, {#, location}&/@#[[1]]]&, Transpose[{Map[Lookup[#[[1]], "name"]&, #[[2]]], #[[2, ;;, {4, 5}]]}]], 1], First, #[[;;, 2]]&]|>]&/@DeleteCases[Map[{#[[{1, 2}]], Lookup[#[[3]], {"characters", "sceneStart", "sceneEnd", "location", "subLocation"}]}&, Lookup[GOTRawData["episodes.json"]["episodes"], {"seasonNum", "episodeNum", "scenes"}]], {_, {_Missing...}}];Пример данных по первой серии первого сезона:
In[31]:=
Style[$GOTEpisodeData[[1]], 10]
Out[31]=
Количество экранного времени у персонажей
30 персонажей Игры престолов с самым большим количеством экранного времени:
In[32]:=
GOTInfographicsPoster[#, "30 персонажей, которых мы видим больше всего на экране", "ImageSize"->1500]&@circleInfographics[{Tooltip[Row[{#[[1]]/.$characterImage, Style[#[[1]], 14, White, Bold], Style[UnitConvert[Quantity[#[[2]], "Seconds"], MixedUnit[{"Hours", "Minutes", "Seconds"}]], 14, White]}, "\n"], #[[1]]/.$characterCardFull], #[[2]]}&/@KeyValueMap[{#1, #2}&, SortBy[Merge[$GOTEpisodeData[[All, "ScreenTime"]], Total[Flatten[#]]&], -#&]][[1;;30]], "Precision"->10^-6, "StepDecrease"->0.99, "ShapeFunction"->Disk, "ColorFunction"->ColorData["Rainbow"], "ImageSize"->1500]Out[32]=
In[33]:=
GOTInfographicsPoster[#, "550+ персонажей и их экранное время", "ImageSize"->1500, "ImageResolution"->150]&@Multicolumn[Style[Row[{#[[1]], " — ", #[[2]], " c"}], FontFamily->"Myriad Pro", 8]&/@KeyValueMap[{#1, #2}&, SortBy[Merge[$GOTEpisodeData[[All, "ScreenTime"]], Total[Flatten[#]]&], -#&]], 6]Out[33]=
Сколько персонажей было в сериях?
In[34]:=
$GOTEpisodeN=Association[Thread[Rule[#, Range[Length[#]]]&@$GOTEpisodeData[[All, "EpisodeN"]]]];
In[35]:=
$GOTEpisodeID=Association[Thread[Rule[Range[Length[#]], #]&@$GOTEpisodeData[[All, "EpisodeN"]]]];
In[36]:=
GOTInfographicsPoster[#, "Количество персонажей в сериях \"Игры престолов\"", "ImageSize"->1000]&@BarChart[#, BarSpacing->{0.05, 2}, AspectRatio->1/2, ImageSize->1000, ChartLabels->{Keys[#], Range[10]}, ColorFunction->Function[{x}, ColorData["Rainbow"][x]], GridLines->{None, Range[0, 100, 5]}, FrameLabel->Map[Style[#, FontFamily->"Open Sans", 20, Bold]&, {"Сезон и серия в нём", "Число задействованных персонажей"}], Frame->True, Background->GrayLevel[0.95]]&@GroupBy[Map[{#["EpisodeN"], Length[#["ScreenTime"]]}&, $GOTEpisodeData[[All, {"EpisodeN", "ScreenTime"}]]], #[[1, 1]]&, #[[;;, 2]]&]Out[36]=
Кто из персонажей был самом большом количестве серий "Игры престолов"?
Список персонажей Игры престолов, отсортированный по количеству серий, в который они встречались:
In[37]:=
$GOTCharacters=DeleteCases[Reverse[SortBy[Tally[Flatten[Keys@$GOTEpisodeData[[All, "ScreenTime"]]]], Last]][[;;, 1]], "БезПерсонажей"];
In[38]:=
$GOTSeriesInSeason=Association[KeyValueMap[#1->Length@#2&, GroupBy[$GOTEpisodeData[[;;, 1]], First]]];
In[39]:=
$GOTSeasonsMask=KeyValueMap[ConstantArray[#1, #2]&, $GOTSeriesInSeason];
In[40]:=
GOTCharacterBySeason[name_]:=Module[{initialData, empty}, initialData=Map[#[[;;, 2]]&, GroupBy[Cases[{#[[1]], Keys[#[[2]]]}&/@Lookup[$GOTEpisodeData, {"EpisodeN", "ScreenTime"}], {number_, episode_/;
Not[FreeQ[episode, name]]}:>number], First]];
empty=Complement[Range[1, 8], Keys[initialData]];
If[Length[empty]===0, initialData, KeySort@Association[initialData, Association[#->{}&/@empty]]]
]In[41]:=
GOTCharacterBySeasonPlot[name_]:=Flatten@KeyValueMap[ReplacePart[$GOTSeasonsMask[[#1]], Thread[Complement[Range[1, $GOTSeriesInSeason[#1]], #2]->0]]&, GOTCharacterBySeason[name]]
In[42]:=
$GOTSeasonColors={0->White}~Join~Thread[Range[1, 8]->ColorData[54, "ColorList"][[1;;8]]];In[43]:=
GOTInfographicsPoster[#, "100 персонажей \"Игры престолов\", присутствовавших в наибольшем количестве серий", "ImageSize"->2500]&@Grid[{{"Персонаж \\ Сезон и серия", SpanFromLeft, Style["% серий\nс участием\nперсонажа", 12]}~Join~Map[Style["S"<>ToString[#[[1]]]<>"\nE"<>ToString[#[[2]]], 10]&, Keys[$GOTEpisodeN]]}~Join~(({ImageResize[#/.$characterImage, {Automatic, 25}], #, PercentForm[N@Total[Length/@GOTCharacterBySeason[#]]/Last[$GOTEpisodeN]]}~Join~ReplaceAll[GOTCharacterBySeasonPlot[#], x_Integer:>Item["", Background->x/.$GOTSeasonColors]]&/@DeleteCases[$GOTCharacters[[1;;100]], "БезПерсонажей"])), ItemSize->{{2, 10, 5, {1.2}}, {4, {1}}}, Background->White, Dividers->Gray, ItemStyle->Directive[FontFamily -> "Open Sans", 14, Bold, LineSpacing->{0.8, 0, 0}], Alignment->{Center, Center}]Out[43]=
Самые популярные локации Игры престолов
Карта локаций "Игры престолов"
In[44]:=
index=1;
In[45]:=
$GOTLakesIDs={11, 8, 9, 10, 2, 529, 530, 522, 523, 533, 532, 526, 521, 525, 531, 524, 528, 527, 7, 3, 4, 5, 6};In[46]:=
$GOTMapPolygons={FaceForm@If[MemberQ[$GOTLakesIDs, index], LightBlue, LightOrange], EdgeForm[AbsoluteThickness[1]], index++;
Polygon[Accumulate[#]]}&/@GOTRawData["lands-of-ice-and-fire.json"]["arcs"];In[47]:=
$GOTMapPlaces=Lookup[GOTRawData["lands-of-ice-and-fire.json"]["objects"]["places"]["geometries"], {"coordinates", "properties"}];In[48]:=
$GOTMapPlaceCoordinates=Map[#[[2, "name"]]->#[[1]]&, $GOTMapPlaces];
In[49]:=
GOTMap[additinals_, OptionsPattern[{"ImageSize" -> 1500}]] := Legended[Graphics[{$GOTMapPolygons, ({{AbsolutePointSize[10], Black, Point[#1[[1]]], AbsolutePointSize[5], White, Point[#1[[1]]]}, Inset[With[{placeType = #1[[2]]["type"]}, (Framed[#1, Background -> (placeType /. Thread[{"city", "castle", "ruin", "town"} -> (Lighter[RGBColor[#1/255], 0.5] & ) /@ {{254, 92, 7}, {254, 252, 9}, {138, 182, 7}, {2, 130, 237}}]), RoundingRadius -> 6, FrameStyle -> None, FrameMargins -> 2] & )[Style[#1[[2]]["name"], LineSpacing -> {0.8, 0, 0}, FontFamily -> "Open Sans", Bold, 12]]], #1[[1]], If[MemberQ[{"Eastwatch", "The Dreadfort", "White Harbor", "Storm's End", "Ghoyan Drohe", "Qohor"}, #1[[2]]["name"]], Scaled[{-0.1, 1/2}], Scaled[{1.1, 1/2}]]]} & ) /@ $GOTMapPlaces, additinals}, ImageSize -> OptionValue["ImageSize"], Background -> LightBlue, PlotRangePadding -> 0], (Placed[#1, "Bottom"] & )[SwatchLegend[(RGBColor[#1/255] & ) /@ {{254, 92, 7}, {254, 252, 9}, {138, 182, 7}, {2, 130, 237}}, {"city", "castle", "ruin", "town"}, LegendLayout -> "Row"]]]In[50]:=
GOTInfographicsPoster[#, "Карта расположения локаций \"Игры престолов\"", "ImageSize"->1500]&@GOTMap[{}]Out[50]=
Перемещения персонажей "Игры престолов" от серии к серии
In[51]:=
GOTCharacterLocationNamesSequence[name_]:=Merge[$GOTEpisodeData[[;;, "CharacterLocations"]], Identity][name];
In[52]:=
GOTCharacterLocationSequence[name_]:=DeleteCases[Partition[Flatten[DeleteCases[GOTCharacterLocationNamesSequence[name]/.{{x_String, y_String}:>y, {x_String}:>x}/.$GOTMapPlaceCoordinates, _String, Infinity], 1], 2, 1], {x_, x_}];In[53]:=
ClearAll[GOTMapTraectory];
In[54]:=
GOTMapTraectory[path_, colorFunction_:ColorData["Rainbow"]]:=Module[{kol},
kol=Length[path];
Table[{Opacity[0.5], colorFunction[(i-1)/(kol-1)], AbsoluteThickness[10i/kol+1], CapForm["Round"], Arrow[BSplineCurve[{path[[i, 1]], Mean[path[[i]]]+RandomInteger[{5000, 20000}]Function[#/Norm[#]][RandomChoice[{1, 1}]{-1, 1}*Reverse[path[[i, 2]]-path[[i, 1]]]], path[[i, 2]]}]]}, {i, 1, kol}]];In[55]:=
(Print[With[{track = #1, name = #1[[1]]}, (GOTInfographicsPoster[#1, Row[{"Перемещения ", Style[name, Bold], " в \"Игре престолов\"", "\n", Style["(линия перемещения утолщается от начала к концу)", 25]}], "ImageSize" -> 1500] & )[GOTMap[{Arrowheads[{0, 0.01}], (With[{color = #1[[2]]}, GOTMapTraectory[GOTCharacterLocationSequence[name]]] & )[track], Inset[track[[1]] /. $characterCardFull, Scaled[{0.99, 0.99}], Scaled[{1, 1}]]}]]]] & ) /@ ({#1, RGBColor[{200, 42, 102}/255]} & ) /@ $GOTCharacters[[1 ;; 10]];In[56]:=
(Export[FileNameJoin[{NotebookDirectory[], "Перемещения", StringJoin[#1[[1]], ".png"]}], With[{track = #1, name = #1[[1]]}, (GOTInfographicsPoster[#1, Row[{"Перемещения ", Style[name, Bold], " в \"Игре престолов\"", "\n", Style["(линия перемещения утолщается от начала к концу)", 25]}], "ImageSize" -> 1500] & )[GOTMap[{Arrowheads[{0, 0.01}], (With[{color = #1[[2]]}, GOTMapTraectory[GOTCharacterLocationSequence[name]]] & )[track], Inset[track[[1]] /. $characterCardFull, Scaled[{0.99, 0.99}], Scaled[{1, 1}]]}]]]] & ) /@ ({#1, RGBColor[{200, 42, 102}/255]} & ) /@ DeleteCases[$GOTCharacters[[1 ;; 101]], "БезПерсонажей"]Out[56]=
Кто больше всего "путешествовал" из персонажей "Игры престолов"?
In[57]:=
GOTInfographicsPoster[#1, "Кто больше всего \"путешествовал\" в \"Игре престолов\"?", "ImageSize" -> 1500]&@((BarChart[#1[[1 ;; All, 1]], PlotRangePadding->0, BarSpacing -> 0.25, BarOrigin -> Left, AspectRatio -> 1.8, ImageSize -> 1500, ChartLabels -> #1[[1 ;; All, 2]], Frame -> True, GridLines -> {Range[0, 10^6, 10^4], None}, ColorFunction -> ColorData["Rainbow"], FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Длина пути в условных единицах", "Длина пути в условных единицах"}}, Background->GrayLevel[0.95]] & )[Cases[SortBy[({Total[(Norm[Subtract @@ #1] & ) /@ GOTCharacterLocationSequence[#1]], #1 /. $characterCardShortSmall } & ) /@ DeleteCases[$GOTCharacters, Alternatives @@ {"БезПерсонажей", "Musician #1", "Musician #2", "Musician #3"}], First[#1] & ], {x_ /;
x > 0, _}][[-50;;-1]]])Out[57]=
Самые популярные локации "Игры престолов" (по экранному времени)
Данные в виде столбчатой гистограммы:
In[58]:=
GOTInfographicsPoster[#1, "Локации \"Игры престолов\" по экранному времени (вид 1)", "ImageSize" -> 2000]&@(BarChart[#[[;;, 1]], PlotRangePadding->0, BarSpacing->{0.5, 3}, BarOrigin->Left, AspectRatio->1.5, ImageSize->2000, ChartLabels->{#[[;;, 2]], None}, ColorFunction->Function[{x}, If[x>4000, Red, ColorData["Rainbow"][x/4000]]], ColorFunctionScaling->False, PlotRange->{0, 61000}, Frame->True, GridLines->{Range[0, 60000, 1000], None}, GridLinesStyle->LightGray, FrameTicks->{All, Automatic}, FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Экранное время, секунды", "Экранное время, секунды"}}, Background->GrayLevel[0.95]]&@KeyValueMap[{Callout[#[[1]], #[[2]], If[#[[1]]>20000, Bottom, Right], If[#[[1]]>4000, Scaled[1/2], Automatic]]&/@Transpose[{#2[[;;, 2]], #2[[;;, 1]]}], #1}&, SortBy[GroupBy[KeyValueMap[{#1, #2}&, Merge[$GOTEpisodeData[[All, "LocationTime"]], Total[Flatten[#]]&]], #[[1, 1]]&, SortBy[Transpose[{#[[;;, 1]]/.{{x_String, y_String}:>y, {x_String}:>x}, #[[;;, 2]]}]/.{"", _}:>Nothing, Last[#]&]&], Total[#[[;;, 2]]]&]])Out[58]=
Данные в виде круговой парной диаграммы:
In[59]:=
{Print[GOTInfographicsPoster[#1, "Локации \"Игры престолов\" по экранному времени (вид 2)", "ImageSize" -> 1500]&@stripLineInfographics[#, "Reverse"->False, "Gaps"->{75, 50}, "ColorFunctionRight"->ColorData["Rainbow"]]], Print[GOTInfographicsPoster[#1, "Локации \"Игры престолов\" по экранному времени\n(отсортированы по географическим областям)", "ImageSize" -> 1500]&@stripLineInfographics[#, "Reverse"->True, "Gaps"->{50, 75}, "ColorFunctionRight"->ColorData["Rainbow"]]]}&@SortBy[GroupBy[KeyValueMap[{#1, #2}&, Merge[$GOTEpisodeData[[All, "LocationTime"]], Total[Flatten[#]]&]], #[[1, 1]]&, SortBy[Transpose[{#[[;;, 1]]/.{{x_String, y_String}:>y, {x_String}:>x}, #[[;;, 2]]}]/.{"", _}:>Nothing, Last[#]&]&], -Total[#[[;;, 2]]]&];В каких фильмах ещё играли актёры Игры престолов и насколько они знакомы?
In[60]:=
$GOTCharactersInAnotherFilms=SortBy[Map[{#[[1]], #[[2]][[;;, "characterName"]], If[Head[#[[3]]]===Missing, 0, StringCases[#[[3]], DigitCharacter..]/.x_/;
Length[x]>0:>ToExpression[x]]/.{{x_}:>x, {}->0}}&, Lookup[Values[GOTRawData["costars.json"]], {"title", "actors", "year"}]], -Length[#[[2]]]&];In[61]:=
$GOTCharactersFilmography=Association@SortBy[Select[#->SortBy[Cases[$GOTCharactersInAnotherFilms, {film_, list_/;
MemberQ[list, #], year_}:>{film, year}], -Last[#]&]&/@$GOTCharacters, Length[#[[2]]]>0&], -Length[#[[2]]]&];Выясним в фильмах каких годов выпуска играли актёры "Игры престолов":
In[62]:=
GOTInfographicsPoster[#1, "Количество фильмов в зависимости от года выпуска, в которых играли актёры \"Игры престолов\"", "ImageSize" -> 800]&@DateHistogram[DeleteMissing@Lookup[Values[GOTRawData["costars.json"]], "year"], ColorFunction->"Rainbow", ImageSize->800, Background->GrayLevel[0.95]]
Out[62]=
Фильмы, в которых играли самые "востребованные" актёры "Игры престолов":
In[63]:=
GOTInfographicsPoster[#1, "Фильмы в которых играли 20 самых \"востребованных\" актёров \"Игры престолов\"", "ImageSize" -> 1500]&@Grid[{#/.$characterCardFull, TextCell[Grid[KeyValueMap[{#1/.{0->"неизв."}, Row[#2, " - "]}&, GroupBy[#, Last, #[[;;, 1]]&]], Alignment->{{Center, Left}, {Top, Top}}], FontFamily->"Open Sans Light", FontSize->14, TextAlignment->Left, LineSpacing->{0.9, 0, 0}]&@$GOTCharactersFilmography[#]}&/@$GOTCharacters[[1;;20]], Alignment->{{Center, Left}, Center}, ItemSize->{{20, 70}, Automatic}, Background->GrayLevel[0.95], Dividers->{None, {None, {Gray}, None}}]Out[63]=
Актёры "Игры престолов" в "Гарри Поттере"
In[64]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Гарри Поттере\"", "ImageSize"->1500]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), " "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"harry potter"~~___]&], -Last[#]&][[{1, -1, 2, 3, 4, 5, 6, 7}]], Background->GrayLevel[0.95], ItemSize->{{25, 70}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]Out[64]=
Актёры "Игры престолов" в "Звёздных войнах"
In[65]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Звёздных войнах\"", "ImageSize"->1100]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), " "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"star wars"~~___]&], -Last[#]&], Background->GrayLevel[0.95], ItemSize->{{25, 45}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]Out[65]=
Актёры "Игры престолов" в "Пиратах карибского моря"
In[66]:=
GOTInfographicsPoster[#, "Актёры \"Игры престолов\" в \"Пиратах карибского моря\"", "ImageSize"->1300]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), " "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, StringMatchQ[ToLowerCase@#[[1]], ___~~"pirates of the"~~___]&], -Last[#]&], Background->GrayLevel[0.95], ItemSize->{{25, 50}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]Out[66]=
В каких фильмах/сериалах много актёров "Игры престолов"
In[67]:=
GOTInfographicsPoster[#, "Фильмы (сериалы) в которых играет больше всего актёров \"Игры престолов\"", "ImageSize"->2000]&@Grid[{Style[#[[1]], FontFamily->"Open Sans Light", 16, Bold], Row[Magnify[#, 0.75]&/@(#[[2]]/.$characterCardFull), " "]}&/@SortBy[Select[$GOTCharactersInAnotherFilms, Length[#[[2]]]>5&], -Length[#[[2]]]&], Background->GrayLevel[0.95], ItemSize->{{20, 100}, Automatic}, Dividers->{None, {None, {LightGray}, None}}, Alignment->{{Center, Left}, Center}]Out[67]=
Как тесно связаны между собой актёры "Игры престолов"
In[68]:=
GOTInfographicsPoster[#, "Как тесно связаны между собой актёры \"Игры престолов\"", "ImageSize"->2500]&@(ConnectedGraphComponents[GOTGraphPlot[#, 1, "ImageSize"->2500, "MaxThickness"->20]][[1]]&@Tally[UndirectedEdge@@@Map[Sort, Flatten[Map[Subsets[#, {2}]&, Select[Values[GOTRawData["costars.json"]][[;;, "actors", All, "characterName"]], Length[#]>1&]], 1]]])Out[68]=
Разговоры в "Игре престолов"
In[69]:=
GOTInfographicsPoster[#, "Количество слов, сказанных в сериях \"Игры престолов\"", "ImageSize"->1000]&@BarChart[#, BarSpacing->{0.05, 1}, AspectRatio->1/2, ImageSize->1000, ChartLabels->{Keys[#], Range[10]}, ColorFunction->Function[{x}, ColorData["Rainbow"][x]], GridLines->{None, Range[0, 10000, 500]}, FrameLabel->Map[Style[#, FontFamily->"Open Sans", 20, Bold]&, {"Сезон и серия в нём", "Количество сказанных слов"}], Frame->True, Background->GrayLevel[0.95], PlotRangePadding->0, PlotRange->All]&@GroupBy[Map[{#[[1;;2]], Total[#[[3]][[;;, "count"]]]}&, Lookup[GOTRawData["wordcount.json"]["count"], {"seasonNum", "episodeNum", "text"}]], #[[1, 1]]&, #[[;;, 2]]&]Out[69]=
In[70]:=
GOTInfographicsPoster[#1, "Кто больше всего говорит в \"Игре престолов\"?", "ImageSize" -> 1500]&@((BarChart[#1[[1 ;; All, 1]], PlotRangePadding->0, BarSpacing -> 0.25, BarOrigin -> Left, AspectRatio -> 1.9, ImageSize -> 1500, ChartLabels -> #1[[1 ;; All, 2]], Frame -> True, GridLines -> {Range[0, 10^5, 10^3], None}, ColorFunction -> ColorData["Rainbow"], FrameLabel->{{None, None}, Style[#, FontFamily->"Open Sans Light", 16]&/@{"Количество сказанных слов", "Количество сказанных слов"}}, FrameTicks->{Automatic, {All, All}}, Background->GrayLevel[0.95]] & )[KeyValueMap[{#2, #1/.$characterCardShortSmall}&, Select[SortBy[GroupBy[Flatten[GOTRawData["wordcount.json"]["count"][[;;, "text"]]], #[["name"]]&, Total[#[[;;, "count"]]]&], #&], #>1000&]]])Out[70]=
In[71]:=
GOTInfographicsPoster[#1, "Соотношение количества экранного времени и сказанных слов у персонажей \"Игры престолов\"\n(масштаб логарифмический)", "ImageSize" -> 2000]&@Module[{data1, data2, intersection},
data1=Merge[$GOTEpisodeData[[;;, "ScreenTime"]], Total[Flatten[#]]&];
data2=GroupBy[Flatten[GOTRawData["wordcount.json"]["count"][[;;, "text"]]], #[["name"]]&, Total[#[[;;, "count"]]]&];
intersection=Intersection[Keys@data1, Keys@data2];
ListPlot[Callout[{data1[#], data2[#]}, #/.$characterCardShortSmall]&/@intersection, AspectRatio->1, ImageSize->2000, PlotRange->All, ScalingFunctions->{"Log10", "Log10"}, GridLines->{{10, 100}~Join~Range[0, 10^5, 1000], {10, 100}~Join~Range[0, 10^5, 1000]}, Frame->True, FrameTicks->All, FrameLabel->ReplaceAll[{{1, 1}"Количество сказанных слов", {1, 1}"Время на экране, с"}, x_String:>Style[x, FontFamily->"Open Sans", 20, Bold]], Background->GrayLevel[0.95], PlotMarkers->{Automatic, Small}, GridLinesStyle->GrayLevel[0.85]]
]Out[71]=
Вспомогательные функции для инфографики
GOTRawData
Функция импорта данных из JSON в виде ассоциации Association.
In[72]:=
ClearAll[GOTRawData];
In[73]:=
GOTRawData[name_String/;
FileExtension[name]==="json"]:=GOTRawData[name]=Import[FileNameJoin[{NotebookDirectory[], name}], "RawJSON"];circleInfographics, circleInfographicsPositions
circleInfographics создает бабл-диаграмму из кругов, пропорциональных величинам данных, при этом поверх самих кругов можно отображать произвольную информацию.
In[74]:=
ClearAll[circleInfographics, circleInfographicsPositions];
In[75]:=
circleInfographicsPositions[data_, OptionsPattern[{"Precision"->10^-3, "StepDecrease"->N[1-1/100], "MaxSteps"->10000}]]:=
Module[{radii, names, kol, translate, subsets, pos, valValue, colorDataLength, colorData, mean, index, colorScale, tol, mult, shapeF, colorFunction,
xmin, xmax, ymin, ymax},
radii=N[Sqrt[#/Max[#]]]&@data;
kol=Length[radii];
pos=RandomReal[{-10, 10}, {kol, 2}];
translate[{p1_, p2_}, dir_]:=dir Normalize[p2-p1];
subsets=Subsets[Range[kol], {2}];
tol=OptionValue["Precision"];
mult=OptionValue["StepDecrease"];
valValue=1.;
index=1;
While[valValue > tol&&index<OptionValue["MaxSteps"],
mean={0, 0};
pos=pos+Map[Mean, GatherBy[
Thread[{
Flatten[subsets, 1],
Flatten[
Map[If[
Norm[Subtract@@pos[[#]]]>=Total[radii[[#]]],
translate[{#, mean}, valValue]&/@pos[[#]],
With[{delta=(Total[radii[[#]]]-Norm[Subtract@@pos[[#]]])/2}, {translate[pos[[#]], -delta],
translate[Reverse[pos[[#]]], -delta]}]]&, subsets], 1]}], First][[;;, ;;, 2]]];
index++;
valValue=mult*valValue ];
pos];In[76]:=
circleInfographics[data_, OptionsPattern[{"Precision"->10^-3, "StepDecrease"->N[1-1/100], "MaxSteps"->10000, "ShapeFunction"->Disk, "Background"->GrayLevel[0.95], "ColorFunction"->ColorData["TemperatureMap"], "ImageSize"->1000}]]:=Module[{radii, names, kol, pos, colorDataLength, colorData, colorScale, shapeF, colorFunction, xmin, xmax, ymin, ymax},
names=data[[;;, 1]];
radii=N[Sqrt[#/Max[#]]]&@data[[;;, 2]];
kol=Length[radii];
pos=circleInfographicsPositions[data[[;;, 2]], "Precision"->OptionValue["Precision"], "StepDecrease"->OptionValue["StepDecrease"], "MaxSteps"->OptionValue["MaxSteps"]];
colorScale=Evaluate[Rescale[#, MinMax[radii], {0, 1}]]&;
colorFunction=OptionValue["ColorFunction"];
{{xmin, xmax}, {ymin, ymax}}=RegionBounds[RegionUnion[Disk@@#&/@Transpose@{pos, radii}]];
shapeF=Which[OptionValue["ShapeFunction"]===Disk, {{colorFunction[colorScale[#2]], Disk[#1, #2]}, Inset[#3, #1, Scaled[{1/2, 1/2}], 1.75#2]}&,
OptionValue["ShapeFunction"]===Circle,
{{colorFunction[colorScale[#2]], Disk[#1, #2], White, Disk[#1, 0.9#2]}, Inset[#3, #1, Scaled[{1/2, 1/2}], 1.75#2]}&];
Graphics[Array[shapeF[pos[[#]], radii[[#]], names[[#]]]&, kol], ImageSize->{1, 1}OptionValue["ImageSize"], PlotRange->1.05{{xmin, xmax}, {ymin, ymax}}, Background->OptionValue["Background"]]]circleInfographicsPositions$GOTLogo, GOTInfographicsPoster
GOTInfographicsPoster служит для создания стилизованного постера с инфографикой из данной статьи.
In[77]:=
$GOTLogo=ImageResize[Import["https://7kingdoms.ru/wp-content/uploads/2011/01/got-logo.png"], 500];
In[78]:=
ClearAll[GOTInfographicsPoster];
In[79]:=
GOTInfographicsPoster[imageInitial_, title_, OptionsPattern[{"Background"->GrayLevel[0.95], "ImageResolution"->150, "ImageSize"->800}]]:=Module[{image=ImageResize[Rasterize[imageInitial, ImageResolution->OptionValue["ImageResolution"]], OptionValue["ImageSize"]], readyImage},
readyImage=
Image[#, ImageSize->All]&@ImageResize[Rasterize[Framed[Pane[Grid[{{Image[$GOTLogo, ImageSize->{Automatic, 30}], Item[Style[title, FontFamily->"Myriad Pro", 30, LineSpacing->{0.8, 0, 0}, TextAlignment->Center], Alignment->Center]}, {"", ""}, {Image[image, ImageSize->OptionValue["ImageSize"]], SpanFromLeft}, {"", ""}, {Item[Style[Row[{"Вся инфографика по \"Игре престолов\" — wolframmathematica.ru/blog/got\nКороткая ссылка — ", Style["bit.ly/2GNk5Gw", Bold]}], FontFamily->"Myriad Pro", 20, GrayLevel[0.4], TextAlignment->Center]], SpanFromLeft}}, Alignment->{Center, Center}], ImageSize->(ImageDimensions[image]+{0, 100}), ImageSizeAction->"ShrinkToFit"], Background->OptionValue["Background"], FrameMargins->20, FrameStyle->OptionValue["Background"]], ImageResolution->OptionValue["ImageResolution"]], ImageDimensions[image][[1]]];
Export[FileNameJoin[{NotebookDirectory[], "GOTInfographics", StringReplace[StringReplace[StringReplace[ToLowerCase[ToString@title], {"\""->"", ", "->" ", "."->"", "\n"->" ", "("->"", ")"->"", "?"->""}], " "..->" "], " "->"-"]<>".png"}], readyImage];
readyImage];stripLineInfographics
stripLineInfographics служит для создания круговой парной диаграммы.
In[80]:=
ClearAll[stripLineInfographics];
In[81]:=
stripLineInfographics[dataInitial_, OptionsPattern[{"Ordering"->True, "Reverse"->False, "Gaps"->{50, 50}, "ColorFunctionLeft"->ColorData["Rainbow"], "ColorFunctionRight"->Function[Blend[ColorData[3, "ColorList"], #]], "ImageSize"->1500, "Background"->GrayLevel[0.95]}]]:=Module[{circle, zeroElement, countSegmentPartition, ordering, data, totalsForRows, rowsMainSegments, rowsColsSegments, totalForCols, colsMainSegments, colsRowsSegments, segmentMaker, $colorizationMax,
rightLabels, leftLabels, preData, dataOriginal},
If[Head[dataInitial]===Association,
{rightLabels, leftLabels, preData}=Transpose[KeyValueMap[{#1, #2[[;;, 1]], #2[[;;, 2]]}&, dataInitial]];
leftLabels=Flatten@leftLabels;
dataOriginal=Module[{n=Length[Flatten[preData]], k=Length[preData], acc},
acc={0}~Join~Accumulate[Length/@preData];
Transpose@Table[ConstantArray[0, {acc[[i]]}]~Join~preData[[i]]~Join~ConstantArray[0, {n-acc[[i+1]]}], {i, 1, k}]]];
If[OptionValue["Reverse"], {rightLabels, leftLabels}={leftLabels, rightLabels};
dataOriginal=Transpose[dataOriginal], Nothing];
circle[pos_, radius_, {min_, max_}, numberOfCirclePartition_:50]:=If[min==max, zeroElement[pos+radius{Cos[min], Sin[min]}+0{Cos[min], Sin[min]}], Table[pos+radius{Cos[a], Sin[a]}+0{Cos[(min+max)/2], Sin[(min+max)/2]}, {a, min, max, (max-min)/numberOfCirclePartition}]];
countSegmentPartition[data_List, {startOfSegment_, endOfSegment_}, gapPercent_:0]:=Module[
{segmentLength=endOfSegment-startOfSegment, segmentLengh, segments, segmentActialLength, delta},
segmentActialLength=(1-gapPercent/100)segmentLength;
delta=(gapPercent/100) segmentLength/(Length[data]+1);
If[Total[data]==0, ConstantArray[zeroElement[{startOfSegment, endOfSegment}], Length[data]],
segments=N[startOfSegment+segmentActialLength*Partition[Prepend[Accumulate[data], 0], 2, 1]/Total[data]];
(*#+0.01{1, -1}(-Subtract@@#)*gapPercent/2&/@segments*)Map[delta+#&, Table[(i-1)delta+ segments[[i]], {i, 1, Length[data]}]]]
];
ordering=If[OptionValue["Ordering"], Ordering[dataOriginal, All, Total[#1]>Total[#2]&], Range[1, Length[dataOriginal]]];
data=dataOriginal[[ordering]];
totalsForRows=Total/@data;
rowsMainSegments=countSegmentPartition[totalsForRows, {Pi/2, 3Pi/2}, OptionValue["Gaps"][[1]]];
rowsColsSegments=Apply[countSegmentPartition[#1, #2, 0]&, Transpose[{data, rowsMainSegments}], {1}];
totalForCols=Total/@Transpose[data];
colsMainSegments=countSegmentPartition[totalForCols, {Pi/2, -Pi/2}, OptionValue["Gaps"][[2]]];
colsRowsSegments=Apply[countSegmentPartition[#1, #2, 0]&, Transpose[{Transpose@data, colsMainSegments}], {1}];
segmentMaker[{{segmentFirst_, segmentSecond_}, {colorization_}}, colorizationMax_]:=Module[{splineFragmentFirst, splineFragmentSecond},
If[Head[segmentFirst]===zeroElement||Head[segmentSecond]===zeroElement,
Nothing,
{splineFragmentFirst, splineFragmentSecond}=Map[circle[{0, 0}, 1, #]&, {segmentFirst, segmentSecond}];
If[FreeQ[{splineFragmentFirst, splineFragmentSecond}, zeroElement],
{Opacity[0.8], OptionValue["ColorFunctionLeft"][1-(colorization-1)/(colorizationMax-1)](*;
Blend[ColorData[$colorScheme, "ColorList"], (colorization-1)/(colorizationMax-1)]*),
With[{reversedSplineFragmentSecond=Reverse[splineFragmentSecond]},
FilledCurve[BezierCurve[Join[splineFragmentFirst, {Mean[{splineFragmentFirst[[-1]], {0, 0}, reversedSplineFragmentSecond[[1]]}]}, reversedSplineFragmentSecond, {Mean[{reversedSplineFragmentSecond[[-1]], {0, 0}, splineFragmentFirst[[1]]}], splineFragmentFirst[[1]]}], SplineDegree->2]]]}, Nothing]]];
$colorizationMax=Length[rowsColsSegments];
Graphics[{SortBy[MapIndexed[Map[segmentMaker[#, $colorizationMax]&, Outer[Sequence, Transpose[#1], {#2}, 1]]&, Transpose[{rowsColsSegments, Transpose@colsRowsSegments}]], ByteCount],
Table[(circle[{0, 0}, 1, #]&@rowsMainSegments[[i]])/.{zeroElement[point_]:>Point[point], line:{_List..}:>{CapForm["Round"], AbsoluteThickness[5], (*Blend[ColorData[$colorScheme, "ColorList"], (i-1)/($colorizationMax-1)];
*)OptionValue["ColorFunctionLeft"][1-(i-1)/($colorizationMax-1)], Line[line]}}, {i, 1, Length[rowsMainSegments]}],
Table[(circle[{0, 0}, 1, #]&@colsMainSegments[[i]])/.{zeroElement[point_]:>Point[point], line:{_List..}:>{AbsoluteThickness[5], CapForm["Round"], OptionValue["ColorFunctionRight"][1-(i-1)/(Length[colsMainSegments]-1)], Line[line]}}, {i, 1, Length[colsMainSegments]}],
Text[Style[#1, FontFamily->"Open Sans", 14], 1.025{Cos[#], Sin[#]}&[Mean@#2], {1, 0}, {Cos[#+Pi], Sin[#+Pi]}&[Mean@#2]]&@@@Transpose[{leftLabels[[ordering]], rowsMainSegments}],
Text[Style[#1, FontFamily->"Open Sans", 14], 1.025{Cos[#], Sin[#]}&[Mean@#2], {-1, 0}, {Cos[#], Sin[#]}&[Mean@#2]]&@@@Transpose[{rightLabels, colsMainSegments}]
}, ImageSize->OptionValue["ImageSize"], Background->OptionValue["Background"]]]GOTGraphPlot
GOTGraphPlot служит для создания специализированных графов.
In[82]:=
Clear[GOTGraphPlot];
In[83]:=
GOTGraphPlot[data_, minData_, OptionsPattern[{"ImageSize"->1500, "Background"->GrayLevel[0.95], "ColorFunction":>ColorData["Rainbow"], "MaxThickness"->10, "Opacity"->True, "VertexF"->(Function[Tooltip[If[Head[#]===Image, Image[#, ImageSize->60], Style[StringReplace[#, " "->"\n"], LineSpacing->{0.8, 0, 0}, FontFamily->"Open Sans Light", Bold, 12]]&@(#/.$characterImage), #/.$characterCardFull]]), "GraphLayout"->"GravityEmbedding"}]]:=Module[{min, max, rescaleF, normF, clearedData, preGraph, vertexList, edgeList},
clearedData=Select[data, #[[2]]>minData&];
{min, max}=MinMax[clearedData[[;;, 2]]];
rescaleF=Evaluate[Rescale[#, {min, max}, {1, OptionValue["MaxThickness"]}]]&;
normF=Evaluate[Rescale[#, {min, max}, {0, 1}]]&;
preGraph=Graph[clearedData[[;;, 1]]];
vertexList=VertexList[preGraph];
edgeList=EdgeList[preGraph];
Graph[Map[Property[#[[1]], {EdgeStyle->Directive[{AbsoluteThickness[rescaleF[#[[2]]]], If[OptionValue["Opacity"], Opacity[0.3+0.7normF[#[[2]]]], Nothing], OptionValue["ColorFunction"][normF[#[[2]]]], CapForm["Round"]}]}]&, clearedData],
VertexLabels->Map[Rule[#, Placed[OptionValue["VertexF"][#], {1/2, 1/2}]]&, vertexList],
ImageSize->OptionValue["ImageSize"], Background->OptionValue["Background"], GraphLayout->OptionValue["GraphLayout"], AspectRatio->1, VertexShapeFunction->None]];
Оставить комментарий