私は、私たちの郡の特定の特性についての情報を持つプロットマップを生成する光沢のあるアプリケーションを持っています。アプリは正常に動作しますが、私が1度呼び出すたびに地図を作成するには40秒かかります。私は前処理を行うためにifとelseを用いて反応式(rt2)を使用する。時間を節約するために何らかの並列処理やこれを行う方法があるのだろうか?私は例を再現することはできませんので、私は自分のアプリで時間がかかるものを光沢のあるアプリでの並列処理
データセットのサンプル
County_ID County_Name EQI air_EQI water_EQI land_EQI sociod_EQI
<int> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1001 Autauga, AL 0.0041379 0.9553846 -1.1097280 -0.7065906 0.6704357
2 1003 Baldwin, AL 0.2002343 0.7179643 -0.5659107 -1.0842990 0.5530728
3 1005 Barbour, AL -0.9506388 0.1310074 -0.9780902 -1.2814700 -1.2362940
4 1007 Bibb, AL -1.0889200 0.0652890 -0.9681726 -0.8274103 -0.6000178
5 1009 Blount, AL -0.5139221 0.4021944 -0.7186447 -0.6229339 0.2965088
6 1011 Bullock, AL -2.0828290 -0.3091858 -1.4513350 -1.2580140 -1.8239700
library(plotly)
library(shiny)
library(tidyr)
library(maps)
library(shinydashboard)
library(viridis)
library(ggplot2)
ui <- navbarPage(
title="Computational Modelling and Investigation of Neuropsychiatric Disease (MIND)",
tabPanel("Home Tab",
sidebarLayout(
sidebarPanel(
uiOutput("selectcol11"),
uiOutput("selectsol11")
),
mainPanel(plotlyOutput("plot2")))))
ui.r server.r
library(plotly)
library(shiny)
library(tidyr)
library(maps)
library(shinydashboard)
library(viridis)
library(ggplot2)
ui <- navbarPage(
title="Computational Modelling and Investigation of Neuropsychiatric Disease (MIND)",
tabPanel("Home Tab",
sidebarLayout(
sidebarPanel(
uiOutput("selectcol11"),
uiOutput("selectsol11")
),
mainPanel(plotlyOutput("plot2")))))
server <- function(input, output) {
output$selectcol11<-renderUI({
selectInput("selectcol11","Select Measure",choices = c("EQI","air_EQI","water_EQI",
"land_EQI","sociod_EQI","built_EQI","good_days","bad_days"),selected = "EQI")
})
output$selectsol11<- renderUI({
sliderInput("selectsol11", "Select Resolution",
min = 2, max = 7, value = 5,step =1)})
rt2 <- reactive({
if(input$selectcol11== "EQI"){
foo <- cbind(data.frame(do.call('rbind', strsplit(as.character(df$County_Name),',',fixed=TRUE))),df[,c(1,3:10)])
colnames(foo)[1] <- "County"
colnames(foo)[2] <- "State"
foo1 <- map_data("county")
eqi1 <- foo %>%
group_by(County) %>%
summarise(EQI = sum(EQI))
eqi10 <- foo %>%
group_by(County) %>%
summarise(County_ID = sum(County_ID))
eqi<- cbind(eqi1,eqi10[,2])
eqi$County <- tolower(eqi$County) # matching string
foo1_eqi <- merge(foo1, eqi, by.x = "subregion", by.y = "County")
foo1_eqi
final.plot1<-foo1_eqi[order(foo1_eqi$order), ]
final.plot1$County_Name_ID <- with(final.plot1, paste("County:",subregion, '<br>', "County_ID:", County_ID))
final.plot1
}
else if(input$selectcol11== "air_EQI"){
foo <- cbind(data.frame(do.call('rbind', strsplit(as.character(df$County_Name),',',fixed=TRUE))),df[,c(1,3:10)])
colnames(foo)[1] <- "County"
colnames(foo)[2] <- "State"
foo1 <- map_data("county")
eqi1 <- foo %>%
group_by(County) %>%
summarise(air_EQI = sum(air_EQI))
eqi10 <- foo %>%
group_by(County) %>%
summarise(County_ID = sum(County_ID))
eqi<- cbind(eqi1,eqi10[,2])
eqi$County <- tolower(eqi$County) # matching string
foo1_eqi <- merge(foo1, eqi, by.x = "subregion", by.y = "County")
foo1_eqi
final.plot1<-foo1_eqi[order(foo1_eqi$order), ]
final.plot1$County_Name_ID <- with(final.plot1, paste("County:",subregion, '<br>', "County_ID:", County_ID))
final.plot1
}
})
output$plot2 <- renderPlotly ({
p<- ggplot(rt2(), aes(x = long, y = lat, group=group,text=County_Name_ID,fill = cut_number(rt2()[,7],input$selectsol11)))
p<- p+ geom_polygon(colour=alpha("black", 1/2))
p<- p+coord_equal()
p<- p+ viridis::scale_fill_viridis(discrete = TRUE)
p<- p+ scale_fill_discrete("Measure Density")
ggplotly(p, tooltip = c("County_Name_ID"))
})
}
私はあなたのサンプルデータセットでより大きなデータセットを複製しようとしましたが、これは簡単ではありません。私の環境では非常に速いですが、いくつかのプロットは現れず、 'fill = cut_number(rt2()[、7]、入力$ selectsol11)'はエラーを生成したので削除されました。さらに、あなたの 'sliderInput'があなたの' server'にあり、同じIDを持っているのはなぜですか? –
exampeは、不幸にも私が提供できない特定のデータセットでのみ動作します。私はそれのuioutputが欲しいので、私のサーバーにスライダーがあります。この作品は心配しないでください。私はそれがより速く動作するようにする方法を考えていただけです –
すべてのコードをコピー&ペーストするのではなく、最小限の再現可能な例を提供する必要があります。 –