Borrar caracteres no ingleses de una BD

Esta semana quería seguir con el tema del Eyetracker, pero las respuestas que he encontrado me han llevado a nuevas preguntas y aún está demasiado flojo el tema como para dar una respuesta a esta duda. Así que lo dejamos ( esperemos) para la semana que viene. Os diré que casi he conseguido evitar los diagramas de densidad y dibujar frecuencias como algunos de vosotros pedíais. Lo único es que me gustaría estructurarlo, porque la verdad es que he encontrado unas 5 soluciones que  espero que os gusten. Así, volvernos a una vieja entrada que es va de como limpiar datos que nuca está de más.

Hace ya tiempo que me vi obligado a tratar una serie de BD portuguesas para hacer un analisis de su liga (Está todavía muy en primeros pasos, pero me gustaría en el futuro mostraros algo). Esto causaba multiples problemas en el trato de caracteres sobre todo al guardar en .RData y cambiar de sistema operativo. Ahora os ofrezco una solución con un poquito de scrapeo de webs fáciles como Wikipedia gracias a librería rvest. El script es el siguiente y lo podeis ejecutar sin problemas sobre vuestra consola R.

Un saludo a todos y muchas gracias por las visitas de esta semana que han sido una gran recompensa para el trabajo que he hecho.

	library(rvest)
	library(data.table)
	library(dplyr)
	lpt <- read_html("https://es.wikipedia.org/wiki/Primeira_Liga_2014/15", encoding = "Windos-1251")
	data <- lpt %>%
	html_nodes("table") %>%
	html_table(fill = T) %>%
	.[[11]] # The 11 table was chosen. We can choose the other( from one to eleven)
	data$Jugador <- iconv(x = data$Jugador, from = "UTF-8", to = "latin1") # Transform to latin1 enconding Windows OS
	data$Equipo <- iconv(x = data$Equipo, from = "UTF-8", to = "latin1")
	data
	data <- data.table(data)
	data[ , Jugador := data$Jugador %>% tolower %>%
	chartr( old="áéíóúàèìòùãõçñôê", new="aeiouaeiouaocnoe", x= .) %>%
	toupper %>% gsub(pattern=" ", replacement="_") %>% gsub(pattern="__", replacement="") %>%
	factor] # Erase the non english characters from Jugador
	data[ , Equipo := data$Equipo %>% tolower %>%
	chartr( old="áéíóúàèìòùãõçñôê", new="aeiouaeiouaocnoe", x= .) %>%
	toupper %>% gsub(pattern=" ", replacement="_") %>% gsub(pattern="__", replacement="") %>%
	factor]
	data

view raw Clean non english characters from a Portugues data base.R hosted with ❤ by GitHub

Plotear datos de Eye Tracker

Hoy vamos a comentar algo más cercnao, al fin a la neurociencia. Gracias a un colega eRRero ( Álex Estudillo)  como yo hace unas semanas se me planteo un duda. ¿Cómo representar unos datos de eyetracker en R?. La verdad es que nunca lo había hecho, aunque si que había hecho varias representaciones sobre mapas. Así que me puse a ello

Lo primero es elegir unas imagenes donde representar los datos que serán las siguientes:

