#---------------------------------------------------------------#
## leer y escribir datos                                  ##

rm(list =ls())           # esta instrucción vacía el entorno

#---------------------------------------------------------------#
## creación de un calendario fácil de menipular                 ##
fabrica_secuencia_dias <- function(inicio = "2000-01-01",
                                    fin   = "2020-12-31" ){
  require(dplyr)
  num_dias  <- as.Date(fin) - as.Date(inicio)
  sec_dias <- seq.Date(as.Date(inicio),
                        by="1 day", 
                        length.out= num_dias+1)
  df <- data.frame(sec_dias)
  df <- dplyr::mutate(df,
          fecha_es = format(as.Date(sec_dias),"%D"),
          anio      = format(as.Date(sec_dias),"%Y"),
          mes    = format(as.Date(sec_dias),"%m"),
          mes_es = format(as.Date(sec_dias),"%h"),
          dia    = substr(sec_dias,9,10),
          dia_semana = as.numeric(format(sec_dias,"%w")),
          dia_semana_es = format(as.Date(sec_dias),"%a"),
          lunes    = dia_semana == 1,
          martes    = dia_semana == 2,
          miercoles = dia_semana == 3,
          jueves    = dia_semana == 4,
          viernes = dia_semana == 5,
          sabado   = dia_semana == 6,
          domingo = dia_semana == 0,
          semana  = !(sabado | domingo)
          )
  }

calendario    <- fabrica_secuencia_dias("2018-01-01",
                                         "2018-12-31")

require("magrittr")
calendario          %>%             # fácil manipulación
     subset(lunes)  %>%
     subset(sec_dias  >= "2018-06-19",
            sec_dias  <= "2018-09-05") 


save(calendario,file="calendario.RData")  # guarda tal cual
                                          # test
rm(calendario)                            # eliminación
load("calendario.RData")                  # devuelve el objeto

saveRDS(calendario, "calendario.Rds")       # copia
calendario_bis <- readRDS("calendario.Rds") # lectura & asignación
identical(calendario,calendario_bis)        # TRUE

#---------------------------------------------------------------#
## creación de una base hash                                     #

                                    # para acceder por fila
                                    # "de manera clásica"
library(filehash)
dbCreate("base_calendario")
filehash_db<- dbInit("base_calendario")

t1 <- Sys.time()
for (i in 1:nrow(calendario)){
     v    <- calendario[i,]
     indx <- paste0(v$anio,v$mes,v$dia)
     dbInsert(filehash_db,indx, v )
     }
d1 <- Sys.time() - t1
d1                               #  no est rápido

rm(calendario) # almacenado por lo que podemos eliminarlo
env <- db2env(filehash_db)       # enlace entre envir y db
                                 # activa binding

tous_los_indx_de_env <- ls(env)  # listas de claves

ligne_20181208 <- env$"20181208" # recuperación de una fila
ligne_20181208
                                 # sin binding podemos ahcer
ligne_20181208_fetch<- dbFetch(filehash_db,"20181208") 
identical(ligne_20181208,ligne_20181208_fetch) # TRUE

l <- as(filehash_db, "list")     # recuperación de todos los datos 
                                      

require(dplyr)
df_ <- bind_rows(l)              # reconstrucción de un dataframe
df_ <- bind_rows(l)[order(df_$sec_dias),]  # ordenado

                                          # recuperación data ok
calendario_bis <- calendario_bis[order(calendario_bis$sec_dias),]
identical(str(df_),str(calendario_bis))   # TRUE misma estrutura
identical(df_[365,],calendario_bis[365,]) # FALSE identical es demasico
bind_rows(df_[365,], calendario_bis[365,])# ok

my_get <- function(x){x[1,]}          # accede a fila1 dataframe
l_ <- lapply(filehash_db, my_get)
identical(l,l_)                       # TRUE

my_get_extrait <- function(x) { g <- my_get(x)
                                g[,c(2,8,9,10,11,12,13,14,15)]}
l__ <- lapply(filehash_db, my_get_extrait)

#---------------------------------------------------------------#

# almacenamiento transpuesto
# una columna del data.frame
# por línea
# económico
dbCreate("t_base_calendario")
t2 <- Sys.time()
dumpDF(calendario_bis,"t_base_calendario")
d2 <- Sys.time() - t2
d2                                   # 10 veces más rápido

filehash_db_t<- dbInit("t_base_calendario")
env_t <- db2env(filehash_db_t)       # relación entre envir y db

env_t$sec_dias                      # los dias
env_t$lunes                          
which(env_t$lunes)                   # indice de los lunes

env_t$sec_dias[which(env_t$lunes)]  # los lunes

                                     # data.frame des lunes
los_lunes <- data.frame(env_t$sec_dias[which(env_t$lunes)],
                        env_t$mes_es[which(env_t$lunes)])
names(los_lunes) <- c("sec_dias","mes_es")

                                    # time serie divergente
set.seed(1)
require(lambda.tools)               # para tener map
valores <- map(c(1:365),function(x) {runif(1)*x})
plot(valores)
dbInsert(filehash_db_t,"valores",valores)

ls(env_t)                            # ¿dónde está valores?
env_t <- db2env(filehash_db_t)       # volver a hacer la relación
ls(env_t)                            # valores está aquí
min(env_t$valores)                   # 0.26
mean(env_t$valores)                  # 88.58
max(env_t$valores)                   # 348.26    

                                     
med <- mean(env_t$valores)
inc <- which(env_t$lunes & env_t$valores >= med)

