R shiny question

[Gerard Dumancas]

Hello,

I apologize for asking this. It took me 2 weeks but I still cannot figure this out. I am learning so much in Shiny R but I don't know where to ask. Maybe this is not the right group to ask, so please direct me to the right one if possible. Thank you very much!

I am wanting to run a code so that when I run it, it will show "Run script." Below is the run script code.

source("05June2020_(Unknown)Specific Spectral Region_App.test.R")

library(shiny)

shinyApp(

  fluidPage(

    actionButton("buttonId", "run script")

  ),

  function(input, output, session) {

    observeEvent(input$buttonId, {

      message("running 05June2020_(Unknown)Specific Spectral Region_App.test.R")

      output$table <- renderDataTable(pred.unknown.all.non.neg.percent.sample.name)

      source("05June2020_(Unknown)Specific Spectral Region_App.test.R")

      output$table <- renderDataTable(pred.unknown.all.non.neg.percent.sample.name)

    })

  }

)

So, in other words, the code will source in another code to be run entitled "05June2020_(Unknown)Specific Spectral Region_App.test.R." Below is the code for "05June2020_(Unknown)Specific Spectral Region_App.test.R." But what happened was when I run the first code above and pressed the "run script" button, it just lagged and did not show the results. It just simply gave me this below:

> runApp('Button_test2.R')

Listening on http://127.0.0.1:6138

running 05June2020_(Unknown)Specific Spectral Region_App.test.R

Code for "05June2020_(Unknown)Specific Spectral Region_App.test.R."

All.FCP <- read.csv("Honey_Concentrations.csv",header=T,sep=",") #selected wavenumbers: 1500.57031- 798.504 cm-1 (corresponds to columns 1301 to 1665)

Train_abs <- All.FCP[1:81,1301:1665]

Test_abs <- All.FCP[82:113,1301:1665]

unknown_abs <- All.FCP[114:169,1301:1665] #Unknown absorbance values should be placed after row 169 harboring only within the 1500.57031- 798.504 cm-1 (corresponds to columns 1301 to 1665 of the .csv file sheet)

Train_conc <- All.FCP[1:81,2:6]

Test_conc <- All.FCP[82:113,2:6]

unknown_conc <- All.FCP[114:169,2:6]

d1.train <-t(diff(t(Train_abs),differences=1)) #1st derivative preprocessing of train set

d1.test <-t(diff(t(Test_abs),differences=1)) #1st derivative preprocessing of test set

d1.unknown <- t(diff(t(unknown_abs),differences=1)) #1st derivative preprocessing of unknown set

library(pls)

pls.model.train.corn <- plsr(as.matrix(Train_conc[,1])~as.matrix(d1.train),ncomp=10) #pls1 model for corn syrup

pls.model.train.cane <- plsr(as.matrix(Train_conc[,2])~as.matrix(d1.train),ncomp=10) #pls1 model for cane syrup

pls.model.train.beet <- plsr(as.matrix(Train_conc[,3])~as.matrix(d1.train),ncomp=10) #pls1 model for beet syrup

pls.model.train.rice <- plsr(as.matrix(Train_conc[,4])~as.matrix(d1.train),ncomp=10) #pls1 model for rice syrup

jpeg("RMSEP_vs_comp_train.jpg") #opens and saves a JPEG file for the RSMEP vs number of components plot for corn, cane, beet, and ricr syrups below

par(mfrow=c(2,2)) #creates 2 rows and 2 columns of the RMSEP vs number of components plot for corn, cane, beet, and rice syrups below

options(warn = -1) #suppresses warning signs

plot(RMSEP(pls.model.train.corn), legendpos = "topright",validation="LOO",main="corn") #components chosen = 4

plot(RMSEP(pls.model.train.cane), legendpos = "topright",validation="LOO",main="cane") #components chosen = 4

plot(RMSEP(pls.model.train.beet), legendpos = "topright",validation="LOO",main="beet") #components chosen = 5

plot(RMSEP(pls.model.train.rice), legendpos = "topright",validation="LOO",main="rice") #components chosen = 4

dev.off() #eturns the number and name of the new active device (after the specified device has been shut down).

R2(pls.model.train.corn) #R2 = 0.8592, components = 4

R2(pls.model.train.cane) #R2 = 0.7716, components = 4 

R2(pls.model.train.beet) #R2 = 0.8646, components = 5

R2(pls.model.train.rice) #R2 = 0.9437, components = 4

jpeg("pred_vs_measured_train.jpg") #opens and saves a JPEG file for the predicted vs measured % mass concentrations plot for corn, cane, beet, and ricr syrups below

par(mfrow=c(2,2)) #creates 2 rows and 2 columns of the predicted vs measured % mass concentrations plot for corn, cane, beet, and rice syrups below

plot(pls.model.train.corn, ncomp=4, asp = 1, line = TRUE, main="corn") #R2 = 0.853, components = 4

plot(pls.model.train.cane, ncomp=4, asp = 1, line = TRUE, main= "cane") #R2 = 0.772, components = 4

plot(pls.model.train.beet, ncomp=5, asp = 1, line = TRUE, main="beet") #R2 = 0.865, components = 5

plot(pls.model.train.rice, ncomp=4, asp = 1, line = TRUE, main="rice") #R2 = 0.944, components = 4

