Visualización de datos con Plotly

library(ggplot2)
library(tidyr)
library(quantmod)

## Loading required package: xts

## Loading required package: zoo

## 
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

## Loading required package: TTR

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

Visualizaciones Interactivas

Iniciamos generando los datos

1. Basics

set.seed(123)
arr_1 <- matrix(rnorm(200), nrow = 50, ncol = 4) 
colnames(arr_1) <- c('A', 'B', 'C', 'D')
df_1 <- as.data.frame(arr_1) 
head(df_1) 

##             A           B           C          D
## 1 -0.56047565  0.25331851 -0.71040656  0.7877388
## 2 -0.23017749 -0.02854676  0.25688371  0.7690422
## 3  1.55870831 -0.04287046 -0.24669188  0.3322026
## 4  0.07050839  1.36860228 -0.34754260 -1.0083766
## 5  0.12928774 -0.22577099 -0.95161857 -0.1194526
## 6  1.71506499  1.51647060 -0.04502772 -0.2803953

2. Line Plot

df_1_long <- pivot_longer(df_1, cols = c('A', 'B', 'C', 'D'), names_to = "Variable", values_to = "Valor")

df_1_long$Index <- rep(1:nrow(df_1), times = 4)

ggplot(data = df_1_long, aes(x = Index, y = Valor, color = Variable)) +
  geom_line() +
  theme_minimal() +
  labs(x = "indice de fila", y = "Valor", title = "grafico de lineas") +
  scale_color_manual(values = c("A" = "red", "B" = "blue", "C" = "green", "D" = "purple"))

Todas las variables muestran cambios significativos a lo largo del gráfico, lo que sugiere alta volatilidad o variabilidad en los datos.Además, las variables se mueven entre valores aproximados de -2 a 2. Las líneas se cruzan entre sí en varios puntos, lo que indica que el valor de las variables cambia con respecto a las demás en diferentes momentos.Por útlimo, no se observa una tendencia clara para ninguna de las variables que sugiera un comportamiento constante o predecible a lo largo del tiempo.

Ahora, carguemos unos datos de varias acciones.

library(readr)
stocks <- read_csv("C:/Users/USUARIO/Downloads/stocks.csv")

## Rows: 105 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl  (6): GOOG, AAPL, AMZN, FB, NFLX, MSFT
## date (1): date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

head(stocks)

## # A tibble: 6 × 7
##   date        GOOG  AAPL  AMZN    FB  NFLX  MSFT
##   <date>     <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2018-01-01 1     1      1    1      1     1   
## 2 2018-01-08 1.02  1.01   1.06 0.960  1.05  1.02
## 3 2018-01-15 1.03  1.02   1.05 0.970  1.05  1.02
## 4 2018-01-22 1.07  0.980  1.14 1.02   1.31  1.07
## 5 2018-01-29 1.01  0.917  1.16 1.02   1.27  1.04
## 6 2018-02-05 0.942 0.894  1.09 0.943  1.19  1.00

library(plotly)

p <- plot_ly(data = stocks, x = ~date, y = ~AMZN, type = 'scatter', mode = 'lines',
             line = list(color = 'blue')) %>%
  layout(title = 'Amazon Stock Prices Over Time',
         xaxis = list(title = 'Date'),
         yaxis = list(title = 'Price'))
p

El gráfico muestra fluctuaciones significativas en el precio de la acción de Amazon. Se observa un pico notable donde el precio alcanza su máximo en agosto 2018 antes de una caída aguda. Por otro lado, note que después de caídas pronunciadas, el gráfico muestra recuperaciones.

fig2 <- plot_ly(data = stocks) %>%
  add_trace(x = ~date, y = ~AAPL, mode = 'lines', name = 'Apple') %>%
  add_trace(x = ~date, y = ~AMZN, mode = 'lines+markers', name = 'Amazon') %>%
  add_trace(x = ~date, y = ~FB, mode = 'lines+markers', name = 'Facebook') %>%
  add_trace(x = ~date, y = ~GOOG, mode = 'lines+markers', name = 'Google',
            line = list(color = 'firebrick', width = 2, dash = 'dashdot')) %>%
  layout(title = 'Stock Price data',
         xaxis = list(title = 'Date'),
         yaxis = list(title = 'Price'))

fig2

## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

Todas las empresas muestran volatilidad en sus precios de acciones, con varios picos y caídas. Apple y Amazon muestran un aumento significativo en los precios de sus acciones hacia el final del gráfico, mientras que Google y Facebook muestran un crecimiento más estable o moderado.En varios puntos, las líneas se cruzan, lo que indica cambios en el desempeño relativo de las acciones. Por ejemplo, hay momentos en los que Facebook supera a Google o viceversa.

3. Style Grids

