#### Team Maker #### # last revised: 2021-09-07 # Open source R script that pulls data from the Team Maker quiz in Canvas # Commons, organizes students into diverse teams, and pushes that into a # Group Set in People in Canvas. Coded by Chad Brassil # # 1) Have students complete the Team Maker quiz as a survey. # 2) Adjust Configuration parameters, critical is the base URL and Access Token # 3) In R Studio, Ctrl-Shift-S will source this entire script. In RGui, from the menu choose File/Source R code.. # 4) You will be prompted to choose the course, confirm labels, and confirm weights. The groups will be displayed, # saved to TeamMaker.csv, and created in the Teams group set in Canvas People ############################## #Configuration parameters section # Replace base url with the address of your institutions Canvas, for example "canvas.unl.edu" # It is recommended you first try this code in the test environment, which get erased each week # The test environment is [organization name].test.instructure.com baseurl = "canvas.unl.edu" # In Canvas, you must go to your Account, Settings, Approved Integrations, and click on "New Access Token". # Copy that list of characters and put it below in "CanvasToken". Never share it with anyone. CanvasToken = "" # weights for each of the questions in Team Maker quiz, in order. Are in the range [-1,1] where -1 means disperse, 0 means ignore, and 1 means cluster (or don't isolate in the case of gender and race). weights <- c(1,1,-1,-0.6,-0.2,-0.6,-0.6,-0.4) #heavily values race c(0.01,1,-0.01,-0.01,-0.01,-0.01,-0.01,-0.01) #my default c(1,1,-1,-0.6,-0.2,-0.6,-0.6,-0.4) ignoreNotice = FALSE #set to TRUE if the first question in the quiz is a "text(no question)" notice to students and therefore the first question should be ignored by this algorithm # if experiment = TRUE, randomly divide students into two treatment groups, than apply weights to half the group and experimental weights to the other half experiment = FALSE experimentWeights <- c(1,1,1,-0.6,-0.2,-0.6,-0.6,-0.4) #ignores this line if experiment = FALSE # Set minimum times size or set the desired number of teams #values are "minSize" to have a minimum size of each team but undetermined number teams #or "numberOf" to have a set number of teams but an undetermined size for each team chooseTeams = "minSize" # "minSize" or "numberOf" TeamSize = 3 #minSize: minimum team size NumberOfTeams = 4 #numberOf: number of teams, divided as evenly as possible. If experiment = TRUE, keeps this same number but divides among treatments. Therefore be sure at least 4. If multiple sections, this is the number per section. #Optionaly, can list the names to use for each team. If teamNames = NULL, the name of each team is an integer number. teamNames = NULL #teamNames = c("Ambystoma","Anaxyrus","Andropogon","Asclepias","Aspidoscelis","Bison","Bombus","Bouteloua","Buteo","Carex","Charadrius","Chelydra","Chrysemys","Cincindela","Crotalus","Cynomys","Daphnia","Dolomedes","Fulica","Gleditsia","Grus","Gryllus","Helianthus","Ictalurus","Lemna","Lepisosteus","Lepomis","Liatris","Lithobates","Lutra","Mammuthus","Melanoplus","Meleagris","Micropterus","Nicrophyorus","Ovis","Panicum","Parietaria","Penstemon","Peromyscus","Phaseolus","Pituophis","Platanthera","Pogonomyrmex","Polygonatum","Polytrichum","Populus","Puma","Rhizobium","Rhus","Salicornia","Scaphirhynchus","Sceloporus","Schizachyrium","Solidago","Spartina","Stipa","Sturnella","Teleoceras","Terrapene","Trimerotropis","Urtica","Wolffia","Zea") # Optimzation parameters #How many times to randomly draw new groups and redo optimization? RandomDraws = 20 #CATME default is 20. Published default is 50 maxSwaps = 250 #Maximum Number of swaps during an optimization run. Published default is 20, which is too few. My default is 100, 250, or nrow(tn) maxMinutes = 2 #Maximum Minutes, after which abort the calculation and report best grouping so far. My default was 2. # Notes # Currently, will create groups within Canvas sections (although that code has not been implemented yet for experiment == TRUE) ############################### ## Option A ######## #Import data File and rename columns ## to use, uncomment the next to lines #file <- file.choose() #asks user to choose file using browser #tm <- read.csv(file) ## Option B ######## #Pull data directly from Canvas # #using httr package, jsonlite, and Canvas API calls to pull data if ( !("httr" %in% installed.packages()) ) install.packages("httr") library("httr") if ( !("jsonlite" %in% installed.packages()) ) install.packages("jsonlite") library("jsonlite") if ( !("dplyr" %in% installed.packages()) ) install.packages("dplyr") library("dplyr") # Would require compiled code to set up with OAuth. First, requires an admin to set a client_id. Second, need complied code to hide the client_secret, i.e. can just sit in a script #stateForOAuth = paste(sample(c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","0","1","2","3","4","5","6","7","8","9"),13,replace=TRUE),collapse="") #r <- GET(paste("https://",baseurl,"/login/oauth2/auth",sep=""),query = list(client_id="XXX", response_type="code", state = stateForOAuth)) set_config(add_headers(Authorization = paste("Bearer",CanvasToken))) #function to grab all pages in a get request getContentAllPages <- function(url,querylist){ r <- GET(url, query = c(querylist, page = 1)) warn_for_status(r) linkFrame <- do.call(rbind.data.frame, strsplit(unlist(strsplit(headers(r)$link,",")),";")) lastPage = as.integer(parse_url(linkFrame[which(linkFrame[,2]==" rel=\"last\""),1])$query$page) rContentCombo <- content(r,as="text") if(lastPage > 1) for(i in 2:lastPage){ r <- GET(url, query = c(querylist, page = i)) warn_for_status(r) rContentCombo <- paste(substr(rContentCombo,1,nchar(rContentCombo)-1),",",substr(content(r,as="text"),2,nchar(content(r,as="text"))),sep="") } return(fromJSON(rContentCombo)) } #get all courses, user selects course, store as courseID s <- getContentAllPages(paste0("https://",baseurl,"/api/v1/courses"),list(enrollment_type = "teacher")) choiceName = select.list(s$name,title="Choose Course") ##### Manually choose Selection from list before executing next line of code ############### courseID = s[s$name==choiceName,"id"] #get quiz ID s <- getContentAllPages(paste("https://",baseurl,"/api/v1/courses/",courseID,"/quizzes",sep=""),list(search_term = "Team Maker")) #requires Quiz to be name "Team Maker" if(is.null(nrow(s))) { stop(paste(choiceName,"does not contain Team Maker quiz")) } else if(nrow(s)>1) { choiceTitle = select.list(s$title,title="Choose Quiz"); quizID = s[s$title==choiceTitle,"id"] } else { quizID = s[1,"id"] } #make report and get report link r <- POST(paste("https://",baseurl,"/api/v1/courses/",courseID,"/quizzes/",quizID,"/reports",sep=""),body=list('quiz_report[report_type]' = "student_analysis",'include'="file")) warn_for_status(r) reportID = content(r)$id #get report link, retry if not available because it is still being build reportURL = NULL #set flag while(is.null(reportURL)){ r <- GET(paste("https://",baseurl,"/api/v1/courses/",courseID,"/quizzes/",quizID,"/reports/",reportID,sep=""),query = list(include = "file")) warn_for_status(r) reportURL = content(r)$file$url } #get report r <- GET(reportURL) warn_for_status(r) tm <- read.table(text = content(r,as="text",encoding="UTF-8"), sep =",",quote = "\"", header = TRUE, stringsAsFactors = FALSE) # pull all students and find those that didn't complete quiz #s <- getContentAllPages(paste("https://",baseurl,"/api/v1/courses/",courseID,"/users",sep=""),list(enrollment_type = "student")) # now using sections in order to extract section information with student list ss <- getContentAllPages(paste("https://",baseurl,"/api/v1/courses/",courseID,"/sections",sep=""),list(include = "students")) #rearrange ss into a data.frame listing sections allStudents = data.frame("name"=character(),"id"=integer(),"sis_user_id"=character(),"section"=character()) for(i in 1:nrow(ss)){ allStudents = bind_rows(allStudents,data.frame(ss[i,"students"][[1]][,c("name","id","sis_user_id")],section = ss[i,"name"])) } allStudents %>% rename(sis_id = "sis_user_id") %>% #rename to align with output from the quiz mutate(sis_id = as.integer(sis_id))-> allStudents #make integer to align with output from the quiz #merge all students. Revised to include section. allStudents %>% left_join(tm,by=c("name","id","sis_id","section")) -> tmMerge tmMerge[is.na(tmMerge)] <- "" #put in "" for NA because that is what happens if a student doesn't answer an individual question. Make that the same for students that didn't answer at all # Continue regardless of A or B ############################## #Process report # #Reduce data set to key columns #Eventually will need code that recognizes gener, race, and GPA. Currently need to be first three questions, and in that order. keeperColumns = c(1,2,3,4,which(substr(names(tmMerge),1,1)=="X")[c(TRUE, FALSE)]) #R will put an X in front of each column that starts with a number, and Canvas puts a number of front of the ones we care about if(ignoreNotice == TRUE) keeperColumns = keeperColumns[-5] #if first question is a notice, drop it from the keeper list tn = tmMerge[,keeperColumns] #rename key columns and have user confirm names(tn) <- c("name","id","sis_id","section","gender","race","GPA","year","area","leadership","ideas","greek")[1:length(keeperColumns)] #truncate in the event that user has fewer questions print(data.frame(Original.File=names(tmMerge)[keeperColumns],New.Labels=names(tn))) invisible(readline(prompt="Confirm gender, race, and GPA are aligned promperly. Labels on other columns are only for convenience. Press [enter] to continue.")) #fix issue with leading zeros in ID and make GPA numeric tn$id = as.factor(sprintf("%06d", tn$id)) #the leading zeros need to be retained for later put of group members tn$GPA <- as.numeric(as.character(tn$GPA)) #make GPA numeric, which puts in NA in place of "" tn$section = factor(tn$section) #make a factor for later use #trim weights to be no longer than extracted keeperColumns without the header weights <- weights[1:(length(keeperColumns)-4)] #display weights aligned with categories ifelse(!experiment,print(data.frame(categories=names(tn)[c(-1,-2,-3,-4)],weights)),print(data.frame(categories=names(tn)[c(-1,-2,-3,-4)],weights,experiment = experimentWeights))) invisible(readline(prompt="Confirm weights for each category. -1 disperses, 0 ignores, 1 for gender and race doesn's isolate. Press [enter] to continue.")) #function to randomly assign groups #randomGroups = function(method){ # if(method == "minSize") return(sample(rep_len(1:floor(nrow(tn)/TeamSize),nrow(tn)))) # if(method == "numberOf") return(sample(rep_len(1:NumberOfTeams,nrow(tn)))) #} randomGroups = function(method,numRows,trt){ if(method == "minSize"){ maxTeamID = floor(numRows/TeamSize) } else if (method == "numberOf" & trt == 0){ maxTeamID = NumberOfTeams } else if (method == "numberOf" & trt == 1){ maxTeamID = ceiling(NumberOfTeams/2) } else if (method == "numberOf" & trt == 2){ maxTeamID = floor(NumberOfTeams/2) } return(sample(rep_len(1:maxTeamID,numRows))) } #scoring method in teamScore function # original idea based on open source code in this: # https://sourceforge.net/projects/team-maker/ # mostly based on algorithm published in # https://eric.ed.gov/?id=EJ1076132 # https://files.eric.ed.gov/fulltext/EJ1076132.pdf # additional variations, like sqrt() # based on https://www.catme.org/faculty/help#index #for race categories, use US Dept of Education guidance from Oct 19, 2007, aggregated into the 7 reporting categories # critical for coding of scores is "White" and "Prefer not to answer". Others can easily be changed or added in Canvas Team Maker survey. # "American Indian or Alaskan Native", "Hispanic or Latino or Spanish Origin", "Asian", "Native Hawaiian or Other Pacific Islander", "Black or African American", "White", "Two or more races" #https://ir.aa.ufl.edu/surveys/race-and-ethnicity-survey/ #function that calculate the score for team 'i', given the teams in 'group' teamScore <- function(group,i,tn,GPAcat,weights) { score = 0; half = ceiling(nrow(tn[group==i,])/2) fullGroupSize = nrow(tn[group==i,]) #don't isolate females. If all males, get 0. If isolated female, get transformed -1. If at least half female, max score. Blanks are ignored, essentially considered Males ct = sum(tn[group==i,"gender"]=="Female") score = score + weights[1]*ifelse(ct==0,0,ifelse(ct==1,-1,(min(1,sqrt(ct/half))-0.5)*2)) #don't isolate non-binary, at least place with females ct = sum(tn[group==i,"gender"]=="Non-binary") ct2 = sum(tn[group==i,"gender"]=="Female"|tn[group==i,"gender"]=="Non-binary") score = score + weights[1]*ifelse(ct==0,0,ifelse(ct==1,-1,(min(1,sqrt(ct2/half))-0.5)*2)) #if no non-binary, keep as 0 #don't isolate by individual races, ignoring "White" or "Prefer not to answer" or blank for(j in which(levels(tn$race)!="White" & levels(tn$race)!="" & levels(tn$race)!="Prefer not to answer") ) #ignores blank race and ignores "Prefer not to answer", essentially treats as White { ct = sum(tn[group==i,"race"]==levels(tn$race)[j]) score = score + weights[2]*ifelse(ct==0,0,ifelse(ct==1,-1,(min(1,sqrt(ct/half))-0.5)*2)) } #don't isolate non-White students. Give partial weight of 0.25 ct = sum(tn[group==i,"race"]!="White" & tn[group==i,"race"]!="" & tn[group==i,"race"]!="Prefer not to answer") #ignores blank race and "Prefer not to answer", essentially treats as White score = score + weights[2]*ifelse(ct==0,0,ifelse(ct==1,-1,(min(1,sqrt(ct/half))-0.5)*2))*0.25 #GPA ct = length(unique(na.omit(GPAcat[group==i]))) #ignores blank GPA, as if the same as another GPA in the team score = score + weights[3]*ifelse(ct==1,1,((1-ct/fullGroupSize)-0.5)*2) #assume the remaining are categorical for(j in which(names(tn)!="name"&names(tn)!="id"&names(tn)!="sis_id"&names(tn)!="section"&names(tn)!="gender"&names(tn)!="race"&names(tn)!="GPA") ) { ct = length(unique(tn[,j][group==i][tn[,j][group==i]!=""])) #ignores blanks score = score + weights[j-4]*ifelse(ct==1,1,((1-ct/fullGroupSize)-0.5)*2) } return(score) } makeTeams <- function(tn,weights,trt){ #make GPA categorical largestGroupSize = max(table(randomGroups(chooseTeams,nrow(tn),trt))) GPAcat = findInterval(tn$GPA, unique(quantile(tn$GPA, seq(0, 1, length.out = largestGroupSize + 1),na.rm=TRUE)), rightmost.closed = TRUE) #clear out bestGroup if(exists("bestGroup")) rm(bestGroup) #start Timer startTime <- proc.time() for(k in 1:RandomDraws) #run with RandomDraws to search for global maximium { if(k==1) cat("Calculating...","\n") #randomly assign for grouping for next iteration group = randomGroups(chooseTeams,nrow(tn),trt) #calculate score for each team teamScoreList <- sapply(1:max(group),function(x)teamScore(group,x,tn,GPAcat,weights)) #kept those out of the top of the while loop to avoid unneccesarily recalculating i #while loop to continue swapping people among groups until no improvment, i.e. local maximum foundBetter = TRUE #set flag to enter while loop swapCounter = 0 while(foundBetter){ #identify which team has the lowest team score minTeamScore = min(teamScoreList) lowGroupNum = which(teamScoreList==minTeamScore)[1] #just in case multiple groups are tied for lowest #pre-randomize a swap list for people in the lowest group and for all others notLowList = sample(which(group!=lowGroupNum)) lowList = sample(which(group==lowGroupNum)) #systematically swap each person on the low list with each in the high list foundBetter = FALSE #flag to indicate a swap has occurred if(length(notLowList)!=0) for(m in 1:length(notLowList)){ #first, ensure there is nothing to swap, i.e. a single group for(n in 1:length(lowList) ){ pos1 = notLowList[m] pos2 = lowList[n] proposedGroup = group proposedGroup[pos1] = group[pos2] proposedGroup[pos2] = group[pos1] proposedSwapTeamScore = teamScore(proposedGroup,group[pos1],tn,GPAcat,weights) proposedMinTeamScore = teamScore(proposedGroup,group[pos2],tn,GPAcat,weights) if((proposedMinTeamScore > minTeamScore) & (proposedSwapTeamScore > teamScoreList[group[pos1]])){ teamScoreList[group[pos1]] = proposedSwapTeamScore teamScoreList[group[pos2]] = proposedMinTeamScore group = proposedGroup swapCounter = swapCounter + 1 foundBetter = TRUE } if(foundBetter) break if(((proc.time()-startTime)[3] > maxMinutes*60)|(swapCounter > maxSwaps)) break #if has exceed time or exceeded max swaps } #cat("iteration",format(k,width=2),"score",format(round(sum(teamScoreList),digits=3),nsmall=3,width=8),"\n") if(foundBetter) break if(((proc.time()-startTime)[3] > maxMinutes*60)|(swapCounter > maxSwaps)) break } } cat("iteration",format(k,width=2),"score",format(round(sum(teamScoreList),digits=3),nsmall=3,width=8),group,"\n") #if best group, store information if(!exists("bestGroup")){ bestGroup = group bestScore = sum(teamScoreList) bestMin = min(teamScoreList) } else if (min(teamScoreList) > bestMin){ #look for least bad group bestGroup = group bestScore = sum(teamScoreList) bestMin = min(teamScoreList) } else if ((min(teamScoreList) == bestMin) & (sum(teamScoreList) > bestScore)){ #if tied, look for best total score bestGroup = group bestScore = sum(teamScoreList) } if(swapCounter > maxSwaps){ cat("Reached maximum swaps. Moving to next random draw.","\n") } if((proc.time()-startTime)[3] > maxMinutes*60){ cat("Reached maximum minutes. Stopping random draws.","\n") break } } return(list("bestGroup"=bestGroup,"teamScoreList"=teamScoreList)) } #main code # this codes calls the above functions and actually does the work # the steps depend on if an experiment is being done, i.e. if two different weightings are being used if(experiment){ #NOTE: EXPERIMENT SECTION IS NOT ROBUST YET TO MULTIPLE SECTIONS # randomly group students into treatments, 1 or 2. experimentTrt = sample(rep_len(1:2,nrow(tn))) # independently make groups within each treatement group trt1Groups = makeTeams(tn[experimentTrt==1,],weights,1) trt2Groups = makeTeams(tn[experimentTrt==2,],experimentWeights,2) #create empty data frame to hold and organize results expDataFrame = data.frame("finalGroup"=rep_len(NA,nrow(tn)),"finalScores"=rep_len(NA,nrow(tn)),"experiment"=rep_len(NA,nrow(tn))) #combine into a coherent set of groups expDataFrame$finalGroup[experimentTrt==1] <- trt1Groups$bestGroup expDataFrame$finalGroup[experimentTrt==2] <- max(trt1Groups$bestGroup) + trt2Groups$bestGroup #pull Team Scores too expDataFrame$finalScores[experimentTrt==1] <- trt1Groups$teamScoreList[trt1Groups$bestGroup] expDataFrame$finalScores[experimentTrt==2] <- trt2Groups$teamScoreList[trt2Groups$bestGroup] #bundle trt info with groups into a data.frame for next step expDataFrame$experiment[experimentTrt==1] <- FALSE expDataFrame$experiment[experimentTrt==2] <- TRUE #randomly renumber groups so that the second half of the numbers are not all of the experimental groups newGroupID = sample(1:max(expDataFrame$finalGroup)) initialGroup = expDataFrame$finalGroup for(i in 1:max(expDataFrame$finalGroup)) {expDataFrame$finalGroup[initialGroup==i] <- newGroupID[i]} finalGroup = expDataFrame$finalGroup finalScores = unname(tapply(expDataFrame$finalScores,finalGroup,mean)) tnFinal = data.frame(Student=tn$name,ID=tn$id,"SIS User ID"=tn$sis_id,Section=tn$section,"Experiment"=expDataFrame$experiment,TeamID=finalGroup,Team=if(is.null(teamNames)){finalGroup}else{teamNames[finalGroup]},tn[,-(1:4)],stringsAsFactors = FALSE) }else { #no experiment noExpGroups = list(bestGroup = integer(),teamScoreList = double() ) #initialize list for(i in 1:length(levels(tn$section))){ #repeat for each section. if only 1 section, just do once makeTeamsOutput <- makeTeams(filter(tn,as.integer(section) == i ),weights,0) makeTeamsOutput$bestGroup = makeTeamsOutput$bestGroup + ifelse(length(noExpGroups$bestGroup)>0,max(noExpGroups$bestGroup),0) #bump up group numbers above any previously in output noExpGroups$bestGroup = c(noExpGroups$bestGroup,makeTeamsOutput$bestGroup) #combine vectors with any previous noExpGroups$teamScoreList = c(noExpGroups$teamScoreList,makeTeamsOutput$teamScoreList) #combine vectors with any previous } finalGroup = noExpGroups$bestGroup finalScores = noExpGroups$teamScoreList tnFinal = data.frame(Student=tn$name,ID=tn$id,"SIS User ID"=tn$sis_id,Section=tn$section,TeamID=finalGroup,Team=if(is.null(teamNames)){finalGroup}else{teamNames[finalGroup]},tn[,-(1:4)],stringsAsFactors = FALSE) } ####################### # view Results #display groups Team.Name=tnFinal$Team print(by(tnFinal[,-c(2,3,4,6)],Team.Name,function(z)as.data.frame(sapply(z,function(x)substr(x,1,20))))) cat("\n") #blank line for when sourced. #display score of each group cat(finalScores,"\n") cat(sum(finalScores),"\n") #can be used for exporting, but will have to adjust file if want to use it with Canvas Import formatting #tnFinal[c(1,2,3,4,6,7)] print(paste("Writing TeamMaker.csv to",getwd())) write.csv(tnFinal,"TeamMaker.csv") #check to see if Teams should be created in Canvas choicePushTeams = select.list(c("Yes, create Teams in Canvas", "No, stop and discard results"),title="You can review the teams on the screen or via the csv file. Would you like to create the teams in Canvas, which will create 'Teams' in Groups and a Page called Teams?") ####################### # PUSH teams into Canvas as a Group Set in People # # Students will see their group name, for example "Team 1", listed at the right-hand side under "Course Groups" # clicking on that will bring them to their course page, in which they can click on "People" # they can see the names of their group members and send them messages via Canvas if(choicePushTeams == "Yes, create Teams in Canvas") { #check to see if Group Set "Teams" already exists r <- GET(paste("https://",baseurl,"/api/v1/courses/",courseID,"/group_categories",sep="")) warn_for_status(r) s <- fromJSON(content(r,as="text")) #if exists, delete Group Set "Teams" if("Teams" %in% s$name){ groupCategoryID =s[s$name=="Teams","id"] r <- DELETE(paste("https://",baseurl,"/api/v1/group_categories/",groupCategoryID,sep="")) warn_for_status(r) } #create Group Set called "Teams" and make groups. This will randomly assign all students, so need to move in next step r <- POST(paste("https://",baseurl,"/api/v1/courses/",courseID,"/group_categories",sep=""),body=list('name' = "Teams",'create_group_count'=max(tnFinal$TeamID))) warn_for_status(r) groupCategoryID = content(r)$id #get list of groups s <- getContentAllPages(paste("https://",baseurl,"/api/v1/group_categories/",groupCategoryID,"/groups",sep=""),list()) groupIDList = s$id #put students into groups for(i in 1:max(finalGroup)){ r <- PUT(paste("https://",baseurl,"/api/v1/groups/",groupIDList[i],sep=""),body=list('name' = tnFinal$Team[tnFinal$TeamID==i][1], 'members'=toString(tnFinal$ID[finalGroup==i]))) warn_for_status(r) } } ####################### # Create a Page in Canvas listing teams as an html table. Can be shared with students. # # if(choicePushTeams == "Yes, create Teams in Canvas") { #using xtable package to format data.frame for HTML if ( !("xtable" %in% installed.packages()) ) install.packages("xtable") library("xtable") #format html into string dfTeams = data.frame(Student=tnFinal$Student,Team=tnFinal$Team) htmlStudent = print(xtable(dfTeams[order(dfTeams$Student),],digits=c(0)),type="html",print.results=FALSE,include.rownames = FALSE) htmlTeam = print(xtable(dfTeams[order(dfTeams$Team),c(2,1)],digits=c(0)),type="html",print.results=FALSE,include.rownames = FALSE) pageBody = paste("

