1. 日期計算

鏈接：https://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://dingdangsunny.shinyapps.io/DateCalculate/

2. FFT

關於FFT（快速傅里葉變換）：https://www.cnblogs.com/dingdangsunny/p/12573744.html

鏈接：https://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.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("總諧波失真THD = ",THD*100,"%",sep = "")    })    output$downloadData <- downloadHandler(      filename = function() {        return("FFTresult.csv")      },      content = function(file) {        write.csv(result(), file)      }    )  })