fig2 <- plot_ly(data = stocks) %>%
  add_trace(x = ~date, y = ~AAPL, mode = 'lines', name = 'Apple') %>%
  add_trace(x = ~date, y = ~AMZN, mode = 'lines+markers', name = 'Amazon') %>%
  add_trace(x = ~date, y = ~FB, mode = 'lines+markers', name = 'Facebook') %>%
  add_trace(x = ~date, y = ~GOOG, mode = 'lines+markers', name = 'Google',
            line = list(color = 'firebrick', width = 2, dash = 'dashdot')) %>%
  layout(
    title = 'Stock Price data',
    xaxis = list(
      showline = TRUE, 
      showgrid = FALSE, 
      showticklabels = TRUE,
      linecolor = 'rgb(204, 204, 204)',
      linewidth = 2, 
      ticks = 'outside',
      tickfont = list(family = 'Arial', size = 12, color = 'rgb(82, 82, 82)')
    ),
    yaxis = list(
      showgrid = FALSE, 
      zeroline = FALSE, 
      showline = FALSE, 
      showticklabels = FALSE
    ),
    autosize = FALSE,
    margin = list(
      autoexpand = FALSE, 
      l = 100, 
      r = 100, 
      t = 100
    ),
    showlegend = FALSE,
    plot_bgcolor = 'white'
  )

fig2

## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

Este gráfico es similar anterior, en este se cambia el estilo del fondo del gráfico y los ejes.

4. Bar Chart

library(gapminder)

df_us <- gapminder[gapminder$country == 'Pakistan',]

fig <- plot_ly(data = df_us, x = ~year, y = ~pop, type = 'bar',
               marker = list(color = 'blue')) %>%
  layout(title = 'Population of Pakistan Over Time',
         xaxis = list(title = 'Year'),
         yaxis = list(title = 'Population'))

# Mostrar el gráfico
fig

El gráfico de barras muestra el crecimiento de la población de Pakistán a lo largo del tiempo.Se observa un aumento constante de la población a medida que pasan los años. La población crece desde 41 millones a más de 160 millones. Este patrón de crecimiento sugiere una tasa de crecimiento poblacional significativa.

df_tips <- read_csv("C:/Users/USUARIO/Downloads/tips.csv")

## Rows: 244 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sex, smoker, day, time
## dbl (3): total_bill, tip, size
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

fig <- plot_ly(data = df_tips, x = ~day, y = ~tip, type = 'bar', color = ~sex,
               colors = c('pink', 'lightblue')) %>%
  layout(title = list(text = 'Tips by Sex on Each Day'),
         xaxis = list(title = 'Day of the Week'),
         yaxis = list(title = 'Tip Amount'))
fig

En cada día mostrado, los hombres parecen dar más propinas que las mujeres. Además, el domingo es el día con las propinas más altas por parte de los hombres, mientras que el sábado lo es para las mujeres. El jueves y el viernes tienen las cantidades más bajas de propinas tanto para hombres como para mujeres.Sin embargo, se observa un notable aumento en las propinas el domingo, especialmente de los hombres, en comparación con otros días.

fig <- plot_ly(data = df_tips, x = ~sex, y = ~total_bill, color = ~smoker, type = 'bar',
               colors = c('blue', 'orange')) %>%
  layout(title = 'Total Bill by Sex and Smoker Status',
         xaxis = list(title = 'Sex'),
         yaxis = list(title = 'Total Bill'),
         barmode = 'group')

fig

La cantidad total de la cuenta acumulada es significativamente más alta para los hombres que para las mujeres en ambos grupos de respuesta (Sí y No). Tanto para los hombres como para las mujeres, la cuenta total es menor para los fumadores.Existe una clara disparidad en el total de la cuenta entre hombres y mujeres.

library(dplyr)

## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:xts':
## 
##     first, last

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(RColorBrewer)

df_asia <- gapminder %>% 
  filter(continent == "Asia", year == 2007, pop > 2e6) %>%
  arrange(desc(pop))

fig <- plot_ly(df_asia, x = ~country, y = ~pop, type = 'bar',
               color = ~country, 
               colors = RColorBrewer::brewer.pal(nlevels(df_asia$country), "Paired")) %>%
  layout(title = "Population of Asian Countries in 2007",
         xaxis = list(title = "Country"),
         yaxis = list(title = "Population"),
         showlegend = FALSE)


fig

Las barras más altas corresponden a China e India, indicando que sus poblaciones son las más altas entre los países listados, superando ampliamente los mil millones de personas. Otros países tienen poblaciones significativamente menores, como se muestra en las barras mucho más cortas.

fig <- plot_ly(df_asia, x = ~country, y = ~pop, type = 'bar',
               color = ~country, 
               colors = RColorBrewer::brewer.pal(nlevels(df_asia$country), "Paired")) %>%
  layout(title = "Population of Asian Countries in 2007",
         xaxis = list(title = "Country", tickangle = -45),
         yaxis = list(title = "Population"),
         showlegend = FALSE) 


fig <- fig %>% layout(uniformtext = list(minsize = 8))

fig

Este gráfico es similar al anterior, lo que cambia es la orientación de los nombres de los países.

5. Scatter Plot

data(iris)
head(iris)

##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

fig <- plot_ly(data = iris, x = ~Sepal.Width, y = ~Sepal.Length,
               type = 'scatter', mode = 'markers',
               color = ~Species, size = ~Petal.Length,
               hoverinfo = 'text',
               text = ~paste('Petal Width:', Petal.Width))
fig

Iris setosa (en azul) tiende a tener una anchura de sépalo mayor con una longitud de sépalo más corta comparada con las otras dos especies. Iris versicolor (en naranja) está distribuido más centralmente en el gráfico, indicando un rango intermedio tanto en la anchura como en la longitud del sépalo. Iris virginica (en verde) tiende a tener una longitud de sépalo mayor, y se distribuye más hacia la derecha del gráfico, indicando una anchura de sépalo generalmente más estrecha en comparación con setosa pero similar o ligeramente mayor que versicolor.

