Wolfram言語

計算写真学

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

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

In[1]:=
Click for copyable input
ServiceConnect["Flickr"]
In[2]:=
Click for copyable input
\!\(\* 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]:=
Click for copyable input
albumIDs = ServiceExecute["Flickr", "UserAlbums", "User" -> username];

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

In[4]:=
Click for copyable input
listOfAlbums = Normal@albumIDs[All, "ID"];

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

In[5]:=
Click for copyable input
links = ServiceExecute["Flickr", "AlbumImages", "AlbumID" -> ToString[#]] & /@ listOfAlbums;
完全なWolfram言語入力を表示する
In[6]:=
Click for copyable input
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]:=
Click for copyable input
exif = Quiet[Import[#, "Exif"] & /@ paths]; exif = Select[exif, MatchQ[#, _Association] &];

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

完全なWolfram言語入力を表示する
In[8]:=
Click for copyable input
times = TimeObject /@ DeleteMissing[Lookup[exif, "DateTime"]]; times = If[# < TimeObject[{7, 0}], DateObject[Tomorrow, #], DateObject[Today, #]] & /@ times;
In[9]:=
Click for copyable input
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]:=
Click for copyable input
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]:=
Click for copyable input
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]:=
Click for copyable input
Multicolumn[pieChart /@ props]
Out[13]=

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

完全なWolfram言語入力を表示する
In[14]:=
Click for copyable input
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]=

関連する例

de en es fr ko pt-br ru zh