[R] Speeding up code?

[Ignacio Martinez]

Hi R-Help!

I'm hoping that some of you may give me some tips that could make my code
more efficient. More precisely, I would like to make the answer to my
stakoverflow
<http://stackoverflow.com/questions/31137940/randomly-assign-teachers-to-classrooms-imposing-restrictions>
question more efficient.

This is the code:

library(dplyr)
library(randomNames)
library(geosphere)
set.seed(7142015)# Define Parameters
n.Schools <- 20
first.grade<-3
last.grade<-5
n.Grades <-last.grade-first.grade+1
n.Classrooms <- 20 # THIS IS WHAT I WANTED TO BE ABLE TO CHANGE
n.Teachers <- (n.Schools*n.Grades*n.Classrooms)/2 #Two classrooms per teacher
# Define Random names function:
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)}
# Generate n.Schools names
gen.schools <- function(n.schools) {
  School.ID <-
    paste0(gen.names(n = n.schools, which.names = "last"), ' School')
  School.long <- rnorm(n = n.schools, mean = 21.7672, sd = 0.025)
  School.lat <- rnorm(n = n.schools, mean = 58.8471, sd = 0.025)
  School.RE <- rnorm(n = n.schools, mean = 0, sd = 1)
  Schools <-
    data.frame(School.ID, School.lat, School.long, School.RE) %>%
    mutate(School.ID = as.character(School.ID)) %>%
    rowwise() %>%  mutate (School.distance = distHaversine(
      p1 = c(School.long, School.lat),
      p2 = c(21.7672, 58.8471), r = 3961
    ))
  return(Schools)}

Schools <- gen.schools(n.schools = n.Schools)
# Generate Grades
Grades <- c(first.grade:last.grade)
# Generate n.Classrooms

Classrooms <- LETTERS[1:n.Classrooms]
# Group schools and grades

SchGr <- outer(paste0(Schools$School.ID, '-'), paste0(Grades, '-'),
FUN="paste")#head(SchGr)
# Group SchGr and Classrooms

SchGrClss <- outer(SchGr, paste0(Classrooms, '-'), FUN="paste")#head(SchGrClss)
# These are the combination of  School-Grades-Classroom
SchGrClssTmp <- as.matrix(SchGrClss, ncol=1, nrow=length(SchGrClss) )
SchGrClssEnd <- as.data.frame(SchGrClssTmp)
# Assign n.Teachers (2 classroom in a given school-grade)
Allpairs <- as.data.frame(t(combn(SchGrClssTmp, 2)))
AllpairsTmp <- paste(Allpairs$V1, Allpairs$V2, sep=" ")

library(stringr)
separoPairs <- as.data.frame(str_split(string = AllpairsTmp, pattern = "-"))
separoPairs <- as.data.frame(t(separoPairs))
row.names(separoPairs) <- NULL
separoPairs <- separoPairs %>% select(-V7)  %>%  #Drops empty column
  mutate(V1=as.character(V1), V4=as.character(V4), V2=as.numeric(V2),
V5=as.numeric(V5)) %>% mutate(V4 = trimws(V4, which = "both"))

separoPairs[120,]$V4#Only the rows with V1=V4 and V2=V5 are valid
validPairs <- separoPairs %>% filter(V1==V4 & V2==V5) %>% select(V1, V2, V3, V6)
# Generate n.Teachers

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)
  return(Teachers)}
Teachers <- gen.teachers(n.teachers = n.Teachers) %>%
  mutate(Teacher.ID = as.character(Teacher.ID))
# Randomly assign n.Teachers teachers to the "ValidPairs"
TmpAssignments <- validPairs[sample(1:nrow(validPairs), n.Teachers), ]
Assignments <- cbind.data.frame(Teachers$Teacher.ID, TmpAssignments)
names(Assignments) <- c("Teacher.ID", "School.ID", "Grade", "Class_1",
"Class_2")
# Tidy Data
library(tidyr)
TeacherClassroom <- Assignments %>%
  gather(x, Classroom, Class_1,Class_2) %>%
  select(-x) %>%
  mutate(Teacher.ID = as.character(Teacher.ID))
# Merge
DF_Classrooms <- TeacherClassroom %>% full_join(Teachers,
by="Teacher.ID") %>% full_join(Schools, by="School.ID")
rm(list=setdiff(ls(), "DF_Classrooms")) # Clean the work space!

*I want to end up with the same*  'DF_Classrooms *data frame* but getting
there in a more efficient way. In particular, when is use n.Classrooms <-4 the
code run fast, but *if I increase it to something like 20 it is painfully
slow.*

Thanks!!!

	[[alternative HTML version deleted]]