我制作的应用程序运行良好。
i最后用ggplot替换了plot函数，这导致输出仅花费一秒钟就花费了几分钟。
我尝试删除ggplot函数，只是在应用程序的开头保留了library（ggplot2），但速度仍然很慢。
有人遇到过类似的问题/知道如何解决吗？
我附上了代码的工作版本。仅仅在开始时添加library（ggplot2）会使它变慢。谢谢！
library(shiny)
ui<- navbarPage("gcxgc modeling",
tabPanel("columns and compounds",
sidebarLayout(
sidebarPanel(
selectInput("phase",
"1D phase:",
c("choose",
unique(as.character(indices$Phase))))
,
selectInput("phase2",
"2D phase:",
c("choose",
unique(as.character(indices$Phase)))),
uiOutput("groups")
),
mainPanel(
fluidRow(
column(6,uiOutput("compounds")),
column(6,tableOutput("confirmed"))
)
)
)),
tabPanel("method development",
fluidRow(
column(4,
tableOutput('table')),
column(8,
plotOutput('plot'))),
fluidRow(
column(3,
'column dimensions',
numericInput("l1d", '1D column length (m):',29.704),
numericInput("id1d",'1D column ID (mm):',0.25),
numericInput("df1d",HTML('1D column film thickness (μm):'),0.25),
numericInput("lmod",'2D modulator column length (m):',0.1),
numericInput("loven", '2D oven column length (m):',1.398),
numericInput("id2d",'2D column ID (mm):',0.25),
numericInput("df2d",HTML('2D column film thickness (μm):'),0.25),
numericInput("lguard", 'transfer line length (m):',0.388),
numericInput("idg",'transfer line ID (mm):',0.25)),
column(3,
'temperature program',
numericInput("starting_temp", 'initial temp (C):',100),
numericInput("initial_hold", 'initial hold (s):',60),
numericInput("tramp1", 'ramp 1 rate (C/min):',10),
numericInput("finaltemp1", 'ramp 1 final temp (C):',300),
numericInput("hold2", 'ramp 1 hold (s):',20000),
numericInput("tramp2", 'ramp 2 rate (C/min):',0),
numericInput("finaltemp2", 'ramp 2 final temp (C)',0)),
column(3,'misc.',
numericInput("flow", 'flow rate (mL/min):',3),
numericInput("secondary_offset", 'secondary oven offset (C):',0),
numericInput("mod_off", 'modulator offset (C):',15),
numericInput("modulation_period", 'modulation period (s):',5),
actionButton("button","submit"))
)))
server<-function(input, output) {
outlet<-1.01325E11
pguardx<-function(flow,temp,lguard,outlet,idg){sqrt(((16*(flow*0.000001/60)*(0.03993*(temp)+18.662)*lguard*(temp+273.15)*1.01325E11)/(outlet^2*298*3.14159*(idg/2000)^4))+1)*outlet}
povenx<-function(flow,temp,secondary_offset,loven,pguard,id2d){sqrt(((16*(flow*0.000001/60)*(0.03993*(temp+secondary_offset)+18.662)*loven*(temp+secondary_offset+273.15)*1.01325E11)/(pguard^2*298*3.14159*(id2d/2000)^4))+1)*pguard}
pmodx<-function(flow,temp,secondary_offset,mod_off,lmod,poven,id2d){sqrt(((16*(flow*0.000001/60)*(0.03993*(temp+secondary_offset+mod_off)+18.662)*lmod*(temp+secondary_offset+mod_off+273.15)*1.01325E11)/(poven^2*298*3.14159*(id2d/2000)^4))+1)*poven}
pinletx<- function(flow,temp,l1d,pmod,id1d){sqrt(((16*(flow*0.000001/60)*(0.03993*(temp)+18.662)*l1d*(temp+273.15)*1.01325E11)/(pmod^2*298*3.14159*(id1d/2000)^4))+1)*pmod}
kx1<-function(i1da,i1db,i1dc,temp,id1d,df1d){exp((i1da+i1db/(temp+273.15)+i1dc*log(temp+273.15))-log(id1d*1000/(df1d*4)))}
ux1<-function(id1d,pmod,pressure,temp,l1d,x){((id1d/1000)^2*pmod*((pressure/pmod)^2-1))/(64*(0.03993*temp+18.662)*l1d*sqrt((pressure/pmod)^2-(x/l1d)*((pressure/pmod)^2-1)))}
kx2<-function(i2da,i2db,i2dc,temp2,id2d,df2d){exp((i2da+i2db/(temp2+273.15)+i2dc*log(temp2+273.15))-log(id2d*1000/(df2d*4)))}
uxmod<-function(id2d,pmod,poven,temp2,lmod,xmod){((id2d/1000)^2*poven*((pmod/poven)^2-1))/(64*(0.03993*temp2+18.662)*lmod*sqrt((pmod/poven)^2-xmod/lmod*((pmod/poven)^2-1)))}
uxoven<-function(id2d,poven,pguard,temp2,loven,xoven){((id2d/1000)^2*pguard*((poven/pguard)^2-1))/(64*(0.03993*temp2+18.662)*loven*sqrt((poven/pguard)^2-xoven/loven*((poven/pguard)^2-1)))}
uxguard<-function(idg,pguard,outlet,temp2,lguard,xguard){((idg/1000)^2*outlet*((pguard/outlet)^2-1))/(64*(0.03993*temp2+18.662)*lguard*sqrt((pguard/outlet)^2-xguard/lguard*((pguard/outlet)^2-1)))}
pic1<-reactive({
pic1<-indices
pic1<-pic1[pic1$Phase==input$phase,]
})
output$groups <- renderUI({
checkboxGroupInput("groups","groups:",unique(as.character(pic1()$Group)))
})
pic2<-reactive({
pic2<-pic1()
pic2<-pic2[pic2$Group %in% input$groups,]
})
output$compounds<-renderUI({
checkboxGroupInput("compounds","compounds:",unique(as.character(pic2()$Name)),selected = unique(as.character(pic2()$Name)))
})
pic3<-reactive({
pic3<-pic2()
pic3<-pic3[pic3$Name %in% input$compounds,]
pic3<-pic3[!duplicated(pic3$Name),]
})
pic4<-reactive({
pic4<-indices
pic4<-pic4[pic4$Phase==input$phase2,]
pic4<-pic4[pic4$Name %in% input$compounds,]
pic4<-pic4[!duplicated(pic4$Name),]
})
pic5<-reactive({
pic5<-pic3()[pic3()$Name %in% pic4()$Name,]
names(pic5)[3]<-"accepted compounds"
pic5
})
output$confirmed<-renderTable(pic5()['accepted compounds'])
guh <- eventReactive(input$button,{
l1d=input$l1d
lmod=input$lmod
loven=input$loven
lguard=input$lguard
id1d=input$id1d
id2d=input$id2d
idg=input$idg
df1d=input$df1d
df2d=input$df2d
flow=input$flow
secondary_offset=input$secondary_offset
mod_off=input$mod_off
modulation_period=input$modulation_period
starting_temp=input$starting_temp
initial_hold=input$initial_hold
tramp1=input$tramp1
finaltemp1=input$finaltemp1
hold2=input$hold2
tramp2=input$tramp2
finaltemp2=input$finaltemp2
results=NULL
for (n in 1:(nrow(pic5()))) {
i1da<-pic5()[n,"A"]
i1db<-pic5()[n,"B"]
i1dc<-pic5()[n,"C"]
i2da<-pic4()[n,"A"]
i2db<-pic4()[n,"B"]
i2dc<-pic4()[n,"C"]
x<-0
rt1<-0
temp<-starting_temp
pguard<-pguardx(flow,temp,lguard,outlet,idg)
poven<-povenx(flow,temp,secondary_offset,loven,pguard,id2d)
pmod<-pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d)
pressure<-pinletx(flow,temp,l1d,pmod,id1d)
k<-kx1(i1da,i1db,i1dc,temp,id1d,df1d)
u<-ux1(id1d,pmod,pressure,temp,l1d,x)
while (x<l1d) {if(rt1<initial_hold) {x=x+u*0.1/(1+k);rt1=rt1+0.1;u=ux1(id1d,pmod,pressure,temp,l1d,x)} else if(rt1<initial_hold+(finaltemp1-starting_temp)/tramp1*60){x=x+u*0.1/(1+k);rt1=rt1+0.1;temp=temp+tramp1*0.1/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);pmod=pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d);pressure=pinletx(flow,temp,l1d,pmod,id1d);k=kx1(i1da,i1db,i1dc,temp,id1d,df1d);u=ux1(id1d,pmod,pressure,temp,l1d,x)} else if(rt1<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2) {x=x+u*0.1/(1+k);rt1=rt1+0.1;u=ux1(id1d,pmod,pressure,temp,l1d,x)} else if (rt1<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2+(finaltemp2-finaltemp1)/tramp2*60) {x=x+u*0.1/(1+k);rt1=rt1+0.1;temp=temp+tramp2*0.1/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);pmod=pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d);pressure=pinletx(flow,temp,l1d,pmod,id1d);k=kx1(i1da,i1db,i1dc,temp,id1d,df1d);u=ux1(id1d,pmod,pressure,temp,l1d,x)} else {x=x+u*0.1/(1+k);rt1=rt1+0.1;u=ux1(id1d,pmod,pressure,temp,l1d,x)}}
xmod<-0
rt2<-0
temp2<-temp+mod_off+secondary_offset
pguard<-pguardx(flow,temp,lguard,outlet,idg)
poven<-povenx(flow,temp,secondary_offset,loven,pguard,id2d)
pmod<-pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d)
k2<-kx2(i2da,i2db,i2dc,temp2,id2d,df2d)
umod<-uxmod(id2d,pmod,poven,temp2,lmod,xmod)
while (xmod<lmod) {if((rt1+rt2)<initial_hold) {xmod=xmod+umod*0.01/(1+k2);rt2=rt2+0.01;umod=uxmod(id2d,pmod,poven,temp2,lmod,xmod)} else if((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60){xmod=xmod+umod*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp1*0.01/60;temp2=temp2+tramp1*0.01/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);pmod=pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d);k2=kx2(i2da,i2db,i2dc,temp2,id2d,df2d);umod=uxmod(id2d,pmod,poven,temp2,lmod,xmod)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2) {xmod=xmod+umod*0.01/(1+k2);rt2=rt2+0.01;umod=uxmod(id2d,pmod,poven,temp2,lmod,xmod)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2+(finaltemp2-finaltemp1)/tramp2*60) {xmod=xmod+umod*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp2*0.01/60;temp2=temp2+tramp2*0.01/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);pmod=pmodx(flow,temp,secondary_offset,mod_off,lmod,poven,id2d);k2=kx2(i2da,i2db,i2dc,temp2,id2d,df2d);umod=uxmod(id2d,pmod,poven,temp2,lmod,xmod)} else {xmod=xmod+umod*0.01/(1+k2);rt2=rt2+0.01;umod=uxmod(id2d,pmod,poven,temp2,lmod,xmod)}}
xoven<-0
rt2=rt2+modulation_period
{if (rt1+rt2<initial_hold){temp=starting_temp} else if (rt1+rt2<initial_hold+(finaltemp1-starting_temp)/tramp1*60){temp=starting_temp+(rt1+rt2-initial_hold)*tramp1/60} else if (rt1+rt2<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2){temp=finaltemp1} else if (rt1+rt2<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2+(finaltemp2-finaltemp1)/tramp2*60) {temp=finaltemp1+(rt1+rt2-initial_hold-hold2-(finaltemp1-starting_temp)/tramp1*60)*tramp2/60} else {temp=finaltemp2}}
temp2<-temp+secondary_offset
pguard<-pguardx(flow,temp,lguard,outlet,idg)
poven<-povenx(flow,temp,secondary_offset,loven,pguard,id2d)
k2<-kx2(i2da,i2db,i2dc,temp2,id2d,df2d)
uoven<-uxoven(id2d,poven,pguard,temp2,loven,xoven)
while (xoven<loven) {if((rt1+rt2)<initial_hold) {xoven=xoven+uoven*0.01/(1+k2);rt2=rt2+0.01;uoven=uxoven(id2d,poven,pguard,temp2,loven,xoven)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60) {xoven=xoven+uoven*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp1*0.01/60;temp2=temp2+tramp1*0.01/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);k2=kx2(i2da,i2db,i2dc,temp2,id2d,df2d);uoven=uxoven(id2d,poven,pguard,temp2,loven,xoven)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2) {xoven=xoven+uoven*0.01/(1+k2);rt2=rt2+0.01;uoven=uxoven(id2d,poven,pguard,temp2,loven,xoven)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2+(finaltemp2-finaltemp1)/tramp2*60) {xoven=xoven+uoven*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp2*0.01/60;temp2=temp2+tramp2*0.01/60;pguard=pguardx(flow,temp,lguard,outlet,idg);poven=povenx(flow,temp,secondary_offset,loven,pguard,id2d);k2=kx2(i2da,i2db,i2dc,temp2,id2d,df2d);uoven=uxoven(id2d,poven,pguard,temp2,loven,xoven)} else {xoven=xoven+uoven*0.01/(1+k2);rt2=rt2+0.01;uoven=uxoven(id2d,poven,pguard,temp2,loven,xoven)}}
xguard<-0
k2<-0
temp2=temp
pguard<-pguardx(flow,temp,lguard,outlet,idg)
uguard<-uxguard(idg,pguard,outlet,temp2,lguard,xguard)
while (xguard<lguard) {if((rt1+rt2)<initial_hold) {xguard=xguard+uguard*0.01/(1+k2);rt2=rt2+0.01;uguard=uxguard(idg,pguard,outlet,temp2,lguard,xguard)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60) {xguard=xguard+uguard*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp1*0.01/60;temp2=temp2+tramp1*0.01/60; pguard=pguardx(flow,temp,lguard,outlet,idg);uguard=uxguard(idg,pguard,outlet,temp2,lguard,xguard)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2) {xguard=xguard+uguard*0.01/(1+k2);rt2=rt2+0.01;uguard=uxguard(idg,pguard,outlet,temp2,lguard,xguard)} else if ((rt1+rt2)<initial_hold+(finaltemp1-starting_temp)/tramp1*60+hold2+(finaltemp2-finaltemp1)/tramp2*60) {xguard=xguard+uguard*0.01/(1+k2);rt2=rt2+0.01;temp=temp+tramp2*0.01/60;temp2=temp2+tramp2*0.01/60; pguard=pguardx(flow,temp,lguard,outlet,idg);uguard=uxguard(idg,pguard,outlet,temp2,lguard,xguard)} else {xguard=xguard+uguard*0.01/(1+k2);rt2=rt2+0.01;uguard=uxguard(idg,pguard,outlet,temp2,lguard,xguard)}}
rt1=rt1/60
rt2=rt2%%modulation_period
results=rbind(results,data.frame(rt1,rt2))}
rownames(results)<-pic5()$'accepted compounds'
results<-cbind(results,pic5()$Group)
names(results)[3]<-"group"
results
})
output$table<-renderTable(guh()[,1:2],include.rownames=TRUE)
output$plot<-renderPlot({plot(guh()[,1:2],ylim=c(0,input$modulation_period))})
}
shinyApp(ui=ui,server=server)