R|Shiny练习

叮叮当当sunny 2020-03-28 我要评论

参考：https:/https://img.qb5200.com/download-x/docs.rstudio.com/shinyapps.io/

1. 日期计算

仿照：http://bjtime.cn/riqi/

链接：https:/https://img.qb5200.com/download-x/dingdangsunny.shinyapps.io/DateCalculate/

练习Shiny基本输入输出。

library(shiny)
ui <- fluidPage(
  titlePanel("使用Shiny进行日期计算"),
  h4(textOutput("currentTime")),
  helpText("请输入起止日期，计算日期间隔。"),
  helpText("默认计算当前日期与今年1月1日的间隔。"),
  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)

这里时间加8小时调整一下时区。

界面：

APP链接：https:/https://img.qb5200.com/download-x/dingdangsunny.shinyapps.io/DateCalculate/

2. FFT

关于FFT（快速傅里叶变换）：https://www.cnblogs.comhttps://img.qb5200.com/download-x/dingdangsunny/p/12573744.html

链接：https:/https://img.qb5200.com/download-x/dingdangsunny.shinyapps.io/FastFourierTransform/

2.1 源代码

global.R

library(dplyr)
FFT<-function(data, Fs, isDetrend=TRUE)
{
  # 快速傅里叶变换
  # data:波形数据
  # Fs:采样率
  # isDetrend:逻辑值，是否进行去均值处理，默认为true
  # 返回[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("逗号" = ",",
                               "分号" = ";",
                               "制表符" = "\t"),
                   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("这是一个基于Shiny创建的网页程序，
                          可以进行快速傅里叶变换（FFT）。",
                          "了解Shiny请访问:",
                          a(em("https://shiny.rstudio.com/"),
                            href="https://shiny.rstudio.com/")),
                 helpText("您可以选择在文本框中输入原始数据或通过CSV文件进行上传，
                          文本框中的数据应由逗号或空格分隔开，CSV中的数据应处于表格
                          的第一列。图像面板中向您展示了原始数据的序列和FFT变换后的结果，
                          通过x和y坐标范围的滑块，可以将分析结果的图形进行放大。
                          如果勾选了数据中心化的复选框，则将滤除直流成分，否则将保留。
                          在频谱面板中，可以查看FFT分析的数值结果并进行下载，通过输入基频，
                          可以获得总谐波失真（THD）计算结果。"),
                 helpText("源代码和演示示例请访问:",
                   a(em("叮叮当当sunny的博客"),
                     href="https://www.cnblogs.comhttps://img.qb5200.com/download-x/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("总谐波失真THD = ",THD*100,"%",sep = "")
  })
  output$downloadData <- downloadHandler(
    filename = function() {
      return("FFTresult.csv")
    },
    content = function(file) {
      write.csv(result(), file)
    }
  )
})