By Student

\n", htmlStudent,"
","

By Team

\n", htmlTeam) pageBody = gsub("","",pageBody) pageBody = gsub("","",pageBody) pageBody = gsub("","",pageBody) #If page already exists, grab url s <- getContentAllPages(paste("https://",baseurl,"/api/v1/courses/",courseID,"/pages",sep=""),list(search_term = "Teams")) existingPageUrl = if(is.null(nrow(s))==TRUE) {NULL } else { s[which(s[,1]=="Teams"),"url"] } #post html into a Canvas page called Teams, overwriting if needed if(length(existingPageUrl)==0){ #create new page r <- POST(paste("https://",baseurl,"/api/v1/courses/",courseID,"/pages",sep=""),body=list('wiki_page[title]' = "Teams",'wiki_page[body]'=pageBody, 'wiki_page[editing_roles]'="teachers",'wiki_page[published]'="true")) } else{ #already exists, so overwrite page r <- PUT(paste("https://",baseurl,"/api/v1/courses/",courseID,"/pages/",existingPageUrl,sep=""),body=list('wiki_page[title]' = "Teams",'wiki_page[body]'=pageBody, 'wiki_page[editing_roles]'="teachers",'wiki_page[published]'="true")) } warn_for_status(r) } ######################## ### Generate fake data to test code #classSize = 250 #tn=data.frame( # name = paste("ID",1:classSize,sep=""), # id = paste(1:classSize,sep=""), # sis_id = paste(1:classSize,sep=""), # section = rep_len("Fake",classSize), # gender = sample(c("Female","Male","Non-binary","Prefer not to answer",""),classSize,replace=TRUE,prob=c(0.48,0.48,0.02,0.01,0.01)), # race = sample(c("American Indian or Alaskan Native","Hispanic or Latino","Asian","Native Hawaiian or Other Pacific Islander","Black or African American", "White","Two or more races","Prefer not to answer",""),classSize,replace=TRUE,prob=c(0.003,0.06,0.026,0,0.027,0.729,0.07,0.075,0.01)), # GPA = as.numeric(ifelse(sample(c(TRUE,FALSE),classSize,replace=TRUE,prob=c(0.99,0.01)),round(rbeta(classSize,(3.3/4)*10.9,(1-(3.3/4))*10.9)*4,digits=2),"")), # year = sample(c("First-year","Sophmore","Junior","Senior","Post-baccalaureate",""),classSize,replace=TRUE,prob=c(0.10,0.64,0.20,0.04,0.01,0.01)), # area = sample(c("Business","Education","Fine Arts","Humanities or Social Science","Pre-health","Science, Technology, Engineering, or Math",""),classSize,replace=TRUE,prob=c(0.03,0.02,0.01,0.04,0.79,0.10,0.01)), # leadership = sample(c("Am a follower","Am often following, but lead as needed","Equally lead and follow","Am often a leader, but follow as needed","Am a leader",""),classSize,replace=TRUE,prob=c(0.10,0.20,0.39,0.20,0.10,0.01)), # ideas = sample(c("Enjoy generating new ideas, but leave the details to others","Prefer the idea phase, but can work through details as needed","Balanced between ideas and details","Can come up with ideas, but would rather work through the details","Let others dream up ideas, while I focus on the practical details",""),classSize,replace=TRUE,prob=c(0.10,0.20,0.39,0.20,0.10,0.01)), # greek = sample(c("Yes","No",""),classSize,replace=TRUE,prob=c(0.15,0.84,0.01)) #)