API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 30th, 2022
82
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.74 KB | None | 0 0
raw download clone embed print report
  1. #Include Libraries
  2.  
  3. library(shiny)
  4. library(dplyr)
  5. library(stringr)
  6. library(tidyverse)
  7. library(ggplot2)
  8. library(readr)
  9. library(gridExtra)
  10. library(plotly)
  11.  
  12.  
  13. #Define constants and parameters
  14. z.quartz <- 8800000
  15. area.effective <- 0.0025^2*pi
  16. amplitude.factor <- 1.4 #pm/V
  17. d26 <- 3.1*0.000000000001
  18.  
  19. U.star = 1
  20. F.elas.star = 1
  21. F.k = 1
  22. K = 1
  23. G.star = 14
  24. a = K/(8*G.star)
  25.  
  26.  
  27. # Define UI
  28. ui <- fluidPage(
  29. titlePanel(
  30. h1("Multiple Range Analysis", align = "left")
  31. ),
  32. #Page will be in row format
  33. fluidRow(column(width=4,offset=0,
  34. div(style = "height:50px;", "by: Griffin Rauber"))),
  35. #File input
  36. fluidRow(column(width=4,
  37. fileInput("upload", NULL, buttonLabel = "Choose File:", multiple = FALSE))),
  38.  
  39. #Helper text
  40. fluidRow(column(width=6,
  41. h6("Use the sliders below to select the ranges you would like to analyze")
  42. )),
  43.  
  44. fluidRow(
  45. column(width = 6,
  46. sliderInput(width = 600, inputId = "sliderRange1", label = h5("Range 1"),
  47. min = 0, max = 2000, value = c(10, 1000))),
  48. column(width = 6,
  49. sliderInput(width = 600, inputId = "sliderRange2", label = h5("Range 2"),
  50. min = 0, max = 2000, value = c(10, 1000)))),
  51.  
  52. #Row 1 - L1
  53. fluidRow(
  54. column(width = 6,
  55. plotOutput("L1_1")),
  56. column(width = 6,
  57. plotOutput("L1_2"))),
  58.  
  59. #Row 2 - R1
  60. fluidRow(
  61. column(width = 6,
  62. plotOutput("R1_1")),
  63. column(width = 6,
  64. plotOutput("R1_2"))),
  65.  
  66. #Row 3 - fs
  67. fluidRow(
  68. column(width = 6,
  69. plotOutput("fs_1")),
  70. column(width = 6,
  71. plotOutput("fs_2"))),
  72.  
  73. #Row 4 - Ch1
  74. fluidRow(
  75. column(width = 6,
  76. plotOutput("Ch1_1")),
  77. column(width = 6,
  78. plotOutput("Ch1_2"))),
  79.  
  80. #Row 5 - Ch2
  81. fluidRow(
  82. column(width = 6,
  83. plotOutput("Ch2_1")),
  84. column(width = 6,
  85. plotOutput("Ch2_2"))),
  86.  
  87. #Helper text
  88. fluidRow(column(width=6,offset=6,
  89. h6("Use the slider below to select the linear range of Energy Lost per Cycle")
  90. )),
  91.  
  92. #Output normal load and COF linear model details
  93. fluidRow(
  94. column(width = 3, offset = 6,
  95. verbatimTextOutput("Load"))),
  96.  
  97. #File name input for results file
  98. fluidRow(
  99. column(width=4,
  100. textInput("filename", "Results file name:"))),
  101. #Helper text
  102. fluidRow(actionButton("show", "Ready to Download? \nClick This Button")),
  103. #Download buttons at bottom of page
  104. fluidRow(
  105. column(width=6,
  106. downloadButton("downloadData", "Download results file"))),
  107. column(width=6,
  108. downloadButton("reorderData", "Download reordered data"))
  109. )
  110.  
  111. # Define server logic required to make the plots
  112. server <- function(input, output) {
  113.  
  114. #Warning message to make sure users did everything correctly
  115. observeEvent(input$show, {
  116. showModal(modalDialog(
  117. title = "Important message",
  118. HTML("Before downloading the results, ensure that:<br>
  119. 1) The correct stiffness intercept has been selected<br>
  120. 2) The correct points have been highlighted for the maximum elastic force<br>
  121. 3) The linear range of energy lost per cycle is accurate")
  122. ))
  123. })
  124.  
  125. #Code for file input
  126. test.tbl <- reactive({
  127. req(input$upload)
  128. inFile <- input$upload
  129. tbl <- read.delim(inFile$datapath, header=FALSE)
  130. return(tbl)
  131. })
  132.  
  133. #Extract the testing conditions and units of measurement from input data
  134. testing.conditions <- reactive ({ test.tbl()[1,c(2:11)] })
  135. units.of.measurement <- reactive ({ test.tbl()[c(2,3),c(3:20)] })
  136. #print(testing.conditions)
  137. #print(units.of.measurement)
  138. normal.load <- reactive ({ as.numeric(gsub(" uN", "", testing.conditions()[7])) })
  139. output$Load <- reactive ({ paste("Normal Load:",normal.load(),"uN") })
  140.  
  141. #Code for tidying the input dataset
  142.  
  143. #Remove empty columns and remove testing condition rows
  144. tidy.tbl <- reactive({ new.tbl <- test.tbl()[-c(1,3),c(3:20)]
  145. #Set column names to first row
  146. colnames(new.tbl) <- new.tbl[1,]
  147. #Remove first row (which is now the column names)
  148. new.tbl[-1,]
  149. })
  150.  
  151. #Add gamma and RMS delta V columns to full dataset
  152.  
  153. #remove and parse time column for later
  154. Time.vec <- reactive({ parse_time(tidy.tbl()$Time) })
  155. segType <- reactive ({ tidy.tbl()$Seg })
  156. segID <- reactive ({ tidy.tbl()$`ID Tag` })
  157.  
  158. tidy.tbl2 <- reactive ({ tidy.tbl()[,c(3,5:18)]%>%
  159. #Change data type of all columns from character to numeric
  160. mutate_if(is.character,as.numeric)%>%
  161. #Compute gamma
  162. mutate(Gamma = R1/(4*pi*L1))%>%
  163. mutate(Ch1 =`Ch1 (RMS)`)%>%
  164. mutate(Ch2 =`Ch2 (RMS)`)%>%
  165. mutate(RMS.deltaV = `Ch1 (RMS)` - `Ch2 (RMS)`)%>%
  166. mutate(Time = Time.vec())%>%
  167. mutate(segType=segType())%>%
  168. mutate(segID=segID())
  169. })
  170.  
  171. #Check for number of segments
  172.  
  173. #Create separate datasets for segments 1,2,3
  174. seg1 <- reactive({ tidy.tbl2()%>%
  175. filter(segID=="s1")%>%
  176. select(segType, Number, Power, C0, C1, L1, R1, fs, Gamma)%>%
  177. arrange(Power)
  178. })
  179.  
  180. seg2 <- reactive({ tidy.tbl2()%>%
  181. # filter(segID!="s1")%>%
  182. # filter(segID!="s3")%>% #I Could not figure out why /// filter(segID!="s1" || "s3")%>% /// does not work!
  183. select(segType, Number, Power, C0, C1, L1, R1, fs, Gamma, RMS.deltaV, Ch1, Ch2)%>%
  184. arrange(Power)
  185. })
  186.  
  187. seg3 <- reactive({ tidy.tbl2()%>%
  188. filter(segID=="s3")%>%
  189. select(segType, Number, Power, C0, C1, L1, R1, fs, Gamma)%>%
  190. arrange(Power)
  191. })
  192.  
  193. #Create final summary dataset with calculated metrics
  194. final.data <- reactive({ data.tbl <- data.frame(RMS.deltaV = seg2()$RMS.deltaV)
  195. #delta fs and gamma
  196. #this part of the code detects which segment is the baseline
  197. #and calculates gamma and frequency shifts accordingly
  198. data.tbl <-
  199. if(seg1()$segType[1] == "B" & seg3()$segType[1] != "B"){
  200. mutate(data.tbl,
  201. deltaFs = seg2()$fs - seg1()$fs,
  202. deltaGamma = seg2()$Gamma - seg1()$Gamma)
  203. } else if(seg3()$segType[1] == "B" & seg1()$segType[1] != "B"){
  204. mutate(data.tbl,
  205. deltaFs = seg2()$fs - seg3()$fs,
  206. deltaGamma = seg2()$Gamma - seg3()$Gamma)
  207. } else if(seg1()$segType[1] == "B" & seg3()$segType[1] == "B"){
  208. mutate(data.tbl,
  209. deltaFs = seg2()$fs - (seg1()$fs+seg3()$fs)/2,
  210. deltaGamma = seg2()$Gamma - (seg1()$Gamma+seg3()$Gamma)/2)
  211. }
  212. data.tbl <- data.tbl%>%
  213. #quality factor
  214. mutate(Q = 2*pi*seg2()$fs*(seg2()$L1/seg2()$R1))%>%
  215.  
  216. #absolutes
  217.  
  218. #amplitude
  219. mutate(Amp = amplitude.factor*Q*sqrt(2)*RMS.deltaV/1000)%>%
  220. #Ki elastic
  221. mutate(Ki.elas = 2*(pi^2)*z.quartz*area.effective*deltaFs/1000)%>%
  222. #2pi fb
  223. mutate(TwoPi.fb = 2*(pi^2)*z.quartz*area.effective*deltaGamma/1000)%>%
  224. #Elastic Force
  225. mutate(F.elas = Ki.elas*Amp)%>%
  226. #Damping Force
  227. mutate(F.damp = TwoPi.fb*Amp)%>%
  228. #deltaE Elastic
  229. mutate(deltaE.elas = F.elas*Amp/2000)%>%
  230. #deltaE Damping
  231. mutate(deltaE.damp =
  232. 2*(pi^3)*z.quartz*area.effective*deltaGamma*(Amp*0.000000001)^2*1000000000000)%>%
  233. #deltaGamma/deltaFs
  234. mutate(delGamma.delFs = deltaGamma/deltaFs)%>%
  235. arrange(Amp)
  236. data.tbl
  237. })
  238.  
  239. #extract slider min and max for output file linear ranges
  240.  
  241. #Range 1
  242. sliderMin1 <- reactive ({ input$sliderRange1[1] })
  243. sliderMax1 <- reactive ({ input$sliderRange1[2] })
  244.  
  245. #Range 2
  246. sliderMin2 <- reactive ({ input$sliderRange2[1] })
  247. sliderMax2 <- reactive ({ input$sliderRange2[2] })
  248.  
  249. #Filter data
  250. filtered1.data <- reactive({ #reactive object updates every time the user changes the slider
  251. req(input$sliderRange1)
  252. filter(final.data(), seg2()$Number>input$sliderRange1[1] & seg2()$Number<input$sliderRange1[2])
  253. })
  254.  
  255. filtered2.data <- reactive({ #reactive object updates every time the user changes the slider
  256. req(input$sliderRange2)
  257. filter(final.data(), seg2()$Number>input$sliderRange2[1] & seg2()$Number<input$sliderRange2[2])
  258. })
  259.  
  260. #Code for L1_1 plot
  261. output$L1_1 <- renderPlot({
  262. ggplot(filtered1.data())+
  263. geom_point(aes(x = seg2()$Number, y = seg2()$L1), color = "blue")+
  264. geom_smooth(aes(x = seg2()$Number, y = seg2()$L1), method = "lm", se=FALSE, color="black", formula =y ~ x)+
  265. labs(title = "L1 vs. Number for region 1",
  266. x = "Number",
  267. y = "L1")+
  268. #edit text sizes for title and axes labels
  269. theme(plot.title = element_text(size=24,face="bold"),
  270. axis.title.x = element_text(size=14),
  271. axis.title.y = element_text(size=14))
  272. })
  273.  
  274. #Code for L1_2 plot
  275. output$L1_2 <- renderPlot({
  276. ggplot(final.data())+
  277. geom_point(aes(x = seg2()$Number, y = seg2()$L1), color = "blue")+
  278. labs(title = "L1 vs. Number for region 2",
  279. x = "Number",
  280. y = "L1")+
  281. #edit text sizes for title and axes labels
  282. theme(plot.title = element_text(size=24,face="bold"),
  283. axis.title.x = element_text(size=14),
  284. axis.title.y = element_text(size=14))
  285. })
  286.  
  287. #Code for R1_1 plot
  288. output$R1_1 <- renderPlot({
  289. ggplot(final.data())+
  290. geom_point(aes(x = seg2()$Number, y = seg2()$R1), color = "blue")+
  291. labs(title = "L1 vs. Number for region 1",
  292. x = "Number",
  293. y = "R1")+
  294. #edit text sizes for title and axes labels
  295. theme(plot.title = element_text(size=24,face="bold"),
  296. axis.title.x = element_text(size=14),
  297. axis.title.y = element_text(size=14))
  298. })
  299.  
  300. #Code for R1_2 plot
  301. output$R1_2 <- renderPlot({
  302. ggplot(final.data())+
  303. geom_point(aes(x = seg2()$Number, y = seg2()$R1), color = "blue")+
  304. labs(title = "L1 vs. Number for region 2",
  305. x = "Number",
  306. y = "R1")+
  307. #edit text sizes for title and axes labels
  308. theme(plot.title = element_text(size=24,face="bold"),
  309. axis.title.x = element_text(size=14),
  310. axis.title.y = element_text(size=14))
  311. })
  312.  
  313. #Code for fs_1 plot
  314. output$fs_1 <- renderPlot({
  315. ggplot(final.data())+
  316. geom_point(aes(x = seg2()$Number, y = seg2()$fs), color = "blue")+
  317. labs(title = "L1 vs. Number for region 1",
  318. x = "Number",
  319. y = "fs")+
  320. #edit text sizes for title and axes labels
  321. theme(plot.title = element_text(size=24,face="bold"),
  322. axis.title.x = element_text(size=14),
  323. axis.title.y = element_text(size=14))
  324. })
  325.  
  326. #Code for fs_2 plot
  327. output$fs_2 <- renderPlot({
  328. ggplot(final.data())+
  329. geom_point(aes(x = seg2()$Number, y = seg2()$fs), color = "blue")+
  330. labs(title = "L1 vs. Number for region 2",
  331. x = "Number",
  332. y = "fs")+
  333. #edit text sizes for title and axes labels
  334. theme(plot.title = element_text(size=24,face="bold"),
  335. axis.title.x = element_text(size=14),
  336. axis.title.y = element_text(size=14))
  337. })
  338.  
  339. #Code for Ch1_1 plot
  340. output$Ch1_1 <- renderPlot({
  341. ggplot(final.data())+
  342. geom_point(aes(x = seg2()$Number, y = seg2()$Ch1), color = "blue")+
  343. labs(title = "L1 vs. Number for region 1",
  344. x = "Number",
  345. y = "Ch1")+
  346. #edit text sizes for title and axes labels
  347. theme(plot.title = element_text(size=24,face="bold"),
  348. axis.title.x = element_text(size=14),
  349. axis.title.y = element_text(size=14))
  350. })
  351.  
  352. #Code for Ch1_2 plot
  353. output$Ch1_2 <- renderPlot({
  354. ggplot(final.data())+
  355. geom_point(aes(x = seg2()$Number, y = seg2()$Ch1), color = "blue")+
  356. labs(title = "L1 vs. Number for region 2",
  357. x = "Number",
  358. y = "Ch1")+
  359. #edit text sizes for title and axes labels
  360. theme(plot.title = element_text(size=24,face="bold"),
  361. axis.title.x = element_text(size=14),
  362. axis.title.y = element_text(size=14))
  363. })
  364.  
  365. #Code for Ch2_1 plot
  366. output$Ch2_1 <- renderPlot({
  367. ggplot(final.data())+
  368. geom_point(aes(x = seg2()$Number, y = seg2()$Ch2), color = "blue")+
  369. labs(title = "L1 vs. Number for region 1",
  370. x = "Number",
  371. y = "Ch2")+
  372. #edit text sizes for title and axes labels
  373. theme(plot.title = element_text(size=24,face="bold"),
  374. axis.title.x = element_text(size=14),
  375. axis.title.y = element_text(size=14))
  376. })
  377.  
  378. #Code for Ch2_2 plot
  379. output$Ch2_2 <- renderPlot({
  380. ggplot(final.data())+
  381. geom_point(aes(x = seg2()$Number, y = seg2()$Ch2), color = "blue")+
  382. labs(title = "L1 vs. Number for region 2",
  383. x = "Number",
  384. y = "Ch2")+
  385. #edit text sizes for title and axes labels
  386. theme(plot.title = element_text(size=24,face="bold"),
  387. axis.title.x = element_text(size=14),
  388. axis.title.y = element_text(size=14))
  389. })
  390.  
  391. output$range1 <- renderPrint({input$sliderRange1})
  392. output$range2 <- renderPrint({input$sliderRange2})
  393.  
  394. #Code for making reordered dataset
  395. reordered.data <- reactive({
  396. cbind(seg1(),seg2(),seg3())
  397. })
  398.  
  399. #Code for dowmloading reordered data
  400. output$reorderData <- downloadHandler(
  401. filename = function() {paste("Reordered ", input$upload$name, ".csv", sep = "")
  402. },
  403. content = function(file){
  404. write.csv(reordered.data(), file, row.names = FALSE)
  405. }
  406. )
  407.  
  408. #Code for dowmloading results table
  409. output$downloadData <- downloadHandler(
  410. filename = function() {paste(input$filename, ".csv", sep = "")
  411. },
  412. content = function(file){
  413. write.csv(results.data(), file, row.names = FALSE)
  414. #capture.output(results.data(), file = "my_list.txt")
  415. }
  416. )
  417. }
  418.  
  419. # Run the application
  420. shinyApp(ui = ui, server = server)
  421.  
  422.  
  423.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!