R|Shiny缁冧範

Posted 2021-03-03

鏍囩锛?a href='http://www.mamicode.com/so/1/hellip' title='hellip'>hellip   閫氳繃   tle   娣诲姞   琛ㄥご   table   tag   tabs   鏁版嵁涓績   

鍙傝€冿細https://docs.rstudio.com/shinyapps.io/

1. 鏃ユ湡璁＄畻

浠跨収锛?a href="http://bjtime.cn/riqi/">http://bjtime.cn/riqi/

閾炬帴锛?a href="https://dingdangsunny.shinyapps.io/DateCalculate/">https://dingdangsunny.shinyapps.io/DateCalculate/

缁冧範Shiny鍩烘湰杈撳叆杈撳嚭銆?/p>

library(shiny)
ui <- fluidPage(
  titlePanel("浣跨敤Shiny杩涜鏃ユ湡璁＄畻"),
  h4(textOutput("currentTime")),
  helpText("璇疯緭鍏ヨ捣姝㈡棩鏈燂紝璁＄畻鏃ユ湡闂撮殧銆?),
  helpText("榛樿璁＄畻褰撳墠鏃ユ湡涓庝粖骞?鏈?鏃ョ殑闂撮殧銆?),
  dateRangeInput(inputId = "daterange", label = "鏃ユ湡鑼冨洿:",
                 start = as.Date(paste(format(Sys.time()+8*60*60, 
                                              "%Y"),
                                       "/01/01",sep = ""),
                                 "%Y/%m/%d"), 
                 end = as.Date(format(Sys.time()+8*60*60, 
                                      "%Y/%m/%d"),
                               "%Y/%m/%d")),
  textOutput("datedif"),
  tags$hr(),
  helpText("璇疯緭鍏ヨ捣濮嬫棩鏈熷拰鏃ユ湡闂撮殧锛屾帹绠楃洰鏍囨棩鏈熴€?),
  helpText("锛堣緭鍏ヨ礋鏁板垯涓哄悜鍓嶆帹绠椼€傦級"),
  dateInput(inputId = "date", label = "璧峰鏃ユ湡锛?),
  numericInput(inputId = "days", label = "鏃ユ湡闂撮殧:",
               value = 100),
  textOutput("dateaft")
)
server <- function(input, output, session) {
  output$currentTime <- renderText({
    invalidateLater(1000, session)
    paste("褰撳墠鏃堕棿鏄?, Sys.time()+8*60*60)
  })
  output$datedif <- renderText({
    paste("鐩歌窛", diff(input$daterange), "澶?)
  })
  output$dateaft <- renderText({
    d <- input$date + input$days
    paste("鎺ㄧ畻寰楁棩鏈熶负", d, format.Date(d,"%A"))
  })
}
shinyApp(ui = ui, server = server)

 杩欓噷鏃堕棿鍔?灏忔椂璋冩暣涓€涓嬫椂鍖恒€?/p>

鐣岄潰锛?/p>

APP閾炬帴锛?a href="https://dingdangsunny.shinyapps.io/DateCalculate/">https://dingdangsunny.shinyapps.io/DateCalculate/

2. FFT

鍏充簬FFT锛堝揩閫熷倕閲屽彾鍙樻崲锛夛細https://www.cnblogs.com/dingdangsunny/p/12573744.html

閾炬帴锛?a href="https://dingdangsunny.shinyapps.io/FastFourierTransform/">https://dingdangsunny.shinyapps.io/FastFourierTransform/

2.1 婧愪唬鐮?/h2>

global.R

library(dplyr)
FFT<-function(data, Fs, isDetrend=TRUE)
{
  # 蹇€熷倕閲屽彾鍙樻崲
  # data:娉㈠舰鏁版嵁
  # Fs:閲囨牱鐜?  # isDetrend:閫昏緫鍊硷紝鏄惁杩涜鍘诲潎鍊煎鐞嗭紝榛樿涓簍rue
  # 杩斿洖[Fre:棰戠巼,Amp:骞呭€?Ph:鐩镐綅锛堝姬搴︼級]
  n=length(data)
  if(n%%2==1)
  {
    n=n-1
    data=data[1:n]
  }
  if(n<4)
  {
    result<-data.frame(Fre=0,Amp=0,Ph=0)
    return(result)
  }
  if(isDetrend)
  {
    data<-scale(data,center=T,scale=F)
  }
  library(stats)
  Y = fft(data)
  #棰戠巼
  Fre=(0:(n-1))*Fs/n
  Fre=Fre[1:(n/2)]
  #骞呭€?  Amp=Mod(Y[1:(n/2)])
  Amp[c(1,n/2)]=Amp[c(1,n/2)]/n
  Amp[2:(n/2-1)]=Amp[2:(n/2-1)]/(n/2)
  #鐩镐綅
  Ph=Arg(Y[1:(n/2)])
  result<-data.frame(Fre=Fre,Amp=Amp,Ph=Ph)
  return(result)
}
SUB<-function(t,REG)
{
  # 閫氳繃姝ｅ垯琛ㄨ揪寮忔彁鍙栬緭鍏ユ暟鎹?  m<-gregexpr(REG, t)
  start<-m[[1]]
  stop<-start+attr(m[[1]],"match.length")-1
  l<-length(start)
  r<-rep("1",l)
  for(i in 1:l)
  {
    r[i]<-substr(t,start[i],stop[i])
  }
  return(r)
}
#鐢熸垚绀轰緥淇″彿
deg2rad<-function(a)
{
  return(a*pi/180)
}
N = 256
Fs = 150
t = (0:(N-1))/Fs
wave = (5 + 8*cos(2*pi*10.*t) + 
  4*cos(2*pi*20.*t + deg2rad(30)) + 
  2*cos(2*pi*30.*t + deg2rad(60)) + 
  1*cos(2*pi*40.*t + deg2rad(90)) + 
  rnorm(length(t))) %>%
  paste(collapse = ",")

ui.R

library(shiny)
shinyUI(fluidPage(
  titlePanel("浣跨敤Shiny杩涜FFT鍒嗘瀽"),
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "input_mode",
                  label = "閫夋嫨涓€绉嶆暟鎹緭鍏ユ柟寮?,
                  choices = c("鏂囨湰杈撳叆", "涓婁紶鏂囦欢")),
      textAreaInput(inputId = "data",
                label = "鍘熷鏁版嵁:",
                value = wave, 
                rows = 10),
      fileInput("file", "閫夋嫨CSV鏂囦欢杩涜涓婁紶",
                multiple = FALSE,
                accept = c("text/csv",
                           "text/comma-separated-values,text/plain",
                           ".csv")),
      checkboxInput("header", "鏄惁鏈夎〃澶?, TRUE),
      radioButtons("sep", "鍒嗛殧绗?,
                   choices = c("閫楀彿" = ",",
                               "鍒嗗彿" = ";",
                               "鍒惰〃绗? = "	"),
                   selected = ","),
      numericInput(inputId = "Fs",
                   label = "閲囨牱棰戠巼:",
                   value = 150),
      sliderInput("xlim", "x鍧愭爣鑼冨洿:",
                  min = 0, max = 1,
                  value = c(0,1)),
      sliderInput("ylim", "y鍧愭爣鑼冨洿:",
                  min = 0, max = 1,
                  value = c(0,1)),
      checkboxInput("isDetrend", "鏁版嵁涓績鍖?, TRUE),
      checkboxInput("showgrid", "娣诲姞缃戞牸绾?, TRUE)
    ),
    mainPanel(
      tabsetPanel(
        type = "tabs",
        tabPanel("鍥惧儚", plotOutput(outputId = "data_in"),
                           plotOutput(outputId = "result")),
        tabPanel("棰戣氨", 
                 helpText("棰戣氨鍒嗘瀽缁撴灉濡備笅銆?),
                 helpText("杈撳叆鍩洪鑾峰彇THD璁＄畻缁撴灉銆?),
                 numericInput(inputId = "fund",
                              label = "鍩洪:",
                              value = 10),
                 verbatimTextOutput("THD"),
                 numericInput(inputId = "num",
                              label = "灞曠ず鍑犺鏁版嵁:",
                              value = 15),
                 downloadButton("downloadData", "涓嬭浇鏁版嵁"),
                 tableOutput("resultview")
                 ),
        tabPanel("甯姪",
                 helpText("杩欐槸涓€涓熀浜嶴hiny鍒涘缓鐨勭綉椤电▼搴忥紝
                          鍙互杩涜蹇€熷倕閲屽彾鍙樻崲锛團FT锛夈€?,
                          "浜嗚ВShiny璇疯闂?",
                          a(em("https://shiny.rstudio.com/"),
                            href="https://shiny.rstudio.com/")),
                 helpText("鎮ㄥ彲浠ラ€夋嫨鍦ㄦ枃鏈涓緭鍏ュ師濮嬫暟鎹垨閫氳繃CSV鏂囦欢杩涜涓婁紶锛?                          鏂囨湰妗嗕腑鐨勬暟鎹簲鐢遍€楀彿鎴栫┖鏍煎垎闅斿紑锛孋SV涓殑鏁版嵁搴斿浜庤〃鏍?                          鐨勭涓€鍒椼€傚浘鍍忛潰鏉夸腑鍚戞偍灞曠ず浜嗗師濮嬫暟鎹殑搴忓垪鍜孎FT鍙樻崲鍚庣殑缁撴灉锛?                          閫氳繃x鍜寉鍧愭爣鑼冨洿鐨勬粦鍧楋紝鍙互灏嗗垎鏋愮粨鏋滅殑鍥惧舰杩涜鏀惧ぇ銆?                          濡傛灉鍕鹃€変簡鏁版嵁涓績鍖栫殑澶嶉€夋锛屽垯灏嗘护闄ょ洿娴佹垚鍒嗭紝鍚﹀垯灏嗕繚鐣欍€?                          鍦ㄩ璋遍潰鏉夸腑锛屽彲浠ユ煡鐪婩FT鍒嗘瀽鐨勬暟鍊肩粨鏋滃苟杩涜涓嬭浇锛岄€氳繃杈撳叆鍩洪锛?                          鍙互鑾峰緱鎬昏皭娉㈠け鐪燂紙THD锛夎绠楃粨鏋溿€?),
                 helpText("婧愪唬鐮佸拰婕旂ず绀轰緥璇疯闂?",
                   a(em("鍙彯褰撳綋sunny鐨勫崥瀹?),
                     href="https://www.cnblogs.com/dingdangsunny/p/12586274.html#_label1"),
                          "")
        )
      )
    )
  )
))

server.R

library(shiny)
library(dplyr)
shinyServer(function(input, output) {
  data <- reactive({
    if(input$input_mode=="鏂囨湰杈撳叆")
    {
      return(SUB(input$data,"[-0-9.]+") %>%
        as.numeric())
    }
    else if(input$input_mode=="涓婁紶鏂囦欢")
    {
      req(input$file)
      data <- read.csv(input$file$datapath,
                        header = input$header,
                        sep = input$sep)
      return(data[,1])
    }
  })
  result <- reactive({
    FFT(data(), input$Fs, input$isDetrend)
  })
  output$data_in <- renderPlot({
    ylabel <- function()
    {
      if(input$input_mode=="涓婁紶鏂囦欢" & input$header==TRUE)
        return((read.csv(input$file$datapath,
                        header = TRUE, sep = input$sep) %>%
                 names())[1])
      else
        return("value")
    }
    par(mai=c(1,1,0.5,0.5))
    plot((1:length(data()))/input$Fs, data(),
         type = "l", main = "The original data", 
         xlab = "time/s", ylab = ylabel())
    if(input$showgrid)
    {
      grid(col = "darkblue", lwd = 0.5)
    }
  })
  output$result <- renderPlot({
    Fre_max <- max(result()$Fre)
    Amp_max <- max(result()$Amp)
    x_ran <- (input$xlim*1.1-0.05)*Fre_max
    y_ran <- (input$ylim*1.1-0.05)*Amp_max
    par(mai=c(1,1,0.5,0.5))
    plot(result()$Fre, result()$Amp, type = "l",
         xlab = "Frequency/Hz", ylab = "Amplitude",
         main = "FFT analysis results",
         xlim = x_ran, ylim = y_ran)
    if(input$showgrid)
    {
      grid(col = "darkblue", lwd = 0.5)
    }
  })
  output$resultview <- renderTable({
    r <- cbind(result()[1:input$num,], 
               result()[(1+input$num):(2*input$num),])
    names(r) <- rep(c("棰戠巼", "骞呭€?, "鐩镐綅"), 2)
    r
  })
  output$THD <- renderPrint({
    n <- floor(dim(result())[1]/input$fund)
    A <- rep(0, n)
    for(i in 1:n)
    {
      A[i] <- result()$Amp[which(abs(result()$Fre-i*input$fund)==
                                   min(abs(result()$Fre-i*input$fund)))]
    }
    THD <- sqrt(sum((A[2:n])^2)/(A[1])^2)
    cat("鎬昏皭娉㈠け鐪烼HD = ",THD*100,"%",sep = "")
  })
  output$downloadData <- downloadHandler(
    filename = function() {
      return("FFTresult.csv")
    },
    content = function(file) {
      write.csv(result(), file)
    }
  )
})

2.2 娴嬭瘯

鐢遍粯璁ゆ暟鎹泦娴嬭瘯寰楀埌鐣岄潰濡備笅锛?/p>

棰戠巼鏁版嵁鐣岄潰锛?/p>

甯姪鏂囨湰鐣岄潰锛?/p>

鐢?a href="https://www.cnblogs.com/dingdangsunny/p/12573744.html#_label2">https://www.cnblogs.com/dingdangsunny/p/12573744.html#_label2涓彁鍒扮殑鏁版嵁杩涜鏂囦欢涓婁紶娴嬭瘯銆?/p>

APP閾炬帴锛?a href="https://dingdangsunny.shinyapps.io/FastFourierTransform/">https://dingdangsunny.shinyapps.io/FastFourierTransform/

鍙﹀锛屽彂鐜颁簡涓€涓敤Shiny鍐欑殑鏈夎叮鐨勫皬宸ュ叿锛?a href="http://qplot.cn/toolbox/">http://qplot.cn/toolbox/锛屽彲浠ヤ竴璇?hellip;…