fig <- plot_ly(data = iris, x = ~Sepal.Width, y = ~Sepal.Length,
               type = 'scatter', mode = 'markers',
               marker = list(color = ~Sepal.Width,
                             size = 10,
                             line = list(color = 'black', width = 2),
                             showscale = TRUE),
               text = ~Species)

fig

No se observa una relación lineal entre el ancho y el largo del sépalo.

set.seed(123)
x <- rnorm(100000)
y <- rnorm(100000)
color <- rnorm(100000)

fig <- plot_ly(x = x, y = y, type = 'scattergl', mode = 'markers',
               marker = list(color = color,
                             colorscale = 'Viridis',
                             line = list(width = 1)))

fig

No se observa una relación entre los datos. La mayoría de los datos se concentran alrededor del 0.

6. Pie Charts

df_asia <- gapminder %>% 
  filter(year == 2007, continent == 'Asia')

fig <- plot_ly(df_asia, labels = ~country, values = ~pop, type = 'pie',
               textinfo = 'label+percent', insidetextorientation = 'radial',
               title = 'Population of Asian continent',
               marker = list(colors = RColorBrewer::brewer.pal(11, "RdBu")))
fig

Se observa que la mayoría de la población de Asia se concentra en China con un 34.6% e Indonesia con un 5.86%.

labels <- c('Water', 'Grass', 'Normal', 'Psychic', 'Fire', 'Ground')
values <- c(110, 90, 80, 80, 70, 60)

colors <- c('blue', 'green', 'black', 'purple', 'red', 'brown')

fig <- plot_ly(labels = labels, values = values, type = 'pie',
               hoverinfo = 'label+percent', textinfo = 'label+percent',
               marker = list(colors = colors,
                             line = list(color = '#FFFFFF', width = 2)),
               pull = c(0.1, 0, 0.2, 0, 0, 0))

fig <- fig %>% layout(font = list(size = 20))

fig

El gráfico muestra que el tipo Agua es el más común, seguido por el tipo Planta, mientras que el tipo Tierra es el menos común de los que se muestran.

7. Histograms

set.seed(123) 
dice_1 <- sample(1:6, 5000, replace = TRUE)
dice_2 <- sample(1:6, 5000, replace = TRUE)
dice_sum <- dice_1 + dice_2

hist_trace <- plot_ly(x = dice_sum, type = 'histogram',
                      marker = list(color = 'blue'),
                      nbinsx = 11, name = 'Dice Sum')

violin_trace <- plot_ly(y = dice_sum, type = 'violin',
                        marker = list(color = 'blue'),
                        box = list(visible = T),
                        meanline = list(visible = T),
                        name = 'Density',
                        spanmode = 'hard')

fig <- subplot(violin_trace, hist_trace, nrows = 2, margin = 0.05)

fig <- fig %>% layout(title = '5000 Dice Roll Histogram',
                      showlegend = FALSE,
                      xaxis = list(title = "Dice Roll"),
                      xaxis2 = list(title = ""),
                      yaxis = list(title = "Dice Sum"),
                      yaxis2 = list(title = ""))

fig

El diagrama de violín muestra que los datos tienen una distribución uniforme, y la caja es simétrica. El histograma muestra que la suma más frecuente es 7 y la menos frecuente es 12. La distribución de los datos es simétrica y no se observan datos atípicos.

fig <- plot_ly(data = df_tips, x = ~total_bill, color = ~sex, type = 'histogram') %>%
  layout(title = 'Histogram of Total Bills by Sex',
         xaxis = list(title = 'Total Bill'),
         yaxis = list(title = 'Count'),
         barmode = 'stack',
         barnorm = '',
         marker = list(line = list(color = 'rgba(255, 255, 255, 0)', width = 0))) 
fig

Se observa que la mayoría de las cuentas para ambos sexos se encuentran en el rango de 10 a 20 unidades. Los hombres tienen una mayor frecuencua de cuentas en casi todos los rangos de precios, especialmente en el rango de 10 a 20, donde la frecuencia es la más alta para ambos sexos. Además, la distribución para los hombres es más ancha, lo que sugiere que hay más variabilidad en las cantidades de sus cuentas en comparación con las de las mujeres. Las cuentas de las mujeres parecen estar más concentradas en los rangos inferiores de precio.También es notable que hay muy pocas cuentas (para ambos sexos) que superan las 40 unidades monetarias.

8. Box Plots

fig <- plot_ly(data = df_tips, x = ~sex, y = ~tip, type = 'box',
               boxpoints = 'all') %>%
  layout(title = 'Tip Distribution by Sex',
         xaxis = list(title = 'Sex'),
         yaxis = list(title = 'Tip'))

fig

Para las propinas dadas por las mujeres, la mediana parece estar justo por encima de 2 unidades monetarias. La caja es relativamente pequeña, lo que indica que la mitad de los datos está bastante agrupada.Para las propinas dadas por los hombres, la mediana también está un poco más arriba de 2, similar a la de las mujeres. Sin embargo, la caja es más larga, indicando una mayor variabilidad en las propinas dadas por los hombres. Se observan un mayor número de datos atípicos en los hombres que en las mujeres.

