añadir randomizado 1

invivos/app.R

@@ -5,6 +5,7 @@ library(openxlsx)
 library(dplyr)
 library(car)
 library(ggbeeswarm)
+library(gtools)
 source("../../funcions.R")
 
 # Define UI for application
@@ -17,9 +18,12 @@ ui <- fluidPage(
                   fileInput(inputId = "file_sizes", label = "Hoja de tamaños", multiple = F),
                   selectInput(inputId = "measure_sys", "Sistema de medida", selected = "L-W-D", choices = c("L-W-D","Min-Max","Absorbance")),
                   sliderInput("ncages", "Cajas", min=1, max=10, value=1),
+                  sliderInput("iterations", "Iteraciones", min=100, max=2000, step=100, value=100),
                   downloadButton("downloadData", "Descargar Excel")
                   ),
-                plotOutput("distPlot")
+                mainPanel(
+                  plotOutput("distPlot") 
+                )
               ),
               tabPanel("Análisis")
               )
@@ -28,9 +32,20 @@ ui <- fluidPage(
 
 # Define server logic required to draw a histogram
 server <- function(input, output) {
-  
+  dades<-reactiveValues()
+  dades$taula<-NULL
+  dades$groups<-NULL
+  dades$db<-NULL
+  observe({
+    if (!is.null(input$file_sizes)){ 
+      dades$taula<-read.xlsx(input$file_sizes$datapath, sheet = 1)
+      dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = 2)[,1]
+    }
+  })
   output$distPlot <- renderPlot({
-    df<-read.xlsx(input$file1$datapath)
+    observeEvent(dades$taula, {})
+    if (!is.null(dades$taula)){
+    df<-dades$taula
     up_cuttof<-400
     low_cuttof<-50
     df<-df[df$Volumen < up_cuttof & df$Volumen > low_cuttof,]
@@ -38,16 +53,16 @@ server <- function(input, output) {
     
     s<-shapiro.test(df$Volumen)[[2]]
     
-    ngroup<-5
+    ngroup<-length(dades$groups)
     
     ind.list<-list()
     pval.list<-list()
     lvn.list<-list()
     test.list<-list()
-    for (data in 1:2000){
+    for (data in 1:input$iterations){
       interr=T
       while(interr == T){
-        ind<-sample(rep(1:ngroup, each=7), length(unique(df$Mouse)))
+        ind<-sample(rep(dades$groups, each=7), length(unique(df$Mouse)))
         df_temp<-merge(df, data.frame("Mouse"=unique(df$Mouse), "group"=as.factor(ind)))
         interr<-any(table(df_temp$group) < floor(nrow(df_temp)/5) | table(df_temp$group) > ceiling(nrow(df_temp)/5))
       }
@@ -66,12 +81,14 @@ server <- function(input, output) {
     
     index<-which(unlist(lvn.list) == min(unlist(lvn.list)[which(unlist(pval.list) %in% sort(unlist(pval.list), decreasing = T)[1:20])]))
     df_def<-merge(df, ind.list[[index]])
+    dades$db<-df_def
     
     ggplot(df_def, aes(group, Volumen))+
       geom_boxplot(outlier.alpha = F)+
       geom_jitter(width=0.25)+
       geom_point(stat="summary", color="blue", size=3)+
       lims(y=c(0,max(df_def$Volumen)+10))
+    }
   })
   
   output$downloadData <- downloadHandler(
@@ -85,23 +102,45 @@ server <- function(input, output) {
       id_tumors<-c("L","R")
       timepoint<-c(7,10,13,16,19,22,25)
       
-      
-      template<-expand.grid(LETTERS[1:ncages], 1:5, id_tumors, timepoint)
-      colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint")
-      template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),]
-      template["Group"]<-""
-      template<-rbind(template, template, template)
-      template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
-      if (input$measure_sys == "L-W-D"){
-        template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
-        dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint) 
-      }
-      if (input$measure_sys == "Min-Max"){
-        template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
-        dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint)  
+      if (!is.null(input$file_sizes)){
+        template<-expand.grid(dades$db$MouseID, timepoint)
+        colnames(template)<-c("MouseID", "Timepoint")
+        template<-template[order(template$Timepoint, template$MouseID),]
+        template<-merge(template, dades$db[c("MouseID", "group")])
+        if (input$measure_sys == "L-W-D"){
+          template<-rbind(template, template, template)
+          template<-template[order(template$Timepoint, template$MouseID),]
+          template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
+          dtemplate<-dcast(template, MouseID+group+TS~Timepoint) 
+          dtemplate<-dtemplate[mixedorder(as.character(dtemplate$MouseID)),]
+        }
+        if (input$measure_sys == "Min-Max"){
+          template<-rbind(template, template)
+          template<-template[order(template$Timepoint, template$MouseID),]
+          template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
+          dtemplate<-dcast(template, MouseID+group+DPV~Timepoint)
+          dtemplate<-dtemplate[mixedorder(as.character(dtemplate$MouseID)),]
+        }
+        dtemplate[,4:ncol(dtemplate)]<-""
+      }else{
+        template<-expand.grid(LETTERS[1:ncages], 1:5, id_tumors, timepoint)
+        colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint")
+        template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),]
+        template["Group"]<-""
+        if (input$measure_sys == "L-W-D"){
+          template<-rbind(template, template, template)
+          template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
+          template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
+          dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint) 
+        }
+        if (input$measure_sys == "Min-Max"){
+          template<-rbind(template, template)
+          template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
+          template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
+          dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint)  
+        }
+        dtemplate[,6:ncol(dtemplate)]<-""
       }
-      
-      dtemplate[,6:ncol(dtemplate)]<-""
       write.xlsx(dtemplate,file)
     }
   )