R语言-Shiny包--学习笔记

R语言_Shiny包_学习笔记ZW2024-03-17ShinyApp的基本构成Shinyapp有两部分（ui.R和server.R可以放在一个R脚本文件中app.R）:一个用户交互脚本（ui）：ui负责控制布局和展示，在源脚本中固定的名称为ui.R一个服务器脚本（server）：server.R脚本包含建立app计算机需要的基本说明文件夹内容如下（创建的www文件夹用来存放JS、CSS、图片、html等）：library(shiny)

ui<-fluidPage(

textOutput("greeting")

)

server<-function(input,output,session){

output$greeting<-renderText("Hellohuman!")

}

shinyApp(ui=ui,server=server)运行方式#app.R的路径

library(shiny)

runApp("my_app")Shinyapps示例Youcanalsoembedplots,forexample:system.file("examples",package="shiny")

runExample("01_hello")#ahistogram

runExample("02_text")#tablesanddataframes

runExample("03_reactivity")#areactiveexpression

runExample("04_mpg")#globalvariables

runExample("05_sliders")#sliderbars

runExample("06_tabsets")#tabbedpanels

runExample("07_widgets")#helptextandsubmitbuttons

runExample("08_html")#ShinyappbuiltfromHTML

runExample("09_upload")#fileuploadwizard

runExample("10_download")#filedownloadwizard

runExample("11_timer")#anautomatedtimer布局fluidPage函数来展示一个自动调整组件尺寸大小来适应浏览器，所有组件放在fluidPage函数中，得到整个app的布局。除了fluidPage()之外，Shiny还提供了一些其他的页面函数，这些函数可以在更专业的情况下派上用场：fixedPage()和fillPage()。library(shiny)

ui<-fluidPage(

titlePanel("titlepanel"),

sidebarLayout(position="right",

sidebarPanel("sidebarpanel"),

mainPanel("mainpanel")

)

)侧边栏（sidebarPanel部分）默认出现在app的左边，通过调整sidebarLayout函数的一个参数position="right"将sidebarPanel调到右边。tabsetPanel()为任意数量的tabPanels()创建一个容器，该容器又可以包含任何其他HTML组件。ui<-fluidPage(

tabsetPanel(

tabPanel("Importdata",

fileInput("file","Data",buttonLabel="Upload..."),

textInput("delim","Delimiter(leaveblanktoguess)",""),

numericInput("skip","Rowstoskip",0,min=0),

numericInput("rows","Rowstopreview",10,min=1)

),

tabPanel("Setparameters"),

tabPanel("Visualiseresults")

)

)如果你想知道用户选择了哪个选项卡，你可以向tabsetPanel提供id参数，它成为一个输入。library(shiny)

ui<-fluidPage(

sidebarLayout(

sidebarPanel(

textOutput("panel")

),

mainPanel(

tabsetPanel(

id="tabset",

tabPanel("panel1","one"),

tabPanel("panel2","two"),

tabPanel("panel3","three")

)

)

)

)

server<-function(input,output,session){

output$panel<-renderText({

paste("Currentpanel:",input$tabset)

})

}

shinyApp(ui=ui,server=server)navlistPanel()与tabsetPanel()类似，但它不是水平运行选项卡标题，而是在侧边栏中垂直显示它们。ui<-fluidPage(

navlistPanel(

id="tabset",

"Heading1",

tabPanel("panel1","Panelonecontents"),

"Heading2",

tabPanel("panel2","Paneltwocontents"),

tabPanel("panel3","Panelthreecontents")

)

)另一种方法是使用navbarPage()：它仍然水平运行选项卡标题，但您可以使用navbarMenu()添加下拉菜单以获得额外的层次结构级别。ui<-navbarPage(

"Pagetitle",

tabPanel("panel1","one"),

tabPanel("panel2","two"),

tabPanel("panel3","three"),

navbarMenu("subpanels",

tabPanel("panel4a","four-a"),

tabPanel("panel4b","four-b"),

tabPanel("panel4c","four-c")

)

)主题安装bslib包或者shinythemes包使用页面主题。thematic包可以为ggplot2、lattice和baseplots提供主题，只需在服务器函数中调用thematic_shiny()。自己制作的主题，可以写好的主题放在www/的子文件夹下ui<-fluidPage(

theme<-bslib::bs_theme(

bg="#0b3d91",

fg="white",

base_font="SourceSansPro"

)

#theme<-shinytheme("cerulean")

#自制主题theme<-"mytheme.css"

)

server<-function(input,output,session){

thematic::thematic_shiny()

output$plot<-renderPlot({

ggplot(mtcars,aes(wt,mpg))+

geom_point()+

geom_smooth()

},res=96)

}conditionalPanel创建一个面板，该面板根据JavaScript表达式的值显示和隐藏其内容。即使你不懂任何JavaScript，简单的比较或相等操作也非常容易做到。ui<-fluidPage(

selectInput("dataset","Dataset",c("diamonds","rock","pressure","cars")),

conditionalPanel(condition="output.nrows",

checkboxInput("headonly","Onlyusefirst1000rows"))

)