Por otro lado, los hombres tienen una variabilidad más alta en las cantidades de propinas dadas. También se observa que aunque la mediana es similar, los hombres parecen dar propinas más altas con más frecuencia, como lo sugieren los valores atípicos en el extremo superior del rango de los hombres.

fig <- plot_ly(data = df_tips, x = ~day, y = ~tip, color = ~sex, type = 'box') %>%
  layout(title = 'Tip Distribution by Day and Sex',
         xaxis = list(title = 'Day'),
         yaxis = list(title = 'Tip'),
         boxmode = 'group')

fig

Los hombres tienen una mayor variabilidad en la cantidad de propina que dejan en comparación con las mujeres, independientemente del día de la semana. También se observa que los valores atípicos tienden a ser más altos en las propinas de los hombres, lo que podría indicar una tendencia a dar propinas más generosas o variaciones más grandes en las cantidades de las cuentas.

fig <- plot_ly(data = df_tips, x = ~sex, y = ~tip, type = 'box') %>%
  add_trace(y = ~tip, x = ~sex, 
            marker = list(color = 'blue'),
            boxmean = 'sd', 
            name = 'Tip',
            text = 'Tip')

fig <- fig %>% layout(title = 'Tip Box Plot with Standard Deviation and Mean',
                      xaxis = list(title = 'Sex'),
                      yaxis = list(title = 'Tip'))

fig

Podemos observar que la media de las propinas de las mujeres parece estar ligeramente por debajo de la mediana, lo que sugiere que hay una distribución sesgada hacia propinas más bajas.Para los hombres, la media está ligeramente por encima de la mediana, lo que sugiere un sesgo hacia propinas más altas.

box_google <- plot_ly(data = stocks, y = ~GOOG, type = 'box', name = 'Google',
                      marker = list(color = 'blue'),
                      boxpoints = 'all', 
                      jitter = 0.5, 
                      whiskerwidth = 0.2) 
box_apple <- plot_ly(data = stocks, y = ~AAPL, type = 'box', name = 'Apple',
                     marker = list(color = 'red'),
                     boxpoints = 'all', 
                     jitter = 0.5, 
                     whiskerwidth = 0.2)
fig <- subplot(box_google, box_apple)

fig <- fig %>% layout(title = 'Stock Prices',
                      yaxis = list(title = 'Price'))

fig

Para Google:

La mediana del precio de las acciones,parece estar cerca de 1.05. Los bigotes se extienden hasta los valores más altos y más bajos dentro de un rango considerado “normal”, excluyendo valores atípicos. Las observaciones individuales de precios de acciones y parecen tener algunos valores atípicos tanto por encima como por debajo del rango del bigote.

Para Apple:

La mediana parece estar alrededor de 1.2.La caja es más alta en comparación con Google, lo que indica un mayor rango intercuartílico y, por tanto, una mayor variabilidad en los precios de las acciones de Apple. Hay numerosos valores atípicos, especialmente en la parte superior, lo que sugiere precios significativamente más altos en ciertos días.

box_google <- plot_ly(data = stocks, y = ~GOOG, type = 'box', name = 'Google')

box_apple <- plot_ly(data = stocks, y = ~AAPL, type = 'box', name = 'Apple')

fig <- subplot(box_google, box_apple)

fig <- fig %>% layout(title = 'Google vs. Apple',
                      yaxis = list(gridcolor = 'rgb(255, 255, 255)', gridwidth = 3),
                      paper_bgcolor = 'rgb(243, 243, 243)',
                      plot_bgcolor = 'rgb(243, 243, 243)')

fig

Este gráfico es similar al anterior, lo único que cambia es que ya no se presentan las observaciones individuales, sino la caja con su respectivo resumen numérico y los datos átipicos para cada una de las acciones.

8. Violin Plot

fig <- plot_ly(data = df_tips, y = ~total_bill, type = 'violin',
               box = list(visible = TRUE), 
               points = 'all')

fig <- fig %>% layout(title = 'Violin Plot of Total Bill',
                      yaxis = list(title = 'Total Bill'))

fig

El violin plot indica que la mayoría de las cuentas totales tienden a agruparse alrededor de los 15-20 dólares, con la densidad de las cuentas disminuyendo a medida que el monto aumenta. Los datos se extienden hasta los 50 dólares, pero con mucha menor frecuencia, como se evidencia por la estrechez del violin plot en montos mayores.

fig_smoker <- plot_ly(data = df_tips, y = ~tip, x = ~sex, color = ~sex, type = 'violin',
                      box = list(visible = TRUE), 
                      points = 'all', 
                      hoverinfo = 'all')
fig_non_smoker <- plot_ly(data = df_tips, y = ~tip, x = ~sex, color = ~sex, type = 'violin',
                          box = list(visible = TRUE),
                          points = 'all', 
                          hoverinfo = 'all') 
fig <- subplot(fig_smoker, fig_non_smoker, nrows = 1)

fig <- fig %>% layout(title = 'Violin Plot of Tips by Sex and Smoking Status',
                      yaxis = list(title = 'Tip'),
                      xaxis = list(title = 'Sex'),
                      xaxis2 = list(title = 'Sex'))

