Dummy version: Fireballs & Meteorites: What is the safest city to live?

Fireballs y Meteorites Landing son dos datasets de la NASA breves y sencillos de manipular, lo cual los hace aptos para un proyecto de fin de semana, donde busco contestar una sencilla pregunta: existen ciudades mas seguras para vivir que otras?

No existe nada que nos proteja de los meteoritos, sin embargo existen razones para pensar que algunas zonas se ven mas expuestas a la caida de los mismos, y a todos los danos posteriores.

Hipotesis cero

Existen lugares donde es mas frecuente la caida de objetos celestes, y es posible elaborar un ranking al respecto.

Datasets

Los datasets de entrada son parte de Kaggle, como este tipo de archivos puede variar en el tiempo, y me gustaria que estos ejemplos continuen funcionando sin ningun tipo de problemas, los inclui dentro de mi repositorio de Github.

Como resolver el problema

Antes de empezar a trabajar me gustaria diagramar rapidamente los pasos:

Ambos dataset tienen por cada caida de un cuerpo celeste, una latitud y longitud asociada.
Por cada caida, mediante una llamada a la API de Google Maps puedo determinar el pais, provincia y ciudad
Almaceno la ubicacion de cada caida
Armo un ranking
Grafico

MVP: Minimum Viable Product

Ya definido como espero resolver el problema, me gustaria crear una version sencilla de la solucion para volver sobre la misma en una subsiguiente y final version.

1. Exploracion de cada dataset

1.1. Carga de datos dataset

url_mete <- 'https://raw.githubusercontent.com/frm1789/stars_safest_city_to_live/master/meteorite-landings.csv'
url_fire <- 'https://raw.githubusercontent.com/frm1789/stars_safest_city_to_live/master/cneos_fireball_data.csv'

df_fire <- read_csv(url(url_fire))
df_mete <- read_csv(url(url_mete))

head(df_fire,3)
head(df_mete,3)

1.2. Limpieza de datos

# Limpieza de valores NA en las columnas 8 y 9 correspondientes a Latitud y Longitud 
df_mete <- df_mete[complete.cases(df_mete[ , 8:9]),]

2. Llamada al API de Google Maps

long = -67.225258
lat = -54.554
API_creada = dato_real
https://maps.googleapis.com/maps/api/geocode/json?latlng=-34.6,-58.38&key=API_creada

Esta llamada basica, me devuelve un archivo JSON, el cual debe ser parseado y almacenado en un dataframe de forma de poder realizar operaciones sobre el mismo.

3. Almacenamiento del archivo JSON de respuesta del API de Google Maps

Almacenamiento de una llamada

apiRequests ="https://maps.googleapis.com/maps/api/geocode/json?latlng=-54.554,-67.225258&key=myKey"
# Call Google Maps API.
conn <- httr::GET(URLencode(apiRequests))

# Parse the JSON response. 
apiResponse <- jsonlite::fromJSON(httr::content(conn, "text"))

# Save the answer into a dataframe
var <- "fireball_name"
df <- as.data.frame(cbind(fireball = var, as.data.frame(apiResponse)))

Almacenamiento de los resultados de todas las llamadas

Cada vez que realizo una nueva llamada almaceno los datos en un dataframe, y mediante la funcion bind_rowsdel paquete dplyrvoy sumando la nueva informacion.

Un detalle a tener en cuenta es que la funcion bind_rows no acepta listas o dataframes anidados, por lo cual es necesario convertir a texto tres de los campos.

# conversion a texto
new_df$results.address_components <- as.character(new_df$results.address_components)
new_df$results.types <- as.character(new_df$results.types)
new_df$results.geometry <- as.character(new_df$results.geometry)

# agregar nuevo dataframe al dataframe existente
df <- dplyr::bind_rows(df, new_df)

4. Creacion del ranking

Paso a paso:

4.1 Para cada par (lat, long) de cada dataset, consultar su posicion, y guardar dicha informacion en un vector, solo necesito la ubicacion.

## Paso lat y long a dos vectores: de forma de controlar cuantos llamados se hacen al API de Google
## Pasaje de longitud y latitud a vectores numericos 
vlong <- c()
vlong <- c()
i <- 1
k <- 1

