2
\$\begingroup\$

I created a function to give me an estimated date of hearing back from grad school applications using the median length of days between each theGradCafe submission and January 1st. I separated submissions into three categories -- general, Interview, Acceptance, Rejection.

This is my first R project and I would love to get some criticisms on how to clean things up with it; the code is really clunky but seems to do the job.

Here it is:

grad=function(x,y){
  #just one link?
  if(missing(y)) {
    #inserting the link
    pat="U.*$"
    require(rvest)
    require(stringr)
    require(dplyr)
    #converting link to text
    h=read_html(x)
    nodes=h %>%
      html_nodes(".tcol3")
    #cleaning up text
    gadmin=sapply(nodes, html_text)[2:length(nodes)]
    gadmin=sub('.*on', '', gadmin)
    a=sub('.*on', '', gadmin)
    gadmin=sub(pat, '', gadmin) %>%
      as.Date("%d %B %Y")
    #finishing
    gadmint_c=format(gadmin, "%m-%d") %>%
      as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #date estimates
    lengthp=as.numeric(julian(gadmint_c, origin_date))
    lengthp=ifelse(lengthp >=334, lengthp-365, lengthp)
    lengthp=ifelse(lengthp > 5.5*sd(lengthp, na.rm=T) | lengthp < -5.5*sd(lengthp, na.rm=T), NA, lengthp)
    estd=as.Date("2021-01-01")+median(lengthp, na.rm=T)
    estd=format(estd, format="%m-%d")
    print(paste("You should hear SOMETHING  by", estd))
    invisible(estd)
    #interview estimates
    nodes_i=nodes[which(str_extract(as.character(nodes), "Interview") =="Interview")]
    gadmin_i=sapply(nodes_i, html_text)
    gadmin_i=sub('.*on', '', gadmin_i)
    gadmin_i= sub(pat, '', gadmin_i) %>%
      as.Date("%d %B %Y")
    #finishing interviews
    gadmint_ci=format(gadmin_i, "%m-%d") %>%
      as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #interview estimates
    lengthpi=as.numeric(julian(gadmint_ci, origin_date))
    lengthpi=ifelse(lengthpi >=334, lengthpi-365, lengthpi)
    lengthpi=ifelse(lengthpi > 5.5*sd(lengthpi, na.rm=T) | lengthpi < -5.5*sd(lengthpi, na.rm=T), NA, lengthpi)
    estdi=as.Date("2021-01-01")+median(lengthpi, na.rm=T)
    estdi=format(estdi, format="%m-%d")
    print(paste("You should hear about Interviews by ", estdi))
    invisible(estdi)
    #acceptance/rejectance estimates
    nodes_r=nodes[c(which(str_extract(as.character(nodes), "Rejected") =="Rejected"))]
    nodes_a=nodes[c(which(str_extract(as.character(nodes), "Accepted") =="Accepted"))]
    gadmin_r=sapply(nodes_r, html_text)
    gadmin_a=sapply(nodes_a, html_text)
    gadmin_r=sub('.*on', '', gadmin_r)
    gadmin_a=sub('.*on', '', gadmin_a)
    gadmin_r= sub(pat, '', gadmin_r) %>%
      as.Date("%d %B %Y")
    gadmin_a= sub(pat, '', gadmin_a) %>%
      as.Date("%d %B %Y")
    #finishing acceptance/rejectance
    gadmint_car_r=format(gadmin_r, format="%m-%d") %>%
      as.Date("%m-%d")
   gadmint_car_a=format(gadmin_a, format="%m-%d") %>%
     as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #acceptance/rejections estimates
    lengthpar_r=as.numeric(julian(gadmint_car_r, origin_date))
    lengthpar_a=as.numeric(julian(gadmint_car_a, origin_date))
    lengthpar_r=ifelse(lengthpar_r >=334, lengthpar_r-365, lengthpar_r)
    lengthpar_r=ifelse(lengthpar_r > 5.5*sd(lengthpar_r, na.rm=T) | lengthpar_r < -5.5*sd(lengthpar_r, na.rm=T), NA, lengthpar_r)
    lengthpar_a=ifelse(lengthpar_a >=334, lengthpar_a-365, lengthpar_a)
    lengthpar_a=ifelse(lengthpar_a > 5.5*sd(lengthpar_a, na.rm=T) | lengthpar_a < -5.5*sd(lengthpar_a, na.rm=T), NA, lengthpar_a)
    estdar_r=as.Date("2021-01-01")+median(lengthpar_r, na.rm=T)
    estdar_a=as.Date("2021-01-01")+median(lengthpar_a, na.rm=T)
    estdar_r=format(estdar_r, format="%m-%d")
    estdar_a=format(estdar_a, format="%m-%d")
    print(paste("You should hear about  Rejections by", estdar_r))
    print(paste("You should hear about  Acceptances by", estdar_a))
    invisible(estdar_r)
    invisible(estdar_a)
  } else {
    #just two links?
    #inserting the link
    pat="U.*$"
    require(rvest)
    require(dplyr)
    #converting link to text
    hx=read_html(x)
    hy=read_html(y)
    nodesx=hx %>%
      html_nodes(".tcol3")
    nodesy=hy %>%
      html_nodes(".tcol3")
    #cleaning up text
    gadminx=sapply(nodesx, html_text)[2:length(nodesx)]
    gadminy=sapply(nodesy, html_text)[2:length(nodesy)]
    gadminx=sub('.*on', '', gadminx)
    ax=sub('.*on', '', gadminx)
    gadminx=sub(pat, '', gadminx) %>%
      as.Date("%d %B %Y")
    gadminy=sub('.*on', '', gadminy)
    ay=sub('.*on', '', gadminy)
    gadminy=sub(pat, '', gadminy) %>%
      as.Date("%d %B %Y")
    gadmin=c(gadminx, gadminy)
    #finishing
    gadmint_c=format(gadmin, format="%m-%d")%>%
      as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #date estimates
    lengthp=as.numeric(julian(gadmint_c, origin_date))
    lengthp=ifelse(lengthp >=334, lengthp-365, lengthp)
    lengthp=ifelse(lengthp > 5.5*sd(lengthp, na.rm=T) | lengthp < -5.5*sd(lengthp, na.rm=T), NA, lengthp)
    estd=as.Date("2021-01-01")+median(lengthp, na.rm=T)
    estd=format(estd, format="%m-%d")
    print(paste("You should hear SOMETHING  by", estd))
    invisible(estd)
    #interview estimates
    nodes_ix=nodesx[which(str_extract(as.character(nodesx), "Interview") =="Interview")]
    nodes_iy=nodesy[which(str_extract(as.character(nodesy), "Interview") =="Interview")]
    gadmin_ix=sapply(nodes_ix, html_text)
    gadmin_iy=sapply(nodes_iy, html_text)
    gadmin_ix=sub('.*on', '', gadmin_ix)
    gadmin_ix= sub(pat, '', gadmin_ix) %>%
      as.Date("%d %B %Y")
    gadmin_iy=sub('.*on', '', gadmin_iy)
    gadmin_iy= sub(pat, '', gadmin_iy) %>%
      as.Date("%d %B %Y")
    #finishing interviews
    gadmint_ci=c(gadmin_ix, gadmin_iy)
    gadmint_ci=format(gadmint_ci, "%m-%d")%>%
      as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #interview estimates
    lengthpi=as.numeric(julian(gadmint_ci, origin_date))
    lengthpi=ifelse(lengthpi >=334, lengthpi-365, lengthpi)
    lengthpi=ifelse(lengthpi > 5.5*sd(lengthpi, na.rm=T) | lengthpi < -5.5*sd(lengthpi, na.rm=T), NA, lengthpi)
    estdi=as.Date("2021-01-01")+median(lengthpi, na.rm=T)
    estdi=format(estdi, format="%m-%d")
    print(paste("You should hear about Interviews by ", estdi))
    invisible(estdi)
    #acceptance/rejectance estimates
    nodes_rx=nodesx[c(which(str_extract(as.character(nodesx), "Rejected") =="Rejected"))]
    nodes_ax=nodesx[which(str_extract(as.character(nodesx), "Accepted") =="Accepted")]
    nodes_ry=nodesy[c(which(str_extract(as.character(nodesy), "Rejected") =="Rejected"))]
    nodes_ay=nodesy[which(str_extract(as.character(nodesy), "Accepted") =="Accepted")]
    gadmin_rx=sapply(nodes_rx, html_text)
    gadmin_ax=sapply(nodes_ax, html_text)
    gadmin_ry=sapply(nodes_ry, html_text)
    gadmin_ay=sapply(nodes_ay, html_text)
    gadmin_rx=sub('.*on', '', gadmin_rx)
    gadmin_ax=sub('.*on', '', gadmin_ax)
    gadmin_ry=sub('.*on', '', gadmin_ry)
    gadmin_ay=sub('.*on', '', gadmin_ay)
    gadmin_rx= sub(pat, '', gadmin_rx) %>%
      as.Date("%d %B %Y")
    gadmin_ax=sub(pat, '', gadmin_ax) %>%
      as.Date("%d %B %Y")
    gadmin_ry= sub(pat, '', gadmin_ry) %>%
      as.Date("%d %B %Y")
    gadmin_ay=sub(pat, '', gadmin_ay) %>%
      as.Date("%d %B %Y")
    gadmin_r=c(gadmin_rx, gadmin_ry)
    gadmin_a=c(gadmin_ax, gadmin_ay)
    #finishing acceptance/rejectance
    gadmint_c_r=format(gadmin_r, format="%m-%d")%>%
      as.Date("%m-%d")
    gadmint_c_a=format(gadmin_a, format="%m-%d") %>%
      as.Date("%m-%d")
    origin_date <- as.Date("2021-01-01")
    #acceptance/rejections estimates
    lengthpar_r=as.numeric(julian(gadmint_c_r, origin_date))
    lengthpar_a=as.numeric(julian(gadmint_c_a, origin_date))
    lengthpar_r=ifelse(lengthpar_r >=334, lengthpar_r-365, lengthpar_r)
    lengthpar_r=ifelse(lengthpar_r > 5.5*sd(lengthpar_r, na.rm=T) | lengthpar_r < -5.5*sd(lengthpar_r,na.rm=T), NA, lengthpar_r)
    lengthpar_a=ifelse(lengthpar_a >=334, lengthpar_a-365, lengthpar_a)
    lengthpar_a=ifelse(lengthpar_a > 5.5*sd(lengthpar_a, na.rm=T) | lengthpar_a < -5.5*sd(lengthpar_a, na.rm=T), NA, lengthpar_a)
    estd_a=as.Date("2021-01-01")+median(lengthpar_a, na.rm=T)
    estd_r=as.Date("2021-01-01")+median(lengthpar_r, na.rm=T)
    estd_r=format(estd_r, format="%m-%d")
    estd_a=format(estd_a, format="%m-%d")
    print(paste("You should hear about Acceptance by ", estd_a))
    print(paste("You should hear about Rejection by ", estd_r))
    invisible(estd_a)
    invisible(estd_r)
  }
}