fig

Los hombres parecen dar propinas más altas en comparación con las mujeres, independientemente del hábito de fumar. Además, hay algunos puntos que representan propinas extremas en cada grupo.

plot_ly(df_tips, x = ~day, y = ~total_bill, type = 'violin',
        color = ~smoker, side = 'negative', split = ~smoker,
        line = list(color = 'blue')) %>%
  layout(violingap = 0)

Los violines ilustran que la distribución de las cuentas es más ancha en rangos inferiores, indicando una mayor frecuencia de valores más bajos en la cuenta. También hay datos que se extienden hacia montos mayores, pero con menor frecuencia. Además, parece haber valores atípicos, como lo indican los puntos que se extienden más allá de la sección más ancha del violín.

plot_ly(df_tips[ df_tips$smoker == 'No', ], x = ~day, y = ~total_bill, type = 'violin',
        legendgroup = 'No', scalegroup = 'No', name = 'No',
        side = 'positive', line = list(color = 'red')) %>%
  layout(violingap = 0, violinmode = 'overlay', showlegend = FALSE) %>%
  add_trace(data = df_tips[ df_tips$smoker == 'Yes', ], x = ~day, y = ~total_bill, type = 'violin',
            legendgroup = 'Yes', scalegroup = 'Yes', name = 'Yes',
            side = 'negative', line = list(color = 'blue')) %>%
  layout(violingap = 0, violinmode = 'overlay')

Se observa que hay diferencias en la distribución de la cuenta total entre fumadores y no fumadores en ciertos días. Por ejemplo, el sábado muestra una mayor variabilidad en las cuentas para fumadores, mientras que los no fumadores tienden a gastar menos. Los días jueves y domingo muestran una distribución similar entre fumadores y no fumadores, con una mediana de cuenta total ligeramente más alta para los fumadores.

9. Density Heatmap

Cargamos los datos

library(readr)
flights <- read_csv("C:/Users/USUARIO/Downloads/flights.csv")

## Rows: 144 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): month
## dbl (2): year, passengers
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

head(flights)

## # A tibble: 6 × 3
##    year month passengers
##   <dbl> <chr>      <dbl>
## 1  1949 Jan          112
## 2  1949 Feb          118
## 3  1949 Mar          132
## 4  1949 Apr          129
## 5  1949 May          121
## 6  1949 Jun          135

heatmap <- plot_ly(flights, x = ~year, y = ~month, z = ~passengers, type = 'heatmap', colors = viridis::viridis(256))

heatmap

Se observa que a lo largo de los años, parece que la cantidad de pasajeros aumenta, como lo indican los colores más claros hacia el final del gráfico, alcanzando el máximo en julio de 1960 con 622 pasajeros.

10. 3D Scatter plot

fig <- plot_ly(data = flights, x = ~year, y = ~month, z = ~passengers, type = 'scatter3d', mode = 'markers',
               marker = list(size = 5, opacity = 0.7, color = ~year, colorscale = 'Viridis'))

fig <- fig %>% layout(width = 800, height = 400)

fig

Se observa una tendencia general de aumento en el número de pasajeros a medida que avanzan los años, y parece haber una periodicidad estacional, con los picos que podrían corresponder a meses de alta temporada turística.

11. 3D Line Plot

fig <- plot_ly(data = flights, x = ~year, y = ~month, z = ~passengers, type = 'scatter3d', mode = 'lines+markers',
               line = list(color = ~year, colorscale = 'Viridis', width = 2),
               marker = list(size = 2, opacity = 0.5))

fig

Este gráfico es similar al anterior, este muestra lineas entre los puntos, los cuales ayudan a mejorar la comprensión de la distribución de los pasajeros durante cada mes. Se observa que en el mes de noviembre, se presenta una ligera caída del número de pasajeros.

12. Scatter Matrix

flights$month <- as.factor(flights$month)

fig <- plot_ly(data = flights, colors = RColorBrewer::brewer.pal(n = 12, name = "Set3")) %>%
  add_trace(
    type = 'splom',
    dimensions = list(
      list(label = 'Year', values = ~year),
      list(label = 'Passengers', values = ~passengers)
    ),
    color = ~month,
    colors = colorRamp(c('blue', 'red')) 
  ) %>%
  layout(title = 'Matriz de dispersión')

fig

Se observa una clara relación lineal entre el número de pasajeros y el año, puesto que es evidente una tendencia creciente entre ambas variables. Además, se puede notar que el mes con mayor demanda de pasajeros es septiembre y el mes con menor demanda es abril.

13. Map Scatter Plot

df <- gapminder %>% filter(year == 2007)

fig <- plot_geo(df, locations = ~country, locationmode = 'country names', color = ~continent,
                hoverinfo = 'text',
                text = ~paste('Country:', country, '<br>Pop:', pop),
                size = ~pop, sizes = c(10, 100)) %>%
  layout(title = 'World Population in 2007',
         geo = list(projection = list(type = 'orthographic')))

fig

## No scattergeo mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

Se puede notar una mayor concentración de puntos en Asia, especialmente en regiones como la India y China. Europa también muestra una cantidad significativa de puntos. África tiene una distribución de puntos que sugiere una población más dispersa, con algunas concentraciones en el norte y sur del continente. Oceanía tiene muy pocos puntos en comparación con los otros continentes, lo que indica una menor densidad de población.