for(i in 1:500) {
  vlat[k] <- as.numeric(df_mete[i, 8])
  vlong[k] <- as.numeric(df_mete[i, 9])
  i <- i + 1
  k <- k + 1
}  
## Pasaje de longitud y latitud a vectores numericos 

## Obtencion de la ubicacion por pais de cada impacto 
vector_resultados <- find_pref2(vlong, vlat, apiKey)

4.2 Sumarizar la informacion basada en la columna “country”, en una nueva columna “value”

# sumarizar los resultados
df_count_mf <- as.data.frame(table(vector_resultados)) 
colnames(df_count_mf)[c(1,2)] <- c("countries", "values")
nrow(df_count_mf) #106

5. Grafico

Existen infinidad de graficos que pueden hacer posible mostrar cuales son las regiones con mayor y menor riesgo. En particular elegi un grafico de Barras divergentes que puede mostrar en un golpe de vista tanto valores negativos y como positivos. La implementacion se hace mediante modificaciones sobre geom_bar().

#Dummies data version 1
countries <- c("Argentina","Brazil","Canada","Denmark","Uruguay","USA", "Albania", "Turkey", "Peru", "Sudan","Paraguay", "Monaco", "Italia", "Francia","Mexico","Colombia","Australia","New Zeland", "Japan", "China", "UK", "Chile", "Portugal","Grecia","Armenia","Alemania","Noruega","Groenlandia","Cuba","Guatemala","Corea","Holanda")
values <- c(161, 261, 113, 960, 890, 840, 801, 851, 769, 719, 661, 496, 389, 343, 243, 315, 415, 876,  105, 115,  220,  202,  323,  65,  45,  72,  98,  120,  141,  101, 204,  229)
dummies <- data.frame(countries, values)

#Dummies data version 2: just first 500 from meteorite dataset
dummies <- df_count_mf

#clasificacion 
dummies$v_type <- ifelse(dummies$values < mean(dummies$values), "below", "above") # above / below avg flag
dummies$values <- ifelse(dummies$values < mean(dummies$values), dummies$values*-1,dummies$values)

#Order by
dummies <- dummies[order(dummies$values), ] # sort
dummies$countries <- factor(dummies$countries, levels = dummies$countries) # convert to factor to retain sorted order in plot.

#Colors from Viridis Palette
A_col <- "#404788FF"
B_col <- "#1F968BFF"

# Diverging Barcharts
ggplot(dummies, aes(x=countries, y=values)) +
geom_bar(stat='identity', aes(fill=v_type), width=.5) +
scale_fill_manual(name="Q caidas",
labels = c("Arriba del promedio", "Abajo del promedio"),
values = c("above"=A_col, "below"=B_col)) +
labs(subtitle="Paises mas seguros e inseguros segun tendencia historica",
title= "Donde vivirias para evitar meteoritos y fireballs") +
coord_flip() +
theme_minimal() +
theme(
axis.text.x = element_text(size = 12, face = "bold")
)

Version final

Para la version final, voy a tomar del resultado de todas las ubicaciones los 10 lugares con mayores impactos y los 10 lugares con menores impactos, de forma de darle mayor claridad al grafico.

df_top <- dplyr::bind_rows(head(dummies), tail(dummies))

6. Fuentes

- https://stackoverflow.com/questions/4862178/remove-rows-with-all-or-some-nas-missing-values-in-data-frame
- https://stackoverflow.com/questions/22235809/append-value-to-empty-vector-in-r
- https://stackoverflow.com/questions/1923273/counting-the-number-of-elements-with-the-values-of-x-in-a-vector
- https://stackoverflow.com/questions/32994634/this-api-project-is-not-authorized-to-use-this-api-please-ensure-that-this-api
- https://stackoverflow.com/questions/46165341/avoid-asdata-frame-change-data-to-factors-when-converting-from-zoo-object
- https://stackoverflow.com/questions/24901216/how-to-create-a-data-frame-with-numeric-and-character-columns
- https://www.fromthebottomoftheheap.net/2012/04/01/saving-and-loading-r-objects/
- How to remove a legend

Tags.

Recent Posts.