dev.off()

library(Metrics)

RMSEP(pls.model.train.corn) #RMSECV = 0.02225, components = 4

RMSEP(pls.model.train.cane) #RMSECV = 0.023655, components = 4

RMSEP(pls.model.train.beet) #RMSECV = 0.022451, components = 5

RMSEP(pls.model.train.rice) #RMSECV = 0.014693, components = 4

pred.corn <- predict(pls.model.train.corn,ncomp=4, newdata=as.matrix(d1.test))

pred.cane <- predict(pls.model.train.cane,ncomp=4,newdata=as.matrix(d1.test))

pred.beet <- predict(pls.model.train.beet,ncomp=5,newdata=as.matrix(d1.test))

pred.rice <- predict(pls.model.train.rice,ncomp=4,newdata=as.matrix(d1.test)) 

RMSEP.corn <- rmse(pred.corn,Test_conc$corn)

RMSEP.cane <- rmse(pred.cane,Test_conc$cane)

RMSEP.beet <- rmse(pred.beet,Test_conc$beet)

RMSEP.rice <- rmse(pred.rice,Test_conc$rice)

pred.corn.unknown <- predict(pls.model.train.corn,ncomp=4,newdata=as.matrix(d1.unknown))

pred.cane.unknown <- predict(pls.model.train.cane,ncomp=4,newdata=as.matrix(d1.unknown))

pred.beet.unknown <- predict(pls.model.train.beet,ncomp=5,newdata=as.matrix(d1.unknown)) 

pred.rice.unknown <- predict(pls.model.train.rice,ncomp=4,newdata=as.matrix(d1.unknown)) 

pred.corn.unknown #4 components, this is the final concentration results of the % corn syrup

pred.cane.unknown #4 components,  this is the final concentration results of the % cane syrup

pred.beet.unknown #5 components,  this is the final concentration results of the % beet syrup

pred.rice.unknown #4 components,  this is the final concentration results of the % rice syrup

pred.unknown.all <- cbind(pred.corn.unknown,pred.cane.unknown,pred.beet.unknown,pred.rice.unknown) #binds all corn, cane, beet, and rice % mass predicted concentrations by the PLS model

dim(pred.unknown.all) #checks the dimension of the unknown predicted results

pred.unknown.all.non.neg <- ifelse(pred.unknown.all < 0, 0, pred.unknown.all) #replaces all negative results with zero for the unknown predicted results

pred.unknown.all.non.neg.percent <- pred.unknown.all.non.neg*100 #multiplying all values by 100% in order to obtain percent values of each syrup in honey

sample.name <- All.FCP[114:169,1] #This column only harbors the sample name/code starting with row 114 where the unknown sample row code starts

pred.unknown.all.non.neg.percent.sample.name <- cbind(sample.name,pred.unknown.all.non.neg.percent)

write.csv(pred.unknown.all.non.neg.percent.sample.name,"pred.unknown.all.non.neg.percent.sample.name.results.csv")

#Part II. PCA analysis for specific wavenumbers: 798.504-1500.57031 cm-1

library(pls)

library(prospectr)

library(Metrics)

library(factoextra)

All.NIR <- read.csv("Unknown_specific_spectral_regions.csv",header=T,sep=",")# specific wavenumbers: 798.504-1500.57031 cm-1, #The file is attached in this email. Only put the unknown absorbance at the very end of the .csv file for this

rownames(All.NIR) <- All.NIR$Code

All.NIR$Code

rownames(All.NIR)

unknown_abs.scaled <- scale(All.NIR[,2:366]) #columns 2 to 366 are the columns of the spectra

set.seed(123)

k.max <- 15 

data <- unknown_abs.scaled

wss <- sapply(1:k.max, function(k){kmeans(data, k, nstart=10 )$tot.withinss})

plot.new()

jpeg("pca.jpg") #opens and saves a JPEG file for the PCA plot

plot(1:k.max, wss, type="b", pch = 19, frame = FALSE, xlab="Number of clusters K", ylab="Total within-clusters sum of squares")

abline(v = 4, lty =2) 

km.res <- kmeans(data, 4, nstart = 25) 

fviz_cluster(km.res,data,ellipse.type="norm",ellipse.level=0.70,main="",ggtheme = theme_classic(),ellipse.alpha = 0.2,pointsize = 1.75,labelsize = 12) 

options(warn = -1) #suppresses warning signs

dev.off()

library('jpeg')

img <- jpeg::readJPEG(source = "pca.jpg")

# Part III. Deployment of ShinyR app based on results from PLS (Part I) and PCA (Part II) for specific wavenumbers: 798.504-1500.57031 cm-1

library(shiny)

## Only run this example in interactive R sessions

if (interactive()) {

  # DataTables example

  shinyApp(

    ui = fluidPage(

      titlePanel("Percent mass of adulterants in honey"),

      fluidRow(

        column(12,

               dataTableOutput('table'),

               #plotOutput("plot1")

               #tags$img(src='p.jpg'))

        )

      )

    ),

    server = function(input, output) {

      output$table <- renderDataTable(pred.unknown.all.non.neg.percent.sample.name)

      #output$plot1 <- renderPlot(img)

    }

  )

}