server<-function(input,output,session){

datasetInput<-reactive({

switch(input$dataset,

"rock"=rock,

"pressure"=pressure,

"cars"=cars)

})

output$nrows<-reactive({

nrow(datasetInput())

})

outputOptions(output,"nrows",suspendWhenHidden=FALSE)

}

shinyApp(ui,server)HTML可以将您自己的HTML添加到ui中。一种方法是用HTML()函数来包含HTML，用r"()"。另外一种是使用Shiny提供的HTML助手。重要的标签元件有常规函数（如h1()和p()），所有其他标签都可以通过tags使用。names(tags)查看标签。ui<-fluidPage(

HTML(r"(

<h1>Thisisaheading</h1>

<pclass="my-class">Thisissometext!</p>

<ul>

<li>Firstbullet</li>

<li>Secondbullet</li>

</ul>

)")

)

#同上

ui<-fluidPage(

h1("Thisisaheading"),

p("Thisissometext",class="my-class"),

tags$ul(

tags$li("Firstbullet"),

tags$li("Secondbullet")

)

)

#注意inline=TRUE;的使用textOutput()默认是生成一个完整的段落。

tags$p(

"Youmade",

tags$b("$",textOutput("amount",inline=TRUE)),

"inthelast",

textOutput("days",inline=TRUE),

"days"

)img函数通过特殊处理才能找到图片，图片文件必须在www文件及在下，www文件和app.R脚本同路径（在同一文件下）img(src="my_image.png",height=72,width=72)library(shiny)

ui<-fluidPage(titlePanel("MyShinyApp"),

sidebarLayout(sidebarPanel(

h1("Firstleveltitle",align="center"),#标题1，居中

h6("Sixthleveltitle"),

p("pcreatesaparagraphoftext.",

style="font-family:'times';font-size:16pt"),#段落，style属性支持CSS

strong("strong()makesboldtext."),#加粗

em("em()createsitalicized(i.e,emphasized)text."),#斜体

br(),#回车

hr(),#水平分割线

code("codedisplaysyourtextsimilartocomputercode"),#行内代码

div("divcreatessegmentsoftextwithasimilarstyle.",

style="color:blue"),

img(src="bigorb.png",height=40,width=40)#图片

),

mainPanel(

h1("Firstleveltitle",align="center"),

h6("Sixthleveltitle"),

p("pcreatesaparagraphoftext.",

style="color:green;text-align:center"),

strong("strong()makesboldtext."),

em("em()createsitalicized(i.e,emphasized)text."),

br(),

code("codedisplaysyourtextsimilartocomputercode"),

div("divcreatessegmentsoftextwithasimilarstyle.",

style="color:blue"),

img(src="bigorb.png",height=400,width=400)

)))

#定义serverlogic

server<-function(input,output){

}

#Runtheapplication

shinyApp(ui=ui,server=server)Shiny具有三个主要依赖项：jQueryshiny（自定义JavaScript和CSS）Bootstrap（JavaScript和CSS）控件Shiny控件用于收集互动信息空间样式和代码可以看下面的链接https://shiny.posit.co/r/gallery/widgets/widget-gallery/library(shiny)

ui<-fluidPage(

titlePanel("MyShinyApp"),

sidebarLayout(

sidebarPanel(

#行

fluidRow(

#列

column(3,#column的网格宽度（必须在1到12之间）

h3("Buttons"),

actionButton("action",label="Action"),#点击

br(),

br(),

downloadButton("downloadData","Download"),

br(),

br(),

submitButton("Submit"),#提交

h3("Singlecheckbox"),

checkboxInput("checkbox",

label="ChoiceA",

value=TRUE)),#单个勾选框

#另起一列

column(3,

checkboxGroupInput("checkGroup",

label=h3("Checkboxgroup"),

choices=list("Choice1"=1,

"Choice2"=2,

"Choice3"=3),

selected=1),#多选框

dateInput("date",

label=h3("Dateinput"),

value="2024-01-01")#日期选择框

)

),

#另起一行

fluidRow(

column(3,

dateRangeInput("dates",

label=h3("Daterange")

)#日期范围选择框

),

column(3,

fileInput("file",

label=h3("Fileinput")

)#文件选择框

),

column(3,

h3("Helptext"),

helpText("Note:helptextisn'tatruewidget,",

"butitprovidesaneasywaytoaddtextto",

"accompanyotherwidgets.")

),

column(3,

numericInput("num",

label=h3("Numericinput"),

value=1)#数字输入框

)

),

fluidRow(

column(3,

radioButtons("radio",

label=h3("Radiobuttons"),

choices=list("Choice1"=1,

"Choice2"=2,

"Choice3"=3),

selected=1)#单选框

),

column(3,

selectInput("select",

label=h3("Selectbox"),

choices=list("Choice1"=1,

"Choice2"=2,

"Choice3"=3),

selected=1)#下拉选择框

),

column(3,

sliderInput("slider1",

label=h3("Sliders"),

min=0,

max=100,

value=50,

animate=

animationOptions(interval=300,loop=TRUE)),#拖动选择

sliderInput("slider2","",

min=0,

max=100,

value=c(25,75))#拖动选择

),

column(3,

textInput("text",

label=h3("Textinput"),

value="Entertext...")#文本输入框

)

)

),

mainPanel(

)

)

)

