R/NscrapBorme_fechas_func.R

Defines functions N_lectura_borme_fechas

Documented in N_lectura_borme_fechas

#' @title Scrapea los Borme para el rango de fechas y las provincias especificadas. Envía el resultado a la plataforma Smart City.
#'
#' @description Scrapea los Borme en PDF en el rango de fechas especificado y de las provincias especificadas (en caso de introducir más de una provincia estas deben estar separadas por comas),
#' en base a un minicipio de referencia y un radio de distancia en km.
#' Devuelve un json con con los campos reflejados por empresa en el borme y lo envía a la plataforma Smart City.
#'
#' @param provincias, radio, municipio, rfechas
#'
#' @return json
#'
#' @examples  N_lectura_borme_fechas('Ermua', 30, 'Bizkaia, Gipuzkoa, Araba', "2020-03-01, 2020-03-30")
#'
#' @import jsonlite
#' pdftools
#' tidyverse
#' stringr
#' tidyr
#' dplyr
#' rvest
#' httr
#' RSelenium
#' geosphere
#' tm
#' anytime
#' xml2
#' purrr
#'
#' @export

N_lectura_borme_fechas <- function(municipio, radio, provincias, fecha = Sys.Date()){

  url_general <- "https://www.boe.es/borme/dias/"
  municipio <- municipio
  radio_ref <- radio
  fecha <- as.character(fecha)

  if(str_detect(provincias,",")){
    provincias <- str_trim(toupper(unlist(str_split(provincias,","))))
  }else{
    provincias <- toupper(provincias)
  }

  #Extración número de días fecha para bucle
  if(grepl(",",fecha)){
    fecha <- str_trim(unlist(str_split(fecha,",")))
  }
  print(fecha)

  if(length(fecha) > 1){
    num_dias <- as.numeric(as.Date(fecha[2]) - as.Date(fecha[1])) + 1
  }else{
    num_dias <- 1
  }

  print(num_dias)

  fechas <- seq(as.Date(fecha[1]),as.Date(fecha[2]),1)


  #Bucle fechas
  for(z in 1:num_dias){

    if(str_detect(fechas[z],"-")){
      fecha_borme <- str_replace_all(fechas[z],"-","/")
    }else{
      fecha_borme <- fechas[z]
    }

    url_fecha <- paste(url_general,fecha_borme, sep = "")

    #Envío JSON a plataforma
    TB_token <- "SDszy9P3S9B3Yc7aFQ42"
    TB_url   <- paste("http://88.99.184.100:8080/api/v1/",TB_token,"/telemetry",sep="")

    #Manejo de errores
    tryCatch({

      html <- read_html(url_fecha)  #Objeto documento html

      titulo <- html %>% html_nodes(".sumario ul")%>% html_nodes(".dispo p") %>% html_text() %>% str_trim() %>% unlist()
      titulo <- titulo[1:grep("ÍNDICE ALFABÉTICO DE SOCIEDADES", titulo)-1]

      url_pdf <- html %>% html_nodes(".puntoPDF") %>% html_nodes("a") %>% html_attr("href") %>% str_trim() %>% unlist()
      url_pdf <- url_pdf[1:length(titulo)+1]

      url_borme_gen <- "https://www.boe.es"

      #Extracción índice provincias en vector título
      posicion_urls <- c()
      for(i in 1:length(provincias)){
        if(any(grepl(provincias[i],titulo))){
          posicion_urls <- c(posicion_urls,grep(provincias[i],titulo))
        }
      }

      #Generación de error en caso de que no se encuentren Bormes de las provincias especificadas
      if(is_empty(posicion_urls)){
        stop("No se encuentran las provincias especificadas en el Borme de hoy")
      }

      #Tiempo de referencia para posterior suma con el objetivo de evitar pisados en el timestamp de la plataforma Smart City
      t_ref <- "00:00:00"

      print(posicion_urls)

      #Bucle ejecución N Bormes
      for(p in 1:length(posicion_urls)){

        url <- paste(url_borme_gen,url_pdf[posicion_urls[p]],sep = "")
        provincia <- titulo[posicion_urls[p]]

        #Lógica para variar timestamp y evitar pisados en plataforma Smart City
        fecha_borme <- as.POSIXct(paste(fechas[z], t_ref)) + 3600*(p-1)

        print("NUEVO")
        print(fecha_borme)
        print(provincia)
        print(url)

        #==========================================================================
        # LECTURA BORME
        #==========================================================================

        #Función que convierte a mayúsculas la primera letra de las palabras de un vector de caracteres
        letras_mayus <- function(x) {
          s <- strsplit(x, " ")[[1]]
          paste(toupper(substring(s, 1,1)), substring(s, 2),sep="", collapse=" ")
        }

        pos_puntos <- gregexpr(pattern = "[[:punct:]]+",text = url)
        pos_barras <- gregexpr(pattern = "[/]+",text = url)
        #nombre_borme <- substr(url,pos_barras[[1]][length(pos_barras[[1]])]+1,pos_puntos[[1]][length(pos_puntos[[1]])]-1)

        archivo_temporal <- tempfile(pattern = "", tmpdir = tempdir(), fileext = ".pdf")
        # mode = wb es en binary
        download.file(url, destfile = archivo_temporal, mode = "wb")

        txt <- pdf_text(archivo_temporal)
        info <- pdf_info(archivo_temporal)
        data<-pdf_data(archivo_temporal)
        pages<-info$pages
        documents <- strsplit(txt,"*.[0-9] - ", fixed=F)  #Split del txt PDF por "-". El número previo a "-" hace referencia al número de empresas del año presente.

        ###############################################

        docs<-{}
        index<-c(1)
        for ( i in 1:pages){
          s<-length(documents[[i]])
          l<-length(index)
          index<-append(index,s+index[l])
          for (j in 1:s){
            docs<-append(docs,documents[[i]][[j]])
          }}
        index<-index[-length(index)]

        #docs <- str_squish(docs)

        docs[index]<-docs[index]%>%gsub("BOLETÍN OFICIAL DEL REGISTRO MERCANTIL.*Pág\\. \\d\\d\\d\\d\r\n","",.)

        for (i in 2:length(index)){
          docs[index[i]-1]<-paste(docs[index[i]-1],docs[index[i]],collpase="")
        }
        docs<-docs[-index]

        #Bucle para evitar errores en la separación del texto (pdf) por empresa
        for(i in 1:length(docs)){
          valor_bool <- grepl("Datos registrales", docs[i])

          if(!valor_bool){
            docs[i] <- paste(docs[i], docs[i+1], sep = "")
            docs<-docs[-(i+1)]
          }

          if(grepl("NANA", docs[i]) | grepl("ISSN:", docs[i])){
            docs<-docs[-i]
          }
        }
        docs <- na.omit(docs)

        ##Nombre de las empresas
        `EMPRESA` <-sub("\\.\n.*", "", docs)

        ##Numero de registros realizados
        total_docs<-length(EMPRESA)
        docs<-docs%>%tolower()
        #docs<-docs%>%gsub("cve: (.*)","",.)

        #docs<-docs%>%gsub("cve: borme.* ","",.)%>%gsub("verificable en https://www.boe.es\n","",.)



        docs<-docs%>%gsub("\"","",.)
        docs<-str_replace_all(docs,"nombramientos","NOMBRAMIENTOS")
        docs<-str_replace_all(docs,"datos registrales","DATOS REGISTRALES")
        docs<-str_replace_all(docs,"ceses/dimisiones","CESES/DIMISIONES")
        docs<-str_replace_all(docs,"otros conceptos","OTROS CONCEPTOS")
        docs<-str_replace_all(docs,"disolución","DISOLUCIÓN")
        docs<-str_replace_all(docs,"extinción","EXTINCIÓN")
        docs<-str_replace_all(docs,"declaración de unipersonalidad","DECLARACIÓN DE UNIPERSONALIDAD")
        docs<-str_replace_all(docs,"ampliación de capital","AMPLIACIÓN DE CAPITAL")
        docs<-str_replace_all(docs,"reelecciones","REELECCIONES")
        docs<-str_replace_all(docs,"cambio de domicilio social","CAMBIO DE DOMICILIO SOCIAL")
        docs<-str_replace_all(docs,"cambio de objeto social","CAMBIO DE OBJETO SOCIAL")
        docs<-str_replace_all(docs,"modificaciones estatutarias","MODIFICACIONES ESTATUTARIAS")
        docs<-str_replace_all(docs,"revocaciones","REVOCACIONES")
        docs<-str_replace_all(docs,"constitución","CONSTITUCIÓN")
        docs<-str_replace_all(docs,"ampliacion del objeto social","AMPLIACIÓN DEL OBJETO SOCIAL")
        docs<-str_replace_all(docs,"reapertura hoja registral","REAPERTURA HOJA REGISTRAL")
        docs<-str_replace_all(docs,"reducción de capital","REDUCCIÓN DE CAPITAL")
        docs<-str_replace_all(docs,"fusión por absorción","FUSIÓN POR ABSORCIÓN")
        docs<-str_replace_all(docs,"cambio de denominación social","CAMBIO DE DENOMINACIÓN SOCIAL")
        docs<-str_replace_all(docs,"situación concursal","SITUACIÓN CONCURSAL")
        docs<-docs%>%str_squish()


        ##SITUACIÓN CONCURSAL
        situacion_concursal<-str_extract(docs,"SITUACIÓN CONCURSAL.*?[A-Z]")%>%gsub("[A-Z]$","",.)

        Sit_conc_procedimiento <- situacion_concursal %>% str_extract("procedimiento concursal.*?\\.")%>%gsub("procedimiento concursal","",.)
        Sit_conc_firme <- situacion_concursal %>% str_extract("firme.*?\\,")%>%gsub("firme:","",.)%>%gsub(",","",.)
        Sit_conc_fecha_resolucion <- situacion_concursal %>% str_extract("fecha de resolución.*?\\.")%>%gsub("fecha de resolución","",.)
        Sit_conc_proceso <- situacion_concursal %>% str_extract("sit_conc_firme.*?\\.")%>%gsub("sit_conc_firme","",.)
        Sit_conc_juzgado <- situacion_concursal %>% str_extract("juzgado: num..*?\\.")%>%gsub("juzgado:","",.)
        Sit_conc_juez <- situacion_concursal %>% str_extract("juez.*?\\.")%>%gsub("juez:","",.)
        Sit_conc_resoluciones <- situacion_concursal %>% str_extract("resoluciones.*?\\.")%>%gsub("resoluciones:","",.)

        `SITUACIÓN CONCURSAL` <- data.frame(Sit_conc_procedimiento, Sit_conc_firme, Sit_conc_fecha_resolucion, Sit_conc_proceso, Sit_conc_juzgado, Sit_conc_juez, Sit_conc_resoluciones,
                                            stringsAsFactors = F)

        ##NOMBRAMIENTOS
        nombramientos<-str_extract(docs,"NOMBRAMIENTOS.*?[A-Z]")%>%gsub("[A-Z]$","",.)

        Nombr_liquiSoli<-nombramientos%>%str_extract("liquisoli.*?\\.")%>%gsub("liquisoli:","",.)
        Nombr_apoderado<-nombramientos%>%str_extract("apoderado.*?\\.")%>%gsub("apoderado:","",.)
        Nombr_adminUnico<-nombramientos%>%str_extract("adm\\. unico.*?\\.")%>%gsub("adm\\. unico:","",.)
        Nombr_liquidador<-nombramientos%>%str_extract("liquidador:.*?\\.")%>%gsub("liquidador:","",.)
        Nombr_liquidador_mancom<-nombramientos%>%str_extract("liquidador m:.*?\\.")%>%gsub("liquidador m:","",.)
        Nombr_adminSolid<-nombramientos%>%str_extract("adm\\. solid\\..*?\\.")%>%gsub("adm\\. solid\\.:","",.)
        Nombr_socprof<-nombramientos%>%str_extract("soc\\.prof\\..*?\\.")%>%gsub("soc\\.prof\\.:","",.)
        Nombr_auditor<-nombramientos%>%str_extract("auditor.*?\\.")%>%gsub("auditor:","",.)
        Nombr_adminMan<-nombramientos%>%str_extract("adm\\. mancom\\..*?\\.")%>%gsub("adm\\. mancom\\.:","",.)
        Nombr_entidDeposit<-nombramientos%>%str_extract("entiddeposit.*?\\.")%>%gsub("entiddeposit:","",.)
        Nombr_entdPromo<-nombramientos%>%str_extract("entd\\.promo\\..*")%>%gsub("entd\\.promo\\.:","",.)
        Nombr_consejero<-nombramientos%>%str_extract("consejero.*?\\.")%>%gsub("consejero:","",.)
        Nombr_vicepresidente<-nombramientos%>%str_extract("vicepresid\\..*?\\.")%>%gsub("vicepresid\\.:","",.)
        Nombr_presidente<-nombramientos%>%str_extract("presidente.*?\\.")%>%gsub("presidente:","",.)
        Nombr_secretario<-nombramientos%>%str_extract("secretario.*?\\.")%>%gsub("secretario:","",.)

        NOMBRAMIENTOS<-data.frame(Nombr_liquiSoli,Nombr_apoderado,Nombr_adminUnico,Nombr_liquidador,Nombr_liquidador_mancom,Nombr_adminSolid,
                                  Nombr_socprof,Nombr_auditor,Nombr_adminMan,Nombr_entidDeposit,
                                  Nombr_entdPromo,Nombr_consejero,Nombr_vicepresidente,Nombr_presidente,
                                  Nombr_secretario,stringsAsFactors=FALSE)


        #Llamada a función letras_mayus para conversión a maysuculas primera letra de los nombres y apellidos
        for(i in 1:nrow(NOMBRAMIENTOS)){
          for(j in 1:ncol(NOMBRAMIENTOS)){
            if(is.na(NOMBRAMIENTOS[i,j])){
              next
            }else{
              NOMBRAMIENTOS[i,j] <- NOMBRAMIENTOS[i,j] %>% gsub(";",", ",.) %>% letras_mayus()
            }
          }
        }


        ##CESES
        ceses<-str_extract(docs,"CESES/DIMISIONES.*?[A-Z]")
        ceses<-ceses%>%gsub("[A-Z]$","",.)

        Ceses_liquiSoli<-ceses%>%str_extract("liquisoli.*?\\.")%>%gsub("liquisoli:","",.)
        Ceses_apoderado<-ceses%>%str_extract("apoderado.*")%>%gsub("apoderado:","",.)
        Ceses_adminUnico<-ceses%>%str_extract("adm\\. unico.*?\\.")%>%gsub("adm\\. unico:","",.)
        Ceses_liquidador<-ceses%>%str_extract("liquidador:.*?\\.")%>%gsub("liquidador:","",.)
        Ceses_liquidador_mancom<-ceses%>%str_extract("liquidador m:.*?\\.")%>%gsub("liquidador m:","",.)
        Ceses_adminSolid<-ceses%>%str_extract("adm\\. solid\\..*?\\.")%>%gsub("adm\\. solid\\.:","",.)
        Ceses_adminMan<-ceses%>%str_extract("adm\\. mancom\\..*?\\.")%>%gsub("adm\\. mancom\\.:","",.)
        Ceses_socprof<-ceses%>%str_extract("soc\\.prof\\..*?\\.")%>%gsub("soc\\.prof\\..*:","",.)
        Ceses_depositorio<-ceses%>%str_extract("depositario.*?\\.")%>%gsub("depositario:","",.)
        Ceses_entidDeposit<-ceses%>%str_extract("entiddeposit.*?\\.")%>%gsub("entiddeposit:","",.)
        Ceses_entdPromo<-ceses%>%str_extract("entd\\.promo\\..*")%>%gsub("entd\\.promo\\.:","",.)
        Ceses_consejero<-ceses%>%str_extract("consejero.*?\\.")%>%gsub("consejero:","",.)
        Ceses_vicepresidente<-ceses%>%str_extract("vicepresid\\..*?\\.")%>%gsub("vicepresid\\.:","",.)
        Ceses_presidente<-ceses%>%str_extract("presidente.*?\\.")%>%gsub("presidente:","",.)
        Ceses_secretario<-ceses%>%str_extract("secretario.*?\\.")%>%gsub("secretario:","",.)

        CESES<-data.frame(Ceses_liquiSoli,Ceses_apoderado,Ceses_adminUnico,Ceses_liquidador,Ceses_liquidador_mancom,
                          Ceses_adminSolid,Ceses_adminMan,Ceses_socprof,Ceses_depositorio,
                          Ceses_entidDeposit,Ceses_entdPromo,Ceses_consejero,
                          Ceses_vicepresidente,Ceses_presidente,Ceses_secretario,stringsAsFactors = FALSE)

        #Llamada a función letras_mayus para conversión a maysuculas primera letra de los nombres y apellidos
        for(i in 1:nrow(CESES)){
          for(j in 1:ncol(CESES)){
            if(is.na(CESES[i,j])){
              next
            }else{
              CESES[i,j] <- CESES[i,j] %>% gsub(";",", ",.) %>% letras_mayus()
            }
          }
        }

        ##AMPLIACION CAPITAL
        ampliacionCapital<-str_extract(docs,"AMPLIACIÓN DE CAPITAL.*?[A-Z]")
        ampliacionCapital<-ampliacionCapital%>%gsub("[A-Z]$","",.)

        Ampl_Cap_suscrito<-ampliacionCapital%>%str_extract("suscrito.*?euros\\.")%>%gsub("suscrito:","",.)
        Ampl_Cap_resultante_suscrito<-ampliacionCapital%>%str_extract("resultante suscrito.*?euros\\.")%>%gsub("resultante suscrito:","",.)
        Ampl_Cap_desembolsado<-ampliacionCapital%>%str_extract("desembolsado.*?euros\\.")%>%gsub("desembolsado:","",.)
        Ampl_Cap_resultante_desembolsado<-ampliacionCapital%>%str_extract("resultante desembolsado.*?euros\\.")%>%gsub("resultante desembolsado:","",.)
        Ampl_Cap_capital<-ampliacionCapital%>%str_extract("capital.*?euros\\.")%>%gsub("capital:","",.)

        `AMPLIACION CAPITAL`<-data.frame(Ampl_Cap_suscrito,Ampl_Cap_resultante_suscrito,Ampl_Cap_desembolsado,
                                         Ampl_Cap_resultante_desembolsado,Ampl_Cap_capital,stringsAsFactors=FALSE)
        ##REDUCCION
        reduccionCapital<-str_extract(docs,"REDUCCIÓN DE CAPITAL.*?[A-Z]")%>%gsub("[A-Z]$","",.)

        Reduc_Cap_importe_reduccion<-reduccionCapital%>%str_extract("importe reducción.*?euros\\.")%>%gsub("importe reducción:","",.)
        Reduc_Cap_resultante_suscrito<-reduccionCapital%>%str_extract("resultante suscrito.*?euros\\.")%>%gsub("resultante suscrito:","",.)

        `REDUCCION CAPITAL`<-data.frame(Reduc_Cap_importe_reduccion,Reduc_Cap_resultante_suscrito,stringsAsFactors=FALSE)

        ##CONSTITUCION
        constitucion<-str_extract(docs,"CONSTITUCIÓN.*?[A-Z]")%>%gsub("[A-Z]$","",.)

        Const_comienzo_operaciones<-constitucion%>%str_extract("comienzo de operaciones.*?\\. ")%>%gsub("comienzo de operaciones:","",.)
        Const_objeto_social<-constitucion%>%str_extract("objeto social.*?\\. domicilio")%>%gsub("objeto social:","",.)
        Const_domicilio<-constitucion%>%str_extract("domicilio.*?\\)")%>%gsub("domicilio:","",.) %>% str_trim()
        Const_capital<-constitucion%>%str_extract("capital.*?euros\\.")%>%gsub("capital:","",.)

        CONSTITUCION<-data.frame(Const_comienzo_operaciones,Const_objeto_social,Const_domicilio,
                                 Const_capital,stringsAsFactors=FALSE)

        ###CAMBIO DENOMINACIÓN SOCIAL
        cambioDenominacionSocial<-str_extract(docs,"CAMBIO DE DENOMINACIÓN SOCIAL.*?[A-Z]")%>%gsub("[A-Z]$","",.)
        Cambio_denominacion_social<-cambioDenominacionSocial

        ###REELECCIONES
        reelecciones<-str_extract(docs,"REELECCIONES.*?[A-Z]")%>%gsub("[A-Z]$","",.)

        Reelecciones_adminUnico<-reelecciones%>%str_extract("adm\\. único.*?\\.")%>%gsub("adm\\. único:","",.)
        for(i in 1:length(Reelecciones_adminUnico)){
          if(!is.na(Reelecciones_adminUnico[i])){
            Reelecciones_adminUnico[i] <-  letras_mayus(gsub(";",", ",Reelecciones_adminUnico[i]))
          }
        }

        Reelecciones_auditor<-reelecciones%>%str_extract("auditor.*?\\.")%>%gsub("auditor:","",.)
        Reelecciones_auditor_suplente<-reelecciones%>%str_extract("aud\\.supl\\..*?\\.")%>%gsub("aud\\.supl\\.:","",.)

        REELECCIONES<-data.frame(Reelecciones_adminUnico,Reelecciones_auditor, Reelecciones_auditor_suplente,stringsAsFactors=FALSE)

        ##REVOCACIONES
        revocaciones<-str_extract(docs,"REVOCACIONES.*?[A-Z]")%>%gsub("[A-Z]$","",.)
        Revocaciones_auditor<-revocaciones%>%str_extract("auditor.*?\\.")%>%gsub("auditor:","",.)
        Revocaciones_apoderado<-revocaciones%>%str_extract("apoderado.*?\\.")%>%gsub("apoderado:","",.)
        Revocaciones_apoderadoMAn<-revocaciones%>%str_extract("apo\\.man\\.soli.*?\\.")%>%gsub("apo\\.man\\.soli:","",.)
        Revocaciones_apoderadoSol<-revocaciones%>%str_extract("apo\\.sol\\..*?\\.")%>%gsub("apo\\.sol\\.:","",.)

        REVOCACIONES<-data.frame(Revocaciones_auditor,Revocaciones_apoderado,Revocaciones_apoderadoMAn,
                                 Revocaciones_apoderadoSol,stringsAsFactors=FALSE)

        #Llamada a función letras_mayus para conversión a maysuculas primera letra de los nombres y apellidos
        for(i in 1:nrow(REVOCACIONES)){
          for(j in 1:ncol(REVOCACIONES)){
            if(is.na(REVOCACIONES[i,j])){
              next
            }else{
              REVOCACIONES[i,j] <- REVOCACIONES[i,j] %>% gsub(";",", ",.) %>% letras_mayus()
            }
          }
        }

        ###FUSIÓN POR ABSORCIÓN

        fusion<-str_extract(docs,"FUSIÓN POR ABSORCIÓN.*?[A-Z]")%>%gsub("[A-Z]$","",.)
        Fusion_sociedades_absorbidas<-fusion%>%str_extract("sociedades absorbidas.*?\\.")

        ##MODIFICACIONES ESTATUTARIAS
        Modificaciones_estatutarias<-str_extract(docs,"MODIFICACIONES ESTATUTARIAS.*?[A-Z]")%>%gsub("[A-Z]$","",.)%>%gsub("MODIFICACIONES ESTATUTARIAS\\.","",.)

        ##CAMBIO DOMICILIO SOCIAL
        Cambio_domicilio_social<-str_extract(docs,"CAMBIO DE DOMICILIO SOCIAL.*?\\)")%>%gsub("CAMBIO DE DOMICILIO SOCIAL.","",.) %>% str_trim()

        ##CAMBIO OBJETO SOCIAL
        Cambio_objeto_social<-str_extract(docs,"CAMBIO DE OBJETO SOCIAL.*?[A-Z]")%>%gsub("[A-Z]$","",.)%>%gsub("CAMBIO DE OBJETO SOCIAL\\.","",.)

        ##EXTINCION
        Extincion <-str_extract(docs,"EXTINCIÓN.*?[A-Z]")%>%gsub("[A-Z]$","",.)%>%gsub("EXTINCIÓN\\.","",.)

        ##DISOLUCION
        Disolucion <-str_extract(docs,"DISOLUCIÓN.*?[A-Z]")%>%gsub("[A-Z]$","",.)%>%gsub("DISOLUCIÓN\\.","",.)

        ##DECLARACIÓN UNIPERSONALIDAD

        declaracionUnipersonalidad<-str_extract(docs,"DECLARACIÓN DE UNIPERSONALIDAD.*?[A-Z]")%>%gsub("[A-Z]$","",.)
        declaracion_unipersonalidad_socio_unico<-declaracionUnipersonalidad%>%str_extract("socio único.*?\\.")%>%gsub("socio único:","",.)
        Declaracion_unipersonalidad<-data.frame(declaracion_unipersonalidad_socio_unico,stringsAsFactors=FALSE)

        ##NO SE DIVIDEN
        Otros_conceptos<-str_extract(docs,"OTROS CONCEPTOS.*?[A-Z]")%>%gsub("[A-Z]$","",.)%>%gsub("OTROS CONCEPTOS:","",.)
        Datos_registrales<-str_extract(docs,"DATOS REGISTRALES.*")%>%gsub("\\.$","",.)%>%gsub("DATOS REGISTRALES\\.","",.)

        data<-data.frame(EMPRESA,Fusion_sociedades_absorbidas,Modificaciones_estatutarias,Cambio_denominacion_social,Cambio_domicilio_social,
                         Cambio_objeto_social,CESES,NOMBRAMIENTOS,`AMPLIACION CAPITAL`,Declaracion_unipersonalidad,
                         `REDUCCION CAPITAL`,REELECCIONES,REVOCACIONES, `SITUACIÓN CONCURSAL`, Disolucion,Extincion,CONSTITUCION,Otros_conceptos,Datos_registrales,stringsAsFactors=FALSE)
        s<-0
        ncol<-ncol(data)
        BBDD<-data.frame(EMPRESA,stringsAsFactors=F)

        #for(j in 2:ncol){
        # l<-{}
        # a<-data[j]%>%lapply(.,function(x) str_extract_all(x,";"))
        # for(i in 1:length(a[[1]])){
        #   if(is.na(a[[1]][[i]]) || identical(a[[1]][[i]],character(0))){
        #     l2<-0
        #   }else{
        #     l2<-length(a[[1]][[i]])
        #   }
        #   l<-append(l,l2)
        # }
        # max<-max(l)
        # if(max!=0){
        #   nombres_columnas_nuevas <- c()
        #   for(k in 1:(max+1)){
        #     nombres_columnas_nuevas <- c(nombres_columnas_nuevas,paste(colnames(data[j]),k,sep=""))
        #   }
        #   dat<-separate(data[j],colnames(data[j]),nombres_columnas_nuevas,sep=";")
        #   BBDD<-cbind(BBDD,dat)
        # }else{BBDD<-cbind(BBDD,data[j])}
        # s<-s+max
        #}

        #####################################################################################
        # CÁLCULO DISTANCIAS ENTRE LONG., LAT. REFERENCIA Y DOMICILIOS CONSTITUCIÓN EMPRESAS
        #####################################################################################

        #Coordenadas de referencia del municipio con geocoder API
        #Endpoint geocoder API
        geocoder_endpoint <- "https://geocoder.api.here.com/6.2/geocode.json?app_id=HRwFz9rfbtRq63qGH4ZQ&app_code=aMRd84WGRs4h1591F-g82w&searchtext="

        coordenadas_ref_municipio <- jsonlite::fromJSON(paste(geocoder_endpoint,URLencode(municipio),"%20(Espa%C3%B1a)",sep = ""))
        coordenadas_ref_municipio <- coordenadas_ref_municipio$Response$View$Result %>% as.data.frame()
        longitud_ref_municipio <- coordenadas_ref_municipio$Location$DisplayPosition$Longitude
        latitud_ref_municipio <- coordenadas_ref_municipio$Location$DisplayPosition$Latitude
        coor_referencia <- c(longitud_ref_municipio, latitud_ref_municipio)

        print("LLEGO")

        #Bucle coordenadas y municipio localización empresa
        variables_domicilio <- c("Const_domicilio", "Cambio_domicilio_social")

        #Cálculo de coordenadas (long, lat) de cada una de las empresas constituidas
        #Obtención coordenadas con geocoder API
        longitud_domicilio_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        latitud_domicilio_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        distancia_geometrica_coordenadas_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        empresa_dentro_del_radio_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        coordenadas_empresa_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        municipio_empresa_m <- matrix(nrow = length(data$Const_domicilio), ncol = length(variables_domicilio))
        lat <- list()
        long <- list()


        for(k in 1:length(variables_domicilio)){
          for(i in 1:length(data[,grep(variables_domicilio[k],names(data))])){
            domicilio <- stripWhitespace(data[,grep(variables_domicilio[k],names(data))][i])
            domicilio <- gsub(" ","%20",domicilio)
            domicilio <- iconv(domicilio,from="UTF-8",to="ASCII//TRANSLIT")

            coordenadas_domicilios <- jsonlite::fromJSON(paste(geocoder_endpoint, domicilio,sep=""))
            coordenadas_domicilios <- coordenadas_domicilios$Response$View$Result %>% as.data.frame()

            if(is.na(domicilio) | is.null(coordenadas_domicilios$Location$DisplayPosition$Longitude[1])){
              longitud_domicilio_m[i,k] <- NA
              latitud_domicilio_m[i,k] <- NA
              municipio_empresa_m[i,k] <- NA
              distancia_geometrica_coordenadas_m[i,k] <- NA
              empresa_dentro_del_radio_m[i,k] <- NA
              next
            }

            longitud_domicilio_m[i,k] <- coordenadas_domicilios$Location$DisplayPosition$Longitude[1]
            latitud_domicilio_m[i,k] <- coordenadas_domicilios$Location$DisplayPosition$Latitude[1]
            municipio_empresa_m[i,k] <- coordenadas_domicilios$Location$Address$City[1]


            if(is.null(unlist(longitud_domicilio_m[i,k]))){
              distancia_geometrica_coordenadas_m[i,k] <- NA
              empresa_dentro_del_radio_m[i,k] <- NA
              municipio_empresa_m[i,k] <- NA
              next
            }

            distancia_geometrica_coordenadas_m[i,k] <- distm(coor_referencia, c(longitud_domicilio_m[[i,k]], latitud_domicilio_m[[i,k]]), fun = distGeo)/1000

            if(distancia_geometrica_coordenadas_m[[i,k]] <= radio_ref){
              empresa_dentro_del_radio_m[i,k] <- "SÍ"
            }else{
              empresa_dentro_del_radio_m[i,k] <- "NO"
            }
          }
        }


        #Combinación columnas matriz en lista
        longitud_domicilio <- list()
        latitud_domicilio <- list()
        distancia_geometrica_coordenadas <- list()
        empresa_dentro_del_radio <- list()
        coordenadas_empresa <- list()
        municipio_empresa <- list()

        for(k in 1:(length(variables_domicilio)-1)){
          for(i in 1:length(data[,grep(variables_domicilio[k],names(data))])){

            if(is.na(longitud_domicilio_m[i,k]) & !is.na(longitud_domicilio_m[i,k+1])){
              longitud_domicilio[i] <- longitud_domicilio_m[i,k+1]
              latitud_domicilio[i] <- latitud_domicilio_m[i,k+1]
              distancia_geometrica_coordenadas[i] <- distancia_geometrica_coordenadas_m[i,k+1]
              empresa_dentro_del_radio[i] <- empresa_dentro_del_radio_m[i,k+1]
              coordenadas_empresa[i] <- coordenadas_empresa_m[i,k+1]
              municipio_empresa[i] <- municipio_empresa_m[i,k+1]
            }else{
              longitud_domicilio[i] <- longitud_domicilio_m[i,k]
              latitud_domicilio[i] <- latitud_domicilio_m[i,k]
              distancia_geometrica_coordenadas[i] <- distancia_geometrica_coordenadas_m[i,k]
              empresa_dentro_del_radio[i] <- empresa_dentro_del_radio_m[i,k]
              coordenadas_empresa[i] <- coordenadas_empresa_m[i,k]
              municipio_empresa[i] <- municipio_empresa_m[i,k]
            }
          }
        }


        #Manejo de NAs
        coordenadas_empresa <- paste(longitud_domicilio,latitud_domicilio,sep = ", ")
        coordenadas_empresa <- str_replace_all(coordenadas_empresa,"NA, NA", "NA")
        coordenadas_empresa <- str_replace_all(coordenadas_empresa,"NULL, NULL", "NA")
        for (i in 1:length(coordenadas_empresa)){
          if(nchar(coordenadas_empresa[i]) < 5){
            coordenadas_empresa[i] <- as.numeric(coordenadas_empresa[i])
            #longitud_domicilio[[i]] <- as.numeric(longitud_domicilio[i])
            #latitud_domicilio[[i]] <- as.numeric(latitud_domicilio[i])
          }

          if(is.na(coordenadas_empresa[i])){
            long[i] <- coordenadas_empresa[i]
            lat[i] <- coordenadas_empresa[i]
          }else{
            long[i] <- as.numeric(str_split(coordenadas_empresa[i],",")[[1]][1])
            lat[i] <- as.numeric(str_split(coordenadas_empresa[i],",")[[1]][2])
          }
        }


        data$`Coordenadas empresa` <- coordenadas_empresa
        data$Latitud <- unlist(lat)
        data$Longitud <- unlist(long)
        data$`Municipio empresa` <- unlist(municipio_empresa)
        data$`Distancia respecto municipio km` <- unlist(distancia_geometrica_coordenadas)
        data$`Dentro del radio de referencia km` <- unlist(empresa_dentro_del_radio)
        data$`Provincia Borme` <- provincia

        data[is.na(data)] <- "-"


        #################################################################
        # CREACIÓN JSON Y ENVÍO A PLATAFORMA SMART CITY
        #################################################################

        nombreArchivo<-info$keys$Subject
        #write.csv(BBDD,paste('C:\\TechFriendly\\IZARRA\\Borme\\',paste(nombreArchivo,".csv",collapse=""),collapse=""),row.names=F)
        #write_json(BBDD,paste('C:\\TechFriendly\\IZARRA\\Borme\\paquete_borme\\',paste(nombreArchivo,".json",collapse=""),collapse=""),pretty=T)

        json_borme_return <- jsonlite::toJSON(data,pretty=T)

        #Extracción timestamp en formato unix
        tsi <- format(as.numeric(anytime(fecha_borme))*1000,scientific = F)
        print(tsi)
        #tsi <- sub("\\..*", "",tsi)
        for(i in 1:nrow(data)){
          ts <- as.numeric(tsi) +i  #Añade i ms al timestamp para poder verse sin solapamiento en el widget de la plataforma smart city.

          #Creación de JSON noticias y eliminación de ][ para cumplir con el formato json con modificación de timestamp de thingsboard.
          json_borme <- jsonlite::toJSON(data[i,],pretty=T)
          json_borme <- sub("[[]","",json_borme)
          json_borme <- sub("[]]","",json_borme)

          #Formato json con modificación de timestamp de thingsboard.
          json_envio_plataforma <- paste('{"ts":',ts,', "values":',json_borme,"}",sep="")

          #Envío JSON a plataforma
          POST(url=TB_url,body=json_envio_plataforma)
        }

        retorno <- json_borme_return
      }

      #==========================================================================
      #==========================================================================


    },error = function(e){

      err <<- conditionMessage(e)
      retorno <<- err

      #Switch de errores
      switch(err,
             "HTTP error 404."={
               error_plataforma <- '{"ERROR": "NO HAY BORME PUBLICADO PARA LA FECHA DE HOY"}'
             },
             "No se encuentran las provincias especificadas en el Borme de hoy"={
               error_plataforma <- '{"ERROR": "NO SE ENCUENTRAN LAS PROVINCIAS ESPECIFICADAS PARA LA FECHA DE HOY"}'
             },
             {
               error_plataforma <- '{"ERROR"}'
             }
      )

      #json_envio_plataforma <- error_plataforma
      #Envío JSON a plataforma
      #POST(url=TB_url,body=json_envio_plataforma)

    })

  }



  return(retorno)
}
KepaAmigoTECHFriendly/scrapBorme documentation built on Aug. 6, 2020, 8:36 a.m.