los_lunes_top <- data.frame(env_t$sec_dias[inc],
                            env_t$mes_es[inc],
                            env_t$valores[inc])

names(los_lunes_top) <- c("sec_dias","mes_es","valores")
View(los_lunes_top)


#---------------------------------------------------------------#

require(sqldf)                    # SQL y R

                                  # lectura filtrada
sentencia_sql <- "select v1,v2 from file where v1 < 0 AND v2 <= 0"
extrait_datatest1 <- read.csv2.sql("datatest1.csv",
                                  sql = sentencia_sql,
                                  dec = ",")
str(extrait_datatest1)

#---------------------------------------------------------------#
## conexión a una base de datos del servidor SQL B_DEMO NOT RUN ##
## en Windows ##
## necesita crear una cadena de conexión ##
## luego obtenemos un controlador para la base de datos##
library(RODBC)
# llave porque hay un caracter especial (espacio)
# en cadena (sintaxis odbc)
c1 <- 'driver={SQL Server};'
# el \\ significa \ porque \ es un carácter de escape en R
c2 <- 'server= MI-PC\\SQLEXPRESS;'
c3 <- 'database={B_DEMO};'
c4 <- 'trusted_connection=true' # ¡¡sin contraseña!!
c <- paste0(c1,c2,c3,c4)
c# para ver la cadena formada
dbhandle <-odbcDriverConnect(c) # nos conectamos a través de odbc

## prueba de conexión,
##en una tabla que existe en todas las bases de datos de sqlserver
res <- sqlQuery(dbhandle, 'select * from information_schema.tables')


# La cadena creada estaba en R:
# "driver={SQL Server};server=
# MI-PC\\SQLEXPRESS;database={B_DEMO};trusted_connection=true"
#
# Que será leído por odbc como (observe el único \):
# driver={SQL Server};server=
# MI-PC\SQLEXPRESS;database={B_DEMO};trusted_connection=true


#------------------------------------------------- --------------#
require(ff) # manejar archivos muy grandes


d_ <- read.csv.ffdf(file="datatest1.csv",
                    sep = ";",
                    dec = ",",
                    header=TRUE, 
                    VERBOSE=TRUE, 
                    first.rows=10000, 
                    next.rows=50000, 
                    colClasses=NA)

d_[1,]              # línea 1
d_[,2]              # columna 2
d_$v1[] <  0        # booleanos
d_$v2[] <= 0
which((d_$v1[] <  0 ) & (d_$v2[] <= 0))           # 23 índices
s <- d_[which((d_$v1[] <  0 ) & (d_$v2[] <= 0)),] # no virtual
# virtual
s <- as.ffdf(d_[which((d_$v1[] <  0 ) & (d_$v2[] <= 0)),])
s$v12

#---------------------------------------------------------------#
require(xml2) # procesar xml y html
# conectar y leer
sitio_html <- read_html("http://www.rstudio.com/")
# mostrar estructura
# del sitio
html_structure(site_html)
# guardar en el disco
write_html(site_html,"site.html")

require(rvest) # scrapper el sitio
enlaces <- html_nodes(site_html,"link") # nodos con enlaces
attr_26 <- html_attrs(enlaces)[[26]] # 26º enlace
paste0(attr_26[3]) # claro!
#---------------------------------------------------------------#
require(jsonlite)
url_api <-"https://www.quandl.com/api/v3/datasets/OPEC/ORB.json"
retorno_api <- fromJSON(url_api)

s_OPEC <- data.frame(retorno_api$data$data)   
names(s_OPEC) <- c("sec_dias","cours")
s_OPEC <- s_OPEC[order(s_OPEC$sec_dias),]   # orden creciente
head(s_OPEC)

#---------------------------------------------------------------#
library(future)                           # paraleliza
library(mlbench)                          # para crear los "benchs"
availableCores()

plan(strategy = sequential)               # sin paralelización
t1 <- Sys.time()
f_2 <- future({c(1:40000,1:9000)*Sys.getpid()})
f_3 <- future({c(1:40000,1:9000)*Sys.getpid()})
m2  <- value(f_2)
m3  <- value(f_3)
d1 <- Sys.time() -t1
d1
rm(m2,m3,f_2,f_3)
gc()                                      # vacía residuos de memoria
# papelera de reciclaje

plan(strategy = multiprocess)             # paralelismo total
t2 <- Sys.time()
f_2 <- future({c(1:40000,1:9000)*Sys.getpid()})
f_3 <- future({c(1:40000,1:9000)*Sys.getpid()})
m2  <- value(f_2)
m3  <- value(f_3)
d2 <- Sys.time() -t2
d2
rm(m2,m3,f_2,f_3)
gc()


#---------------------------------------------------------------#
#---------------------------------------------------------------#

# tools funcionales
library(lambda.r)
require(pryr)
library(functional)               
library(lambda.tools) 

#---------------------------------------------------------------#
memory.limit()
memory.profile()
gcinfo(TRUE)
gc()
mem_used()
#---------------------------------------------------------------#
library(mlbench)

mem_change(p_df <- as.data.frame(mlbench.hypercube(n = 10000)))
anytypes(p_df)
rls()

gcinfo(FALSE)
gc()
mem_used()

mem_change(rm(p_df))
gc()
mem_used()
rls()


#---------------------------------------------------------------#
