发布地址:
https://yanshenli.shinyapps.io/shinydemo/
(shinyapp.io打开比较慢)
参考资料
《Mastering Shiny》
https://mastering-shiny.org/index.html
补充:https://rdrr.io/cran/shiny/man/
代码分享
链接:https://pan.baidu.com/s/1jleRa0e9P1D2YMLDTbXSVA?pwd=cnxr
提取码:cnxr
使用方法:下载代码包,修改“shiny.R”中的工作路径,正常就可以直接运行了。
(有疑问欢迎交流,仅限周六日)
shinyapp.R
library(shiny)
library(ggplot2)
setwd("C:\\Users\\ysl\\Desktop\\shinydemo")
load("global.R")
load("ui.R")
load("server.R")
shinyApp(ui, server)
global.R
data = iris
ui.R
ui <- navbarPage(
theme = bslib::bs_theme(bootswatch = "flatly"),
"Nobeli.cn",
tabPanel("Load Data",
absolutePanel(id = "load data",
draggable = TRUE,
top = "60px",
left = "10%",
right = "auto",
bottom = "auto",
width = "250px",
height = "auto",
actionButton("submitButten1","First:Click here to load data")
),
fluidRow(
column(8,
dataTableOutput("summar")
),
column(4,
plotOutput("plot1",width = "600px",height = "450px") # plotOutput("plo",width = "100%",height = "600px")
)
)
),
# Point&line Graph panel
tabPanel("Point&line Graph",
plotOutput("plot2",width = "1600px", height = "900px"),
absolutePanel(
id = "load data",
draggable = TRUE,
top = "100px",
left = "auto",
right = "30px",
bottom = "auto",
width = "200px",
height = "auto",
uiOutput("variable_x"),
uiOutput("variable_y"),
uiOutput("variable_z"),
actionButton("submitButten2","MAP EXPLORE"),
textInput("tI1", label = "Please Input the Title", value = "GGPLOT2")
)
),
# Hist Graph panel
tabPanel("Hist Graph",
plotOutput("plot3",width = "1600px", height = "900px"),
absolutePanel(
id = "hist graphy",
draggable = TRUE,
top = "100px",
left = "auto",
right = "30px",
bottom = "auto",
width = "200px",
height = "auto",
uiOutput("hist_variable_x"),
uiOutput("hist_variable_z"),
actionButton("hist_submitButten2","Hist Graph"),
textInput("hist_tI1", label = "Please Input the Title", value = "GGPLOT2")
)
),
# supanel panels
navbarMenu("subpanels(空)",
tabPanel("panel 4a", "four-a"),
tabPanel("panel 4b", "four-b"),
tabPanel("panel 4c", "four-c")
)
)
server.R
server <- function(input, output, session) {
dataset <- eventReactive(input$submitButten1,data)
# DATA LOAD PANEL SERVER
output$summar <- renderDataTable({
dataset()
})
output$plot1 <- renderPlot({
pairs(dataset())
},res = 96)
# point graph SERVER
## 创建交互变量选择窗口 renderUI
output$variable_x <- renderUI({
selectInput("variableNames_x", label = "Variable_X", choices = names(dataset()))
})
output$variable_y <- renderUI({
selectInput("variableNames_y", label = "Variable_Y", choices = names(dataset()))
})
output$variable_z <- renderUI({
selectInput("variableNames_z", label = "Variable_Z", choices = names(dataset()))
})
df1 <- eventReactive(input$submitButten2,{
test <- data.frame(dataset()[input$variableNames_x], dataset()[input$variableNames_y],dataset()[input$variableNames_z])
colnames(test) <- c("X", "Y","Z")
return(test)
})
## 绘图
output$plot2 <- renderPlot({
ggplot(df1(),mapping = aes(x = X, y = Y, group = Z, color=Z)) +
geom_point()+
geom_line() +
labs(y = input$variableNames_y,x = input$variableNames_x,title = input$tI1)+
theme_bw() +
theme(plot.title = element_text(face="bold",size=24,vjust = 0.5,hjust = 0.5),
legend.background = element_rect(fill="white",size=18,color = "white"),
legend.position = c(0.95,0.1),
legend.justification = c(0.95,0.1))
})
# hist graph SERVER
## 创建交互变量选择窗口 renderUI
output$hist_variable_x <- renderUI({
selectInput("hist_variableNames_x", label = "Variable_X", choices = names(dataset()))
})
output$hist_variable_z <- renderUI({
selectInput("hist_variableNames_z", label = "Variable_Z", choices = names(dataset()))
})
df2 <- eventReactive(input$hist_submitButten2,{
test <- data.frame(dataset()[input$hist_variableNames_x], dataset()[input$hist_variableNames_z])
colnames(test) <- c("X","Z")
return(test)
})
## 绘图
output$plot3 <- renderPlot({
ggplot(df2(),mapping = aes(x = X, fill=factor(Z))) +
geom_bar(position = "dodge")+
labs(x = input$hist_variableNames_x,title = input$hist_tI1)+
theme_bw() +
theme(plot.title = element_text(face="bold",size=24,vjust = 0.5,hjust = 0.5),
legend.background = element_rect(fill="white",size=18,color = "white"),
legend.position = c(0.95,0.1),
legend.justification = c(0.95,0.1))
})
}