So for example, if I wanted to look at Stanford submissions, I would type grad("https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250") and get back:

 grad("https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250")
[1] "You should hear SOMETHING  by 03-21"
[1] "You should hear about Interviews by  12-18"
[1] "You should hear about  Rejections by 02-12"
[1] "You should hear about  Acceptances by 03-20"

Or, if I applied to Stanford and Harvard:

 grad("https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250", "https://www.thegradcafe.com/survey/index.php?q=harvard&t=a&o=&pp=250")
[1] "You should hear SOMETHING  by 03-17"
[1] "You should hear about Interviews by  12-18"
[1] "You should hear about Acceptance by  03-18"
[1] "You should hear about Rejection by  03-05"

The reason why SOMETHING is sometimes behind the others is because it's general, lumping everything in together, while the others are more specific.

\$\endgroup\$
2
  • \$\begingroup\$ This is quite a bit of code. Without reading every single line, can you advise what differs between the if and else block? \$\endgroup\$
    – Parfait
    Jan 6, 2021 at 17:27
  • \$\begingroup\$ @Parfait Sorry about that! I was reading on Stack Overflow and that was their recommendation for specifying optional arguments in R functions. The if specifies the first link which is required, while the else specifies the second link which is optional. \$\endgroup\$
    – JerBear
    Jan 6, 2021 at 18:10

