我有这段代码，我正在使用操作按钮标题类型来刻面绘图。现在，我有三列SSN，unit和Type。我想将列SSN和单元粘贴在一起，然后用Type绘制连接的列。我已经在这段代码上尝试过了，但是在这里不起作用是我尝试过的。我使用了plotdata1 eventReaction在操作按钮上的代码
plotdata1()$SSN.unit <- paste0(plotdata1()[,"SSN"],".", plotdata1()[,"unit"])
z <-ncol(plotdata1())
plotdata1()[,1] <- plotdata1()[,"SSN.unit"]
plotdata1() <- plotdata1()[,-c(2,z)]
})
这是带有一些数据的完整代码
library(shiny)
library(ggplot2)
library(dplyr)
library(shinycssloaders)
library(DT)
library(installr)
library(nesRdata)
library(feather)
library(reshape2)
library(pander)
suppressMessages(library(dplyr))
library(signal)
library(prospectr)
setwd("path")
ui <- fluidPage(
titlePanel("Neospec Visualization"),
sidebarLayout(
sidebarPanel(
#fileInput(inputId = "fls", "Upload Neodata", multiple = F, buttonLabel = "Load file", placeholder = "No file loaded", accept = NULL),
uiOutput("unit"),
uiOutput("Type"),
uiOutput("FaceUnit"),
tags$hr(),
uiOutput("FaceType")
),
mainPanel(
tabsetPanel(
tabPanel("Table", dataTableOutput("table"),6),
tabPanel("Main Plot", withSpinner(plotOutput("plts"))),
tabPanel("Unit Facet", withSpinner(plotOutput("plts2"))),
tabPanel("Type Facet", withSpinner(plotOutput("plts3")))
)
)
)
)
server <- function(input, output, session){
options(shiny.maxRequestSize=150*1024^2)
#upld.dt<- reactive({
#inFile <- input$fls
#if (is.null(inFile))
#return(NULL)
#all.spec<-read.csv(inFile$datapath)
#all.spec
#})
neos <- reactive({read_feather("path")})
#########Ui to select Units and type####################
output$unit <- renderUI({
selectInput(inputId = "unit", label = "Select Unit", choices = as.vector(unique(neos()$unit)), selected = NULL)
})
output$Type <- renderUI({
selectInput(inputId = "Type", label = "Select Type", choices = as.vector(unique(neos()$Type)), selected = NULL)
})
output$FaceUnit <- renderUI({
actionButton(inputId = "Faceunit", label = " Unit")
})
output$FaceType <- renderUI({
actionButton(inputId = "FaceType", label = " Type")
})
#########################Subset data by stds###################
sbst.unt<-reactive({
neodt<-neos()
unt.sbst <- neodt[(neodt$unit==input$unit & neodt$Type==input$Type),]
unt.sbst
})
output$table <- renderDataTable({sbst.unt()})
###Plot by selction of Unit and Type ############################
output$plts <- renderPlot({
plt.dt <- sbst.unt()
wavelength<-as.numeric(substr(colnames(plt.dt[,-c(1:3)]),2,19))
colnames(plt.dt) <- c("SSN","unit","Type",wavelength)
spec.m <- melt(plt.dt, id = c("SSN","unit","Type"))
p <- ggplot(data =spec.m , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
theme(
plot.background = element_blank()
,panel.grid.major = element_blank()
,panel.grid.minor = element_blank()
)
p <- p + theme(plot.title = element_text(hjust = 0.5))
p <- p + theme(legend.position = "none")
p
})
####here you react off the FaceType button#############
plotdata <- eventReactive(input$Faceunit,{
req(input$Faceunit)
neos()
})
output$plts2 <- renderPlot({
plt.dt2 <- plotdata()
wavelength2 <- as.numeric(substr(colnames(plt.dt2[,-c(1:3)]),2,19))
colnames(plt.dt2) <- c("SSN","unit","Type",wavelength2)
# Average plt.dt2 and index by SSN and unit
spec.m2 <- melt(plt.dt2, id = c("SSN","unit","Type"))
p2 <- ggplot(data = spec.m2 , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength2))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
theme(
plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank())
p2 <- p2 + theme(plot.title = element_text(hjust = 0.5))
p2 <- p2 + theme(legend.position = "none")
fac.unit <- p2 + facet_grid(.~unit, switch ='y', scales = "free")
fac.unit
})
###Plot by Action button of Type ##############################################################
# here you react off the FaceType button
plotdata1 <- eventReactive(input$FaceType,{
req(input$FaceType)
neos()
plotdata1()$SSN.unit <- paste0(plotdata1()[,"SSN"],".", plotdata1()[,"unit"])
z <-ncol(plotdata1())
plotdata1()[,1] <- plotdata1()[,"SSN.unit"]
plotdata1() <- plotdata1()[,-c(2,z)]
})
output$plts3 <- renderPlot({
plt.dt2 <- plotdata1()
wavelength2 <- as.numeric(substr(colnames(plt.dt2[,-c(1:2)]),2,19))
colnames(plt.dt2) <- c("SSN","Type",wavelength2)
spec.m2 <- melt(plt.dt2, id = c("SSN","Type"))
p2 <- ggplot(data = spec.m2 , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength2))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
theme(
plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank())
p2 <- p2 + theme(plot.title = element_text(hjust = 0.5))
p2 <- p2 + theme(legend.position = "none")
fac.typ <- p2 + facet_grid(.~Type, switch ='y', scales = "free")
fac.typ
})
}
shinyApp(ui = ui, server = server)
这是一些数据
dput(
SSN unit Type X2600.000003874302 X2597.4609457191823 X2594.926835544204
RResmicro1g3SI1 Unit1 soil 0.37285368 0.364537573 0.356995724
RResmicro1g3SI1 Unit2 soil 0.295855514 0.292268904 0.289343551
RResmicro1g3SI1 Unit3 soil 0.296041336 0.294366508 0.292749726
RResmicro1mSGe2 Unit1 soil 0.387475087 0.38768638 0.387886013
RResmicro1mSGe2 Unit2 soil 0.428004392 0.42284043 0.41852246
RResmicro1mSGe2 Unit3 soil 0.422322559 0.419495941 0.416767303
RresMicro1mtHj Unit1 dung 0.458153765 0.456678695 0.455340966
RresMicro1mtHj Unit2 dung 0.429987543 0.429523389 0.429238502
）