[R-es] consultas formularios web

[Javier Marcuzzi]

Estimados

Estoy aprendiendo, concretamente RSelenium me parece una buena opción
puesto que hay otras que no están en todos los sistemas operativos, y trato
de escribir independiente del sistema.

Necesitaría si no es molestia que corran un código R y analizar si se
repite el siguiente error.

> todo_javier<-lapply(nombres_ddoo_grep_javier,leer)
Error in tabla[[1]] : subscript out of bounds
Error in tabla[[1]] : subscript out of bounds
Error in tabla[[1]] : subscript out of bounds
Error in tabla[[1]] : subscript out of bounds
Error in tabla[[1]] : subscript out of bounds

Copio y pego el código original, o casi porque tiene pequeñas anotaciones
personales para aprender.

#########################################################
#
# Jorge Ayuso Rejas
# Open Analytics 2014
# https://github.com/jayusor/openanalytics_2014
#
#########################################################

rm(list = ls());gc()
library(RCurl)
library(RSelenium)
library(XML)
library(data.table)
library(parallel)
url<-"http://www.verema.com/vinos/portada"

checkForServer()
Sys.sleep(.5)
startServer()
Sys.sleep(2)

parsear_tablas<-function(j){

  doc<-getURI(j)
  error<-1
  intentos<-0

  while(error==1 & intentos<10){

    tabla<-readHTMLTable(doc ,stringsAsFactors = FALSE,
encoding="UTF-8",header = TRUE)
    if(!inherits(try(tabla[[1]]), "try-error") ) error<-0
    intentos<-intentos+1

  }

  if(inherits(try(tabla[[1]]), "try-error") ) return()

  if(is.null(tabla)|length(tabla)==0|is.null(tabla[[1]])) return()
  tabla<-try(tabla[[1]])
  if(length(tabla)<2) return(NULL)

  tabla$Vino<-gsub("\\n\\(function.*$","",tabla$Vino)
  cual<-grep("Anterior.*Siguiente",tabla$Vino)
  if(length(cual)>0) tabla<-tabla[-cual,]
  return(as.data.table(tabla))
}


leer<-function(i){
  firefox$navigate(url)
  Sys.sleep(2)

firefox$findElement("xpath",paste0('//*[@id="producto_ddoo_id"]/option[.=\'',i,'\']'))$clickElement()
  Sys.sleep(1)

firefox$findElement("xpath",'//*[@id="leftflex-cell-col300"]/div/div[1]/div/form/input[4]')$clickElement()

  url_ddoo<-firefox$getCurrentUrl()[[1]]


vinos_total<-firefox$findElement("xpath",'//*[@id="leftflex-cell-col300"]/h1/span')

vinos_total<-as.numeric(gsub("^\\W*([0-9]+).*$","\\1",vinos_total$getElementText()[[1]]))

  if(inherits(try(vinos_total==0), "try-error")|is.na(vinos_total) )
browser()

  if(vinos_total==0) return()

  if(vinos_total>50){
    if(vinos_total>500){
      url_ddoo<-paste0(url_ddoo,apply(expand.grid(1:7,1:10),1,function(x)
paste0("&rango_precio=",x[1],'&page=',x[2])))
    }else{
      url_ddoo<-paste0(url_ddoo,paste0("&page=",1:ceiling(vinos_total/50)))

    }
  }

  url_ddoo<-gsub("&page=1$","",url_ddoo)

  # zoom<-mclapply(url_ddoo,parsear_tablas,mc.cores = 6)   #mclapply solo
funciona en linux/unix poner lapply
  zoom<-lapply(url_ddoo,parsear_tablas)   #mclapply solo funciona en
linux/unix poner lapply
  zoom<-rbindlist(zoom)

  if(length(zoom)==0) return()
  zoom$DO<-i
  return(zoom)
}

firefox <- remoteDriver()
# firefox <- remoteDriver(browserName = "phantomjs")

firefox$open()
firefox$navigate(url)