1 Answer 1

3
\$\begingroup\$

Consider breaking up your repetitive operations into separate functions. And specifically for grad function use R's ellipsis feature, allowing you to pass many URLs with same call. Both steps will keep your code DRY (Don't Repeat Yourself). Finally, heed R's emphasis on everything that exists is an object and store your results in list of data frames (one for each URL) via lapply iteration instead of a one-time printout without persistent data.

Functions

  • Space out your sections and operators
  • Line break long calls
  • Use <- operator for object assignment
  • Remove multiple invisible for single return
  • Avoid pipes %>% for simple one nest like as.Date

node_subset

node_subset <- function(nodes, search_word=NA) {  
  if(is.na(search_word)) {
    sub_nodes <- nodes
  } else {
    sub_nodes <- nodes[which(str_extract(as.character(nodes), search_word)==search_word)]
  }
  
  pat <- "U.*$"
  gadmin <- sapply(sub_nodes, html_text)
  gadmin <- sub('.*on', '', gadmin)
  gadmin <-  as.Date(sub(pat, '', gadmin), format="%d %B %Y")
  gadmin_dt <- as.Date(format(gadmin, "%m-%d"), format="%m-%d")
  
  return(gadmin_dt)
}

date_calc

date_calc <- function(param_dt, origin_date=as.Date("2021-01-01")) {  
  lengthp <- as.numeric(julian(param_dt, origin_date))
  lengthp <- ifelse(lengthp >= 334, lengthp-365, lengthp)
  lengthp <- ifelse(lengthp > 5.5 * sd(lengthp, na.rm=TRUE) |
                      lengthp < -5.5 * sd(lengthp, na.rm=TRUE), NA, lengthp)
  estd <- as.Date("2021-01-01") + median(lengthp, na.rm=TRUE)
  estd <- format(estd, format="%m-%d")
  
  return(estd)
}

