使用lapply和read

问题描述

我用R Shiny编写了一个应用程序，可帮助我从包含所有url的数据库中对图片，价格和尺寸进行网页剪贴，并按列显示结果。

selection <- read_sheet(ss,col_names = FALSE)
selection

    # A tibble: 9 x 1
      ...1                                                                                
      <chr>                                                                               
    1 https://www.vinted.fr/femmes/jupes-et-robes-tailleurs/510518112-ensemble-jupe-et-ve…
    2 https://www.vinted.fr/femmes/autres-pull-overs-and-sweat-shirts/637915120-gilet-vio…
    3 https://www.vinted.fr/femmes/autres-pull-overs-and-sweat-shirts/631947178-pull-levis
    4 https://www.vinted.fr/femmes/autres-hauts/630105689-pull-col-cheminee               
    5 https://www.vinted.fr/femmes/autres-hauts/627899752-pull-liu-jo                     
    6 https://www.vinted.fr/femmes/autres/637266304-gilet-bien-chaud                      
    7 https://www.vinted.fr/femmes/chaussures-plateforme/636078726-bottines-zara          
    8 https://www.vinted.fr/femmes/chaussures-plateforme/594651764-botas-jeffrey-campbell 
    9 https://www.vinted.fr/femmes/manteaux-longs/484936900-manteau-cuir-et-fourrure

您将在ui部分下面找到我正在使用lapply（）生成与小标题中的行一样多的输出的

ui <- fluidPage(
        setBackgroundColor(color = "#f7929a"),tags$style(HTML('body {font-family:"Futura",sans-serif; font-weight: "bold"}')),fluidRow(
            lapply(seq_along(selection$...1),function(i){
                column(3,withSpinner(uIoUtput(paste0("image",i)),type = getoption("spinner.type",default = 8),color = getoption("spinner.color",default = "#8A2BE2")),textoutput(paste0("price",textoutput(paste0("size",i))
                       )
                })
            )
        )

然后是服务器部分，我再次使用lapply（）每次生成适当数量的输出：

图片=> read_html（）从网址中抓取图片
price => read_html（）从网址中取消价格

size => read_html（）从网址中抓取大小

server <- function(input,output) {

lapply(seq_along(selection$...1),function(i){
    output[[paste0("image",i)]] <- renderUI({
        res1 <- selection$...1[i] %>% read_html() %>% html_nodes("figure.item-description:nth-child(1) > a:nth-child(1)") %>% str_extract_all("http[^\"><]+") %>% unlist()
        tags$a(href = selection$...1[i],target="_blank",tags$img(src = res1[1],height = "532.9px",width = "352.8px"))
    })
})

lapply(seq_along(selection$...1),function(i){
    output[[paste0("price",i)]] <- renderText({
        res2 <- selection$...1[i] %>% read_html() %>% html_nodes(".c-text--heading") %>% html_text()
    })
})

lapply(seq_along(selection$...1),function(i){
    output[[paste0("size",i)]] <- renderText({
        res3 <- selection$...1[i] %>% read_html() %>% html_nodes(".details-list--details > div:nth-child(2) > div:nth-child(2)") %>% html_text()
        paste0("Taille ",res3)
    })
})
}

shinyApp(ui = ui,server = server)

因此，我最终得到一个非常慢的应用程序，平均需要40秒才能显示结果，而且我不知道如何提高应用程序的速度。我使用profvis对脚本进行了分析，实际上，lapply（）中的read_html（）函数显着增加了延迟。

如果您能提出建议，将不胜感激。

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

使用lapply和read_html

问题描述

解决方法