我不确定如何问这个问题，但在这里：
我正在使用R中的闪亮包。我正在输出一个ggplot2图，这很好。
我想绘制两个图形，一个在另一个之上，以直观地比较它们之间的差异。
理想情况下，我希望能够使用单选按钮选择绘图位置（顶部或底部）。当我更改输入以生成我现在已经得到的绘图时，它将显示在顶部/底部单选按钮选择的任何位置。
trim_down<-function(LAB,TYPE,FORM,CLASS,AMI,DATE){
ma<<-dft
if (is.nan(TYPE)==FALSE){ma<<-subset(ma, type %in% TYPE)}
if (is.nan(FORM)==FALSE){ma<<-subset(ma, form %in% FORM)}
if (is.nan(CLASS)==FALSE){ma<<-subset(ma, class %in% CLASS)}
if (is.nan(AMI)==FALSE){ma<<-subset(ma, ami %in% AMI)}
ma<<-subset(ma, as.Date(dateStarted,"%m/%d/%Y")>=DATE[1] )
ma<<-subset(ma, as.Date(dateStarted,"%m/%d/%Y")<=DATE[2] )
dim(ma)
ma<<-ma[,-(1:length(test_factors))]
all_test_names<<-names(ma)
ma<<-as.matrix(ma)
ma<<-t(apply(ma, 1,as.numeric,na.rm=TRUE))
aa<<-1-colMeans(ma,na.rm=TRUE)
b<<-colSums(!is.na(ma))
active_test_names<<-all_test_names[!is.nan(aa)]
x<<-rbind(aa,b)
graph.me(x,all_test_names,active_test_names,trimmed_up=FALSE)
}
graph.me<-function(x,all_test_names,active_test_names,trimmed_up=TRUE){
library(reshape2)
aa<<-x[1,]
b<<-x[2,]
aa[aa==0]=-.1
aa[is.na(aa)]=0
XAXIS<<-all_test_names
success <- as.data.frame(aa)
rownames(success)<-XAXIS
samples <- as.data.frame(b)
data.long <- cbind(melt(success,id=1), melt(samples, id=1))
names(data.long) <- c("success", "count")
rownames(data.long)<-XAXIS
threshold <- 25
data.long$fill <- with(data.long,ifelse(count>threshold,max(count),count))
data.long$fill[data.long$fill>threshold]<-threshold
library(ggplot2)
library(RColorBrewer)
print(ggplot(data.long) +
geom_bar(aes(x=XAXIS, y=success, fill=fill),colour="grey70",stat="identity")+
scale_fill_gradientn(colours=brewer.pal(9,"RdYlGn")) +
theme(axis.text.x=element_text(angle=-90,hjust=0,vjust=0.4)))
}
ui.r
library(shiny)
# Define UI for miles per gallon application
shinyUI(pageWithSidebar(
# Application title
headerPanel("Example"),
sidebarPanel(
# checkboxGroupInput("_lab", "lab:",unique(dft$lab)),
checkboxGroupInput("type", "Type:",unique(dft$type),selected=unique(dft$type)),
checkboxGroupInput("form", "Form:",unique(dft$form),selected=unique(dft$form)),
checkboxGroupInput("class", "Class:",unique(dft$class),selected=unique(dft$class)),
checkboxGroupInput("ami", "AMI:",unique(dft$ami),selected=unique(dft$ami)),
dateRangeInput("daterange", "Date range:",
start = min(as.Date(dft$date,"%m/%d/%Y")),
end = max(as.Date(dft$date,"%m/%d/%Y")))
),
mainPanel(
h3(textOutput("caption")),
plotOutput("Plot")
)
))
server.r
library(shiny)
shinyServer(function(input, output) {
# Compute the forumla text in a reactive expression since it is
# shared by the output$caption and output$mpgPlot expressions
formulaText <- reactive({
paste(input$type,input$form,input$class,input$ami)
})
# Return the formula text for printing as a caption
output$caption <- renderText({
formulaText()
})
# Generate a plot of the requested variable against mpg and only
# include outliers if requested
output$Plot <- renderPlot(function(){
print(trim_down(NA,input$type,input$form,input$class,input$ami,input$daterange))
})
})
感谢您的帮助...对于这么多代码感到抱歉，但我不确定为每个人的评论省略什么是安全的。如果它有帮助，我觉得问题可以通过解决ggplot在一些布局网格上绘图来解决......比如，grid.arrange()由顶部或底部的单选按钮驱动？
根据回复，我试过这个：
ui.r
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Example"),
sidebarPanel(
radioButtons("plotSpot", "Position", c(1,2)),
checkboxGroupInput("type", "Type:",unique(dft$type),selected=unique(dft$type)),
checkboxGroupInput("form", "Form:",unique(dft$form),selected=unique(dft$form)),
checkboxGroupInput("class", "Class:",unique(dft$class),selected=unique(dft$class)),
checkboxGroupInput("ami", "AMI:",unique(dft$ami),selected=unique(dft$ami)),
dateRangeInput("daterange", "Date range:",
start = min(as.Date(dft$date,"%m/%d/%Y")),
end = max(as.Date(dft$date,"%m/%d/%Y")))
),
mainPanel(
plotOutput("topPlot"),
plotOutput("bottomPlot")
)
))
server.r
library(shiny)
p<-list()
output$Plot <- renderPlot({
p[input$plotSpot]<-trim_down(NA,input$type,input$form,input$class,input$ami,input$daterange)
output$topPlot <- renderPlot(ifelse(input$position == "Top", print(p[1]), print(p[2])))
output$bottomPlot <- renderPlot(ifelse(input$position == "Top", print(p[2]), print(p[1])))
})
})
但是，这只会产生一个图表。我虽然切换了持有ggplot的列表的索引，然后保持它们绘制的顺序相同就可以了，但没有运气。
答案 0 :(得分：3)
好的，我不打算完成所有代码，但这里有一个可以做你想要的例子。如果我误解了，请尝试使用 minimal 示例重新发布，将其全部删回到您要解决的问题。
<强> ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Plot position"),
sidebarPanel(
radioButtons("position", "Position", c("Top", "Bottom"))),
mainPanel(
plotOutput("topPlot"),
plotOutput("bottomPlot"))))
<强> server.R
library(shiny)
library(ggplot2)
dat <- data.frame(A = 1:10, B = rnorm(10))
shinyServer(function(input, output) {
p1 <- ggplot(dat, aes(A, B)) + geom_point(colour = "red")
p2 <- ggplot(dat, aes(A, B)) + geom_path(colour = "blue")
output$topPlot <- renderPlot(ifelse(input$position == "Top", print(p1), print(p2)))
output$bottomPlot <- renderPlot(ifelse(input$position == "Top", print(p2), print(p1)))
})
修改
根据您对问题的新描述，以下内容可能有所帮助。我认为你太复杂了 - 如果不同的地块的设置不同，那么每个不同的地块都有输入。可能只有一套，但会大大增加复杂性。
<强> ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Plot position"),
sidebarPanel(
h2("Top plot settings"),
radioButtons("topPlotColour", "Colour:",
list("Blue" = "blue",
"Red" = "red")),
radioButtons("topPlotGeom", "Geom:",
list("Point" = "point",
"Line" = "line")),
h2("Bottom plot settings"),
radioButtons("bottomPlotColour", "Colour:",
list("Blue" = "blue",
"Red" = "red")),
radioButtons("bottomPlotGeom", "Geom:",
list("Point" = "point",
"Line" = "line"))),
mainPanel(
plotOutput("topPlot"),
plotOutput("bottomPlot"))))
<强> server.R
library(shiny)
library(ggplot2)
dat <- data.frame(A = 1:10, B = rnorm(10))
shinyServer(function(input, output) {
p1_geom <-reactive({
geom <- switch(input$topPlotGeom,
point = geom_point(colour = input$topPlotColour),
line = geom_line(colour = input$topPlotColour))
})
p2_geom <-reactive({
geom <- switch(input$bottomPlotGeom,
point = geom_point(colour = input$bottomPlotColour),
line = geom_line(colour = input$bottomPlotColour))
})
p1_colour <- reactive({input$topPlotColour})
output$topPlot <- renderPlot({print(ggplot(dat, aes(A, B), colour = p1_colour()) + p1_geom())})
output$bottomPlot <- renderPlot(print(ggplot(dat, aes(A, B), colour = toString(quote(input$bottomPlotColour))) + p2_geom()))
})