grad

grad <- function(...) {  
  lapply(list(...), function(x) {
  
    #inserting the link
    require(rvest)
    require(stringr)
    require(dplyr)
    
    #converting link to text
    h <- read_html(x)
    nodes <- html_nodes(h, ".tcol3")
    
    #cleaning up text
    gadmint_c <- node_subset(nodes)
    gadmint_ci <- node_subset(nodes, "Interview")
    gadmint_car_r <- node_subset(nodes, "Rejected")
    gadmint_car_a <- node_subset(nodes, "Accepted")
    
    #date estimates
    estd <- date_calc(gadmint_c)
    print(paste("You should hear SOMETHING  by", estd))
  
    #interview estimates
    estdi <- date_calc(gadmint_ci)
    print(paste("You should hear about Interviews by ", estdi))
    
    #acceptance/rejections estimates
    estdar_r <- date_calc(gadmint_car_r)
    print(paste("You should hear about  Rejections by", estdar_r))
    
    estdar_a <- date_calc(gadmint_car_a)
    print(paste("You should hear about  Acceptances by", estdar_a))

    return(data.frame(url = x, 
                      estd = estd, 
                      estdi = estdi, 
                      estdar_r = estdar_r, 
                      estdar_a = estdar_a,
                      stringsAsFactors = FALSE)    # ARG UNNEEDED FOR R 4.0+
           )
  })
}

Calls

df_list1 <- grad("https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250")
# [1] "You should hear SOMETHING  by 03-21"
# [1] "You should hear about Interviews by  12-18"
# [1] "You should hear about  Rejections by 03-21"
# [1] "You should hear about  Acceptances by 03-20"

df_list2 <- grad("https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250", 
                 "https://www.thegradcafe.com/survey/index.php?q=harvard&t=a&o=&pp=250")
# [1] "You should hear SOMETHING  by 03-21"
# [1] "You should hear about Interviews by  12-18"
# [1] "You should hear about  Rejections by 03-21"
# [1] "You should hear about  Acceptances by 03-20"
# [1] "You should hear SOMETHING  by 03-05"
# [1] "You should hear about Interviews by  12-18"
# [1] "You should hear about  Rejections by 03-04"
# [1] "You should hear about  Acceptances by 03-07"

Data

str(df_list1)
# List of 1
#  $ :'data.frame': 1 obs. of  5 variables:
#   ..$ url     : chr "https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250"
#   ..$ estd    : chr "03-21"
#   ..$ estdi   : chr "12-18"
#   ..$ estdar_r: chr "03-21"
#   ..$ estdar_a: chr "03-20"

str(df_list2)
# List of 2
#  $ :'data.frame': 1 obs. of  5 variables:
#   ..$ url     : chr "https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250"
#   ..$ estd    : chr "03-21"
#   ..$ estdi   : chr "12-18"
#   ..$ estdar_r: chr "03-21"
#   ..$ estdar_a: chr "03-20"
#  $ :'data.frame': 1 obs. of  5 variables:
#   ..$ url     : chr "https://www.thegradcafe.com/survey/index.php?q=harvard&t=a&o=&pp=250"
#   ..$ estd    : chr "03-05"
#   ..$ estdi   : chr "12-18"
#   ..$ estdar_r: chr "03-04"
#   ..$ estdar_a: chr "03-07"

Even combine list of multiple data frames into a single data frame:

final_df <- do.call(rbind, df_list2)
final_df

#                                                                                url  estd estdi estdar_r estdar_a
# 1 https://www.thegradcafe.com/survey/index.php?q=Stanford+University&t=a&o=&pp=250 03-21 12-18    03-21    03-20
# 2             https://www.thegradcafe.com/survey/index.php?q=harvard&t=a&o=&pp=250 03-05 12-18    03-04    03-07
\$\endgroup\$
1
  • \$\begingroup\$ Thank you! :D @Parfait \$\endgroup\$
    – JerBear
    Jan 7, 2021 at 20:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.