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 <cof en 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 <ignacio82 en 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 en r-project.org >> https://stat.ethz.ch/mailman/listinfo/r-help-es >> > > > > -- > Saludos, > Carlos Ortega > www.qualityexcellence.es >[[alternative HTML version deleted]]
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 <ignacio82 en 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 <cof en 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 <ignacio82 en 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 en r-project.org >>> https://stat.ethz.ch/mailman/listinfo/r-help-es >>> >> >> >> >> -- >> Saludos, >> Carlos Ortega >> www.qualityexcellence.es >> >-- Saludos, Carlos Ortega www.qualityexcellence.es [[alternative HTML version deleted]]
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 <cof en 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 <ignacio82 en 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 <cof en 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 <ignacio82 en 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 en r-project.org >>>> https://stat.ethz.ch/mailman/listinfo/r-help-es >>>> >>> >>> >>> >>> -- >>> Saludos, >>> Carlos Ortega >>> www.qualityexcellence.es >>> >> > > > -- > Saludos, > Carlos Ortega > www.qualityexcellence.es >[[alternative HTML version deleted]]