Si quereis runear este código deberiais de descargaros estas imagenes en el directorio base ( ver linea 19 del siguiente script).

	# S Install and load package ----------------------------------------------
	needed <- list("ggplot2", "data.table", "png", "jpeg", "grid")
	unlist(lapply(needed, FUN = function(x){
	if(!x %in% installed.packages()){
	cat("====================================================\n")
	cat("The following package will be installed ",x, "\n")
	install.packages(x)
	cat("====================================================\n")
	}
	library(x, character.only = T, verbose = F)
	return(paste0( x , " successfully loaded"))
	}))
	# E Install and load package ----------------------------------------------
	# S Create data -----------------------------------------------------------
	rm(list = ls())
	# Heatmaps for eyetracker
	setwd("C:/Users/usuario//Dropbox/Chabi/Blog/Numero 3/") # Put your path
	set.seed(123456)
	# S Image 1 ---------------------------------------------------------------
	# read Image 1
	img <- readPNG(source = "disggust.png")
	# Transform
	g <- rasterGrob(image = img, interpolate=TRUE)
	# create data 1 per ROI
	noise_mean <- 0
	noise_sd <- 10e-2 * .5
	RightEye_n <- 200 + 2
	RightEye_x <- 0.25 + rnorm(n = RightEye_n,mean = noise_mean, sd = noise_sd )
	RightEye_y <- 0.65 + rnorm(n = RightEye_n,mean = noise_mean, sd = noise_sd )
	LeftEye_n <- 200 + 2
	LeftEye_x <- 0.45 + rnorm(n = LeftEye_n,mean = noise_mean, sd = noise_sd )
	LeftEye_y <- 0.70 + rnorm(n = LeftEye_n,mean = noise_mean, sd = noise_sd )
	Mouth_n <- 150 + 4
	Mouth_x <- 0.4 + rnorm(n = Mouth_n, mean = noise_mean, sd = noise_sd )
	Mouth_y <- 0.45 + rnorm(n = Mouth_n,mean = noise_mean, sd = noise_sd )
	Nouse_n <- 100 + 10
	Nouse_x <- 0.38 + rnorm(n = Mouth_n, mean = noise_mean, sd = noise_sd )
	Nouse_y <- 0.55 + rnorm(n = Mouth_n,mean = noise_mean, sd = noise_sd )
	Noise_n <- 20
	Noise_x <- seq(from = 0.38, to = 1, length.out = Noise_n) +
	rnorm(n = Noise_n , mean = noise_mean, sd = noise_sd )
	Noise_y <-
	seq(from = 0.55,to = 1, length.out = Noise_n) +
	rnorm(n = Noise_n , mean = noise_mean, sd = noise_sd )
	x <- c(RightEye_x, Mouth_x, Nouse_x, LeftEye_x , Noise_x)
	y <- c(RightEye_y, Mouth_y, Nouse_y, LeftEye_y , Noise_y)
	a <- data.table(x,y)
	summary(a)
	data1 <- a
	# E Create data -----------------------------------------------------------

view raw Create data from a eye tracker.r hosted with ❤ by GitHub

Una vez hecho esto ahora vamos a simular unos datos de mirada sobre ellas (Esto causa problemas en la representación, espero solucionarlos en posts posteriores).



Una vez generados los datos llega la hora de representarlos. En este post lo vamos a hacer por la lógica de una función de densidad.
Lo siguiente será plotear y explicar las ordenes que sirven para esto:

 ggplot(a, aes(x = x, y =y)) Dibuja los puntos en las coordenadas x e y de la BD y con nombres de columnas x e y
annotation_custom(g, # Image
                    xmin= -0.15, # Coordinates to represent the image
                    xmax= 1.25,
                    ymin= -0.25,
                    ymax= 1.25) Nos dibuja la imagen g intentando fijar los puntos más cercanos posible a las esquinas definidas ( Este es el problema de simular datos, lo tengo solucinar en futuros posts)
stat_density2d(data= a, aes(x= x, y=y, fill = ..level.., alpha = ..level..), size= 10, bins= 50, geom='polygon') Dibuja la densidad. Size y bins sirven para hacer más visibles o menos el mapa de densidad.
geom_point(data= a, aes(x=x, y=y),  
             color="black",
             position=position_jitter(w=0.01,h=0.01),
             alpha=0.5)  Dibuja los puntos desviados gracias a la función jitter y se hacen más o menos transparentes con alpha.
scale_fill_gradient( low = "green",  
                       high = "red",
                       limits = c(0, 15) ,
                       breaks = c(0, 3, 5, 10) 
  ) Esta orden define como rellenamos el dibujo de densidad. Loe nos dice el datos inferior, High nos dice cual es el color superior,  limits( a nivel leyenda) nos dice los limites de nuestra escala y finalmente breks ( a nivel leyenda) nos dice los putnos de corte para la escala, Guide es booleano que nos deice si se muestra la leyenda o no.
Las siguientes ordenes solo definen el nivel de transparencia (scale_alpha_continuous) con la misma lógica que lo anterior y los límites del plot(xlim e ylim).

 

