Laboratorio # 1

Oscar Padilla - 13000285

bike_data<-
  bike %>%
  dplyr::select(season, atemp, humidity)

bike_data %>% 
  ggplot(aes(x=atemp,y=..density..)) +
  geom_histogram(bins=60) +
  geom_density() + 
  facet_wrap(.~season)

bike_data %>% 
  ggplot(aes(x=humidity,y=..density..)) +
  geom_histogram(bins=30) +
  geom_density() + 
  facet_wrap(.~season)

bike_data$group<-
  cut(bike_data$atemp, breaks = c(0,10,20,30,40))

bike_data %>% 
  group_by(group) %>% 
  summarise(n())

bike_data$group<-
  cut(bike_data$atemp, breaks = quantile(bike_data$atemp,probs = c(0,0.25,0.5,0.75,1)))

bike_data %>% 
  mutate(group=cut(bike_data$atemp, breaks = seq(0,30,length.out = 30))) %>% 
  group_by(group) %>% 
  summarise(cnt=n()) %>% 
  ggplot(aes(x=group,y=cnt))+
  geom_point()

bike_data %>% 
  mutate(group=cut(bike_data$atemp, breaks = seq(0,30,length.out = 30))) %>% 
  group_by(group) %>% 
  summarise(cnt=n()) %>% 
  ungroup() %>% 
  mutate(sum=sum(cnt)) %>% 
  mutate(prob=cnt/sum) %>% 
  dplyr::select(-sum)

bike_data_season <- bike_data %>% filter(season==1)
bike_density <- kde2d(bike_data_season$atemp,bike_data_season$humidity, n=1000)

sum(bike_density$z)

## [1] 306.9665

bike_density$z<-bike_density$z/sum(bike_density$z)
sum(bike_density$z)

## [1] 1

contour(bike_density)
text(12.2,92,"1",cex=1.5)
points(12.2,89,col="red",pch=18)
text(10.4,47,"2",cex=1.5)
points(10.4,43,col="red",pch=18)
text(21,45,"3",cex=1.5)
points(21,40,col="red",pch=18)
text(21.6,82,"4",cex=1.5)
points(21.6,78,col="red",pch=18)

hm_col_scale<-
  colorRampPalette(c("black","blue","green","orange","red"))(1000)

image(bike_density$z,  
      col = hm_col_scale,
      zlim=c(min(bike_density$z), max(bike_density$z)))
text(0.31,0.46,"Most Frequent",col="blue",cex=0.8)
points(0.31,0.45,col="blue",pch=18)

1) Análisis unidimensional:

Dado un par de valore contenidos en la función de probabilidad conjunta y un valor de longitud, determinar la probabilidad contenida sobre la línea que se forma en el eje x y en el eje y del punto.

prob_line<-function(a,b,c,d,ked){
  
  atemp_res<-
    which(ked$x>a&ked$x<b)
  
  hum_res<-
    which(ked$y>c&ked$y<=d)
  
  return(sum(ked$z[atemp_res,hum_res]))
}



prob_line(10,20,30,40,bike_density)

## [1] 0.07229915

2) Análisis Bidimensional:

Dado un par de valores contenidos en la función de densidad conjunta (x𝑥∗,y𝑦∗) y un valor cualquier que representa el radio de un circulo con centro (x𝑥∗,y𝑦∗) construir una función/mecanismo en R que permita calcular la probabilidad del circulo formado con estos parámetros.

prob_circle<-function(a,b,r,ked){
  
  M<-
    matrix(0,ncol=1000,nrow = 1000)
  
  for(i in 1:1000){
    for(j in 1:1000){
      M[i,j]<-(i-a)^2+(j-b)^2<=r^2
    }
  }
  
  return(sum(ked$z*M))
}

prob_circle(250,250,200,bike_density)

## [1] 0.122488