R語(yǔ)言-Shiny包--學(xué)習(xí)筆記

R語(yǔ)言_Shiny包_學(xué)習(xí)筆記ZW2024-03-17ShinyApp的基本構(gòu)成Shinyapp有兩部分（ui.R和server.R可以放在一個(gè)R腳本文件中app.R）:一個(gè)用戶(hù)交互腳本（ui）：ui負(fù)責(zé)控制布局和展示，在源腳本中固定的名稱(chēng)為ui.R一個(gè)服務(wù)器腳本（server）：server.R腳本包含建立app計(jì)算機(jī)需要的基本說(shuō)明文件夾內(nèi)容如下（創(chuàng)建的www文件夾用來(lái)存放JS、CSS、圖片、html等）：library(shiny)

ui<-fluidPage(

textOutput("greeting")

)

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

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

}

shinyApp(ui=ui,server=server)運(yùn)行方式#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函數(shù)來(lái)展示一個(gè)自動(dòng)調(diào)整組件尺寸大小來(lái)適應(yīng)瀏覽器，所有組件放在fluidPage函數(shù)中，得到整個(gè)app的布局。除了fluidPage()之外，Shiny還提供了一些其他的頁(yè)面函數(shù)，這些函數(shù)可以在更專(zhuān)業(yè)的情況下派上用場(chǎng)：fixedPage()和fillPage()。library(shiny)

ui<-fluidPage(

titlePanel("titlepanel"),

sidebarLayout(position="right",

sidebarPanel("sidebarpanel"),

mainPanel("mainpanel")

)

)側(cè)邊欄（sidebarPanel部分）默認(rèn)出現(xiàn)在app的左邊，通過(guò)調(diào)整sidebarLayout函數(shù)的一個(gè)參數(shù)position="right"將sidebarPanel調(diào)到右邊。tabsetPanel()為任意數(shù)量的tabPanels()創(chuàng)建一個(gè)容器，該容器又可以包含任何其他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")

)

)如果你想知道用戶(hù)選擇了哪個(gè)選項(xiàng)卡，你可以向tabsetPanel提供id參數(shù)，它成為一個(gè)輸入。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()類(lèi)似，但它不是水平運(yùn)行選項(xiàng)卡標(biāo)題，而是在側(cè)邊欄中垂直顯示它們。ui<-fluidPage(

navlistPanel(

id="tabset",

"Heading1",

tabPanel("panel1","Panelonecontents"),

"Heading2",

tabPanel("panel2","Paneltwocontents"),

tabPanel("panel3","Panelthreecontents")

)

)另一種方法是使用navbarPage()：它仍然水平運(yùn)行選項(xiàng)卡標(biāo)題，但您可以使用navbarMenu()添加下拉菜單以獲得額外的層次結(jié)構(gòu)級(jí)別。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包使用頁(yè)面主題。thematic包可以為ggplot2、lattice和baseplots提供主題，只需在服務(wù)器函數(shù)中調(diào)用thematic_shiny()。自己制作的主題，可以寫(xiě)好的主題放在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創(chuàng)建一個(gè)面板，該面板根據(jù)JavaScript表達(dá)式的值顯示和隱藏其內(nèi)容。即使你不懂任何JavaScript，簡(jiǎn)單的比較或相等操作也非常容易做到。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()函數(shù)來(lái)包含HTML，用r"()"。另外一種是使用Shiny提供的HTML助手。重要的標(biāo)簽元件有常規(guī)函數(shù)（如h1()和p()），所有其他標(biāo)簽都可以通過(guò)tags使用。names(tags)查看標(biāo)簽。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()默認(rèn)是生成一個(gè)完整的段落。

tags$p(

"Youmade",

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

"inthelast",

textOutput("days",inline=TRUE),

"days"

)img函數(shù)通過(guò)特殊處理才能找到圖片，圖片文件必須在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"),#標(biāo)題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(),#回車(chē)

hr(),#水平分割線(xiàn)

code("codedisplaysyourtextsimilartocomputercode"),#行內(nèi)代碼

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具有三個(gè)主要依賴(lài)項(xiàng)：jQueryshiny（自定義JavaScript和CSS）Bootstrap（JavaScript和CSS）控件Shiny控件用于收集互動(dòng)信息空間樣式和代碼可以看下面的鏈接https://shiny.posit.co/r/gallery/widgets/widget-gallery/library(shiny)

ui<-fluidPage(

titlePanel("MyShinyApp"),

sidebarLayout(

sidebarPanel(

#行

fluidRow(

#列

column(3,#column的網(wǎng)格寬度（必須在1到12之間）

h3("Buttons"),

actionButton("action",label="Action"),#點(diǎn)擊

br(),

br(),

downloadButton("downloadData","Download"),

br(),

br(),

submitButton("Submit"),#提交

h3("Singlecheckbox"),

checkboxInput("checkbox",

label="ChoiceA",

value=TRUE)),#單個(gè)勾選框

#另起一列

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)#數(shù)字輸入框

)

),

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)),#拖動(dòng)選擇

sliderInput("slider2","",

min=0,

max=100,

value=c(25,75))#拖動(dòng)選擇

),

column(3,

textInput("text",

label=h3("Textinput"),

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

)

)

),

mainPanel(

)

)

)

#定義serverlogic

server<-function(input,output){

}

#Runtheapplication

shinyApp(ui=ui,server=server)#按鈕復(fù)位

#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)控件輸入輸入函數(shù)：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)輸出函數(shù)ui中輸出函數(shù)：Output，htmlOutput，imageOutput，plotOutput，tableOutput，dataTableOutput，textOutput,uiOutput，verbatimTextOutputserver中render函數(shù)render，renderImage，renderPlot，renderPrint，renderTable，renderText，renderUI，renderPrint每個(gè)render*函數(shù)都有唯一參數(shù)。在render函數(shù)之內(nèi)的代碼，一旦控件的某個(gè)值改變，那么，Shiny會(huì)重新執(zhí)行render內(nèi)的所有代碼塊。uiOutput：動(dòng)態(tài)UI輸出plotlyOutput：使用plotly包中的函數(shù)動(dòng)態(tài)輸出renderUI：動(dòng)態(tài)UI輸入renderPlotly：使用plotly包中的函數(shù)動(dòng)態(tài)輸出library(shiny)

ui<-fluidPage(

titlePanel("字體大小，字體顏色"),

sidebarLayout(

sidebarPanel(

sliderInput("psize",

label=h3("字體大小調(diào)節(jié)"),

min=6,

max=100,

value=10),#拖動(dòng)選擇,

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)動(dòng)態(tài)調(diào)整按鈕調(diào)整按鈕顯示文本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都運(yùn)行后才會(huì)產(chǎn)生影響。ui<-fluidPage(#創(chuàng)建三個(gè)選擇框和一個(gè)輸出表

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

selectInput("customername","Customer",choices=NULL),#customername會(huì)自動(dòng)生成，所以choices=NULL

selectInput("ordernumber","Ordernumber",choices=NULL),#ordernumber會(huì)自動(dòng)生成，所以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)

})#每當(dāng)territory()更改時(shí)，都會(huì)更新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)

})#每當(dāng)customer()更改時(shí)，都會(huì)更新input$ordernumber選擇框中choices的列表

output$data<-renderTable({

req(input$ordernumber)

customer()%>%

filter(ORDERNUMB