14. Choropleth Maps

url <- 'https://raw.githubusercontent.com/plotly/datasets/master/geojson-counties-fips.json'
counties <- rjson::fromJSON(file=url)
url2<- "https://raw.githubusercontent.com/plotly/datasets/master/fips-unemp-16.csv"
df <- read.csv(url2, colClasses=c(fips="character"))

g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa'),
  showlakes = TRUE,
  lakecolor = toRGB('white')
)
fig <- plot_ly()
fig <- fig %>% add_trace(
    type="choropleth",
    geojson=counties,
    locations=df$fips,
    z=df$unemp,
    colorscale="Viridis",
    zmin=0,
    zmax=12,
    marker=list(line=list(
      width=0)
    )
  )
fig <- fig %>% colorbar(title = "Unemployment Rate (%)")
fig <- fig %>% layout(
    title = "US Unemployment"
)

fig <- fig %>% layout(
    geo = g
  )

fig

Se observa que en general la tasa de desempleo es baja en Estados Unidos, a excepción de ciertas zonas como al sur del país donde la tasa aumenta por encima del 10%.

15. Polar Chart

wind <- read_csv("C:/Users/USUARIO/Downloads/wind.csv")

## New names:
## Rows: 128 Columns: 4
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (2): direction, strength dbl (2): ...1, frequency
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

fig <- plot_ly(data = wind, type = 'scatterpolar', mode = 'markers',
               r = ~frequency, theta = ~direction,
               color = ~strength, size = ~frequency, symbol = ~strength)

fig <- fig %>% layout(
  polar = list(
    radialaxis = list(visible = TRUE, range = c(min(wind$frequency), max(wind$frequency))),
    angularaxis = list(direction = "clockwise")
  )
)

fig

La dirección desde el centro hacia el borde del círculo indica de dónde sopla el viento. El gráfico muestra que hay una variedad de velocidades de viento desde diferentes direcciones, y algunas direcciones son más prevalentes o tienen vientos más fuertes que otras.

colors <- c('blue', 'cyan', 'green', 'yellow', 'orange', 'red', 'darkred')

p <- plot_ly(wind, type = 'scatterpolar', mode = 'lines',
             r = ~frequency, theta = ~direction,
             line = list(color = ~as.numeric(strength), width = 2),
             color = ~strength, colors = colors,
             opacity = 0.7)

p <- p %>% layout(
  polar = list(
    radialaxis = list(
      visible = TRUE,
      range = c(0, max(wind$frequency))
    ),
    bgcolor = "black" 
  ),
  paper_bgcolor = "black", 
  plot_bgcolor = "black", 
  showlegend = TRUE,
  width = 800,
  height = 400
)
p

Este gráfico presenta un resumen o promedio de los datos representados por los símbolos en el primer gráfico, ofreciendo una vista general de la dirección e intensidad del viento a lo largo de un período extendido de tiempo.

16. Ternary plot

df_exp <- read_csv("C:/Users/USUARIO/Downloads/experiment.csv")

## New names:
## Rows: 100 Columns: 6
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (2): gender, group dbl (4): ...1, experiment_1, experiment_2, experiment_3
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

df_exp <- df_exp %>%
  mutate(gender = as.factor(gender))

colors <- c('female' = '#FF69B4', 'male' = '#1E90FF') # Rosa para 'female', Azul para 'male'

fig <- plot_ly(data = df_exp, type = 'scatterternary',
               mode = 'markers',
               a = ~experiment_1,
               b = ~experiment_2,
               c = ~experiment_3,
               hoverinfo = 'text',
               text = ~paste("Group:", group, "<br>Gender:", gender),
               marker = list(size = 10,
                             color = ~I(colors[as.character(gender)]))) 

fig

Se puede observar que los puntos azules y rosas están bastante juntos, lo que indica que las proporciones de los componentes A, B y C son relativamente similares entre las muestras masculinas y femeninas.

17. Facets

ggplot(df_tips, aes(x = total_bill, y = tip, color = smoker)) +
  geom_point() +
  facet_wrap(~sex) +
  labs(title = "Scatter plot of Total Bill vs. Tip", x = "Total Bill", y = "Tip") +
  theme_minimal()

En general, parece haber una correlación positiva entre el total de la cuenta y la propina. Además, los puntos están más dispersos en el lado masculino que en el femenino, lo que podría sugerir una variabilidad más grande en las cantidades de las cuentas y las propinas entre los hombres. Por último, parece que los puntos que representan a los fumadores están un poco más dispersos hacia cuentas totales más altas en el lado de los hombres, lo que podría sugerir que los hombres fumadores tienden a tener cuentas más altas en este conjunto de datos.

df_att <- read_csv("C:/Users/USUARIO/Downloads/att.csv")

## New names:
## Rows: 60 Columns: 6
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (1): attention dbl (5): ...1, Unnamed: 0, subject, solutions, score
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

p <- ggplot(df_att, aes(x = solutions, y = score)) + 
  geom_line() + 
  facet_wrap(~subject, ncol = 5) + 
  labs(title = 'Scores Based on Attention', x = 'Solutions', y = 'Score')

