añadir randomizado 1

This commit is contained in:
marcelcosta
2020-11-03 19:40:52 +01:00
parent c47ff6ff12
commit 940f9b8429
+47 -8
View File
@@ -5,6 +5,7 @@ library(openxlsx)
library(dplyr) library(dplyr)
library(car) library(car)
library(ggbeeswarm) library(ggbeeswarm)
library(gtools)
source("../../funcions.R") source("../../funcions.R")
# Define UI for application # Define UI for application
@@ -17,9 +18,12 @@ ui <- fluidPage(
fileInput(inputId = "file_sizes", label = "Hoja de tamaños", multiple = F), 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")), 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("ncages", "Cajas", min=1, max=10, value=1),
sliderInput("iterations", "Iteraciones", min=100, max=2000, step=100, value=100),
downloadButton("downloadData", "Descargar Excel") downloadButton("downloadData", "Descargar Excel")
), ),
mainPanel(
plotOutput("distPlot") plotOutput("distPlot")
)
), ),
tabPanel("Análisis") tabPanel("Análisis")
) )
@@ -28,9 +32,20 @@ ui <- fluidPage(
# Define server logic required to draw a histogram # Define server logic required to draw a histogram
server <- function(input, output) { 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({ output$distPlot <- renderPlot({
df<-read.xlsx(input$file1$datapath) observeEvent(dades$taula, {})
if (!is.null(dades$taula)){
df<-dades$taula
up_cuttof<-400 up_cuttof<-400
low_cuttof<-50 low_cuttof<-50
df<-df[df$Volumen < up_cuttof & df$Volumen > low_cuttof,] df<-df[df$Volumen < up_cuttof & df$Volumen > low_cuttof,]
@@ -38,16 +53,16 @@ server <- function(input, output) {
s<-shapiro.test(df$Volumen)[[2]] s<-shapiro.test(df$Volumen)[[2]]
ngroup<-5 ngroup<-length(dades$groups)
ind.list<-list() ind.list<-list()
pval.list<-list() pval.list<-list()
lvn.list<-list() lvn.list<-list()
test.list<-list() test.list<-list()
for (data in 1:2000){ for (data in 1:input$iterations){
interr=T interr=T
while(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))) 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)) 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])])) 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]]) df_def<-merge(df, ind.list[[index]])
dades$db<-df_def
ggplot(df_def, aes(group, Volumen))+ ggplot(df_def, aes(group, Volumen))+
geom_boxplot(outlier.alpha = F)+ geom_boxplot(outlier.alpha = F)+
geom_jitter(width=0.25)+ geom_jitter(width=0.25)+
geom_point(stat="summary", color="blue", size=3)+ geom_point(stat="summary", color="blue", size=3)+
lims(y=c(0,max(df_def$Volumen)+10)) lims(y=c(0,max(df_def$Volumen)+10))
}
}) })
output$downloadData <- downloadHandler( output$downloadData <- downloadHandler(
@@ -85,23 +102,45 @@ server <- function(input, output) {
id_tumors<-c("L","R") id_tumors<-c("L","R")
timepoint<-c(7,10,13,16,19,22,25) timepoint<-c(7,10,13,16,19,22,25)
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) template<-expand.grid(LETTERS[1:ncages], 1:5, id_tumors, timepoint)
colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint") colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint")
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),] template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),]
template["Group"]<-"" template["Group"]<-""
if (input$measure_sys == "L-W-D"){
template<-rbind(template, template, template) template<-rbind(template, template, template)
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),] 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) template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint) dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint)
} }
if (input$measure_sys == "Min-Max"){ 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) template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint) dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint)
} }
dtemplate[,6:ncol(dtemplate)]<-"" dtemplate[,6:ncol(dtemplate)]<-""
}
write.xlsx(dtemplate,file) write.xlsx(dtemplate,file)
} }
) )