[R-es] Crear datos aleatorios con restriciones

Lun Jul 13 23:54:54 CEST 2015

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