有人可以解释为什么VIP menuSubItem（inputID = traziVIP）中的按钮不起作用吗？如果我点击HT menuSubItemit中的按钮就行了。但是VIP并没有奏效。我认为这是一个愚蠢的错误，但我无法弄清楚。 这是up的代码：
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
library(DT)
library(rvest)
library(stringr)
library(stringi)
# library(webshot)
# library(RSelenium)
source(file.path("ImenAuto_functions.R"), local = TRUE, encoding = "UTF-8")
# APP
header <- dashboardHeader(title = "ImenAuto")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Imenici", tabName = "imenici", icon = icon("phone"),
menuSubItem("HT", tabName = "ht"),
menuSubItem("VIP", tabName = "vip"))
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "ht",
fluidRow(
tabBox(
tabPanel(title = "",
fileInput("fileHT", "Izaberite csv file",
accept = c("text/csv", ".csv"), buttonLabel = "Pronađi datoteku",
placeholder = "Nema podataka"),
br(),
actionButton("traziHT", "Traži brojeve"),
br(),
br(),
dataTableOutput("input_tablica")
)
)
)
),
tabItem(tabName = "vip",
fluidRow(
tabBox(
tabPanel(title = "",
fileInput("fileVIP", "Izaberite csv file za pretragu VIP imenika",
accept = c("text/csv", ".csv"), buttonLabel = "Pronađi datoteku",
placeholder = "Nema"),
br(),
actionButton(inputId = "traziVIP", "Traži brojeve"),
br(),
br(),
dataTableOutput("input_tablica_VIP")
)
)
)
)
)
)
# Define UI
ui <- dashboardPage(header, sidebar, body)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
user <- reactive({
session$user
})
user_account <- reactive({
if (is.null(user())){
return("nepoznato/lokalno")
} else{
return(user())
}
})
# observeEvent(input$fileHT, {
# x <- read.csv2(inFile$datapath, header = TRUE, stringsAsFactors = FALSE, encoding = "UTF-8")
# validate(
# need(ncol(x) < 2, 'Check at least one letter!')
# )
# })
brojevi_ht <- eventReactive(input$traziHT,{
withProgress(message = 'Traženje brojeva u imeniku HT-a',{
inFile <- input$fileHT
if (is.null(inFile))
return(NULL)
x <- read.csv2(inFile$datapath, header = TRUE, stringsAsFactors = FALSE, encoding = "UTF-8")
validate(
need(ncol(x) < 3, 'Input tablica može imati najviše dvije kolone')
)
# x <- read.csv2("E:/data/R/ShinyApps/ImenAuto/sample.csv", header = TRUE, stringsAsFactors = FALSE,
# encoding = "UTF-8") # TEST
# guess_encoding(x)
if(ncol(x) == 1){gdje <- rep(NA, nrow(x))}else{gdje <- x[,2]}
tko <- x[,1]
if (length(tko) <= 5){
df_final <- list()
for (j in 1:length(tko)){
## fill and submit form
ht <- html_session("http://imenik.tportal.hr", encoding = "UTF-8")
form <- html_form(ht)[[1]]
fake_submit_button <- list(name = 'brzaPretragaSearchForm',
type = "submit",
value = NULL,
checked = NULL,
disabled = NULL,
readonly = NULL,
required = FALSE)
attr(fake_submit_button, "class") <- "input"
form[["fields"]][["submit"]] <- fake_submit_button
from_filled <- form %>% set_values(tko = tko[j], gdje = gdje[j])
session <- submit_form(ht, from_filled)
# webshot(session$url, paste0(session$response$cookies$value, ".png"))
# remDr$navigate("https://imenik.tportal.hr")
# remDr$findElement(using = "xpath", "//*[@id='tko']")$clearElement()
# Sys.sleep(1L)
# remDr$findElement(using = "xpath", "//*[@id='tko']")$sendKeysToElement(list(tko[j]))
#
# remDr$findElement(using = "xpath", "//*[@id='gdje']")$clearElement()
# Sys.sleep(1L)
# remDr$findElement(using = "xpath", "//*[@id='gdje']")$sendKeysToElement(list(gdje[j], key = "enter"))
# Sys.sleep(2L)
# remDr$screenshot(display = FALSE, file = paste0("tet.png"))
# doc <- remDr$getPageSource()[[1]]
# Scrap
x <- read_html(session, encoding = "UTF-8")
# write_xml(doc, file="temp.html")
to <- x %>%
html_nodes("#pretragaContainerInner_brzaPretraga > div > div") %>%
html_children() %>%
length(.)
df <- list()
for (i in 1:to){
naziv <- x %>%
html_nodes(paste0('#pretragaContainerInner_brzaPretraga > div > div > div:nth-child(', i, ') > div.ImenikContainerInnerDetailsLeft.borderGrey > div')) %>%
html_text()
adresa <- x %>%
html_nodes(paste0('#pretragaContainerInner_brzaPretraga > div > div > div:nth-child(', i, ') > div.ImenikContainerInnerDetailsLeft.borderGrey > ul > li.secondColumn > div:nth-child(1)')) %>%
html_text()
mjesto <- x %>%
html_nodes(paste0('#pretragaContainerInner_brzaPretraga > div > div > div:nth-child(', i, ') > div.ImenikContainerInnerDetailsLeft.borderGrey > ul > li.secondColumn > div:nth-child(2)')) %>%
html_text()
brojevi <- x %>%
html_nodes(paste0('#pretragaContainerInner_brzaPretraga > div > div > div:nth-child(', i, ') > div.ostaliPodaciContainer > div > div.ostalipodaciTextInner')) %>%
html_text() %>%
stringr::str_extract_all(., "\\d+") %>%
unlist() %>%
paste0(., collapse = ", ")
if(brojevi == "" | is.null(brojevi)){
brojevi <- x %>%
html_nodes(paste0('#pretragaContainerInner_brzaPretraga > div > div > div:nth-child(', i, ') > div.imenikSearchResultsRight > div.imenikTelefon')) %>%
html_text()
}
podaci_request_names <- c("url", names(lapply(unlist(session$response$all_headers), `[[`, 1)))
podaci_request <- c(session$response$url, lapply(unlist(session$response$all_headers), `[[`, 1))
names(podaci_request) <- NULL
podaci_request <- unlist(podaci_request)
names(podaci_request) <- podaci_request_names
podaci_request <- as.matrix(t(rep(podaci_request[1:4], length(brojevi))), nrow = length(brojevi))
df[[i]] <- cbind(Input = tko[j], gdje[j], naziv, adresa, mjesto, brojevi, podaci_request)
# df[[i]] <- cbind(Input = tko[j], gdje[j], naziv, adresa, mjesto, brojevi)
}
df_merge <- df[lapply(df,length)>3]
df_final[[j]] <- do.call(rbind, df_merge)
}
# save
ht <- do.call(rbind, df_final)
}else{
ht <- data.frame(`Najviše_tri_retka` = "Tablica sadrži više od tri retka")
}
# remDr$close()
ht
})
})
output$input_tablica <- renderDataTable({
MyDataTable(brojevi_ht())
}, server = FALSE)
# observeEvent(input$TraziBrzoNekretnine, {
# broj <- loadDataUsers(table_users, user_account())$paket
# updateData(broj, user_account())
# })
brojevi_vip <- eventReactive(input$traziVIP,{
withProgress(message = 'Traženje brojeva u imeniku VIP-a',{
inFileVIP <- input$fileVIP
if (is.null(inFileVIP))
return(NULL)
x <- read.csv2(inFileVIP$datapath, header = TRUE, stringsAsFactors = FALSE, encoding = "UTF-8")
validate(
need(ncol(x) < 4, 'Input tablica može imati najviše tri kolone')
)
# x <- read.csv2("E:/data/R/ShinyApps/ImenAuto/sample_vip.csv", header = TRUE, stringsAsFactors = FALSE,
# encoding = "UTF-8") # TEST
# guess_encoding(x)
if(ncol(x) == 1){gdje <- rep(NA, nrow(x))}else{gdje <- x[,3]}
tko <- x[,1]
tko_2 <- x[,2]
if (length(tko) <= 5){
df <- list()
for (j in 1:length(tko)){
## fill and submit form
vip <- html_session("http://www.vipnet.hr/imenik", encoding = "UTF-8")
form <- html_form(vip)[[1]]
from_filled <- form %>% set_values(fname = tko[j], lname = tko_2[j], lname = gdje[j])
session <- submit_form(vip, from_filled)
# Scrap
x <- read_html(session, encoding = "UTF-8")
df[[j]] <- x %>%
html_nodes(xpath = "//*[@id='p_p_id_imenik_WAR_vipnetimenikr_INSTANCE_fIgPMrz3HY2I_']/div/div/div/section[2]/div/div/div/div/div") %>%
html_text() %>%
str_split(., " ") %>%
do.call(rbind, .) %>%
as.data.frame(., stringsAsFactors = FALSE)
if(length(df[[j]]) == 0){df[[j]] <- as.data.frame(t(rep(NA, 6)))}
colnames(df[[j]]) <- c("rbr", "imePrezime", "adresa", "grad", "posta", "broj")
}
df_final <- do.call(rbind, df)
}
df_final
})
})
output$input_tablica_vip <- renderDataTable({
MyDataTable(brojevi_vip())
}, server = FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
最重要的部分是第212行。为什么事件反应功能不起作用？
答案 0 :(得分：0)
我找到了解决方案。这是一个错字......