Hola, No entiendo muy bien. El número de clases lo puedes modificar a tu gusto, en la variable "numDi".
He puesto un valor de ejemplo de 4 porque así aparecía en tu código, obviamente puedes poner otro valor... La única limitación aparecerá cuando escojas un valor muy grande y el cálculo de las combinaciones posibles tarde en generarse. He probadoc con 20 y sigue siendo manejable. #--------------------------------------------- #Generar "c" Divisiones: c1, c2, c3... *numDi <- 4* divis <- paste("c", 1:numDi, sep="") #---------------------------------------------- Y la otra discrepancia parece ser el número de combinaciones válidas. Lo que has dicho es que quieres "asignar un profesor a una escuela un grado y dos clases". Dos clases, del mismo colegio y en el mismo grado, ¿es así?... Saludos, Carlos Ortega www.qualityexcellence.es El 14 de julio de 2015, 0:07, Ignacio Martinez <ignaci...@gmail.com> escribió: > Gracias Carlos, > > Tu codigo es un gran paso en el sentido correcto pero no produce > exactamente lo que estoy buscando. > > Mi "solucion" en stackoverflow > <http://stackoverflow.com/questions/31137940/randomly-assign-teachers-to-classrooms-imposing-restrictions/31143808#31143808> > produce un data frame `schoolGrade` con 240 observaciones y 7 variables. Mi > objetivo es poder generar un data frame asi pero con la flexibilidad de > poder usar n.classrooms <- 20 (o cualquier otro numero) en lugar de 4 > (hardcoded) > > Gracias de nuevo! > > Ignacio > > > > > On Mon, Jul 13, 2015 at 5:54 PM Carlos Ortega <c...@qualityexcellence.es> > wrote: > >> Hola, >> >> Esta es una forma de hacerlo, evitando bucles.... >> >> >> #------------------------------------------------------------------------------------------ >> #1. Quiero generar N escuelas, con G grados y C divisiones. >> #2. Quiero asignar cada uno de T maestros a 2 divisiones en un grado y >> escuela >> >> #---------------------- Combinaciones de: Escuelas - Grados - Divisiones >> #Generar "n" Escuelas: e1, e2, e3... >> numEs <- 20 >> escuelas <- paste("e", 1:numEs, sep="") >> >> #Generar "g" Grados: g1, g2, g3... >> numGr <- 3 >> grados <- paste("g", 1:numGr, sep="") >> >> #Generar "c" Divisiones: c1, c2, c3... >> numDi <- 4 >> divis <- paste("c", 1:numDi, sep="") >> >> >> #Agrupo Escuelas - Grados >> EsGra <- outer(escuelas, grados, FUN="paste") >> >> #Agrupo (Escuelas - Grados) - Divisiones >> EsGraDiv <- outer(EsGra, divis, FUN="paste") >> >> #Estas son todas las combinaciones de Escuelas-Grados-Divisiones >> EsGraDivTmp <- as.matrix(EsGraDiv, ncol=1, nrow=length(EsGraDiv) ) >> EsGraDivEnd <- as.data.frame(EsGraDivTmp) >> >> #---------------------- Profesores >> #Asignar a cada uno de los T maestros a 2 clases en 1 grado y 1 escuela >> #Al ser 2 clases creo todas las parejas posibles >> #de las que escogeré 2 clases del mismo grado y misma escuela >> Allpairs <- as.data.frame(t(combn(EsGraDivTmp, 2))) >> AllpairsTmp <- paste(Allpairs$V1, Allpairs$V2, sep=" ") >> >> #Aqui tengo las parejas en la misma fila y separadas en columnas >> library(stringr) >> separoPairs <- as.data.frame(str_split_fixed(AllpairsTmp, " ", 6)) >> >> #de este data.frame escojo filas donde V1=V4 y V2=V5 : misma escuela + >> mismo grado >> separoPairs$valid <- ifelse(separoPairs$V1 == separoPairs$V4 & >> separoPairs$V2 == separoPairs$V5, "Valid", "Invalid") >> >> #Resultado Final >> validPairs <- separoPairs[separoPairs$valid=="Valid",] >> >> #Si a los "validPairs" tengo que asignar "T" profesores, de forma >> aleatoria >> t <- 10 >> validPairs[sample(1:nrow(validPairs), t), ] >> >> #--------------------------------------------------------- >> >> Saludos, >> Carlos Ortega >> www.qualityexcellence.es >> >> >> El 13 de julio de 2015, 21:03, Ignacio Martinez <ignaci...@gmail.com> >> escribió: >> >>> Hola, >>> >>> 0. La falta de 'elegancia' hace que sea mas dificil hacer cambios al >>> codigo. Por ejemplo cambiar n.classrooms <- 4 a n.classrooms <- 20 >>> >>> 1. Cuando tengo solo 4 puedo hacer esto: >>> >>> schoolGrade$A <- Teachers$Teacher.ID[1:cuttoff1] >>> schoolGrade$B <- Teachers$Teacher.ID[1:cuttoff1] >>> schoolGrade$C <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>> schoolGrade$D <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>> >>> Pero si tengo 20 tendria que escribir 20 lines en lugar de 4 y calcular >>> los cutoff para cada linea. Con 20 classrooms por escuela y por grado tengo >>> que asignar 600 maestros a 2 classrooms cada uno. >>> >>> 2. No necesito todas las asignaciones posible, con una es suficiente. >>> >>> Gracias! >>> >>> On Mon, Jul 13, 2015 at 2:54 PM Carlos Ortega <c...@qualityexcellence.es> >>> wrote: >>> >>>> Hola, >>>> >>>> ¿Pero el problema que tienes es de "elegancia del código" como indicas >>>> en StackOverflow? >>>> o ¿de performance porque al subir el número de clases el número total >>>> de combinaciones te explota?... >>>> >>>> En cuanto a las asignaciones de los profesores, ¿quieres tener todas >>>> las posibles asignaciones? ¿un solo caso de asignación?... >>>> >>>> Saludos, >>>> Carlos Ortega >>>> www.qualityexcellence.es >>>> >>>> 2015-07-13 15:23 GMT+02:00 Ignacio Martinez <ignaci...@gmail.com>: >>>> >>>>> Hola, >>>>> >>>>> Esta pregunta la hice en stackoverflow >>>>> >>>> < >>>>> http://stackoverflow.com/questions/31137940/randomly-assign-teachers-to-classrooms-imposing-restrictions/31143808#31143808 >>>>> >pero >>>> >>>> >>>>> nadie pudo contestarla. >>>>> >>>>> 1. Quiero generar N escuelas, con G grados y C divisiones. >>>>> 2. Quiero asignar cada uno de T maestros a 2 divisiones en un grado y >>>>> escuela >>>>> >>>>> Si tengo C=4 divisiones, puedo lograr lo que quiero con este código: >>>>> >>>>> library(randomNames) >>>>> set.seed(6232015) >>>>> n.schools <-20 >>>>> n.grades <- 3 >>>>> n.classrooms <- 4 >>>>> total.classrooms <- n.classrooms*n.grades*n.schools >>>>> >>>>> gen.names <- function(n, which.names = "both", name.order = >>>>> "last.first"){ >>>>> names <- unique(randomNames(n=n, which.names = which.names, >>>>> name.order = name.order)) >>>>> need <- n - length(names) >>>>> while(need>0){ >>>>> names <- unique(c(randomNames(n=need, which.names = which.names, >>>>> name.order = name.order), names)) >>>>> need <- n - length(names) >>>>> } >>>>> return(names)} >>>>> #Generates teachers data frame >>>>> n.teachers=total.classrooms/2 >>>>> gen.teachers <- function(n.teachers){ >>>>> Teacher.ID <- gen.names(n = n.teachers, name.order = "last.first") >>>>> Teacher.exp <- runif(n = n.teachers, min = 1, max = 30) >>>>> Teacher.Other <- sample(c(0,1), replace = T, prob = c(0.5, 0.5), >>>>> size = n.teachers) >>>>> Teacher.RE <- rnorm(n = n.teachers, mean = 0, sd = 1) >>>>> Teachers <- data.frame(Teacher.ID, Teacher.exp, Teacher.Other, >>>>> Teacher.RE) %>% mutate(Teacher.ID=as.character(Teacher.ID)) >>>>> return(Teachers)} >>>>> Teachers <- gen.teachers(n.teachers = n.teachers) >>>>> str(Teachers$Teacher.ID) >>>>> #Make a ‘schoolGrade’ object and then reshape >>>>> >>>>> schoolGrade <- expand.grid(grade = c(3,4,5), >>>>> School.ID = paste0(gen.names(n = n.schools, >>>>> which.names = "last"), >>>>> ' School')) >>>>> # assign each of T teachers to 2 classrooms within a single school and >>>>> grade >>>>> cuttoff1<-n.teachers/2 >>>>> schoolGrade$A <- Teachers$Teacher.ID[1:cuttoff1] >>>>> schoolGrade$B <- Teachers$Teacher.ID[1:cuttoff1] >>>>> schoolGrade$C <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>>>> schoolGrade$D <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>>>> >>>>> library(tidyr) >>>>> schoolGrade <- gather(schoolGrade, Classroom, Teacher.ID, A:D) %>% >>>>> full_join(Teachers, by="Teacher.ID") >>>>> >>>>> El problema es si quiero incrementar n.classroom incrementar de 4 a 20 >>>>> (en >>>>> lugar de A a D tener de A a T >>>>> >>>>> Gracias por la ayuda! >>>>> >>>>> [[alternative HTML version deleted]] >>>>> >>>>> _______________________________________________ >>>>> R-help-es mailing list >>>>> R-help-es@r-project.org >>>>> https://stat.ethz.ch/mailman/listinfo/r-help-es >>>>> >>>> >>>> >>>> >>>> -- >>>> Saludos, >>>> Carlos Ortega >>>> www.qualityexcellence.es >>>> >>> >> >> >> -- >> Saludos, >> Carlos Ortega >> www.qualityexcellence.es >> > -- Saludos, Carlos Ortega www.qualityexcellence.es [[alternative HTML version deleted]] _______________________________________________ R-help-es mailing list R-help-es@r-project.org https://stat.ethz.ch/mailman/listinfo/r-help-es