#定义serverlogic

server<-function(input,output){

}

#Runtheapplication

shinyApp(ui=ui,server=server)#按钮复位

#https://hadley.shinyapps.io/ms-update-reset/

ui<-fluidPage(

sliderInput("x1","x1",0,min=-10,max=10),

sliderInput("x2","x2",0,min=-10,max=10),

sliderInput("x3","x3",0,min=-10,max=10),

actionButton("reset","Reset")

)

server<-function(input,output,session){

observeEvent(input$reset,{

updateSliderInput(inputId="x1",value=0)

updateSliderInput(inputId="x2",value=0)

updateSliderInput(inputId="x3",value=0)

})

}

shinyApp(ui=ui,server=server)控件输入输入函数：textInput，passwordInput，textAreaInput，sliderInput如果你想确保文本具有某些属性，你可以使用validate()。library(shiny)

ui<-fluidPage(

theme<-bslib::bs_theme(bootswatch="cerulean"),

titlePanel("MyShinyApp"),

sidebarLayout(

sidebarPanel(

actionButton("action",label="Action")

),

mainPanel(

verbatimTextOutput("value")

)

)

)

#定义serverlogic

server<-function(input,output){

output$value<-renderPrint({input$action})

}

#Runtheapplication

shinyApp(ui=ui,server=server)输出函数ui中输出函数：Output，htmlOutput，imageOutput，plotOutput，tableOutput，dataTableOutput，textOutput,uiOutput，verbatimTextOutputserver中render函数render，renderImage，renderPlot，renderPrint，renderTable，renderText，renderUI，renderPrint每个render*函数都有唯一参数。在render函数之内的代码，一旦控件的某个值改变，那么，Shiny会重新执行render内的所有代码块。uiOutput：动态UI输出plotlyOutput：使用plotly包中的函数动态输出renderUI：动态UI输入renderPlotly：使用plotly包中的函数动态输出library(shiny)

ui<-fluidPage(

titlePanel("字体大小，字体颜色"),

sidebarLayout(

sidebarPanel(

sliderInput("psize",

label=h3("字体大小调节"),

min=6,

max=100,

value=10),#拖动选择,

hr(),

radioButtons("pcolor",

label=h3("字体颜选择色"),

choices=list("red"="red",

"blue"="blue",

"green"="green"),

selected="blue")

),

mainPanel(

p("123",styles='colors'),

htmlOutput("colors"),

textOutput("sizes")

)

)

)

#定义serverlogic

server<-function(input,output){

output$colors<-renderText(paste0('"color:',input$pcolor,'"'))

output$sizes<-renderText(paste0('"front-size:',input$psize,'pt"'))

}

#Runtheapplication

shinyApp(ui,server)动态调整按钮调整按钮显示文本ui<-fluidPage(numericInput("n","Simulations",10),

actionButton("simulate","Simulate"))

server<-function(input,output,session){

observeEvent(input$n,{

label<-paste0("Simulate",input$n,"times")

updateActionButton(inputId="simulate",label=label)

})

}

shinyApp(ui=ui,server=server)updateSelectInput()只有在所有output和observer都运行后才会产生影响。ui<-fluidPage(#创建三个选择框和一个输出表

selectInput("territory","Territory",choices=unique(sales$TERRITORY)),

selectInput("customername","Customer",choices=NULL),#customername会自动生成，所以choices=NULL

selectInput("ordernumber","Ordernumber",choices=NULL),#ordernumber会自动生成，所以choices=NULL

tableOutput("data")

)

server<-function(input,output,session){

territory<-reactive({

filter(sales,TERRITORY==input$territory)

})#包含sales与所选territory匹配的行

observeEvent(territory(),{

choices<-unique(territory()$CUSTOMERNAME)

updateSelectInput(inputId="customername",choices=choices)

})#每当territory()更改时，都会更新input$customername选择框中choices的列表

customer<-reactive({

req(input$customername)

filter(territory(),CUSTOMERNAME==input$customername)

})#包含territory()与所选customername匹配的行

observeEvent(customer(),{

choices<-unique(customer()$ORDERNUMBER)

updateSelectInput(inputId="ordernumber",choices=choices)

})#每当customer()更改时，都会更新input$ordernumber选择框中choices的列表

output$data<-renderTable({

req(input$ordernumber)

customer()%>%

filter(ORDERNUMB