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]]