In DimitriF/DLC: Deep Layer Chromatography

knitr::opts_chunk$set(dpi=300, cache=F,echo=F,warning=F,message=F,autodep=T,dev=c("pdf"))

if(input$mono.knitr.file.name == T){
  inFilep <- inFile.photo()
  inFilex <- inFile.X()
  data <- cbind(
    c("Batch file",paste0("Chromatogram file ",seq(nrow(inFilep)))),
    c(as.character(inFilex$name),as.character(inFilep$name))
    )
  # kable(data,row.names=NA,col.names=NA)
  kable(data, caption = 'Files')
}

if(input$monoknitrpicture == T){
  par(mar=c(0,0,0,0), xaxt='n',yaxt='n', ann=FALSE)
  par(mfrow=c(1,1))
  inc <- 0
  inFile <- inFile.photo()
  for(i in seq(nrow(inFile))){
    n.pic<-i
    if(input$TableDimensionConvention == 'Linomat'){
      largeur<-as.numeric(TableDimension()[n.pic,1])
      dist.gauche<-as.numeric(TableDimension()[n.pic,2])
      band<-as.numeric(TableDimension()[n.pic,3])
      ecart<-as.numeric(TableDimension()[n.pic,4])
      tolerance<-as.numeric(TableDimension()[n.pic,5])
    }else{
      largeur<-as.numeric(TableDimension()[n.pic,1])
      band<-as.numeric(TableDimension()[n.pic,3])
      dist.gauche<-as.numeric(TableDimension()[n.pic,2])-band/2
      ecart<-as.numeric(TableDimension()[n.pic,4])-band
      tolerance<-as.numeric(TableDimension()[n.pic,5])
    }
    nbr.band<-round((largeur-2*dist.gauche)/(band+ecart))
    plot(c(0,200),c(0,100), type='n',ylab="",xlab="",bty='n')
    rasterImage(f.read.image(as.character(inFile[n.pic,4]),native=T,format=input$mono.Format.type),0 , 0, largeur, 100)
    for(j in seq(nbr.band)){
      inc <- inc+1
      text(x=(dist.gauche+tolerance+(j-1)*(band+ecart)),y=90,labels=dataX.edited()[inc,1],col="red",cex=1)
    }
  }
}

################# batch simple #################
if(input$mono.knitr.batch.simple == T){
  # kable(dataX.mono.pre())
  # kable(dataX.mono.pre(),row.names=F)
  kable(dataX.mono.pre(),row.names=F, caption = 'Batch table')
}
if(input$mono.knitr.batch.pred == T){
  # kable(dataX.mono.pre())
  kable(cbind(dataX.mono.pre(),Pred.prediction.data()),row.names=F, caption = 'Batch table')
}

### chromatogram juste 2 
if(input$mono.knitr.plot.brut == "2"){
################# image1  #################
  par(cex.lab=1.5,mar=c(5, 4, 2, 0.5))
  n.band<-as.numeric(input$name.band.mono.bef.1)
  f.plot.array(data.mono.2(),n.band,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,cex=1.5)
  n.band<-as.numeric(input$name.band.mono.bef.2)
  f.plot.array(data.mono.2(),n.band,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,cex=1.5)
}


### chromatogram all

if(input$mono.knitr.plot.brut == "all"){
################# image1  #################
  par(cex.lab=1.5,mar=c(5, 4, 2, 0.5))
  for(i in seq(nrow(dataX.mono.pre()))){
    f.plot.array(data.mono.2(),i,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,cex=1.5)
  }
}

  if(input$mono.knitr.preprocess == T && length(input$Preprocess.order)>0){
    name <- c()
    value <- c()
    for(i in Preprocess.order()){
      if(i == 'Warping'){
        name <- c(name,i)
        value <- c(value,T)
        name <- c(name,names(Preprocess.options()[[i]]))
        value <- c(value,Preprocess.options()[[i]])
      }
      if(i == 'Standard.Normal.Variate'){
        name <- c(name,i)
        value <- c(value,T)
      }
      if(i == 'medianFilter'){
        name <- c(name,i)
        value <- c(value,Preprocess.options()[[i]])
      }
      if(i == 'gammaCorrection'){
        name <- c(name,i)
        value <- c(value,Preprocess.options()[[i]])
      }
      if(i == 'Mean.centering'){
        name <- c(name,i)
        value <- c(value,T)
      }
      if(i == 'Autoscaling'){
        name <- c(name,i)
        value <- c(value,T)
      }
      if(i == 'Baseline.correction'){
        name <- c(name,i)
        value <- c(value,T)
        name <- c(name,names(Preprocess.options()[[i]]))
        value <- c(value,Preprocess.options()[[i]])
      }
      if(i == 'Smoothing'){
        name <- c(name,i)
        value <- c(value,T)
        name <- c(name,names(Preprocess.options()[[i]]))
        value <- c(value,Preprocess.options()[[i]])
      }
    }
    truc <- cbind(name, value)
    rownames(truc) <- seq(nrow(truc))
    kable(truc, caption = 'Preprocessing Options')
  }