ddoo<-firefox$findElements("xpath",'//*[@id="producto_ddoo_id"]/option')
Sys.sleep(3)
datosddoo<- ddoo
datosddoo
summary(datosddoo)
str(datosddoo)
datosddoo$getElementText

#nombres_ddoo<-sapply(ddoo,function(x) x$getElementText())
#nombres_ddoo<-do.call(c,nombres_ddoo)
#nombres_ddoo<-nombres_ddoo[grep("^España",nombres_ddoo)]

nombres_ddoo_javier<-sapply(datosddoo,function(x) x$getElementText())
nombres_ddoo_javier

#    ####################   los pasa de esta forma
#[[166]]
#[1] "Australia - Yenda"
#
#[[167]]
#[1] "Argentina - Mendoza"
#   ######################  a esta otra forma
#[1] "Todos"
#[2] "España - D.O. Abona"
#[3] "España - D.O. Alella"


nombres_ddoo_docall_javier<-do.call(c,nombres_ddoo_javier)
nombres_ddoo_docall_javier

# toma los de España con grep
nombres_ddoo_grep_javier<-nombres_ddoo_docall_javier[grep("^España",nombres_ddoo_docall_javier)]
nombres_ddoo_grep_javier

# todo<-lapply(nombres_ddoo,leer)
todo_javier<-lapply(nombres_ddoo_grep_javier,leer)
todo_javier

##  eeeeerrrrrooooorrrrrrr

firefox$close()
firefox$closeServer()

todo<-rbindlist(todo)

# save(todo,file=paste0(Sys.Date(),"_vinos.Rdata"))

El 16 de febrero de 2015, 18:59, Carlos Ortega <cof en qualityexcellence.es>
escribió:

> Hola,
>
> Tienes una presentación sobre esto que hizo Gregorio Serrano en el Grupo
> de Madrid:
> http://madrid.r-es.org/martes-20-mayo-de-2014/
> "Webscrapping with el paquete Relenium"
>
> Y otra alternativa es utilizar RSelenium:
>
> http://cran.r-project.org/web/packages/RSelenium/vignettes/RSelenium-basics.html
>
> Saludos,
> Carlos Ortega
> www.qualityexcellence.es
>
> El 16 de febrero de 2015, 20:13, <javier.ruben.marcuzzi en gmail.com>
> escribió:
>
>> Estimados
>>
>>
>> Les consulto por lo siguiente, incluso creo que de esto se habló en una
>> oportunidad en esta lista, por ese motivo cualquier sugerencia es
>> bienvenida.
>>
>>
>> Hay algo de información que me hace falta para un trabajo, pero esta no
>> es de una única fuente, y desconozco si brindan los registros, pero lo que
>> es accesible son los sitios web donde estas fuentes publican un formulario
>> HTML simple, la respuesta es otro HTML simple, luego puede ser otro HTML
>> simple con algunas tablas. Es decir, algo de información hay pero necesita
>> de trabajo, nada que un script y consultas automatizadas junto a una base
>> de datos y un excelente diseño no pueda lograr.
>>
>>
>> Una alternativa podría ser el siguiente paquete
>> http://cran.r-project.org/web/packages/httr/index.html (como otros tanto
>> que tendría que estudiar), o simplemente curl, tengo que organizar desde el
>> inicio.
>>
>>
>>
>> ¿Alguna sugerencia o recomendación?​
>>
>>
>> Recuerdo que yo mismo participe en debates sobre como tomar información
>> desde internet a R, pero como hace un tiempo no uso esa tecnología, puedo
>> estar muy desactualizado.
>>
>>
>> Javier Marcuzzi
>>         [[alternative HTML version deleted]]
>>
>> _______________________________________________
>> R-help-es mailing list
>> R-help-es en r-project.org
>> https://stat.ethz.ch/mailman/listinfo/r-help-es
>>
>
>
>
> --
> Saludos,
> Carlos Ortega
> www.qualityexcellence.es
>

	[[alternative HTML version deleted]]