Este es el código :

	# Plot data 1
	p <-
	ggplot(a, aes(x = x, y =y)) +
	annotation_custom(g, # Image
	xmin= -0.15, # Coordinates to represent the image
	xmax= 1.25,
	ymin= -0.25,
	ymax= 1.25) +
	stat_density2d(data= a, aes(x= x, y=y, fill = ..level.., alpha = ..level..),
	size= 10, bins= 50, geom='polygon') +
	geom_point(data= a, aes(x=x, y=y), # coordinates
	color="black", # Color point
	position=position_jitter(w=0.01,h=0.01), # Point plot desviation
	alpha=0.5) + # Point transaparence
	theme_bw() + # Kind of theme. I strongly recomend theme_bw
	scale_fill_gradient( low = "green", # Lowest color value
	high = "red", # High color value
	limits = c(0, 15) , # Limits for coloring
	breaks = c(0, 3, 5, 10) # Breaks in the color legend
	) +
	scale_alpha_continuous(range=c(0.0, 1) , guide = FALSE) + # You can play with the range to show a better image. Range belongs to [0, 1] interval
	xlim(0, 1) + # Control lim for x-axe
	ylim(0, 1) # Control lim for y-axe
	print(p)
	jpeg(filename = "disgust with density plot.jpeg", res = 100,
	width = 18, height =10 ,units = "cm")
	print(p)
	dev.off()

view raw Plot disgust.R hosted with ❤ by GitHub

Siguiendo esta lógica dibujaremos y simularemos otros ejemplo:

	img <- readJPEG(source = "happy face.jpg")
	# Transform
	g <- rasterGrob(image = img, interpolate=TRUE)
	# create data 1 per ROI
	noise_mean <- 0
	noise_sd <- 10e-2 * .5
	RightEye_n <- 200 + 2 + 25
	RightEye_x <- 0.25 + rnorm(n = RightEye_n,mean = noise_mean, sd = noise_sd )
	RightEye_y <- 0.65 + rnorm(n = RightEye_n,mean = noise_mean, sd = noise_sd )
	LeftEye_n <- 200 + 2 + 25
	LeftEye_x <- 0.45 + rnorm(n = LeftEye_n,mean = noise_mean, sd = noise_sd )
	LeftEye_y <- 0.70 + rnorm(n = LeftEye_n,mean = noise_mean, sd = noise_sd )
	Mouth_n <- 150 + 4 - 50
	Mouth_x <- 0.4 + rnorm(n = Mouth_n, mean = noise_mean, sd = noise_sd )
	Mouth_y <- 0.45 + rnorm(n = Mouth_n,mean = noise_mean, sd = noise_sd )
	Nouse_n <- 100 + 10
	Nouse_x <- 0.38 + rnorm(n = Mouth_n, mean = noise_mean, sd = noise_sd )
	Nouse_y <- 0.55 + rnorm(n = Mouth_n,mean = noise_mean, sd = noise_sd )
	Noise_n <- 20
	Noise_x <- seq(from = 0.38, to = 1, length.out = Noise_n) +
	rnorm(n = Noise_n , mean = noise_mean, sd = noise_sd )
	Noise_y <-
	seq(from = 0.55,to = 1, length.out = Noise_n) +
	rnorm(n = Noise_n , mean = noise_mean, sd = noise_sd )
	x <- c(RightEye_x, Mouth_x, Nouse_x, LeftEye_x , Noise_x)
	y <- c(RightEye_y, Mouth_y, Nouse_y, LeftEye_y , Noise_y)
	a <- data.table(x,y)
	summary(a)
	data2 <- a
	jpeg(filename = "disgust with density plot.jpeg", res = 100,
	width = 18, height =10 ,units = "cm")
	print(p)
	dev.off()

view raw Blog 2015.10.18 Create Data and plot happy.R hosted with ❤ by GitHub