print(p)

Los gráficos muestran diferentes tendencias y patrones, sugiriendo que la relación entre las “Solutions” y las “Scores” varía considerablemente entre los diferentes conjuntos de datos. Algunos gráficos (como el 1, 5, 8, 10) muestran una tendencia ascendente, lo que sugiere que a medida que aumenta el número de la solución, también lo hace la puntuación. Otros gráficos (como el 2, 3, 6, 9) muestran poca o ninguna tendencia clara, lo que indica que no hay una relación fuerte entre las soluciones y las puntuaciones en esos conjuntos de datos.

18. Animated Plot

cnt <- read_csv("C:/Users/USUARIO/Downloads/cnt.csv")

## New names:
## Rows: 1704 Columns: 9
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): country, continent, iso_alpha dbl (6): ...1, year, lifeExp, pop,
## gdpPercap, iso_num
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

fig <- cnt %>%
  plot_ly(
    x = ~gdpPercap, 
    y = ~lifeExp, 
    size = ~pop, 
    color = ~continent, 
    frame = ~year, 
    text = ~country, 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  )
fig <- fig %>% layout(
    xaxis = list(
      type = "log"
    )
  )

fig

Se observa una tendencia creciente entre GDP y la esperanza de vida. Además, Europa es el contimente con una mayor esperanza de vida seguido de America. Mientras que Africa es el continente con la esperanza de vida más baja.

fig <- cnt %>%
  plot_ly(
    x = ~continent,        
    y = ~pop,             
    color = ~continent,    
    frame = ~year,         
    text = ~country,       
    hoverinfo = "text",
    type = 'bar',          
    marker = list(size = ~pop)
  )

fig

Se observa que a medida que pasan los años las poblaciones de todos los continentes va en aumento. Asia es el continente con la mayor población seguido de África, mientras que Oceanía es el continente con la menor población.

Análisis Geoespacial

library(sf)

## Linking to GEOS 3.11.2, GDAL 3.8.2, PROJ 9.3.1; sf_use_s2() is TRUE

library(ggplot2)
library(dplyr)
library(plotly)
library(leaflet)

## 
## Attaching package: 'leaflet'

## The following object is masked from 'package:xts':
## 
##     addLegend

library(leaflet.extras)

1. How Does Mapping Work?

Iniciamos importando los datos de un archivo geojson.

datos_sf <- st_read("C:/Users/USUARIO/Downloads/factoriesindustrial-sites.geojson")

## Reading layer `factoriesindustrial-sites' from data source 
##   `C:\Users\USUARIO\Downloads\factoriesindustrial-sites.geojson' 
##   using driver `GeoJSON'
## Simple feature collection with 732 features and 7 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: 2.730691 ymin: 6.382559 xmax: 4.190527 ymax: 6.687934
## Geodetic CRS:  WGS 84

head(datos_sf)

## Simple feature collection with 6 features and 7 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: 3.034175 ymin: 6.460904 xmax: 3.782269 ymax: 6.678689
## Geodetic CRS:  WGS 84
##                                  id state_code source
## 1  u_fc_poi_factory_industry_site.1         LA   GRID
## 2  u_fc_poi_factory_industry_site.2         LA   GRID
## 3  u_fc_poi_factory_industry_site.4         LA   GRID
## 4 u_fc_poi_factory_industry_site.11         LA   GRID
## 5 u_fc_poi_factory_industry_site.18         LA   GRID
## 6 u_fc_poi_factory_industry_site.22         LA   GRID
##                              name status ward_code
## 1 JJ International Block Industry In Use  LASIUI05
## 2           Kadiri Block Industry In Use  LASIUI04
## 3                     Teju Blocks In Use  LASIKU29
## 4     Adurumigba Block Industries In Use  LASBDY08
## 5               Abllat Nig Co Ltd In Use  LASAMO24
## 6           Maras Nig Enterprises In Use  LASIKU23
##                              global_id                  geometry
## 1 000b39d0-ba96-4d62-91f3-52bef3d64890 POINT (3.782269 6.472439)
## 2 001a5124-6f66-457f-ac1b-c4f1fde6a61a POINT (3.684066 6.460904)
## 3 004d7b39-d3b8-4074-b270-d0fc09a20510  POINT (3.543618 6.59287)
## 4 006bb17c-b0fc-4b09-acc4-59250acdcfce POINT (3.034175 6.463356)
## 5 0097ec77-7a51-44a4-a83d-c15f67e03fad POINT (3.259548 6.526905)
## 6 00b741ae-e6d4-4848-af4f-e7c9c62be78d POINT (3.494027 6.678689)

Extraemos las coordenadas de latitud y longitud.

datos_sf <- datos_sf %>%
  mutate(lon = st_coordinates(geometry)[,1],
         lat = st_coordinates(geometry)[,2])
names(datos_sf)

##  [1] "id"         "state_code" "source"     "name"       "status"    
##  [6] "ward_code"  "global_id"  "geometry"   "lon"        "lat"

plot_ly(datos_sf, x = ~lon, y = ~lat, type = "scatter", mode = "markers", 
        marker = list(color = "blue")) %>%
  layout(title = "A Scatter Plot of the Latitude and Longitude of Factories in Lagos",
         xaxis = list(title = "Longitude", gridcolor = "lightgrey", showgrid = TRUE),
         yaxis = list(title = "Latitude", gridcolor = "lightgrey", showgrid = TRUE),
         plot_bgcolor = 'rgba(0,0,0,0)')

