Watts-College / cpp-527-spr-2022

https://watts-college.github.io/cpp-527-spr-2022/
0 stars 1 forks source link

Final Project- Loop is printing graphs and tables in Rstudio but only printing graphs in html #34

Open dholford opened 2 years ago

dholford commented 2 years ago

Hello,

I successfully (mostly) created a loop to run through each unit (I'm still struggling to figure out the best way to collect the graph and table for each unit), but for some reason when I knit the file, it only prints the graphs in the html doc and doesn't include the tables. I'm going to only include the two functions I'm referencing, along with a function I packaged into one, and my loop since that is what seems to be off.

add_position <- function( t, position, y, xmax, scale.f=8 )
{

  t.original <- t
  t <- filter( t.original, title==position )
  dot.size <- 2 + scale.f*sum(t$p)
  offset.n <- 1 + sum(t$p)*2

  male.median <- NA
  n.male <- NA
  t <- filter( t.original, title==position & gender == "male" )
  if( nrow(t) > 0 )
  { 
    male.median <- t$q50 
    n.male <- t$n
  }

  female.median <- NA
  n.female <- NA
  t <- filter( t.original, title==position & gender == "female" )
  if( nrow(t) > 0 )
  { 
    female.median <- t$q50 
    n.female <- t$n
  }

  # dumbell plots 
  segments( x0=female.median, x1=male.median, y0=y,
          col=gray(0.3,0.5), lwd=7 )
  points( male.median, y,
          col=adjustcolor( "darkblue", alpha.f = 0.5), 
          pch=19, cex=dot.size  )
  points( female.median, y,
          col=adjustcolor( "firebrick", alpha.f = 0.5), 
          pch=19, cex=dot.size  )

  pos.f <- 2
  pos.m <- 4
  if( ! ( is.na(female.median) | is.na(male.median) ) )
  {
    pos.f <- ifelse( female.median > male.median, 4, 2 )
    pos.m <- ifelse( female.median > male.median, 2, 4 )
  }

  # add salaries to right and left 
  text( female.median, y, paste0("$",round(female.median/1000,0),"k"),
        col=adjustcolor( "firebrick", alpha.f = 0.7), 
        cex=1.2, pos=pos.f, offset=offset.n )
  text( male.median, y, paste0("$",round(male.median/1000,0),"k"),
        col=adjustcolor( "darkblue", alpha.f = 0.7), 
        cex=1.2, pos=pos.m, offset=offset.n ) 

  # add faculty counts
  n.female <- ifelse( is.na(n.female), 0, n.female )
  n.female <- ifelse( nchar(n.female)==1, 
                      paste0( " ", n.female), n.female )
  n.male <- ifelse( is.na(n.male), 0, n.male )
  n.male <- ifelse( nchar(n.male)==1, 
                      paste0( " ", n.male), n.male )
  text( xmax-0.1*xmax, y+0.14, paste0( "f   = ", n.female),
        col="gray50", cex=1.1, pos=4  )
  text( xmax-0.1*xmax, y-0.14, paste0( "m = ", n.male),
        col="gray50", cex=1.1, pos=4  )

  axis( side=2, at=y, labels=position, 
        las=2, tick=F, cex.axis=1.5, col.axis="gray50" )
}

build_graph <- function( t.salary, unit )
{
  unique.titles <- unique( t.salary$title )
  ymax <- length(unique.titles)
  xmax <- round( max(t.salary$q50), -3 ) + 50000
  color.key.pos <- 40000 + ( xmax - 40000 ) / 2
  color.key.inc <- ( xmax - 40000 ) / 10

  t.mf <- filter( t.salary, gender %in% c("male","female") )
  N <- sum( t.mf$n )

  par( mar=c(6,15,4.1,0) )
  plot.new()
  plot.window( xlim=c(40000-10000,xmax), ylim=c(0,ymax+1) )

  abline( v=seq(40000,xmax-40000,20000), lwd=1.5, lty=2, col=gray(0.5,0.5) )
  axis( side=1, 
        at=seq(40000,xmax-40000,20000), 
        labels=paste0("$",seq(40,(xmax-40000)/1000,20),"k"),
        cex.axis=1.1, col.axis="gray40", tick=FALSE )

  y <- ymax

  if( "Full Professor" %in% unique.titles )
  {
    add_position( t.salary, position="Full Professor", y, xmax )
    y <- y-1
  }
  if( "Associate Professor" %in% unique.titles )
  {
    add_position( t.salary, position="Associate Professor", y, xmax )
    y <- y-1
  }
  if( "Assistant Professor" %in% unique.titles )
  {
    add_position( t.salary, position="Assistant Professor", y, xmax )
    y <- y-1
  }
  if( "Teaching Faculty" %in% unique.titles )
  {
    add_position( t.salary, position="Teaching Faculty", y, xmax )
    y <- y-1
  }
  if( "Researcher" %in% unique.titles )
  {
    add_position( t.salary, position="Researcher", y, xmax )
    y <- y-1
  }

  text( color.key.pos + 3*color.key.inc, 0, "MALE", 
        col=adjustcolor( "darkblue", alpha.f = 0.7), cex=1.2 )
  text( color.key.pos + 1.8*color.key.inc, 0, "FEMALE", 
        col="firebrick",  cex=1.2 )
  text( xmax - 0.1*xmax, 0, paste0("N = ",N), col="gray40",  cex=1.2, pos=4 )

  title( main="Median Salary by Rank and Gender", cex.main=1.5, col.main="gray30" )
  title( xlab=unit, col.lab="gray50", cex.lab=1.5, line=5 )
  title( xlab="dot size represents proportion of faculty at that rank",
         col.lab="gray50", cex.lab=0.9 )

  return(NULL)
}

Step 10: Top Five Salaries


dollarize <- function(salary)
{ paste0("$", format( round( salary, 0 ), big.mark="," ) ) }

get_top_5 <- function(Data){

t.top5 <- select(Data, c('Full.Name', 'gender', 'Job.Description', 'salary'))%>% 
          arrange(desc(salary)) %>% 
          slice(1:5)

t.top5$salary <-dollarize(t.top5$salary)

t.top5 <- pander(t.top5)

return(t.top5)

}

Step 11: Package Functions into Single Process


analyze_data <- function(Data){
  Data <- add_gender(Data)
  Data <- add_titles(Data)
  Data$salary <- convert_currency(Data)
  Data$salary <- get_fte(Data)
  t.salary <- create_salary_table(Data)
  build_graph(t.salary, unit = i)
  get_top_5(Data)

}

URL <- 'https://docs.google.com/spreadsheets/d/1RoiO9bfpbXowprWdZrgtYXG9_WuK3NFemwlvDGdym7E/export?gid=1335284952&format=csv'
d <- read.csv( URL )

academic.units <- c("CISA-Intrdisp Hum & Comm", "CISA-Science & Mathematics", 
"College of Health Solutions MS", "College of Health Solutions NT", 
"College of Health Solutions SH", "College Of Law", "English", "Hugh Downs School Of Comm", 
"Humanities Arts & Cultural", "Journalism & Mass Comm", "Ldrshp and Integrative Studies", 
"Math & Natural Sciences Div", "MDT Music", "Physics Department", 
"Psychology", "Sch Biological & Hlth Sys Engr", "Sch Compt Infor & Dec Sys Engr", 
"Sch Elect Comptr & Energy Engr", "Sch Engr Matter Trnsprt Energy", 
"Sch Future of Innov in Society", "Sch Sustain Engr & Built Envrn", 
"School Of Art", "School of Criminology & Crim J", "School Of Earth & Space Explor", 
"School of Geog Sci & Urban Pln", "School of Math & Stat Sciences", 
"School of Molecular Sciences", "School of Politics & Global St", 
"School Of Public Affairs", "School of Social Transform", "School Of Social Work", 
"SHPRS History Faculty", "Social & Behavioral Sciences", "Sols Administration & Faculty", 
"SOS Faculty & Researchers", "The Design School", "The Sanford School", 
"WPC Accountancy", "WPC Economics", "WPC Information Systems", 
"WPC Management", "WPC Supply Chain Management")

for( i in academic.units )
{

  d2 <- filter( d, Department.Description == i )
  if( nrow(d2) == 0 ) { next } 
  else {

    analyze_data(d2)

  }

}
Dselby86 commented 2 years ago

A function can only return a single value or object. It looks like what is happening is in your analyze data function you are returning a graph and a Table.

Try commenting out this line:

build_graph(t.salary, unit = i)

And if it now displays tables you

need to write a second function

that just returns a table.

On Thu, Feb 24, 2022, 12:20 AM dholford @.***> wrote:

Hello,

I successfully (mostly) created a loop to run through each unit (I'm still struggling to figure out the best way to collect the graph and table for each unit), but for some reason when I knit the file, it only prints the graphs in the html doc and doesn't include the tables. I'm going to only include the two functions I'm referencing, along with a function I packaged into one, and my loop since that is what seems to be off.

add_position <- function( t, position, y, xmax, scale.f=8 ) {

t.original <- t t <- filter( t.original, title==position ) dot.size <- 2 + scale.fsum(t$p) offset.n <- 1 + sum(t$p)2

male.median <- NA n.male <- NA t <- filter( t.original, title==position & gender == "male" ) if( nrow(t) > 0 ) { male.median <- t$q50 n.male <- t$n }

female.median <- NA n.female <- NA t <- filter( t.original, title==position & gender == "female" ) if( nrow(t) > 0 ) { female.median <- t$q50 n.female <- t$n }

dumbell plots

segments( x0=female.median, x1=male.median, y0=y, col=gray(0.3,0.5), lwd=7 ) points( male.median, y, col=adjustcolor( "darkblue", alpha.f = 0.5), pch=19, cex=dot.size ) points( female.median, y, col=adjustcolor( "firebrick", alpha.f = 0.5), pch=19, cex=dot.size )

pos.f <- 2 pos.m <- 4 if( ! ( is.na(female.median) | is.na(male.median) ) ) { pos.f <- ifelse( female.median > male.median, 4, 2 ) pos.m <- ifelse( female.median > male.median, 2, 4 ) }

add salaries to right and left

text( female.median, y, paste0("$",round(female.median/1000,0),"k"), col=adjustcolor( "firebrick", alpha.f = 0.7), cex=1.2, pos=pos.f, offset=offset.n ) text( male.median, y, paste0("$",round(male.median/1000,0),"k"), col=adjustcolor( "darkblue", alpha.f = 0.7), cex=1.2, pos=pos.m, offset=offset.n )

add faculty counts

n.female <- ifelse( is.na(n.female), 0, n.female ) n.female <- ifelse( nchar(n.female)==1, paste0( " ", n.female), n.female ) n.male <- ifelse( is.na(n.male), 0, n.male ) n.male <- ifelse( nchar(n.male)==1, paste0( " ", n.male), n.male ) text( xmax-0.1xmax, y+0.14, paste0( "f = ", n.female), col="gray50", cex=1.1, pos=4 ) text( xmax-0.1xmax, y-0.14, paste0( "m = ", n.male), col="gray50", cex=1.1, pos=4 )

axis( side=2, at=y, labels=position, las=2, tick=F, cex.axis=1.5, col.axis="gray50" ) }

build_graph <- function( t.salary, unit ) { unique.titles <- unique( t.salary$title ) ymax <- length(unique.titles) xmax <- round( max(t.salary$q50), -3 ) + 50000 color.key.pos <- 40000 + ( xmax - 40000 ) / 2 color.key.inc <- ( xmax - 40000 ) / 10

t.mf <- filter( t.salary, gender %in% c("male","female") ) N <- sum( t.mf$n )

par( mar=c(6,15,4.1,0) ) plot.new() plot.window( xlim=c(40000-10000,xmax), ylim=c(0,ymax+1) )

abline( v=seq(40000,xmax-40000,20000), lwd=1.5, lty=2, col=gray(0.5,0.5) ) axis( side=1, at=seq(40000,xmax-40000,20000), labels=paste0("$",seq(40,(xmax-40000)/1000,20),"k"), cex.axis=1.1, col.axis="gray40", tick=FALSE )

y <- ymax

if( "Full Professor" %in% unique.titles ) { add_position( t.salary, position="Full Professor", y, xmax ) y <- y-1 } if( "Associate Professor" %in% unique.titles ) { add_position( t.salary, position="Associate Professor", y, xmax ) y <- y-1 } if( "Assistant Professor" %in% unique.titles ) { add_position( t.salary, position="Assistant Professor", y, xmax ) y <- y-1 } if( "Teaching Faculty" %in% unique.titles ) { add_position( t.salary, position="Teaching Faculty", y, xmax ) y <- y-1 } if( "Researcher" %in% unique.titles ) { add_position( t.salary, position="Researcher", y, xmax ) y <- y-1 }

text( color.key.pos + 3color.key.inc, 0, "MALE", col=adjustcolor( "darkblue", alpha.f = 0.7), cex=1.2 ) text( color.key.pos + 1.8color.key.inc, 0, "FEMALE", col="firebrick", cex=1.2 ) text( xmax - 0.1*xmax, 0, paste0("N = ",N), col="gray40", cex=1.2, pos=4 )

title( main="Median Salary by Rank and Gender", cex.main=1.5, col.main="gray30" ) title( xlab=unit, col.lab="gray50", cex.lab=1.5, line=5 ) title( xlab="dot size represents proportion of faculty at that rank", col.lab="gray50", cex.lab=0.9 )

return(NULL) }

Step 10: Top Five Salaries

dollarize <- function(salary) { paste0("$", format( round( salary, 0 ), big.mark="," ) ) }

get_top_5 <- function(Data){

t.top5 <- select(Data, c('Full.Name', 'gender', 'Job.Description', 'salary'))%>% arrange(desc(salary)) %>% slice(1:5)

t.top5$salary <-dollarize(t.top5$salary)

t.top5 <- pander(t.top5)

return(t.top5)

}

Step 11: Package Functions into Single Process

analyze_data <- function(Data){ Data <- add_gender(Data) Data <- add_titles(Data) Data$salary <- convert_currency(Data) Data$salary <- get_fte(Data) t.salary <- create_salary_table(Data) build_graph(t.salary, unit = i) get_top_5(Data)

}

URL <- 'https://docs.google.com/spreadsheets/d/1RoiO9bfpbXowprWdZrgtYXG9_WuK3NFemwlvDGdym7E/export?gid=1335284952&format=csv' d <- read.csv( URL )

academic.units <- c("CISA-Intrdisp Hum & Comm", "CISA-Science & Mathematics", "College of Health Solutions MS", "College of Health Solutions NT", "College of Health Solutions SH", "College Of Law", "English", "Hugh Downs School Of Comm", "Humanities Arts & Cultural", "Journalism & Mass Comm", "Ldrshp and Integrative Studies", "Math & Natural Sciences Div", "MDT Music", "Physics Department", "Psychology", "Sch Biological & Hlth Sys Engr", "Sch Compt Infor & Dec Sys Engr", "Sch Elect Comptr & Energy Engr", "Sch Engr Matter Trnsprt Energy", "Sch Future of Innov in Society", "Sch Sustain Engr & Built Envrn", "School Of Art", "School of Criminology & Crim J", "School Of Earth & Space Explor", "School of Geog Sci & Urban Pln", "School of Math & Stat Sciences", "School of Molecular Sciences", "School of Politics & Global St", "School Of Public Affairs", "School of Social Transform", "School Of Social Work", "SHPRS History Faculty", "Social & Behavioral Sciences", "Sols Administration & Faculty", "SOS Faculty & Researchers", "The Design School", "The Sanford School", "WPC Accountancy", "WPC Economics", "WPC Information Systems", "WPC Management", "WPC Supply Chain Management")

for( i in academic.units ) {

d2 <- filter( d, Department.Description == i ) if( nrow(d2) == 0 ) { next } else {

analyze_data(d2)

}

}

— Reply to this email directly, view it on GitHub https://github.com/Watts-College/cpp-527-spr-2022/issues/34, or unsubscribe https://github.com/notifications/unsubscribe-auth/AB4EHB2V7DOX3AXHCQRWFITU4XL5TANCNFSM5PGRVCRA . Triage notifications on the go with GitHub Mobile for iOS https://apps.apple.com/app/apple-store/id1477376905?ct=notification-email&mt=8&pt=524675 or Android https://play.google.com/store/apps/details?id=com.github.android&referrer=utm_campaign%3Dnotification-email%26utm_medium%3Demail%26utm_source%3Dgithub.

You are receiving this because you are subscribed to this thread.Message ID: @.***>

dholford commented 2 years ago

So I dug a little deeper and think the problem is the knit is printing:

summarise() has grouped output by 'title'. You can override using the

.groups argument.

as opposed to printing the actual table

I tried adding

options(dplyr.summarise.inform = FALSE)

to the function, and while that did take the warning message out of the console when I run the function, the knit still only printed the warning message.

I also tried adding warning = FALSE to the r chunk and that didn't work either.