También podemos modificar como rellenas la escala, como por ejemplo por rangos

	# S Extra info -------------------------------------------------------------
	# Extra Tip
	Colors <- rainbow( 5 )
	Breaks <- c(0, 1, 3, 5, 7, 10)
	p <-
	ggplot(a, aes(x = x, y =y)) +
	annotation_custom(g, xmin= -0.5 , xmax= 1.25, ymin= -0.25, ymax= 1.25) +
	stat_density2d(data= a,
	aes(x= x, y=y , fill = factor( cut(..level.. , breaks = c(0, 1, 3, 5, 7, 10)) ) ), # Transform levels to factor and deffine the breaks...
	size= 10, bins= 50, geom='polygon') +
	geom_point(data= a, aes(x=x, y=y),
	color="black", position=position_jitter(w=0.01,h=0.01), alpha=0.1) +
	theme_bw() +
	scale_fill_manual(values = Colors , breaks = Breaks, guide = F) + # We lost the guide
	xlim(0, 1) +
	ylim(0, 1)
	print(p)
	jpeg(filename = "Happy with density plot by ranges.jpeg", res = 100,
	width = 18, height =10 ,units = "cm")
	print(p)
	dev.off()
	# annotation_custom(g, xmin= -Inf , xmax=Inf, ymin=-Inf, ymax=Inf) # Así ocupa todo
	# S Extra info -------------------------------------------------------------

view raw Blog2015.10.18-Plot_by_Range.R hosted with ❤ by GitHub

El problema que tiene simular datos es que tengo problemas para fijar el gráfico. En futuros post intentaré solventar esto. Todos eso gracias a mi colega Alex que me ha ayudado mucho en este post y al cual le quiero agredecer desde aquí su colaboración. Una respuesta no es nada si un una buena pregunta.

Code Combat una manera divertida de aprender.

Hace unas semanas llegó a mí un divertido juego para aprender a programar en distintos lenguajes de programación. Lo cierto es que aprender a programar jugando es una gran idea y ojalá pronto añadan nuevos lenguajes (como por ejemplo R). La verdad es que esta iniciativa tiene mucha salida en el mundo docente ¿qué mejor manera de motivar a los alumnos que un videojuego? Por lo menos a los más nerds de la clase. También es útil para los que no sepáis programar y queráis una aproximación a este mundo. La única faena es que no se pueda jugar offline. A continuación os dejo un video para que disfrutéis de un friki game play.

Computar diferencias entre fechas con R

Como cientifico de datos muchas veces te encuentras el problema de que a varias fechas le quieres restar una fecha concreta. Aquí os muestro una función para autoamtizar este proceso.

	library(data.table)
	library(dplyr)
	########################################################################################
	# Create example data set
	########################################################################################
	set.seed(123456)
	data <- data.frame( id = 1:100,
	Date1 = Sys.Date( ) + sample( -1000: 1000, 100) ,
	Date2 = as.character( Sys.Date( ) + sample( -1000: 1000, 100) ) ,
	Date3 = Sys.Date( ) + sample( -1000: 1000, 100)
	)
	########################################################################################
	# Function
	########################################################################################
	DiffDates <-
	function( data, DTNames = NULL, format = "%Y-%m-%d", DateForDifference = Sys.Date(), ... ){
	# data with detes to compute the difference
	# Names of dates colums if the colums has date format ignore this
	# format of the dates if is DTnNames = NULL ignore this parameter
	# Date for compute the difference
	if( !is.data.table( data ) ){
	data <- data.table( data)
	warning( "Warning: Be carrefull data frame or matrix transformed to data table")
	}
	print( class( data))
	if( is.null( DTNames ) ){
	DTNames <- names(data)[ sapply(X = data , FUN = class) == "Date" ]
	}else{ # Otherwise transform to date some colums
	# transform DT in to Date class. For more info about data.table lapply see:
	# http://stackoverflow.com/questions/9236438/how-do-i-run-apply-on-a-data-table
	data[ , (DTNames) :=
	lapply(X = .SD,
	FUN = function(x, format){
	as.Date( x, format)
	}),
	.SDcol = DTNames]
	}
	print( class( data))
	data[ , (DTNames) :=
	lapply(X = .SD,
	FUN = function(x, format){
	difftime( time1 = x, time2 = DateForDifference, ...) # Dots allows to call others parameters of this function in the main one
	}),
	.SDcol = DTNames]
	}
	summary(data) # show the original data set
	########################################################################################
	# Example 1
	########################################################################################
	DiffDates(data = data, units = "days")
	########################################################################################
	# Example 2
	########################################################################################
	data$Date2 <- data$Date2 %>% as.Date(format = "%Y-%m-%d")
	DiffDates(data = data, DTNames =c("Date1", "Date2" , "Date3"), units = "days")

view raw substract dates.R hosted with ❤ by GitHub