2. How to create a map in folium

mark <- leaflet() %>%
  addTiles(urlTemplate = "https://{s}.basemaps.cartocdn.com/light_all/{z}/{x}/{y}.png") %>%
  setView(lng = 3.3792, lat = 6.5244, zoom = 12)

for(i in 1:nrow(datos_sf)) {
  mark <- mark %>%
    addMarkers(lng = datos_sf$lon[i], lat = datos_sf$lat[i], popup = datos_sf$name[i])
}

mark

Se puede notar que las observaciones se concentran en la ciudad de Lagos y se dispersan a otras ciudades en menor proporción.

3. Bubble Charts

bubble <- leaflet() %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  setView(lng = 3.3792, lat = 6.5244, zoom = 12)

mc <- markerClusterOptions()
bubble <- bubble %>%
  addMarkers(lng = datos_sf$lon, lat = datos_sf$lat, clusterOptions = mc)

bubble

Las áreas alrededor de Agege e Ikeja tienen números significativamente más altos (72, 43) en comparación con otras áreas, lo que sugiere una alta concentración en esas localidades. Los números más pequeños, como los que se ven en las periferias del mapa (por ejemplo, en Ikorodu y a lo largo de la costa), indican menos ocurrencias o menor densidad del elemento medido.

4. Heat Map

heat <- leaflet() %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  setView(lng = 3.3792, lat = 6.5244, zoom = 10)

heat <- heat %>%
  addHeatmap(lng = ~lon, lat = ~lat, data = datos_sf, radius = 10, blur = 20, max = 0.05)

heat

El mapa de calor sugiere que hay varias áreas con una concentración significativa del fenómeno medido, especialmente en la región central alrededor de Ikeja en Lagos, y otras concentraciones visibles al este de Lagos y cerca de la costa en Lekki. Las áreas sin color indican muy poca o ninguna actividad relacionada con el fenómeno que se está rastreando.

5. Circle Map

status <- aggregate(cbind(count = status) ~ status, data = datos_sf, FUN = length)
colnames(status)[2] <- "count"

ggplot(status, aes(x = status, y = count, fill = status)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = c("In Use" = "blue", "Unused Good" = "yellow", "Unused Poor" = "purple")) +
  labs(title = "Status of Factories and Industrial Sites in Lagos", x = "Status", y = "Count")

La mayoría de las fábricas y sitios industriales en Lagos están en uso, como lo muestra la barra azul dominante que sobrepasa los 600 en el conteo.Una pequeña cantidad de sitios no están siendo utilizados pero están en buen estado, como lo indica la barra amarilla baja.Una cantidad similarmente baja de sitios no se utilizan y están en mal estado, como lo muestra la barra violeta.

fig <- leaflet() %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  setView(lng = 3.3792, lat = 6.5244, zoom = 10)

color_producer <- function(val) {
  if (val == 'In Use') {
    return('blue')
  } else if (val == 'Unused Good') {
    return('yellow')
  } else {
    return('purple')
  }
}

for(i in 1:nrow(datos_sf)) {
  fig <- fig %>%
    addCircles(lng = datos_sf$lon[i], lat = datos_sf$lat[i], radius = 20,
               color = color_producer(datos_sf$status[i]), fill = TRUE)
}

fig

La densidad de puntos es mayor en ciertas áreas, como alrededor de Agege e Ikeja. También hay una distribución notable de puntos en la región de Ikorodu y a lo largo de la costa sureste cerca de la Lagos Lagoon. La densidad de puntos disminuye en las áreas periféricas, lo que puede sugerir una menor concentración industrial.

6. Visualising Maps in plotly

fig <- plot_ly(data = datos_sf, type = 'scattermapbox', mode = 'markers',
               lat = ~lat, lon = ~lon,
               color = ~status, colors = c('In Use' = 'blue', 'Unused Good' = 'yellow', 'Unused Poor' = 'purple'),
               text = ~name, hoverinfo = 'text') %>%
  layout(mapbox = list(
    style = 'carto-positron',
    zoom = 10,
    center = list(lat = 6.5244, lon = 3.3792) # Centrar el mapa aquí
    )
  )

fig

La mayoría de las instalaciones en el mapa están en uso, como lo indica la predominancia de puntos azules. Hay una cantidad relativamente pequeña de instalaciones no usadas, tanto en buen estado como en mal estado, señaladas por puntos amarillos y violetas respectivamente. Las instalaciones no usadas se encuentran dispersas entre las que están en uso.

7. Heat Map in plotly

map <- leaflet(datos_sf) %>%
  addProviderTiles("CartoDB.Positron") %>% 
  setView(lng = 3.3792, lat = 6.5244, zoom = 9) %>%
  addHeatmap(lng = ~lon, lat = ~lat, blur = 15, max = 0.05, radius = 15) 

map

Las áreas rojas y naranjas indican las concentraciones más altas de fábricas y sitios industriales en uso, reflejando una mayor actividad industrial.Las áreas verdes y azules pueden indicar una densidad más baja de fábricas o sitios industriales.