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