Wolfram Language™

Explorez la filmologie

Utilisez la base de connaissances de Wolfram pour étudier le coût par minute et les recettes des films sortis depuis l'an 2000. En outre, explorez la durée moyenne de ces films qui, de manière inhabituelle parmi les objets fabriqués par l'homme, semble suivre une loi de distribution dite stable.

Utilisez une classe d'entités implicitement définie pour sélectionner les films sortis depuis le début du millénaire.

In[1]:=

Length[movies = EntityClass["Movie", EntityProperty["Movie", "ReleaseDate"] -> Between[{DateObject[{2000}], DateObject[{2015}]}]] // EntityList]

Out[1]=

Récupérez les titres, les genres, les durées d'exploitation, les budgets de production et les recettes totales des films.

In[2]:=

movieData = EntityValue[ movies, {EntityProperty["Movie", "Name"], EntityProperty["Movie", "Genres"], EntityProperty["Movie", "Runtime"], EntityProperty["Movie", "ReleaseDate"], EntityProperty["Movie", "ProductionBudget"], EntityProperty["Movie", "DomesticBoxOfficeGross"]}];

Le coût par minute d'un film diffusé est une fonction très fluctuante dans le temps.

In[3]:=

costPerMinute = TimeSeries[{#[[1, 4]], Mean[#5/#3 & @@@ #]} & /@ Split[SortBy[ Cases[movieData, {_, _, _Quantity, _DateObject, _Quantity, _}], \ #[[4]] &], #1[[4]] === #2[[4]] &]];

In[4]:=

DateListLogPlot[costPerMinute, FrameLabel -> Automatic, PlotLabel -> "average cost per minute", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}]

Out[4]=

Toutefois, si l'on fait la moyenne sur un mois, certaines périodicités du coût par minute deviennent visibles. En particulier, les lignes vertes de la grille indiquent le 4 juillet et les lignes violettes Thanksgiving dans le tracé suivant.

In[5]:=

DateListPlot[MovingAverage[costPerMinute, Quantity[1, "Months"]], FrameLabel -> Automatic, PlotLabel -> "average cost per minute", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}, GridLines -> {Join[{#, Darker[Green]} & /@ Table[DateObject[{y, 7, 4}], {y, 2000, 2015}], {#, Darker[Purple]} & /@ Table[DateObject@ WolframAlpha[ "Thanksgiving " <> IntegerString[y], {{"Result", 1}, "ComputableData"}], {y, 2000, 2015}]], None}]

Out[5]=

Comme le montre le tracé logarithmique suivant, les recettes au box-office par minute sont une fonction encore plus fluctuante.

In[6]:=

profitPerMinute = TimeSeries[{#[[1, 4]], Mean[#6/#3 & @@@ #]} & /@ Split[SortBy[ Cases[movieData, {_, _, _Quantity, _DateObject, _, _Quantity}], \ #[[4]] &], #1[[4]] === #2[[4]] &]];

In[7]:=

DateListLogPlot[MovingAverage[profitPerMinute, Quantity[1, "Months"]], FrameLabel -> Automatic, PlotLabel -> "box office receipts per film minute", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}, PlotRange -> {{DateObject[{2000, 1, 1}], DateObject[{2015, 12, 31}]}, All}]

Out[7]=

La durée moyenne des films a été relativement constante au cours des 15 dernières années.

In[8]:=

averageRuntimes = {#[[1, 1]], Mean[#[[All, -1]]]} & /@ Split[Sort[{DateObject[{#4["Year"]}], UnitConvert[#3, "Minutes"]} & @@@ Cases[movieData, {_, _, _Quantity, _DateObject, _, _}]], #1[[ 1]] === #2[[1]] &];

In[9]:=

DateListPlot[averageRuntimes, FrameLabel -> Automatic, PlotLabel -> "average runtime", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}]

Out[9]=

Si l'on regarde plus en détail, la répartition des durées d'exploitation des films semble relativement lisse.

In[10]:=

movieRuntimes = DeleteMissing[movieData[[All, 3]]];

In[11]:=

hg = Histogram[movieRuntimes, {1, 200, 5}, "PDF", AxesLabel -> Automatic]

Out[11]=

La modélisation à l'aide d'un grand nombre de lois intégrées indique que l'ajustement le plus proche est fourni par une loi stable de Lévy. Ici, les ajustements utilisant une loi normale (distribution des moyennes de variables aléatoires tirées indépendamment de distributions indépendantes), une loi log-normale (distribution du produit multiplicatif de nombreuses variables aléatoires positives indépendantes) et une loi stable sont calculés.

In[12]:=

edNormal = EstimatedDistribution[movieRuntimes, NormalDistribution[\[Mu], \[Sigma]]]

Out[12]=

In[13]:=

edLogNormal = EstimatedDistribution[movieRuntimes, LogNormalDistribution[\[Mu], \[Sigma]]]

Out[13]=

In[14]:=

edStable = EstimatedDistribution[movieRuntimes, StableDistribution[1, \[Alpha], \[Beta], \[Mu], \[Sigma]]]

Out[14]=

Il est intéressant de constater que la loi stable est visuellement la mieux adaptée.

In[15]:=

Show[{hg, ListLinePlot[ Table[{x, #}, {x, Quantity[0, "Minutes"], Quantity[200, "Minutes"], Quantity[1, "Minutes"]}] & /@ {PDF[edNormal, x], PDF[edLogNormal, x], PDF[edStable, x]}, PlotLegends -> {"normal", "lognormal", "stable"}, Filling -> Axis, PlotRange -> All]}]

Out[15]=

Seuls quelques objets fabriqués par l'homme obéissent à une loi stable. L'une des caractéristiques d'une loi stable est l'apparition de valeurs aberrantes relativement importantes, souvent quelques fois plus grandes que la moyenne. Les films répondent à cette caractéristique. Ici, une classe d'entités implicitement définie est utilisée pour sélectionner les 10 films les plus longs (en termes de durée) sortis après le 1^er janvier 2000.

In[16]:=

longest = EntityClass[ "Movie", {EntityProperty["Movie", "ReleaseDate"] -> Between[{DateObject[{2000}], DateObject[{2015}]}], EntityProperty["Movie", "Runtime"] -> TakeLargest[10]}] // EntityList

Out[16]=

Résumez dans une grille.

In[17]:=

With[{props = {EntityProperty["Movie", "Name"], EntityProperty["Movie", "Genres"], EntityProperty["Movie", "Runtime"], EntityProperty["Movie", "ReleaseDate"]}}, TextGrid[Prepend[EntityValue[longest, props], props], Dividers -> All, Alignment -> Left, Background -> {None, {LightBlue}}]] // TraditionalForm

Out[17]//TraditionalForm=