Wolfram Language

Acceso enriquecido a la base de conocimiento

Explore la cinematografía

Utilice Wolfram Knowledgebase para estudiar el costo por minuto y los recibos de taquilla para las películas lanzadas desde el año 2000. Además, explore el tiempo de proyección promedio de estas películas, que, de manera inusual entre los objetos hechos por el hombre, parece seguir la denominada ley de distribución estable.

Utilice una clase de entidades implícitamente definida para seleccionar las películas lanzadas desde el cambio de milenio.

In[1]:=
Click for copyable input
Length[movies = EntityClass["Movie", EntityProperty["Movie", "ReleaseDate"] -> Between[{DateObject[{2000}], DateObject[{2015}]}]] // EntityList]
Out[1]=

Recupere los títulos de película, los géneros, tiempos de proyección, presupuestos de producción y totales de taquilla.

In[2]:=
Click for copyable input
movieData = EntityValue[ movies, {EntityProperty["Movie", "Name"], EntityProperty["Movie", "Genres"], EntityProperty["Movie", "Runtime"], EntityProperty["Movie", "ReleaseDate"], EntityProperty["Movie", "ProductionBudget"], EntityProperty["Movie", "DomesticBoxOfficeGross"]}];

El costo por minuto de una película estrenada es una función altamente fluctuante en el tiempo.

muestre la entrada completa de Wolfram Language
In[3]:=
Click for copyable input
costPerMinute = TimeSeries[{#[[1, 4]], Mean[#5/#3 & @@@ #]} & /@ Split[SortBy[ Cases[movieData, {_, _, _Quantity, _DateObject, _Quantity, _}], \ #[[4]] &], #1[[4]] === #2[[4]] &]];
In[4]:=
Click for copyable input
DateListLogPlot[costPerMinute, FrameLabel -> Automatic, PlotLabel -> "average cost per minute", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}]
Out[4]=

Sin embargo, promediado en un mes, algunas periodicidades del costo por minuto son visibles. En particular, las líneas verdes denotan el Cuatro de Julio y las líneas en morado denotan el Día de Acción de Gracias en el siguiente gráfico.

muestre la entrada completa de Wolfram Language
In[5]:=
Click for copyable input
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]=

Como se muestra en el gráfico logarítmico, los recibos de taquilla por minuto constituyen una función aún más fluctuante.

muestre la entrada completa de Wolfram Language
In[6]:=
Click for copyable input
profitPerMinute = TimeSeries[{#[[1, 4]], Mean[#6/#3 & @@@ #]} & /@ Split[SortBy[ Cases[movieData, {_, _, _Quantity, _DateObject, _, _Quantity}], \ #[[4]] &], #1[[4]] === #2[[4]] &]];
In[7]:=
Click for copyable input
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]=

El promedio de proyección de las películas ha sido bastante constante en los últimos 15 años.

muestre la entrada completa de Wolfram Language
In[8]:=
Click for copyable input
averageRuntimes = {#[[1, 1]], Mean[#[[All, -1]]]} & /@ Split[Sort[{DateObject[{#4["Year"]}], UnitConvert[#3, "Minutes"]} & @@@ Cases[movieData, {_, _, _Quantity, _DateObject, _, _}]], #1[[ 1]] === #2[[1]] &];
In[9]:=
Click for copyable input
DateListPlot[averageRuntimes, FrameLabel -> Automatic, PlotLabel -> "average runtime", AxesOrigin -> {DateObject[{2000, 1, 1}], 0}]
Out[9]=

Viendo con más detalle, la distribución de las proyecciones de películas parece ser relativamente suave.

In[10]:=
Click for copyable input
movieRuntimes = DeleteMissing[movieData[[All, 3]]];
In[11]:=
Click for copyable input
hg = Histogram[movieRuntimes, {1, 200, 5}, "PDF", AxesLabel -> Automatic]
Out[11]=

El modelado usando un gran número de distribuciones incorporadas indica que el ajuste más cercano es proporcionado por la distribución estable de Lévy. Aquí, se calcula el ajuste usando una normal (distribución de los promedios de variables aleatorias tomadas independientemente de distribuciones independientes), lognormal (la distribución del producto multiplicativo de muchas variables aleatorias positivas independientes), y una distribución estable.

In[12]:=
Click for copyable input
edNormal = EstimatedDistribution[movieRuntimes, NormalDistribution[\[Mu], \[Sigma]]]
Out[12]=
In[13]:=
Click for copyable input
edLogNormal = EstimatedDistribution[movieRuntimes, LogNormalDistribution[\[Mu], \[Sigma]]]
Out[13]=
In[14]:=
Click for copyable input
edStable = EstimatedDistribution[movieRuntimes, StableDistribution[1, \[Alpha], \[Beta], \[Mu], \[Sigma]]]
Out[14]=

Curiosamente, la distribución estable es visualmente la que mejor se ajusta.

muestre la entrada completa de Wolfram Language
In[15]:=
Click for copyable input
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]=

Sólo muy pocos objetos hechos por el hombre obedecen a una distribución estable. Una característica de una distribución estable es la ocurrencia de valores atípicos relativamente grandes, usualmente varias veces mayores que la media. Esta característica se cumple en las películas. Aquí, una clase de entidades implícitamente definida es utilizada para seleccionar las 10 películas más largas (por tiempo de proyección) estrenadas después del 1 de enero de 2000.

In[16]:=
Click for copyable input
longest = EntityClass[ "Movie", {EntityProperty["Movie", "ReleaseDate"] -> Between[{DateObject[{2000}], DateObject[{2015}]}], EntityProperty["Movie", "Runtime"] -> TakeLargest[10]}] // EntityList
Out[16]=

Resúmalo en una retícula.

muestre la entrada completa de Wolfram Language
In[17]:=
Click for copyable input
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=

Ejemplos relacionados

de en ja ko pt-br ru zh