ソーシャルメディアからの集合のインポートと分析: Wolfram言語 11の新機能

ソーシャルメディアからの集合のインポートと分析

ServiceConnectを使ってFlickrからの画像を集め，Importを使ってインポートして埋め込まれたメタ情報を取得すると，取得した画像についてのさまざまな統計を計算することができる．

In[1]:=

ServiceConnect["Flickr"]

In[2]:=

\!\(\*
GraphicsBox[
TagBox[RasterBox[CompressedData["
1:eJztnd9r2+oZx8V2s8v9C7sX3u2uBL4cGAxnDHzhm2NWHwam8+kxGwZfHII6
KsRK5YtF0FJRiA4loWBvGI+6bo2pW9dM7mrD7LZaqtCIVmqkVmqDKL7Inley
HcWRG8dWcJroC0kt6f3l9/n4ed5fbn6V+NM3yZ9hGPbDL+DXN9/+JXzp0rfZ
3/0SLn5/8Yc/fnfxwh9+ezFz4bsLl36T+Dnc/DX8/Ad+0Ou9QIECnWJZlqXr
+ps3b+RAhwTdAp0DXbRsK50RQU/u7OxAl5qmuRvokKBboHOgiwLkfNH79+8/
fPiwbKuedkEXQUct21ZnQZqmffr0adn2PO2CLoKOWratzoIMw1i2Mb8OQUct
21ZnQQFvMyrgzRcFvM2ogDdfFPA2owLefFHA24wKePNFX+Dtn/7Js3ylxWIu
RehGg46RNVmp5fBM5XB656lvAB1TAW/zaiBssBRFcVVp7yjeND80nTcaw0hR
MzQFSdOMBhnJ1WRD6bf7Hlw5T30D6JhyeLOkOkNRDFuUB8s241cjlYmvdFRd
N1GXLZk3PO+u3iEK/F6KbcFlt0A7ri9Gl7ThU2V3V1vPEERm/d98JpahUziG
kzWf2fLS0L8NTN1Ui9l0VV+yFb8e6WyaHffWUnnLYxieyiClUnRbG/HWIIlc
bVcsAGlsQ9TkVgzD4D48pRtihSSAMNHYbeUjkCDFlvqSdmKU7csdT5tMth7w
NqsQb+rowi/eNjc3X716dXzeYiwP4jiuAAi5eZNrOSxRGNpalmQNAIs57q4g
oZstmsAS6ydAlrcC3ubVifD29OnTy5cv12q1nZ2dmXlD8dTtm9y8iYUMnhsG
Sk0WRcVADi1B51Pg1NYNNH0gcLrhJ1Jf1JG8WaZpWr6P6vQilWaq4tz5J1ol
FimqPK20ReuaVuwivF29evVvXoIJyI+2rl+/PuHovjhfoBXXHTdvWhtmrxF7
fiDlMCxjx1OyYexqDQKyNWTEG3kqeLOkanw0yw4lWdHHgySWEIZC4/w8RQ4k
Nh5yWhXObjjtFagQttL0vy67ug2+7pV3Id5WV1f/7qVr1645vK2trW1vb8/s
3yZ5I23eIsizaSVyGEDxBCeNnkKyfiEDAP7jWuR08GayISxMVXVrYMrCSjxZ
V331cpY5HwDVFei5tKBaplSNYliU68FNgQmHmA567NnGeetCkjcwjDI9HpxU
PL1y5cqTJ08OP5rG20zSNEU7FSvS03nTGQxLbvQmu9nsMcmw83nJ8sLQvFYv
HU7Xe/UV50mUM61OMhStjpZXLHEjHKZkyN3hwDeFQqFwGJyTq/CBWqSSQ18a
p3r6lLqsHrjclfrQzuIGZFmBiw4bBRecjtpJIbvNx9S6PN+CRwNMPj1MFkKC
GngXeIvy1mq1Hj58OHFza2trwq35w9up0RfiqVSmnFDKVzujflbhVpgqQ6qB
LoB5GOeJJTimZsodVYVRKdhhUEQs1B1bwusQZcc7S5clCdKUs6EQJYwJ4FHk
TtdF1dSlIkOVJcu7LhQcw8KoNVaPgyRN0+YNi5Y7sq72ILRi6fJgal2eb8Gz
AXu6qvbKWXgbPSgFJneq28/Nz5uiKDdu3ICgeefOndld35nnDYGii0U2a6OU
FHTHvuA/OI5lYe6dhgvHjjZvjHAg80DkwbAC2E2vQ8KqeqDkDkTAMQNmExjZ
kA7EQu+6HN4sdxrE2348hcIEAIpyN8Vdl3exXg0Ypu+Am2d8jKfPnj0jSfLH
o7S5uXkOeRtJgkFTmBHMDtqqo4r1Zr0Kqjebgqg7vLkxGMnkwliyKPX4KPwz
YUvhEG/lg0B612V1bLCH9pfLwEtW2jvIW3Nlgjd3Xd7FejVgmB7R6ydvY+cG
AvDoKXr9+vW54m0gl8NYdEOQzAHMF5oQbbJVGH9JaScY2eFKFJqyw5jNW/OQ
VfQm44x/uN4kiwd421MZsHeU6qnW3sDqFFleUKfVVUXuNttB84V6HA0VEWYo
noZh0GVZege5rJXq9Lo8i/VsgN0PEswXsCL6WFm66qZ4ofEbzAgAtiCeuucL
VTY9PnUQpcoOTZZcT4bGt+N1Z0aA4qkHb+CB0GgKpg+HHkCMA4fpsl5nJbpf
20ZHn1rXQGZHyzTj9ZAOGw8nk6OEzERgPBC7pxXr1QAneTkbHt3PivslLzpf
AEf34sULH3nT7M16vwHxWUfF04Hptd5r2XcP47WgBpZHsZ51ea9Co/werYKo
G3KzPb1YzwZMSXwi6yHz8Sa3+cj4sxKjuye1EarV+PX+EYUrdCRWU6Y+PsP7
WXUqHs8yTBa5Lc+5wGJalDdVVd+9ewe/d3Z21JHm4U2pEWhvqm1fyHwCwyLc
yRCnkBhROaJoLU9EKueSN7VX51mGYbh6z2smsKgW5e3Ro0f379+/desWjOVu
3rzZbDbv3bs3B29dLoYR+X0LSxWSLgAU/RKN2w4vkuNlYKXNxWIpZ6chxaFz
Sm0uE0ul7DQE10I7DmIljw8T2DsOWpeO2TfwRKm/xSWchzjXVgyxkrAviBSH
cmpt0vawRCJFYJHz6d9OWIvytr29/dNPP92+fbtQKKytrbVarfl4a9C4x4a7
fQyJrnRlsZGCGMt17W1WjG9LcpsDLhrooAj4xUxbVtrgE/G8IpVwDF/vyppU
Ayz5vlZAOVlR01qANEZuSa0MDmT2FcPeii10DU1Em/98v5RxUioNLoUKD3jz
Xz6M38Ct3b17d3V19cGDB8AbvH779i0E2WPyNnHAw1BkRa6RWIx3rpVaDiPY
Lec4HJJM4ijkof3Vin3QV6kQOPnfCokGf2w+z6ITSzj9LxLwE4dlShLykTRh
+y65AqTm8iA2h5L+9c/7KQHFcxpPT1gqm96fd8/H2+PHj58/fw6wSZLU7/fX
bb18+fJYvLXZCAzYxtUbXRbDEq0aiWdKzh3N3tD/3z5vCJshb87BcqUWwclO
CbDM2YfoQOx67VEGRmtDcjSxLxm78pA3qQRBk3WSwq/14vf7KRUH5ll4E9iV
4HzvzDLRGkw6zRTRSadlzk+lEgTKjDNfsAMclilpXQiaeAFNJmXgEadbisu/
efK2hbIkWmg6YPAxcJlbHIERNMoiVSB+5mTIiBNogmq0wauxbURVl0sQ9AOY
HuNkCbpAbuQhnh45frPEcjadjoaSXmtogaZoMLBA9sR3ueshUo3FXeshNghG
LZ8Y3omQXW13dDzpAG/kmDeClt1ZYnnR2NX6pdEyC842JCizlEM32JYCM4tR
fYmKZBhSJTZuABaZYfy233WB5tByeXMsqciyrBxcrTA0RTvm0ogxeXJJU5Qp
781QDlY3y5mn4PuAvmiJ3z/9uhTw5ouC79fPqIA3XxTwNqMC3nxRwNuMCnjz
RQFvMyrgzRcFvM2ogDdfFPA2owLefJFpmsH/F32koIugo5Ztq7Mg6MmPHz8u
256nXdBF0FHLttVZ0OfPnz/aCrycp5zPIwg6atm2OiOCnty1/5CKEeiQnD+7
E8AWKFCgc6j/A6XFfQc=
"], {{0, 47}, {208, 0}}, {0, 255},
ColorFunction->RGBColor],
BoxForm`ImageTag["Byte", ColorSpace -> "RGB", Interleaving -> True],
Selectable->False],
DefaultBaseStyle->"ImageGraphics",
ImageSize->208,
ImageSizeRaw->{208, 47},
PlotRange->{{0, 208}, {0, 47}}]\)

FlickrユーザのアルバムIDを取得する．

In[3]:=

albumIDs = ServiceExecute["Flickr", "UserAlbums", "User" -> username];

IDから実際のアルバムへのリンクを構築する．

In[4]:=

listOfAlbums = Normal@albumIDs[All, "ID"];

アルバム中の全画像へのリンクを作り，Exifメタデータをインポートする．

In[5]:=

links = ServiceExecute["Flickr", "AlbumImages", 
     "AlbumID" -> ToString[#]] & /@ listOfAlbums;

完全なWolfram言語入力を表示する

In[6]:=

urlString = 
  Flatten[Table[
      Options[#[i, "Thumbnail"], MetaInformation][[1, 2, "Source", 
       1]], {i, Range[Length[#]]}] & /@ links];
paths = Quiet[
   Flatten[Block[{constrURL}, 
       constrURL = 
        URLBuild[{"https://www.flickr.com", 
          StringJoin[URLExpand[URLExpand[#]], "sizes/o"]}];
       First[
        Select[Import[constrURL, "ImageLinks"], 
         StringMatchQ[#, "https" ~~ ___ ~~ ".jpg"] &]]] & /@ 
     urlString]];

In[7]:=

exif = Quiet[Import[#, "Exif"] & /@ paths];
exif = Select[exif, MatchQ[#, _Association] &];

一日の内で写真が撮られた時刻の分布を可視化する．

完全なWolfram言語入力を表示する

In[8]:=

times = TimeObject /@ DeleteMissing[Lookup[exif, "DateTime"]];
times = If[# < TimeObject[{7, 0}], DateObject[Tomorrow, #], 
     DateObject[Today, #]] & /@ times;

In[9]:=

DateHistogram[times, {DateObject[Today, TimeObject[{7, 0}]], 
  DateObject[Tomorrow, TimeObject[{7, 0}] - Quantity[1, "Second"]], 
  Quantity[.5, "Hours"]}, "Count", 
 DateTicksFormat -> {"Hour12", " ", "AMPM"}, ImageSize -> 400]

Out[9]=

焦点距離の正規化頻度を時間とともに可視化する．

In[10]:=

Show[Table[
  SmoothHistogram[selectFocal[dateFocal, year], 
   PlotTheme -> "Marketing",
   GridLines -> None, 
   FrameLabel -> {"Focal Length", "Normalized Frequency"}, 
   FrameStyle -> Directive[Gray, Dotted, 12], 
   PlotStyle -> colors[year], PlotLegends -> {year}, 
   ImageSize -> Large, PlotRange -> {0, 0.035}], {year, yrs}], 
 ImageSize -> 400]

Out[11]=

さまざまなExifタグについての可視化のまとめを作る．

完全なWolfram言語入力を表示する

In[12]:=

pieChart[prop_, t_: 80] := With[
  {data = 
    AssociationThread @@ 
     Transpose[
      Tally[SortBy[DeleteMissing[Lookup[exif, prop]], 
        If[StringQ, ToExpression, Identity]]]]},
  Labeled[
   PieChart[Select[data, # > t &], 
    ChartLabels -> Placed[Automatic, "RadialOutside"], 
    PerformanceGoal -> "speed", PlotRange -> All], prop]
  ]
props = Sort@{"ExposureTime", "FNumber", "ExposureProgram", 
    "ISOSpeedRatings", "ApertureValue", "FocalLength", "ExposureMode",
     "WhiteBalance", "MeteringMode"};

In[13]:=

Multicolumn[pieChart /@ props]

Out[13]=

次のグラフィックスは，より複雑ではあるが，時間の経過とともにレンズの使用がどのように変わったのかが分かる．

完全なWolfram言語入力を表示する

In[14]:=

minThreshold = 70;
granularity = {"Year", "Month"};
(*granularity={"Year","Month","Day"};*)
palette = 97;
pairs = Sort@
   DeleteMissing[Lookup[exif, {"DateTime", "LensModel"}], 1, 2];
common = Select[Tally[pairs[[All, 2]]], Last[#] > minThreshold &][[
   All, 1]];
models = GroupBy[
   Select[pairs, 
    MemberQ[common, 
      Last[#]] &], (DateValue[First[#], granularity] &) -> Last, 
   Rule @@@ Tally[#] &];
data = Accumulate@*(Normalize[#, Total] &) /@ (Map[
       Replace[common, #, 1] &, Values@models] /. 
      Thread[common -> 0]) // N;
legend = SwatchLegend[ColorData[palette] /@ Range[Length[common]], 
   common, LegendLayout -> "Row"];
filling = 
  Prepend[Most[
    Thread[RotateLeft[
       Range[Length[common]]] -> ({{#}, ColorData[palette][# + 1]} & /@
         Range[Length[common]])]], 1 -> {0, ColorData[palette][1]}];
Legended[DateListPlot[TemporalData[Transpose[data], {Keys[models]}], 
  Joined -> True, Filling -> filling, AspectRatio -> 1/5, 
  PlotStyle -> Transparent, 
  FrameTicks -> {{None, None}, {None, All}},
  LabelStyle -> Directive[GrayLevel[0, 1], FontFamily -> "Helvetica"],
   PlotRangePadding -> None, ImageSize -> 550, 
  PlotLabel -> "Fraction of pictures by lens model"], 
 Placed[legend, Bottom]]

Out[14]=

Wolfram言語™

ソーシャルメディアからの集合のインポートと分析

関連する例