if(input$mono.knitr.prediction.summary.model == T | input$mono.knitr.var.select ==T){
  kable(selection.table()[selection.table()$use==T,2:4], caption = 'Variables Selection')
}

### chromatogram juste 2
if(input$mono.knitr.plot.net == "2"){
################# image1  #################
  # par(mar=c(3,4,2,0),mfrow=c(1,2),mgp=c(2,0.75,0))
  par(cex.lab=1.5,mar=c(5, 4, 2, 0.5))
  n.band<-as.numeric(input$name.band.mono.aft.1)
  f.plot.array(data.mono.3(),n.band,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,reconstruct=F,cex=1.5)
  n.band<-as.numeric(input$name.band.mono.aft.2)
  f.plot.array(data.mono.3(),n.band,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,reconstruct=F,cex=1.5)
}

if(input$mono.knitr.plot.net == "all"){
################# image1  #################
  par(cex.lab=1.5,mar=c(5, 4, 2, 0.5))
  for(i in seq(nrow(dataX.mono.pre()))){
    f.plot.array(data.mono.3(),i,names(Truc.mono()),input$hauteur.mono,input$Zf.mono,input$dist.bas.mono,reconstruct=F,cex=1.5)
  }
}

### PCA
if(input$mono.knitr.pca.plot == T){
  print(pca.plot.1())
}


### cluster
if(input$mono.knitr.cluster.plot == T){
    data<-data.cluster.1()
  if(length(input$Var.cluster.1) == 0){rownames(data)<-dataX.mono.pre()[,"id"]}
  if(length(input$Var.cluster.1) == 1){rownames(data)<-dataX.mono.pre()[,input$Var.cluster.1]}
  if(length(input$Var.cluster.1) > 1){rownames(data)<-apply(dataX.mono.pre()[,input$Var.cluster.1],1,paste0,collapse=" - ")}
  d <- dist(data, method = input$method.dist.cluster.1) # distance matrix
  fit <- hclust(d, method=input$method.clust.cluster.1)
#   label.color <- paste(input$col.cluster.1,collapse=', ')
#   label.color <- gsub(1,'red',gsub(2,'green',gsub(3,'blue',gsub(4,'grey',label.color))))
  if(nrow(data) > 50){cex.value <- 50/nrow(data)}else{cex.value<-1}
  plot(fit,main="Cluster dentogram",xlab="",
       ylab=paste0("Distance method: ",input$method.dist.cluster.1,"\n","Cluster method: ",input$method.clust.cluster.1),cex=cex.value) # display dendogram
  groups <- cutree(fit, k=input$cluster.nbr.1)
  rect.hclust(fit, k=input$cluster.nbr.1, border="red")
}
### heatmap
if(input$mono.knitr.heatmap.plot == T){
  data<-data.heatmap()
  if(input$Var.heatmap.1 != "ID"){rownames(data)<-paste(dataX.mono.pre()[,input$Var.heatmap.1],dataX.mono.pre()[,"ID"],sep=" , ")}
  heatmap(data[,rev(seq(dim(data)[2]))],Colv=NA)
}

## model summary
if(input$mono.knitr.prediction.summary.model == T){
    if(input$filedemouse != 'QC'){
      # print(xtable(selection.table()),include.rownames=F,colnames=T)
      print(Train.model())
    }else{
      # print(xtable(selection.table()),include.rownames=F,colnames=T)
      print(Pred.upload.model()[[1]])
    }
}

if(length(input$mono.knitr.prediction.validation) != 0){
  for(i in input$mono.knitr.prediction.validation){
    if(i == 'Cross-validation data'){
        x <- Train.model()$pred$obs
        y <- Train.model()$pred$pred
      }
      if(i == 'Training data'){
        x <- Train.Dep()[Train.partition() == T]
        y<-Train.prediction()[Train.partition() == T]
      }
      if(i == 'Test data'){
        x <- Train.Dep()[Train.partition() == F]
        y<-Train.prediction()[Train.partition() == F]
      }
    if(input$Trainproblem == 'classification'){
      print(confusionMatrix(x,y))
    }else{
      plot(x=x,y=y,xlab='Observation',ylab='Prediction',
       main=paste0('Regression Curve: ',i,'\n','R2 = ',cor(x,y)^2,' - RMSE = ',RMSE(x,y)))
    }
  }
}