diff --git a/.Rapp.history b/.Rapp.history new file mode 100644 index 0000000..5068548 --- /dev/null +++ b/.Rapp.history @@ -0,0 +1,1054 @@ +q() +install.packages(c('repr','pbdZMQ','devtools')) +devtools::install_github(c('IRkernal/IRdisplay','IRkernal/IRkernal')) +devtools::install_github(c('IRkernel/IRdisplay','IRkernel/IRkernal')) +devtools::install_github(c('IRkernel/IRdisplay','IRkernel/IRkernel')) +q() +# Admit to Net Enroll Model with Caret# +## +# Sean Fahey# +# 2016-08-12# +## +# This script uses the Caret package to make and compare admit to net enroll models# +## +# +################# +## +# CONFIGURE ENVIRONMENT# +## +################## +# +# This is designed to be run in the /Student Lifecycle/Admit to Net Enroll directory# +getwd()# +# +# Load needed libraries# +library(plyr) # this is here to make sure it loads before dplyr# +library(dplyr)# +### BUILD DATASET# +# +# load base dataset# +load("../../data/tidy_data/Inquiry Lifecycle Admits 2014- Tidy.RData")# +# +# join the ESperformance dataset# +load("../../data/tidy_data/ESPerformanceData.RData")# +mdata %>% left_join(inquiriesByOwner) -> mdata# +# +### PREPARE MODLING DATASET# +# +# Select only the variables to be used for the model# +mdata1 <- select(mdata, application_university_name, md_degree_level, application_program_area, gpa__c, application_decision_original, application_has_pushed, application_is_program_switch, has_gpa, vel_inq_to_app, vel_app_to_admit, fa_prob, has_loi, student_age_at_startdate, marital_status__c, inquiry_channel_group, x_is_international, application_is_full_scholarship, scholarship_total__c, FID.monthNumber, ES_pct_admit_to_netenroll, x_is_net_enroll, x_is_cancelled_enroll, sf_app_id)# +# +# Generate factors for variables# +mdata1$application_program_area <- as.factor(mdata1$application_program_area)# +mdata1$application_decision_original <- as.factor(mdata1$application_decision_original)# +mdata1$marital_status__c[mdata1$marital_status__c == '']<- 'Unknown'# +mdata1$marital_status__c[is.na(mdata1$marital_status__c)]<- 'Unknown'# +mdata1$marital_status__c <- as.factor(mdata1$marital_status__c)# +mdata1$FID.monthNumber <- as.factor(mdata1$FID.monthNumber)# +# +# show the number of NAs# +sapply(mdata1, function(x) sum(is.na(x)))# +# +## IMPUTE MISSING DATA# +# +# impute missing GPA data as the mean # +mdata1$gpa__c[is.na(mdata1$gpa__c)]<- mean(mdata1$gpa__c, na.rm=T)# +# +# impute missing ES percent admit to net enroll# +mdata1$ES_pct_admit_to_netenroll[is.na(mdata1$ES_pct_admit_to_netenroll)]<- mean(mdata1$ES_pct_admit_to_netenroll, na.rm=T)# +# +# impute missing app to start data as the mean # +mdata1$inquiry_channel_group <- as.factor(mdata1$inquiry_channel_group)# +mdata1$x_is_international <- ifelse(mdata1$x_is_international== 1, 'International', 'US/Canada') # +mdata1$x_is_international <- as.factor(mdata1$x_is_international)# +# + # create a text outcome variable# +mdata1$outcome <- NA# +mdata1$outcome[mdata1$x_is_net_enroll == 1] <- 'Enrolled'# +mdata1$outcome[mdata1$x_is_cancelled_enroll == 1] <- 'Cancelled'# +mdata1$outcome<-as.factor(mdata1$outcome)# +mdata1$x_is_net_enroll <- NULL # we remove the integer flag since we have the outcome variable# +mdata1$x_is_cancelled_enroll <- NULL # we remove the integer flag since we have the outcome variable# +# show the number of NAs# +sapply(mdata1, function(x) sum(is.na(x)))# +# +mdata1 <- mdata1[complete.cases(mdata1),] # This removes cases with NAs to ensure the caret predictions work# +str(mdata1)# +### CREATE TRAINING AND TEST DATA PARTITIONS# +# +library(caret) # This is a useful ML library we will be using that has a handy function for creating data partitions# +set.seed(1234) # pick a specific random seed so the results can be recreated# +intrain<-createDataPartition(y=mdata1$outcome,p=0.7,list=FALSE)# +training<-mdata1[intrain,]# +testing<-mdata1[-intrain,]# +# +# Set the machine learning cross validation training rules# +# +fitControl_cv <- trainControl(## 5-fold CV, repeated 3 times# + method = "repeatedcv",# + number = 5,# + repeats = 3, # + classProbs = TRUE,# + summaryFunction = twoClassSummary)# +## DECISION TREE MODEL# +# +# Train the model # +rpart_cv <- train(outcome ~ ., data = select(training, -sf_app_id),# + method = "rpart",# + trControl = fitControl_cv,# + metric = "ROC")# +# +# Show how well the model performed on the training data# +confusionMatrix(predict(rpart_cv),training$outcome, positive = "Enrolled")# +# Predict the outcomes for the test data set# +rpart_cv.pred <- predict(rpart_cv, newdata = select(testing, -sf_app_id))# +# +# Show how well the model performed on the testing data# +confusionMatrix(rpart_cv.pred,testing$outcome, positive = "Enrolled")# +## GRADIENT BOOSTING MACHINE# +# +# Train the model # +gbm_cv <- train(outcome ~ ., data = select(training, -sf_app_id),# + method = "gbm",# + trControl = fitControl_cv,# + metric = "ROC")# +# +# Show how well the model performed on the training data# +confusionMatrix(predict(gbm_cv),training$outcome, positive = "Enrolled")# +# Predict the outcomes for the test data set# +gbm_cv.pred <- predict(gbm_cv, newdata = select(testing, -sf_app_id))# +# +# Show how well the model performed on the testing data# +confusionMatrix(gbm_cv.pred,testing$outcome, positive = "Enrolled")# +# +# ## GENERALIZED LINEAR MACHINE# +# +# # Train the model # +# glm_cv_cs <- train(outcome ~ ., data = select(training, -sf_app_id),# + # method = "glm",# + # trControl = fitControl_cv,# + # preProcess = c("center", "scale"),# + # metric = "ROC")# +# +# # Show how well the model performed on the training data# +# confusionMatrix(predict(glm_cv_cs),training$outcome, positive = "Enrolled")# +# # Predict the outcomes for the test data set# +# glm_cv_cs.pred <- predict(glm_cv_cs, newdata = select(testing, -sf_app_id))# +# +# # Show how well the model performed on the testing data# +# confusionMatrix(glm_cv_cs.pred,testing$outcome, positive = "Enrolled")# +# +## GRADIENT BOOSTING MACHINE WITH PREPROCESSING# +# +# Train the model # +gbm_cv_cs <- train(outcome ~ ., select(training, -sf_app_id),# + method = "gbm",# + trControl = fitControl_cv,# + preProcess = c("center", "scale"),# + metric = "ROC")# +# +# Show how well the model performed on the training data# +confusionMatrix(predict(gbm_cv_cs),training$outcome, positive = "Enrolled")# +# Predict the outcomes for the test data set# +gbm_cv_cs.pred <- predict(gbm_cv_cs, newdata = select(testing, -sf_app_id))# +# +# Show how well the model performed on the testing data# +confusionMatrix(gbm_cv_cs.pred,testing$outcome, positive = "Enrolled")# +# +# # SUPPORT VECTOR MACHINE# +# +# Train the model # +# svm_cv <- train(outcome ~ ., data = select(training, -sf_app_id),# + # method = "svmLinear2",# + # trControl = fitControl_cv,# + # metric = "ROC")# +# +# Show how well the model performed on the training data# +# confusionMatrix(predict(svm_cv),training$outcome, positive = "Enrolled")# +# Predict the outcomes for the test data set# +# svm_cv.pred <- predict(svm_cv, newdata = select(testing, -sf_app_id))# +# +# Show how well the model performed on the testing data# +# confusionMatrix(svm_cv.pred,testing$outcome, positive = "Enrolled")# +# +# # NEURAL NETWORK# +# +# Train the model # +# nnet_cv <- train(outcome ~ ., data = select(training, -sf_app_id),# + # method = "nnet",# + # trControl = fitControl_cv,# + # metric = "ROC")# +# +# Show how well the model performed on the training data# +# confusionMatrix(predict(nnet_cv),training$outcome, positive = "Enrolled")# +# Predict the outcomes for the test data set# +# nnet_cv.pred <- predict(nnet_cv, newdata = select(testing, -sf_app_id))# +# +# Show how well the model performed on the testing data# +# confusionMatrix(nnet_cv.pred,testing$outcome, positive = "Enrolled")# +## MODEL COMPARISON# +# +# results <- resamples(list(GBM=gbm_cv, GBM_cs = gbm_cv_cs, RPART=rpart_cv, NNET = nnet_cv, SVM = svm_cv))# +results <- resamples(list(GBM_cs=gbm_cv_cs, GBM = gbm_cv, RPART=rpart_cv))# +summary(results)# +bwplot(results) +q() +? read.csv +q() +ls() +rm(list = ls()) +ls() +q() +ip <- installed.packages() +pkgs.to.remove <- ip[!(ip[,"Priority"] %in% c("base", "recommended")), 1] +sapply(pkgs.to.remove, remove.packages) +q() +update9) +update() +# Inquiry to Net Enroll Model Development# +## +# Sean Fahey# +# 2016-06-16# +## +# This script develops and compares models for predicting the likelihood that an inquiry will net enroll including both internal inquiry lifecycle view data as well# +# as external zip code data# +## +# +################# +## +# CONFIGURE ENVIRONMENT# +## +################## +# set working directory# +getwd()# +# setwd("/Users/sean.fahey/Google Drive/Analytics and Data/Modeling/Inquiry to Enroll/code/")# +# load needed packages# +library(dplyr)# +library(caret)# +library(zipcode)# +library (ROCR)# +source("modelAssess.R")# +################ +## +# GET RAW DATA# +## +################ +# +### Comment out either the Query or Load line# +# +# Option 1 - Query DB for raw data# +# source("../rawData/All Inquiries (De-ID) 2014-.R", echo=TRUE)# +# +# Optiona 1a - Save the raw data for later offline analysis# +# save(data, file="../rawData/All Inquiries (De-ID) with zip 2014- Raw.RData")# +# write.csv(data, file = "../rawData/All Inquiries (De-ID) with zip 2014- Raw.csv")# +# Option 2 - Load saved raw data# +# load(file="../rawData/All Inquiries (De-ID) with zip 2013- Raw.RData")# +################ +## +# GET TIDY DATA# +## +################ +# +# Option 1 - Run Script to prepare raw data for modeling# +# source("../tidyData/Inquiry Lifecycle Query Prep.R", echo=TRUE)# +# +# Option 1a - Save tidy data for later offline analysis# +# save(mdata, file="../tidyData/All Inquiries (De-ID) 2013- Tidy.RData")# +# +# Option 2 - Load saved tidy data# +load("../tidyData/All Inquiries (De-ID) 2014- Tidy.RData")# +# - Add external data from ACS DP02# +# o HC03_VC04 - Percent; HOUSEHOLDS BY TYPE - Total households - Family households (families)# +# o HC03_VC06 - Percent; HOUSEHOLDS BY TYPE - Total households - Family households (families) - Married-couple family# +# o HC03_VC10 - Percent; HOUSEHOLDS BY TYPE - Total households - Family households (families) - Female householder, no husband present, family# +# o HC01_VC21 - Estimate; HOUSEHOLDS BY TYPE - Average household size# +# o HC03_VC81 - Percent; SCHOOL ENROLLMENT - Population 3 years and over enrolled in school - College or graduate school# +# o HC03_VC91 - Percent; EDUCATIONAL ATTAINMENT - Population 25 years and over - Bachelor's degree# +# o HC03_VC92 - Percent; EDUCATIONAL ATTAINMENT - Population 25 years and over - Graduate or professional degree# +# o Create variable (VC92- VC91)# +# o HC03_VC96 - Percent; EDUCATIONAL ATTAINMENT - Percent bachelor's degree or higher# +# o HC03_VC121 - Percent; RESIDENCE 1 YEAR AGO - Population 1 year and over - Different house in the U.S.# +# o HC03_VC125 - Percent; RESIDENCE 1 YEAR AGO - Population 1 year and over - Different house in the U.S. - Different county - Different state# +# - Add external data from ACS DP03# +# o HC01_VC04 - Estimate; EMPLOYMENT STATUS - Population 16 years and over - In labor force# +# o HC03_VC04 - Percent; EMPLOYMENT STATUS - Population 16 years and over - In labor force# +# o HC03_VC07 - Percent; EMPLOYMENT STATUS - Population 16 years and over - In labor force - Civilian labor force – Unemployed# +# o HC01_VC15 - Estimate; EMPLOYMENT STATUS - Females 16 years and over - In labor force# +# o HC03_VC15 - Percent; EMPLOYMENT STATUS - Females 16 years and over - In labor force# +# o HC01_VC59 - Estimate; INDUSTRY - Civilian employed population 16 years and over - Educational services, and health care and social assistance# +# o HC03_VC59 - Percent; INDUSTRY - Civilian employed population 16 years and over - Educational services, and health care and social assistance# +# o HC01_VC85 - Estimate; INCOME AND BENEFITS (IN 2014 INFLATION-ADJUSTED DOLLARS) - Total households - Median household income (dollars)# +# o HC01_VC114 - Estimate; INCOME AND BENEFITS (IN 2014 INFLATION-ADJUSTED DOLLARS) - Families - Median family income (dollars)# +# o HC01_VC118 - Estimate; INCOME AND BENEFITS (IN 2014 INFLATION-ADJUSTED DOLLARS) - Per capita income (dollars)# +# o HC03_VC161 - Percent; PERCENTAGE OF FAMILIES AND PEOPLE WHOSE INCOME IN THE PAST 12 MONTHS IS BELOW THE POVERTY LEVEL - All families# +#### Build ACS Zip Code dataset# +ACS_demo <- read.csv("../external_data/ACS_14_5YR_DP02_selected.csv")# +ACS_demo <- select(ACS_demo, - GEO.id, - GEO.display.label)# +names(ACS_demo)[names(ACS_demo)=='HC03_VC04']<-'DP02_HC03_VC04'# +ACS_econ <- read.csv("../external_data/ACS_14_5YR_DP03_selected.csv", stringsAsFactors=FALSE)# +ACS_econ <- select(ACS_econ, - GEO.id, - GEO.display.label)# +ACS_econ$HC01_VC85 <- as.numeric(ACS_econ$HC01_VC85)# +ACS_econ$HC01_VC114 <- as.numeric(ACS_econ$HC01_VC114)# +ACS <- left_join(ACS_demo, ACS_econ, by = "GEO.id2")# +ACS_scaled<- ACS# +ACS_scaled[,-c(1)] <- scale(ACS_scaled[,-c(1)])# +ACS_scaled$zip_code <- clean.zipcodes(ACS_scaled$GEO.id2)# +#### Load US Economic condition data# +US_econ <- read.csv("../external_data/US Economic Condition by Month.csv")# +US_econ$Year <- as.factor(US_econ$Year)# +# +# load base lifecycle view (LCV) data and select only zip codes# +load("../tidyData/All Inquiries (De-ID) 2014- Tidy.RData")# +LCV <- mdata# +LCV$zip_code <- LCV$student_postal_code# +LCV$zip_code<- clean.zipcodes(LCV$zip_code) # +LCV$zip_code[is.na(LCV$student_postal_code)] <- LCV$inquiry_postal_code[is.na(LCV$student_postal_code)] # +LCV$zip_code<- clean.zipcodes(LCV$zip_code) # +LCV$FID.year <- as.factor(LCV$FID.year)# +LCV$inquiry_age <- Sys.Date() - LCV$date_first_inquiry# +LCV$inquiry_age_log <- log(as.numeric(LCV$inquiry_age))# +# +# join datasets# +LCV <- left_join(LCV, ACS_scaled)# +LCV <- left_join(LCV, US_econ, by = c("FID.month" = "Month", "FID.year" = "Year"))# +# +# show NAs# +sapply(LCV, function(x) sum(is.na(x)))# +################ +## +# PREPARE TIDY DATA FOR MODELING# +## +################ +# +# filter out recent inquiries to give time for enrollment# +# +LCV <- LCV[LCV$date_first_inquiry<"2016-05-01",]# +# set Outcome Variable# +LCV$outcome_var <- LCV$x_is_net_enroll# +LCV$outcome_var <- factor(LCV$outcome_var)# +# +# Create class variables# +LCV$Class[LCV$outcome_var == 0 ] = "Not"# +LCV$Class[LCV$outcome_var == 1] = "Enrolled"# +# +# Build training, validation and testsets# +inTrain <- createDataPartition(y = LCV$outcome_var, p = .75, list = FALSE)# +training <- LCV[inTrain,]# +testing <- LCV[-inTrain,]# +# +# # filter out unused variables# +# LCVdata <- select(LCV, inquiry_postal_code, x_is_net_enroll,inquiry_degree_group, inquiry_channel, FID.month, student_postal_code, FID.year)# +# # remove unneeded variables# +# LCVdata$x_is_net_enroll <- NULL# +# LCVdata$zip_code <- NULL# +# LCVdata$inquiry_postal_code <- NULL# +# LCVdata$student_postal_code <- NULL# +# LCVdata$GEO.id2 <- NULL# +# # Create factors# +# mdata$outcome_var = factor(mdata$outcome_var)# +# mdata$inquiry_channel = factor(mdata$inquiry_channel)# +################ +## +# BUILD MODELS# +## +################ +# +attach(training)# +# +### Model 1 - Inquiry Degree Group and Channel# +m1.logit.fit = glm(outcome_var ~ inquiry_degree_group + inquiry_channel, family= binomial(logit), data = training)# +m1.logit.modelAssess <- modelAssess(m1.logit.fit, testing)# +# +### Model 2 - Inquiry Degree Group, Channel and seasonality# +m2.logit.fit = glm(outcome_var ~ inquiry_degree_group + inquiry_channel + FID.month, family= binomial(logit), data = training)# +m2.logit.modelAssess <- modelAssess(m2.logit.fit, testing)# +# +### Model 3 - Inquiry Degree Group, Channel, seasonality and macroeconomics# +m3.logit.fit = glm(outcome_var ~ inquiry_degree_group + inquiry_channel + FID.month + UnempRate + JobOpenings_EdHealth, family= binomial(logit), data = training)# +m3.logit.modelAssess <- modelAssess(m3.logit.fit, testing)# +# +### Model 4 - Inquiry Degree Group, Channel, seasonality, macroeconomics and zipcode SES# +m4.logit.fit = glm(outcome_var ~ inquiry_degree_group + inquiry_channel + FID.month + UnempRate + JobOpenings_EdHealth + HC03_VC161 + HC01_VC85, family = binomial(logit), data = training)# +m4.logit.modelAssess <- modelAssess(m4.logit.fit, testing)# +# ### Model 4 Caret - GLM - Inquiry Degree Group, Channel and FID Month with 1 pass 10 fold cross validation# +# ctrl <- trainControl(method = "repeatedcv", repeats = 1, number = 3, classProbs = TRUE, summaryFunction = twoClassSummary)# +# m4c.fit <- train(make.names(outcome_var) ~ inquiry_degree_group + inquiry_channel + FID.month + UnempRate + JobOpenings_EdHealth + HC03_VC161 + HC01_VC85, data= training, method = "glm", trControl = ctrl, metric = "Sens")# +# m4c.PredClass <- predict(m4c.fit, select(testing, inquiry_degree_group, inquiry_channel, FID.monthUnempRate, JobOpenings_EdHealth, HC03_VC161, HC01_VC85))# +# confusionMatrix(m4c.PredClass, testing$Class)# +# ### Model 4 - adaBoost - Inquiry Degree Group, Channel and FID Month with 1 pass 10 fold cross validation# +# ctrl <- trainControl(method = "repeatedcv", repeats = 1, classProbs = TRUE, summaryFunction = twoClassSummary)# +# m4.fit <- train(Class ~ inquiry_degree_group + inquiry_channel + FID.month, data= training, method = "adaboost", trControl = ctrl, metric = "ROC")# +# m4.PredClass <- predict(m4.fit, select(testing, -outcome_var))# +# confusionMatrix(m4.PredClass, testing$Class)# +# +################ +## +# PLOT MODEL PERFORMANCE# +## +################ +par(mfrow=c(2,2))# +# +# Plot Persistence/Recall Curve# +plot(m1.logit.modelAssess$precrec, col=1, lwd=2, main="Precision/Recall Curve", xlim=c(0,1), ylim=c(0,1))# +plot(m2.logit.modelAssess$precrec, col=2, lwd=2, add=T)# +plot(m3.logit.modelAssess$precrec, col=3, lwd=2, add=T)# +plot(m4.logit.modelAssess$precrec, col=4, lwd=2, add=T)# +legend("bottomright",col=c(1:7),lwd=2,legend=c("M1","M2","M3","M4"),bty='n')# +# +# Plot F measure vs. Cutoff Curve# +plot(m1.logit.modelAssess$f, col=1, lwd=2, main="F Measure vs. Cutoff Value", xlim=c(0,1), ylim=c(0,1))# +plot(m2.logit.modelAssess$f, col=2, lwd=2, add=T)# +plot(m3.logit.modelAssess$f, col=3, lwd=2, add=T)# +plot(m4.logit.modelAssess$f, col=4, lwd=2, add=T)# +legend("bottomright",col=c(1:7),lwd=2,legend=c("M1","M2", "M3", "M4"),bty='n')# +# +# Plot ROC Curve# +plot(m1.logit.modelAssess$roc, col=1, lwd=2,main="ROC Curve")# +plot(m2.logit.modelAssess$roc, col=2, lwd=2, add=T)# +plot(m3.logit.modelAssess$roc, col=3, lwd=2, add=T)# +plot(m4.logit.modelAssess$roc, col=4, lwd=2, add=T)# +abline(a=0,b=1,lwd=2,lty=2,col="gray")# +legend("bottomright",col=c(1:8),lwd=2,legend=c("M1","M2","M3", "M4"),bty='n')# +###### +# CARET# +##### +# +#### Build Dataset# +# +# Pick the outcome variable and predictor variables# +# +#### Preprocessing# +# +# Create Dummy Variables# +# +# can use the model.matrix base R function here to make a numeric set of factors# +# model.matrix(survived ~ ., data = etitanic)# +# +# can also use dummyVars function# +# dummyVars(survived ~ ., data = etitanic) # note this is full rank and does not have an intercept# +# Remove Near Zero Variance Variables# +# +# can use nearZeroVar# +# +# nzv <- nearZeroVar(mdrrDescr)# +# filteredDescr <- mdrrDescr[, -nzv]# +# dim(filteredDescr)# +# +#### Sampling# +# +# set.seed(998)# +# inTraining <- createDataPartition(Sonar$Class, p = .75, list = FALSE)# +# training <- Sonar[ inTraining,]# +# testing <- Sonar[-inTraining,]# +#### Training# +# +# ctrl <- trainControl(method = "repeatedcv", repeats = 3, classProbs = TRUE, summaryFunction = twoClassSummary)# +# mx.logit.fit <- train(Class ~ inquiry_degree_group + inquiry_channel + FID.month, data= training, method = "glm", trControl = ctrl, metric = "ROC", preProc = c("center", "scale"))# +# +#### Compare Models# +# resamps <- resamples(list(GBM = gbmFit3,# +# SVM = svmFit,# +# RDA = rdaFit))# +# resamps# +# summary(resamps)# +# trellis.par.set(theme1)# +# bwplot(resamps, layout = c(3, 1))# +# trellis.par.set(caretTheme())# +# dotplot(resamps, metric = "ROC")# +# # +# # T-test differences in performance# +# difValues <- diff(resamps)# +# difValues# +# summary(difValues)# +# trellis.par.set(theme1)# +# bwplot(difValues, layout = c(3, 1)) +# Inquiry to Net Enroll Model Development# +## +# Sean Fahey# +# 2016-06-16# +## +# This script develops and compares models for predicting the likelihood that an inquiry will net enroll including both internal inquiry lifecycle view data as well# +# as external zip code data# +## +# +################# +## +# CONFIGURE ENVIRONMENT# +## +################## +# set working directory# +getwd()# +# setwd("/Users/sean.fahey/Google Drive/Analytics and Data/Modeling/Inquiry to Enroll/code/")# +# load needed packages# +library(dplyr)# +library(caret)# +library(zipcode)# +library (ROCR)# +source("modelAssess.R") +q() +library(MASS) +data(cats) +str(cats) +plot (bwt ~ hwt) +plot (cats$bwt ~ cats$hwt) +plot(cats$Bwt, cats$Hwt) +m <- glm(Bwt ~ Hwt, data = cats) +summary(m) +bwt2 <- predict(m,cats$Hwt) +bwt2 <- predict(m,data = cats$Hwt) +with(cats, plot( Bwt, Bwt2, Hgt)) +with(cats, plot( Bwt, Hgt, Bwt2, Hgt)) +plot(cats$Bwt, cats$Hwt, Bwt2, cats$Hwt) +plot(cats$Bwt, cats$Hwt) +abline(m) +q() +a<- c(1,2,NA,3) +b<- c(2,3,4,NA) +plot(a,b) +b<-c(b,3) +plot(a,b) +nrow(a) +nrows(a) +rows(a) +str(a) +len(a) +size(a) +length(a0) +length(a) +help(ave) +attach(warpbreaks)# +ave(breaks, wool)# +ave(breaks, tension)# +ave(breaks, tension, FUN = function(x) mean(x, trim = 0.1))# +plot(breaks, main =# + "ave( Warpbreaks ) for wool x tension combinations")# +lines(ave(breaks, wool, tension ), type = "s", col = "blue")# +lines(ave(breaks, wool, tension, FUN = median), type = "s", col = "green")# +legend(40, 70, c("mean", "median"), lty = 1,# + col = c("blue","green"), bg = "gray90")# +detach() +names(warpbreaks) +head(warpbreaks) +str(warpbreaks) +boxplot(breaks, wool) +boxplot(warpbreaks$breaks, warpbreaks$wool) +table(wool) +table(warpbreakswool) +table(warpbreaks$wool) +q() +help order +order?? +) +order +? order +q() +library(Rmonkey) +smlogin() +options(sm_secret = '247980397240465379297676830494544653711') +options(sm_client_id = 'xNrzuB4PTCaaQM326voPgA') +smlogin() +q() +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# Load the latest library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools")# +}# +install_github("seanofahey/Rmonkey")# +library("Rmonkey") +# get a long lasting oauth token# +smlogin() +options(sm_secret = '247980397240465379297676830494544653711') +options(sm_client_id = 'xNrzuB4PTCaaQM326voPgA') +smlogin() +userdetails() +userdetails +userdetails <- function(# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + u <- 'https://api.surveymonkey.net/v3/users/me'# + if(!is.null(oauth_token))# + token <- paste('bearer', oauth_token)# + else# + stop("Must specify 'oauth_token'. Try smlogin() first to get a token.")# + out <- POST(u, config = add_headers(Authorization=token))# + stop_for_status(out)# + content <- parsed_content(out)# + # if(content$status != 0)# + # warning("An error occurred: ",content$errmsg)# + structure(content$data$user_details, class='sm_userdetails')# +} +userdetails +userdetails() +library(httr) +library(curl) +userdetails() +u <- userdetails() +str(u) +u +userdetails <- function(# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + u <- 'https://api.surveymonkey.net/v3/users/me'# + if(!is.null(oauth_token))# + token <- paste('bearer', oauth_token)# + else# + stop("Must specify 'oauth_token'. Try smlogin() first to get a token.")# + out <- GET(u, config = add_headers(Authorization=token))# + stop_for_status(out)# + content <- parsed_content(out)# + # if(content$status != 0)# + # warning("An error occurred: ",content$errmsg)# + structure(content$data$user_details, class="sm_userdetails")# +} +userdetails() +q() +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# load needed libraries# +library(curl)# +library(httr)# +# +# Load the latest Rmonkey library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools")# +}# +install_github("seanofahey/Rmonkey")# +library("Rmonkey") +options(sm_secret = '247980397240465379297676830494544653711') +options(sm_client_id = 'xNrzuB4PTCaaQM326voPgA') +smlogin() +userdetails +userdetails() +u1 <- userdetails() +class(u1) +u1 +str(u1) +names(u1) +h <- add_headers(Authorization=token,# + 'Content-Type'='application/json') +oauth_token = getOption('sm_oauth_token') +oauth_token +u <- 'https://api.surveymonkey.net/v3/users/me' +token <- paste('bearer', oauth_token) +token +out <- GET(u, config = add_headers(Authorization=token,# + 'Content-Type'='application/json')) +out +str(out) +content <- parsed_content(out) +str(content) +userdetails <- function(# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + u <- 'https://api.surveymonkey.net/v3/users/me'# + if(!is.null(oauth_token))# + token <- paste('bearer', oauth_token)# + else# + stop("Must specify 'oauth_token'. Try smlogin() first to get a token.")# + out <- GET(u, config = add_headers(Authorization=token,# + 'Content-Type'='application/json'))# + stop_for_status(out)# + content <- parsed_content(out)# + # if(content$status != 0)# + # warning("An error occurred: ",content$errmsg)# + structure(content$data$user_details, class="sm_userdetails")# +} +userdetails() +u1 <- userdetails() +str(u1) +content +structure(content, class="sm_userdetails") +str(content) +u1 <- userdetails() +str(u1) +u1 +rm(list = ls()) +smlogin() +userdetails <- function(# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + u <- 'https://api.surveymonkey.net/v3/users/me'# + if(!is.null(oauth_token))# + token <- paste('bearer', oauth_token)# + else# + stop("Must specify 'oauth_token'. Try smlogin() first to get a token.")# + out <- GET(u, config = add_headers(Authorization=token,# + 'Content-Type'='application/json'))# + stop_for_status(out)# + content <- parsed_content(out)# + # if(content$status != 0)# + # warning("An error occurred: ",content$errmsg)# + structure(content, class="sm_userdetails")# +} +u1 <- userdetails() +str(u1) +sl <- surveylist() +sl +# Lookup userdetails to test API# +users <- userdetails()# +# +# Show a list of surveys# +sl <- surveylist() +sl +surveydetails(sl[[1]]) +sd1.q <- surveydetails(sl[[1]], question_details = TRUE) +str(sd1.q) +q() +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# load needed libraries# +library(curl)# +library(httr)# +# +# Load the latest Rmonkey library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools")# +}# +install_github("seanofahey/Rmonkey")# +library("Rmonkey")# +# +# Create a SurveyMonkey App to enable the API# +# 1) go to https://developer.surveymonkey.com/apps/ to create an app# +# 2) set the OAuth redirect URL as http://localhost:1410# +# 3) set the scope permissions (I used all the view ones but no create ones)# +# 4) note the following values from the App screen: clientID, Secret# +# Enter your app API info into R# +options(sm_client_id = 'YourMasheryDeveloperUsername')# +options(sm_secret = 'YourAPISecret')# +# +# Get a long lasting oauth token. This function completes the OAuth handshake# +# and saves a long lasting token on the computer. It needs to be done only once# +smlogin()# +# +# Lookup userdetails to test API# +users <- userdetails()# +# +# Show a list of surveys# +sl <- surveylist()# +# +# Display the list of surveys# +# (This shows each survey using the print.sm_survey function which overrides the standard# +# print function)# +sl# +# +# Get and display more details for the first survey on the list# +# (This uses the same print.sm_survey function but has more data to display)# +sd1 <- surveydetails(sl[[1]])# +# +# Get and display survey deatils including the details on the survey questions# +sd1.q <- surveydetails(sl[[1]], question_details = TRUE) +options(sm_client_id = 'xNrzuB4PTCaaQM326voPgA') +options(sm_secret = '247980397240465379297676830494544653711') +smlogin() +getOption(sm_oauth_token) +oauth_token = getOption('sm_oauth_token'), +oauth_token = getOption('sm_oauth_token') +oauth_token +# Lookup userdetails to test API# +users <- userdetails()# +# +# Show a list of surveys# +sl <- surveylist()# +# +# Display the list of surveys# +# (This shows each survey using the print.sm_survey function which overrides the standard# +# print function)# +sl# +# +# Get and display more details for the first survey on the list# +# (This uses the same print.sm_survey function but has more data to display)# +sd1 <- surveydetails(sl[[1]])# +# +# Get and display survey deatils including the details on the survey questions# +sd1.q <- surveydetails(sl[[1]], question_details = TRUE) +users +# Get and display more details for the first survey on the list# +# (This uses the same print.sm_survey function but has more data to display)# +sd1 <- surveydetails(sl[[1]])# +sd1# +# +# Get and display survey deatils including the details on the survey questions# +sd1.q <- surveydetails(sl[[1]], question_details = TRUE)# +sd1.q +str(sd1.q) +getresponses <- function(# + survey,# + collector = NULL,# + bulk = FALSE,# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + if (inherits(survey, 'sm_survey')) {# + survey$id <- survey$id# + } else {# + stop("'survey' is not of class sm_survey")# + }# + if (!is.null(collector)) {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses?', sep='') # + }# + } else {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses?', sep='') # + }# + }# + if (!is.null(oauth_token)) {# + token <- paste('bearer', oauth_token)# + } else {# + stop("Must specify 'oauth_token'")# + }# + h <- add_headers(Authorization=token,# + 'Content-Type'='application/json')# + out <- GET(u, config = h, ...)# + stop_for_status(out)# + content <- parsed_content(out)# + # if (content$status != 0) {# + # warning("An error occurred: ",content$errmsg)# + # return(content)# + # } else {# + if (!is.null(content$data)) {# + lapply(content$data, `class<-`, "sm_response")# + # content$data <- lapply(content$data, `attr<-`, 'survey_id', survey)# + }# + return(structure(content, class = 'sm_response_list'))# +} +getresponses(sl[[1]]) +sl1.r <- getresponses(sl[[1]]) +sl1.r[[1]] +sl1.r[[2]] +sl1.r$data[[1]] +class(sl1.r$data[[1]]) +class(sl1.r) +str(sl1.r) +lapply(sl1.r$data, `class<-`, "sm_response") +getresponses +getresponses <- function(# + survey,# + collector = NULL,# + bulk = FALSE,# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + if (inherits(survey, 'sm_survey')) {# + survey$id <- survey$id# + } else {# + stop("'survey' is not of class sm_survey")# + }# + if (!is.null(collector)) {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses?', sep='') # + }# + } else {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses?', sep='') # + }# + }# + if (!is.null(oauth_token)) {# + token <- paste('bearer', oauth_token)# + } else {# + stop("Must specify 'oauth_token'")# + }# + h <- add_headers(Authorization=token,# + 'Content-Type'='application/json')# + out <- GET(u, config = h, ...)# + stop_for_status(out)# + content <- parsed_content(out)# + # if (content$status != 0) {# + # warning("An error occurred: ",content$errmsg)# + # return(content)# + # } else {# + if (!is.null(content$data)) {# + lapply(content$data, `class<-`, "sm_response")# + }# + structure(content, class = 'sm_response_list')# +} +sl1.r <- getresponses(sl[[1]]) +class(sl1.r) +sl1.r +str(sl1.r) +lapply(sl1.r$data, `class<-`, "sm_response") +is.null(sl1.r$data) +!is.null(sl1.r$data) +getresponses <- function(# + survey,# + collector = NULL,# + bulk = FALSE,# + oauth_token = getOption('sm_oauth_token'),# + ...# +){# + if (inherits(survey, 'sm_survey')) {# + survey$id <- survey$id# + } else {# + stop("'survey' is not of class sm_survey")# + }# + if (!is.null(collector)) {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses?', sep='') # + }# + } else {# + if (bulk) {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses/bulk?', sep='') # + } else {# + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses?', sep='') # + }# + }# + if (!is.null(oauth_token)) {# + token <- paste('bearer', oauth_token)# + } else {# + stop("Must specify 'oauth_token'")# + }# + h <- add_headers(Authorization=token,# + 'Content-Type'='application/json')# + out <- GET(u, config = h, ...)# + stop_for_status(out)# + content <- parsed_content(out)# + if (!is.null(content$data)) {# + lapply(content$data, `class<-`, "sm_response")# + }# + structure(content, class = 'sm_response_list')# +} +getresponses +getresponses(sl[[2]]) +sl2.r <- getresponses(sl[[2]]) +class(sl2.r) +class(sl2.r$data) +class(sl2.r$data[[1]]) +sl2.r$data +sl2.r$data[[1]] +lapply(sl2.r$data, `class<-`, "sm_response") +# Show the responses to a survey# +sl1.r <- getresponses(sl[[1]]) +sl1.r +surveyquestions(sl[[1]]) +sl1.q <- surveyquestions(sl[[1]]) +class(sl1.q) +str(sl1.q) +surveypreview(sl[[1]]) +sd1 +sl1.q <- surveyquestions() +sl1.q <- surveyquestions(sl[[1]]) +sl1.q +sl1.rd <- getresponses(sl[[1]], bulk = TRUE) +sl1.rd +sl1.rd <- getresponses(sl[[1]], bulk = TRUE) +q() +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# load needed libraries# +library(curl)# +library(httr)# +# +# Load the latest Rmonkey library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools") +} +install_github("seanofahey/Rmonkey")# +library("Rmonkey") +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# load needed libraries# +library(curl)# +library(httr)# +# +# Load the latest Rmonkey library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools")} +install_github("seanofahey/Rmonkey")# +library("Rmonkey") +smlogin +q() +getwd() +setwd(../) +setwd("../") +dir() +setwd("../") +dir() +setwd("../") +dir() +setwd("Users/") +dir() +setwd("sean.fahey/") +dir() +setwd("Rmonkey/") +dir() +# RMonkey library demo# +## +# Sean Fahey# +# 2016-12-28# +## +# This program shows how the RMonkey library can be used to access SurveyMonkey data# +# via API V3.# +## +# +# load needed libraries# +library(curl)# +library(httr)# +library(jsonlite)# +library(dplyr)# +# +# Load the latest Rmonkey library from github# +if(!require("devtools")) {# + install.packages("devtools")# + library("devtools")# +}# +install_github("seanofahey/Rmonkey")# +library("Rmonkey") +ls(pos = package:"Rmonkey") +ls(pos = "package:Rmonkey") +q() diff --git a/DESCRIPTION b/DESCRIPTION index 63643dc..a0b039f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,17 +1,30 @@ Package: Rmonkey -Version: 0.3.3 -Date: 2016-03-20 +Version: 0.5 +Date: 2016-12-28 Title: A Survey Monkey R Client Authors@R: c(person("Thomas J.", "Leeper", role = c("aut", "cre"), email = "thosjleeper@gmail.com"), + person("Sean", "Fahey", role = "ctb", + email = "seanmfahey@yahoo.com"), person("Kevin", "Little", role = "ctb", email = "klittle@iecodesign.com"), person("David", "Robinson", role = "ctb", email = "drobinson@stackoverflow.com"), person("Stephan", "Renatus", role = "ctb")) Maintainer: Thomas J. Leeper -Imports: stats, utils, httr, jsonlite, curl, plyr -Description: Programmatic access to the Survey Monkey API , which currently provides extensive functionality for monitoring surveys and retrieving survey results and some functionality for creating new surveys and data collectors. +Imports: + stats, + utils, + httr, + jsonlite, + curl, + plyr +Description: Programmatic access to the Survey Monkey API , which currently provides extensive functionality + for monitoring surveys and retrieving survey results and some functionality for + creating new surveys and data collectors. License: GPL-2 URL: https://github.com/cloudyr/Rmonkey BugReports: https://github.com/cloudyr/Rmonkey/issues +RoxygenNote: 5.0.1 + diff --git a/NAMESPACE b/NAMESPACE index dcf5e4b..28a1683 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,30 +1,12 @@ -export('smlogin') -export('userdetails') -export('surveylist') -export('surveydetails') -export('surveyquestions') -export('surveypreview') -export('collectors') -export('createcollector') -export('responsecounts') -export('respondentlist') -export('getresponses') -export('getallresponses') -export('templates') -export('createsurvey') +# Generated by roxygen2: do not edit by hand -S3method(print, 'sm_survey') -S3method(print, 'sm_collector') -S3method(print, 'sm_respondent') -S3method(print, 'sm_response') -S3method(print, 'sm_template') - -S3method(as.data.frame, 'sm_response') -S3method(as.data.frame, 'sm_response_list') - -importFrom('stats', 'setNames') -importFrom('utils', 'head', 'browseURL') -importFrom('plyr', 'rbind.fill') -importFrom('curl', 'curl_escape') -import('httr') -import('jsonlite') +export(getresponses) +export(print.sm_response) +export(print.sm_survey) +export(smlogin) +export(surveydetails) +export(surveylist) +export(surveypreview) +export(surveyquestions) +export(surveyresponses) +export(userdetails) diff --git a/NEWS b/NEWS index 3e87d81..ef264eb 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,14 @@ +# CHANGES TO Rmonkey 0.5 # + +## SIGNIFICANT USER-VISIBLE CHANGES ## +* Rebuilt several functions to work with SurkeyMonkey API V3 (smlogin, userdetails, surveylist, surveydetails) +* + +## BUG FIXES ## + +## DOCUMENTATION ## +* added Roxygen comments to new functions + # CHANGES TO Rmonkey 0.4 # ## SIGNIFICANT USER-VISIBLE CHANGES ## diff --git a/R/asdataframe.R b/R/asdataframe.R index c219488..9380aaf 100644 --- a/R/asdataframe.R +++ b/R/asdataframe.R @@ -12,65 +12,83 @@ as.data.frame.sm_response <- function(x, row.names, optional, details = NULL, st } else { stop("'details' is missing and cannot be determined automatically") } + + survey<-x + # These first functions unpack the surveydetails() with questions + details <- surveydetails(survey, question_details = TRUE) + + # extract all questions from the `question` element in all pages + # note: this assumes that all data records are identical and so the first can be used as a model questions <- do.call('c', lapply(details$pages, function(i) i[['questions']])) + # `type` contains info about each question type qtypes <- sapply(questions, function(i) { - fam <- i$type$family + fam <- i$family if (fam == "matrix") { - setNames(paste0(fam, "_", i$type$subtype), i$question_id) + setNames(paste0(fam, "_", i$subtype), i$id) } else { - setNames(fam, i$question_id) + setNames(fam, i$id) } }) + # set variable names varnames <- sapply(questions, function(i) { # `heading` is the display text - setNames(i$heading, i$question_id) + setNames(i$heading, i$id) }) + # alternate method which reuses an existing function and cleans HTML tags + varnames2 <- surveyquestions(survey) + # extract all answers from the `answers` elements of each subelement of `question` # `answer_id` is what is recorded in `sm_response` # `text` is the display seen by respondents # `answers` is empty for "open_ended" type questions answerchoices <- sapply(questions, function(i) { out <- list() - for (k in seq_along(i$answers)) { - if (i$type$family == "matrix") { - if (i$type$subtype == "rating") { - if (i$answers[[k]]$type == "other") { - out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$answer_id) - } else { - # exclude "col" values from matrix questions - if (i$answers[[k]]$type == "row") { - out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$answer_id) - } - } - out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$answer_id) - } else if (i$type$subtype == "menu") { - if (i$answers[[k]]$type == "col") { - tmp_txt <- unlist(lapply(i$answers[[k]]$items, `[`, "text")) - tmp_ans <- unlist(lapply(i$answers[[k]]$items, `[`, "answer_id")) - out[[k]] <- setNames(tmp_txt, tmp_ans) - rm(tmp_txt) - rm(tmp_ans) - } - } - } else { - out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$answer_id) - } + for (k in seq_along(i$answers$choices)) { + # if (i$family == "matrix") { + # if (i$subtype == "rating") { + # if (i$answers[[k]]$type == "other") { + # out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$id) + # } else { + # # exclude "col" values from matrix questions + # if (i$answers[[k]]$type == "row") { + # out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$id) + # } + # } + # out[[k]] <- setNames(i$answers[[k]]$text, i$answers[[k]]$id) + # } else if (i$type$subtype == "menu") { + # if (i$answers[[k]]$type == "col") { + # tmp_txt <- unlist(lapply(i$answers[[k]]$items, `[`, "text")) + # tmp_ans <- unlist(lapply(i$answers[[k]]$items, `[`, "id")) + # out[[k]] <- setNames(tmp_txt, tmp_ans) + # rm(tmp_txt) + # rm(tmp_ans) + # } + # } + # } else { + out[[k]] <- setNames(i$answers$choices[[k]]$text, i$answers$choices[[k]]$id) + # } } return(unlist(out)) }) answerchoices <- unlist(do.call(c, answerchoices)) + # extract question_ids - question_ids <- unlist(sapply(x$questions, `[`, 'question_id')) - # count number of answers per question - nanswers <- integer() - for (i in seq_along(x$questions)) { - nanswers[i] <- length(x$questions[[i]]$answers) - } - rm(i) + question_ids <- unlist(sapply(questions, `[`, 'id')) + + # # count number of answers per question + # nanswers <- integer() + # for (i in seq_along(x$questions)) { + # nanswers[i] <- length(x$questions[[i]]$answers) + # } + # rm(i) + + # count the number of answer choices per question + nanswers <- sapply(questions, function(x) {length(x$answers$choices)}) + # create vector of answer names by repeating question names `nanswers` times each answer_names <- rep(question_ids, nanswers) diff --git a/R/getresponses.r b/R/getresponses.r index 23e5c9c..4488e0b 100644 --- a/R/getresponses.r +++ b/R/getresponses.r @@ -1,87 +1,173 @@ +#' getresponses +#' +#' Get responses for a SurveyMonkey survey +#' +#' @param survey A sm_survey object, as retrieved by \code{surveylist()}. +#' @param collector A sm_collector object, as retrieved by \code{collectorlist}. By default = NULL +#' @param bulk A logical variable to indicate if list response should include a list of full expanded responses, including answers to all questions. By default = FALSE +#' @param page Integer number to select which page of resources to return. By default is 1. +#' @param per_page Integer number to set the number of surveys to return per page. By default, is 50 surveys per page. +#' @param start_created_at Date string used to select surveys created after this date. By default is NULL. +#' @param end_created_at Date string used to select surveys modified before this date. By default is NULL. +#' @param start_modified_at Date string used to select surveys last modified after this date. By default is NULL. +#' @param end_modified_at Date string used to select surveys modified before this date. By default is NULL. +#' @param sort_order String used to set the sort order for returned surveys: 'ASC’ or 'DESC’. By default, DESC. +#' @param sort_by String value of field used to sort returned survey list: ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified. +#' @param oauth_token Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}. +#' @return A list of object of class {sm_response} +#' @references SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#survey-responses} +#' @export getresponses +#' @export print.sm_response +# +# get a set of bulk responses (this will get 50 responses with the following structure: +# $per_page : int = total number of responses per page +# $total : int = number of survey responses +# $data[[x]] : list = list with an entry for each individual survey response +# $total_time : int = time spent on the survey +# $href : chr = api url for survey response +# $custom_variables : list = custom variables for respondents +# $ip_address : chr = IP address for respondent +# $id : chr = id of survey response +# $logic_path : list +# $date_modified : chr = date survey response last modified +# $response_status : chr = status of response {completed, partial, etc...} +# $custom_value : chr = ? +# $analyze_url : chr = web browsable url to view responses +# $pages : list = list with data for questions and answers on each survey page +# $id : chr = id +# $ questions : list +# $ id : chr = id +# $ answers : list +# $ choice_id : chr = id of answer choice +# $page_path : list = ? +# $recipient_id : chr = id of survey recipient +# $collector_id : chr = id of survey collector +# $date_created : chr = date the survey response was started +# $survey_id : chr = id of the survey +# $collection_mode : chr = ? +# $edit_url : chr = web browsable url to modify responses +# $metadata : list = list with additional information about respondent +# $contact : list +# $contact$first_name : list +# $contact$first_name$type : chr = type for first_name$value variable +# $contact$first_name$value : chr = respondent first name +# $contact$last_name : list +# $contact$last_name$type : chr = type for last_name$value variable +# $contact$lasy_name$value : chr = respondent last name +# $contact$email : list +# $contact$email$type : chr = type for email variable +# $contact$email$value : chr = respondent email address +# $page : int = page of responses +# $links : list = urls for the previous ($last), current ($self) and next ($next) response pages +# ) + + + getresponses <- function( - respondents, survey, - api_key = getOption('sm_api_key'), + collector = NULL, + bulk = FALSE, + page = 1, + all_pages = FALSE, + per_page = NULL, + start_created_at = NULL, + end_created_at = NULL, + start_modified_at = NULL, + end_modified_at = NULL, + sort_order = 'DESC', + sort_by = 'date_modified', oauth_token = getOption('sm_oauth_token'), ... ){ - if (missing(survey)) { - svals <- unique(unlist(lapply(respondents, `[`, "survey_id"))) - if (length(svals) > 1) { - stop("'respondents' must all come from one survey") + if (inherits(survey, 'sm_survey')) { + survey$id <- survey$id + } else { + stop("'survey' is not of class sm_survey") + } + if (!is.null(collector)) { + if (bulk) { + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses/bulk?', sep='') + } else { + u <- paste('https://api.surveymonkey.net/v3/collectors/',collector$id,'/responses?', sep='') } - survey <- svals[1] } else { - if (inherits(survey, 'sm_survey')) { - survey <- survey$survey_id + if (bulk) { + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses/bulk?', sep='') } else { - stop("'survey' is missing and could not be extracted from 'respondents'") + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey$id,'/responses?', sep='') } } - if (inherits(respondents, "sm_respondent")) { - respondents <- respondents$respondent_id - } else if (is.list(respondents)) { - respondents <- unname(sapply(respondents, `[`, "respondent_id")) - } - if (!is.null(api_key)) { - u <- paste('https://api.surveymonkey.net/v2/surveys/get_responses?', - 'api_key=', api_key, sep='') - } else - stop("Must specify 'api_key'") if (!is.null(oauth_token)) { token <- paste('bearer', oauth_token) } else { - stop("Must specify 'oauth_token'") + stop("Must specify 'oauth_token', Try using smlogin() first.") } - if (length(respondents)>100) { - respondents <- head(respondents, 100) - warning("Maximum number of respondents exceeded. Only first 100 used.") - } - h <- add_headers(Authorization=token, + if (inherits(start_created_at, "POSIXct") | inherits(start_created_at, "Date")) { + start_created_at <- format(start_created_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + } + if (inherits(end_created_at, "POSIXct") | inherits(end_created_at, "Date")) { + end_created_at <- format(end_created_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + } + if (inherits(start_modified_at, "POSIXct") | inherits(start_modified_at, "Date")) { + start_modified_at <- format(start_modified_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + } + if (inherits(end_modified_at, "POSIXct") | inherits(end_modified_at, "Date")) { + end_modified_at <- format(end_modified_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + } + + # need to add error checking for status + b <- list(page = page, + per_page = per_page, + start_created_at = start_created_at, + end_created_at = end_created_at, + start_modified_at = start_modified_at, + end_modified_at = end_modified_at, + sort_order = sort_order, + sort_by = sort_by) + nulls <- sapply(b, is.null) + if (all(nulls)) { + b <- NULL + } else { + b <- b[!nulls] + } + h <- httr::add_headers(Authorization=token, 'Content-Type'='application/json') - b <- toJSON(list(respondent_ids = as.list(respondents), survey_id = survey), auto_unbox = TRUE) - out <- POST(u, config = h, ..., body = b) - stop_for_status(out) - content <- content(out, as='parsed') - if (content$status != 0) { - warning("An error occurred: ",content$errmsg) - return(content) - } else { - if (!is.null(content$data)) { - lapply(content$data, `class<-`, 'sm_response') - content$data <- lapply(content$data, `attr<-`, 'survey_id', survey) - } - return(structure(content$data, class = 'sm_response_list')) + + + out <- httr::GET(u, config = h, ..., query = b) + httr::stop_for_status(out) + parsed_content <- httr::content(out, as = 'parsed') + if (!is.null(parsed_content$data)) { + lapply(parsed_content$data, `class<-`, "sm_response") + } + structure(parsed_content, class = 'sm_response_list') + + # build data frame from reponses + responses <- parsed_content$data + + # recursively get all responses if all_pages = TRUE + if (all_pages == TRUE & (!is.null(parsed_content$links[['next']]))) { + rnext <- getresponses (survey, + collector, + bulk, + page = page + 1, + all_pages, + per_page, + start_created_at, + end_created_at, + start_modified_at, + end_modified_at, + sort_order, + sort_by) + responses <- c(responses, rnext) } + return (responses) } print.sm_response <- function(x, ...){ - if (!is.null(x$respondent_id)) { - cat('Respondent ID:',x$respondent_id,'\n') + if (!is.null(x$id)) { + cat('Respondent ID:',x$id,'\n') } invisible(x) } -getallresponses <- function( - survey, - api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), - wait = 0, - ... -) { - r <- respondentlist(survey, api_key = api_key, oauth_token = oauth_token, ...) - Sys.sleep(wait) - respondents <- unname(sapply(r, `[`, "respondent_id")) - Sys.sleep(wait) - n <- ceiling(length(respondents)/100) - w <- split(1:length(respondents), rep(1:n, each = 100)[1:length(respondents)]) - out <- list() - for (i in seq_len(n)) { - out <- c(out, getresponses(unlist(respondents[w[[i]]]), survey = survey, - api_key = api_key, oauth_token = oauth_token, ...)) - Sys.sleep(wait) - } - class(out) <- 'sm_response_list' - d <- surveydetails(survey, api_key = api_key, oauth_token = oauth_token, ...) - as.data.frame(out, details = d) -} diff --git a/R/smlogin.r b/R/smlogin.r index 6891b67..cc97fc9 100644 --- a/R/smlogin.r +++ b/R/smlogin.r @@ -1,30 +1,44 @@ +#' smlogin +#' +#' Obtains a long lasting oauth token for API access. +#' +#' This function takes as input a SurveyMonkey API account client ID and +#' secret code and conducts the oauth2 authentication process to return +#' an oauth token. The client_id and secret values can be obtained from the settings +#' section of the appropriate SurveyMonkey apps page at https://developer.surveymonkey.com/apps/ +#' + +#' @param client_id Your SurveyMonkey App client_id. By default, retrieved from \code{getOption('sm_client_id')}. +#' @param secret Your API secret key. By default, retrieved from \code{getOption('sm_secret')}. +#' @param redirect_uri Default value is \url{http://localhost:1410}. No other value is allowed. This must be the redirect URL registered for your application in your Survey Monkey developer account. +#' @param response_type Default value is \code{code}. No other values are allowed. +#' @return oauth_token +#' @export smlogin + smlogin <- function(client_id = getOption('sm_client_id'), - api_key = getOption('sm_api_key'), secret = getOption('sm_secret'), redirect_uri = 'http://localhost:1410', - response_type='code'){ - if(is.null(client_id)) - stop("Must supply developer username as 'client_id'") - if(is.null(api_key)) - stop("Must supply developer API key as 'api_key'") - if(is.null(secret)) - stop("Must supply developer secret key as 'secret'") - a <- list(response_type = response_type, - redirect_uri = redirect_uri, - client_id = client_id, - api_key = api_key) - a <- paste(names(a), curl_escape(a), sep='=', collapse='&') - e <- structure(list(authorize = 'https://api.surveymonkey.net/oauth/authorize', - access = 'https://api.surveymonkey.net/oauth/token'), class='oauth_endpoint') - e$authorize <- paste(e$authorize,a,sep='?') - e$access <- paste(e$access,'?api_key=',api_key,sep='') - smapp <- oauth_app('surveymonkey', client_id, secret) - - token <- oauth2.0_token(e, smapp, use_oob = FALSE, cache = FALSE) - if('error' %in% names(token$credentials)){ - warning('OAuth error ', token$credentials$error, - ': ', token$credentials$error_description, sep='') - } else - options('sm_oauth_token' = token$credentials$access_token) - invisible(token) + response_type = 'code') { + if (is.null(client_id)) + stop("Must supply developer username as 'client_id'") + if (is.null(secret)) + stop("Must supply developer secret key as 'secret'") + a <- list(response_type = response_type, + redirect_uri = redirect_uri, + client_id = client_id) + a <- paste(names(a), + curl::curl_escape(a), + sep = '=', + collapse = '&') + e <- structure(list(authorize = 'https://api.surveymonkey.net/oauth/authorize', + access = 'https://api.surveymonkey.net/oauth/token'), + class = 'oauth_endpoint') + e$authorize <- paste(e$authorize, a, sep = '?') + smapp <- httr::oauth_app('surveymonkey', client_id, secret) + token <- httr::oauth2.0_token(e, smapp, use_oob = FALSE, cache = FALSE) + if ('error' %in% names(token$credentials)) { + warning('OAuth error ', token$credentials$error, ': ', token$credentials$error_description, sep = '') + } else + options('sm_oauth_token' = token$credentials$access_token) + invisible(token) } diff --git a/R/surveydetails.r b/R/surveydetails.r index 3f34dfb..bdc2340 100644 --- a/R/surveydetails.r +++ b/R/surveydetails.r @@ -1,51 +1,157 @@ +#' surveydetails +#' +#' Get detailed information about a survey +#' +#' \code{sureydetails()}This function calls the SurveyMonkey API using the current oauth token and returns +#' details about a survey including the number of pages, questions, answer choices, +#' urls, etc... +#' +#' \code{surveyquestions()}This function extracts a named character vector of question wordings +#' from a \dQuote{sm_survey} object. This can be useful for creating a codebook of responses or for mapping +#' responses (from \code{\link{getresponses}}) to the original question wordings. +#' +#' \code{surveypreview} opens a survey preview url in a web browser via \code{\link[utils]{browseURL}}. +#' +#' @param survey A sm_survey object, as retrieved by \code{surveylist()}. +#' @param question_detail A logical value to indicate whether to include details on questions and answer choices. By default = TRUE. +#' @param oauth_token Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}. +#' +#' @return A list of objects of class \code{sm_survey}. +#' @references SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} +#' @export surveydetails +#' @export print.sm_survey +#' @export surveyquestions +#' @export surveypreview +#' @keywords +#' +# +# This function returns details about a SurveyMonkey survey in the list structure based on the +# JSON response format +# +# $response_count : int = total number of responses +# $pages_count : int = number of pages in the survey +# $buttons_text : list of chr = display text for buttons +# $custom_variables : named list = ? +# $nickname : chr = short name for survey +# $id : chr = SurveyMonkey id for the survey +# $question_count : int = total number of questions on the survey +# $category : chr = broad category for survey +# $preview : chr = web browsable url to preview the survey +# $is_owner : logical = is user owner of the survey(?) +# $language : chr = langauge the survey is written in +# $date_modified : chr = date/time when survey was last modified +# $title : chr = survey title +# $analyze_url : chr = web browsable url to analyze responses +# $pages : list +# $ href : chr = api accessible weblink for data on this page +# $ description : chr = text displayed at top of page +# $ questions : list = length is the number of questions on the page +# $ display_options : list +# $ show_display_number : logical +# $ sorting : +# $ type : (e..g, random) +# $ ignore_last +# $ family : chr = general style of question (e.g., matrix, single-choice) +# $ subtype : chr = detailed style of question (e.g., single) +# $ required : +# $ text: chr = text to display if not answered(?) +# $ amount : chr = +# $ type : chr = ? +# $ answers : list +# $ rows : list = used in matrix questions to store row headings +# $ visible +# $ text +# $ position +# $ id +# $ choices : list +# $ description : chr = (used in matrix questions?) +# $ weight : int = (used in matrix questions?) +# $ is_na : logical = (used in matrix questions?) +# $ visible : logical +# $ text : chr = answerchoice text +# $ position : int = answerchoice position +# $ id : chr = answerchoice id +# $ visible : logical +# $ href : api accessible weblink for this question +# $ headings : list +# $ heading : chr = HTML text displayed with question +# $ position : int = display position for question on the page +# $ validation : +# $ id : chr = id for the question +# $ forced_ranking : logical +# $ title : chr +# $ position : int +# $ id : id for page +# $ question_count : int = number of questions on this page +# $summary_url : chr = web browsable url for survey summary +# $href : chr = api accessible web link for survey data +# $date_created : chr = date survey originally created +# $collect_url : chr = web browsable url to collect responses +# $edit_url : chr = web browsable url to edit the survey + surveydetails <- function( survey, - api_key = getOption('sm_api_key'), + question_details = TRUE, oauth_token = getOption('sm_oauth_token'), ... ){ if(inherits(survey, 'sm_survey')) - survey <- survey$survey_id - if(!is.null(api_key)) { - u <- paste('https://api.surveymonkey.net/v2/surveys/get_survey_details?', - 'api_key=', api_key, sep='') - } else - stop("Must specify 'api_key'") - if(!is.null(oauth_token)) - token <- paste('bearer', oauth_token) + survey <- survey$id + if(question_details) { + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey,'/details?',sep='') + } + else + u <- paste('https://api.surveymonkey.net/v3/surveys/',survey,'?',sep='') + if(!is.null(oauth_token)) { + token <- paste('bearer', oauth_token) + } else - stop("Must specify 'oauth_token'") - h <- add_headers(Authorization=token, + stop("Must specify 'oauth_token'. Try using smlogin() first.") + h <- httr::add_headers(Authorization=token, 'Content-Type'='application/json') - b <- toJSON(list(survey_id = survey), auto_unbox = TRUE) - out <- POST(u, config = h, ..., body = b) - stop_for_status(out) - content <- content(out, as='parsed') - if(content$status != 0) { - warning("An error occurred: ",content$errmsg) - return(content) - } else - structure(content$data, class='sm_survey') + out <- httr::GET(u, config = h, ...) + httr::stop_for_status(out) + parsed_content <- httr::content(out, as = 'parsed') + structure(parsed_content, class = "sm_survey") } -surveyquestions <- function( - survey, - details, - api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), - ... -){ - if (!missing(survey)) { - d <- surveydetails(survey, api_key = api_key, oauth_token = oauth_token, ...) - } else { - d <- details - } +surveyquestions <- function(survey){ + d <- surveydetails(survey, oauth_token = getOption('sm_oauth_token'), question_details = TRUE) questions <- unlist(unlist(lapply(d$pages, `[`, "questions"), recursive = FALSE), recursive = FALSE) - n <- unname(unlist(lapply(questions, `[`, "question_id"))) - w <- unname(unlist(lapply(questions, `[`, "heading"))) + n <- unname(unlist(lapply(questions, `[`, "id"))) + w <- unname(unlist(lapply(questions, `[`, "headings"))) + w <- gsub("<.*?>", "", w) structure(w, names = n, class = c("character", "sm_surveyquestions")) } -surveypreview <- function(details) { - browseURL(details$preview_url) +surveypreview <- function(survey) { + d <- surveydetails(survey, oauth_token = getOption('sm_oauth_token')) + browseURL(d$preview) } + +print.sm_survey <- function(x, ...){ + if(!is.null(x$title)) + cat('Survey Title:', x$title, '\n') + if(!is.null(x$nickname)) + cat('Survey Nickname:', x$nickname, '\n') + if(!is.null(x$id)) + cat('ID:', x$id, '\n') + if(!is.null(x$language)) + cat('Language:', x$language, '\n') + if(!is.null(x$question_count)) + cat('No. of Questions:', x$question_count, '\n') + if(!is.null(x$response_count)) + cat('Respondents:', x$response_count, '\n') + if(!is.null(x$preview)) + cat('Preview URL:', x$preview, '\n') + if(!is.null(x$analyze_url)) + cat('Analysis URL:', x$analyze_url, '\n') + if(!is.null(x$date_created)) + cat('Date Created: ', x$date_created, '\n') + if(!is.null(x$date_modified)) + cat('Date Modified:', x$date_modified, '\n') + if(!is.null(x$pages)) + cat('Survey Pages:', length(x$pages), '\n') + invisible(x) +} + diff --git a/R/surveylist.r b/R/surveylist.r index 52cf2eb..4d3293e 100644 --- a/R/surveylist.r +++ b/R/surveylist.r @@ -1,74 +1,64 @@ +#' surveylist +#' +#' Get the list of the user's surveys. +#' +#' This function calls the SurveyMonkey API using the current oauth token and returns +#' a list of surveys filtered by the parameters entered. +#' +#' @param page Integer number to select which page of resources to return. By default is 1. +#' @param per_page Integer number to set the number of surveys to return per page. By default, is 50 surveys per page. +#' @param sort_by String used to sort returned survey list: ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified. +#' @param sort_order String used to set the sort order for returned surveys: 'ASC’ or 'DESC’. By default, DESC. +#' @param start_modified_at Date string used to select surveys last modified after this date. By default is NULL. +#' @param end_modified_at Date string used to select surveys modified before this date. By default is NULL. +#' @param title String used to select survey by survey title. By default is NULL. +#' @param include Comma separated strings used to filter survey list: 'shared_with’, 'shared_by’, or 'owned’ (useful for teams) or to specify additional fields to return per survey: 'response_count’, 'date_created’, 'date_modified’, 'language’, 'question_count’, 'analyze_url’, 'preview’. By default is NULL. +#' @param oauth_token Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}. +#' @return A list of objects of class \code{sm_survey}. +#' @references SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} +#' @export surveylist + + surveylist <- function( page = NULL, - page_size = NULL, - start_date = NULL, - end_date = NULL, + per_page = NULL, + sort_by = NULL, + sort_order = NULL, + start_modified_at = NULL, + end_modified_at = NULL, title = NULL, - recipient_email = NULL, - order_asc = NULL, - fields = NULL, - api_key = getOption('sm_api_key'), + include = NULL, oauth_token = getOption('sm_oauth_token'), ... ){ - if(!is.null(api_key)) { - u <- paste('https://api.surveymonkey.net/v2/surveys/get_survey_list?', - 'api_key=', api_key, sep='') - } else - stop("Must specify 'api_key'") - if(!is.null(oauth_token)) + if(!is.null(oauth_token)){ + u <- 'https://api.surveymonkey.net/v3/surveys?' token <- paste('bearer', oauth_token) + } else stop("Must specify 'oauth_token'") - if(inherits(start_date, "POSIXct") | inherits(start_date, "Date")) - start_date <- format(start_date, "%Y-%m-%d %H:%M:%S", tz = "UTC") - if(inherits(end_date, "POSIXct") | inherits(end_date, "Date")) - end_date <- format(end_date, "%Y-%m-%d %H:%M:%S", tz = "UTC") - b <- list(page = page, page_size = page_size, - start_date = start_date, end_date = end_date, - title = title, recipient_email = recipient_email, - order_asc = order_asc, fields = as.list(fields)) + if(inherits(start_modified_at, "POSIXct") | inherits(start_modified_at, "Date")) + start_modified_at <- format(start_modified_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + if(inherits(end_modified_at, "POSIXct") | inherits(end_modified_at, "Date")) + end_modified_at <- format(end_modified_at, "%Y-%m-%d %H:%M:%S", tz = "UTC") + b <- list( page = page, + per_page = per_page, + sort_by = sort_by, + sort_order = sort_order, + start_modified_at = start_modified_at, + end_modified_at = end_modified_at, + title = title, + include = include) nulls <- sapply(b, is.null) if(all(nulls)) - b <- '{}' + b <- NULL else - b <- toJSON(b[!nulls], auto_unbox = TRUE) - h <- add_headers(Authorization=token, + b <- b[!nulls] + h <- httr::add_headers(Authorization=token, 'Content-Type'='application/json') - out <- POST(u, config = h, ..., body = b) - stop_for_status(out) - content <- content(out, as='parsed') - if(content$status != 0){ - warning("An error occurred: ",content$errmsg) - return(content) - } else - lapply(content$data$surveys, `class<-`, 'sm_survey') -} - -print.sm_survey <- function(x, ...){ - if(!is.null(x$title)) { - if(is.list(x$title)) - cat('Survey Title:', x$title$text, '\n') - else - cat('Survey Title:', x$title, '\n') - } - if(!is.null(x$survey_id)) - cat('ID:', x$survey_id, '\n') - if(!is.null(x$language_id)) - cat('Language:', x$language_id, '\n') - if(!is.null(x$question_count)) - cat('No. of Questions:', x$question_count, '\n') - if(!is.null(x$num_responses)) - cat('Respondents:', x$num_responses, '\n') - if(!is.null(x$preview_url)) - cat('Preview URL:', x$preview_url, '\n') - if(!is.null(x$analysis_url)) - cat('Analysis URL:', x$analysis_url, '\n') - if(!is.null(x$date_created)) - cat('Date Created: ', x$date_created, '\n') - if(!is.null(x$date_modified)) - cat('Date Modified:', x$date_modified, '\n') - if(!is.null(x$pages)) - cat('Survey Pages:', length(x$pages), '\n') - invisible(x) -} + out <- httr::GET(u, config = h, ..., query = b) + httr::stop_for_status(out) + parsed_content <- httr::content(out, as = 'parsed') + sl <- parsed_content$data + lapply(sl, `class<-`, 'sm_survey') +} \ No newline at end of file diff --git a/R/surveyquestions.R b/R/surveyquestions.R new file mode 100644 index 0000000..a6a7c4f --- /dev/null +++ b/R/surveyquestions.R @@ -0,0 +1,134 @@ +#' surveyquestions +#' +#' Creates a data frame from the survey questions and answers +#' +#' @param survey A sm_survey object, as retrieved by \code{surveylist()}. +#' @return A data frame with one row per question/subquestion/answer choice +#' @export surveyquestions +#' +surveyquestions <- function(survey) { + df <- data.frame() + sd <- surveydetails(survey, question_details = TRUE) + survey_id <- sd$id + questions <- + do.call('c', lapply(sd$pages, function(i) + i[['questions']])) + for (i in questions) { + question_id <- i$id + question_type <- i$family + question_subtype <- i$subtype + question_text <- gsub("<.*?>", "",unlist(i$heading)) + + j <- 0 + # use a repeat loop to account for cases where there are no answer rows + repeat { + j <- j + 1 # increment counter first for array indexing + if (is.null(i$answers$rows)) { + subquestion_id <- NA + subquestion_text <- NA + } else { + subquestion_id <- i$answers$rows[[j]]$id + subquestion_text <- i$answers$rows[[j]]$text + } + k <- 0 + repeat { + k <- k + 1 # increment counter first for array indexing + if (is.null(i$answers$choices)) { + answerchoice_id <- NA + answerchoice_text <- NA + answerchoice_weight <- NA + } else { + answerchoice_id <- i$answers$choices[[k]]$id + answerchoice_text <- i$answers$choices[[k]]$text + if (!is.null(i$answers$choices[[k]]$weight)) { + answerchoice_weight <- + i$answers$choices[[k]]$weight + } else { + answerchoice_weight <- NA + } + } + newrow <- + data.frame( + survey_id, + question_id, + subquestion_id, + answerchoice_id, + question_type, + question_subtype, + question_text, + subquestion_text, + answerchoice_text, + answerchoice_weight, + stringsAsFactors = FALSE, + check.rows = FALSE + ) + + # append a second new row for other options on select questions + if(!is.null(i$answers$other) & k == 1) { + answerchoice_id <- i$answers$other$id + answerchoice_text <- i$answers$other$text + answerchoice_weight <- NA + newrow2 <- + data.frame( + survey_id, + question_id, + subquestion_id, + answerchoice_id, + question_type, + question_subtype, + question_text, + subquestion_text, + answerchoice_text, + answerchoice_weight, + stringsAsFactors = FALSE, + check.rows = FALSE + ) + newrow <- rbind(newrow, newrow2) + } + + # add new row(s) to dataframe + df <- rbind(df, newrow) + if (k >= length(i$answers$choices)) { + break + } + } + if (j >= length(i$answers$rows)) { + break + } + } + + } + return(df) +} + +# Future work +# +# This code works but is inelegant since it uses loops (for and repeat) vs. using vectorized approaches like lapply +# or data table approaches like those in dplyr. To use lapply, I have to solve how to nest the functions +# so I can both manage cases where there are no rows for some answers (e.g., single choice answers) and the +# case where there are multiple rows per answer which require applying the choices to each row. +# To use dplyr, I need to figure out how to build tables that I can join for quesitons, answer rows, and +# answer choices. The trick here, is figuring out how to include the question id as a key in the +# answer row and answer choice tables. Some work to this end is below: + +# One can use the lapply in the inner call here to extract the answers$rows elements but they lack the +# question_id. The index of the lapply array is the question number but once the do.call is applied +# that structure is lost. +# answerrows <- do.call('c', lapply(questions, function(i) i[['answers']][['rows']])) +# answerchoices <- answerchoices <- do.call('c', lapply(questions, function(i) i[['answers']][['choices']])) + +# These functions make data frames from the resulting data. If the question ids were included they could be joined +# with dplyr to offer a more elegant solution +# q_df <- do.call(rbind, lapply(questions, function(x) data.frame(question_id = x$id, question_type = x$family, question_subtype = x$subtype, question_text = x$heading, stringsAsFactors = FALSE))) +# ac_df <- do.call(rbind, lapply(answerchoices, function(x) data.frame(answerchoice_text = x$text, answerchoice_id = x$id, stringsAsFactors = FALSE))) +# ar_df <- do.call(rbind, lapply(answerrows, function(x) data.frame(subquestion_text = x$text, subquestion_id = x$id, stringsAsFactors = FALSE))) + +# these work but don't preserve the question ID in the ar and ac frames preventing joining + +# experiment to extract row data and then apply question ids as names +# q_id <- do.call('c', lapply(questions, function(i) i[['id']])) +# ar <- lapply(questions, function(i) i[['answers']][['rows']]) + +# write the question_id into the answer row list prior to unpacking +# for (i in 1:length( ar) ) {if (!is.null(ar[[i]])) {ar[[i]]$rows$question_id <- questions[[i]]$id}} +# setNames(ar, q_id) diff --git a/R/surveyresponses.r b/R/surveyresponses.r new file mode 100644 index 0000000..ab96383 --- /dev/null +++ b/R/surveyresponses.r @@ -0,0 +1,112 @@ +#' surveyresponses +#' +#' Extracts data from the survey responses data set and formats it as a data frame for analysis +#' +#' @param survey A sm_survey object, as retrieved by \code{surveylist()}. +#' @param response_format A string indicating the desired data frame response format: 'Table' = one survey response per row and one column per question, or 'Column' = a key/value arrangement with each row holding data for a single question response +#' @return A data frame with survey responses +#' @export surveyresponses + + +surveyresponses <- function(survey, + response_format) { + + if (missing(response_format)) {response_format = 'table'} + + df <- data.frame() + sr <- getresponses(survey, bulk = TRUE, all_page = TRUE, per_page = 100) + sq <- surveyquestions(survey) + survey_id <- survey$id + + # Iterate through responses + for (h in sr) { + response_id <- h$id + recipient_id <- h$recipient_id + collector_id <- h$collector_id + questions <- + do.call('c', lapply(h$pages, function(x) + x[['questions']])) + for (i in questions) { + question_id <- i$id + j <- 0 + # use a repeat loop to account for cases where there are no answer rows + repeat { + j <- j + 1 # increment counter first for array indexing + answertext <- NA + if (is.null(i$answers[[j]]$row_id)) { + subquestion_id <- NA + } else { + subquestion_id <- i$answers[[j]]$row_id + } + if (is.null(i$answers[[j]]$choice_id)) { + if (is.null(i$answers[[j]]$other_id)) { + answerchoice_id <- NA + answertext <- i$answers[[j]]$text + } else { + answerchoice_id <-i$answers[[j]]$other_id + answertext <- i$answers[[j]]$text + } + } else { + answerchoice_id <- i$answers[[j]]$choice_id + } + newrow <- + data.frame( + response_id, + survey_id, + recipient_id, + collector_id, + question_id, + subquestion_id, + answerchoice_id, + answertext, + stringsAsFactors = FALSE, + check.rows = FALSE + ) + df <- rbind(df, newrow) + if (j >= length(i$answers)) { + break + } + } + } + } + + # join responses to question data + df <- dplyr::left_join (df, sq, by = c("survey_id", "question_id", "subquestion_id", "answerchoice_id")) + + # Combine the two question headers to make a single one + df$question_text_full <- + ifelse ( + df$question_type == 'multiple_choice', + paste(df$question_text, "-", df$answerchoice_text), + ifelse( + !is.na(df$subquestion_text), + paste(df$question_text, "-", df$subquestion_text), + paste(df$question_text) + ) + ) + + # # Remove rows with NA as question_text (these are the 'other' responses that still need to be managed) + # df <- df[!is.na(df$question_text_full),] + + # for text responses replace the answerchoice field with the text + df$answerchoice_text[!is.na(df$answertext)] <- df$answertext[!is.na(df$answertext)] + + # Select only the columns for the final dataframe + df <- dplyr::select(df, response_id, survey_id, collector_id, recipient_id, question_text_full, answerchoice_text) + + if (tolower(response_format) == 'column') {return(df)} else { + + # remove any duplicate rows (need to change questiontext to quesiton ID to avoid this) + df <- df[!duplicated(df),] + + # Spread from column to tablular form + df_table <- tidyr::spread(df, question_text_full, answerchoice_text) + + return(df_table)} + +} + + # Future work + # + + # do.call(rbind, lapply(i$answers, function(x) data.frame(answerchoice_id = x$choice_id, subquestion_id = x$row_id, stringsAsFactors = FALSE))) \ No newline at end of file diff --git a/R/userdetails.r b/R/userdetails.r index b0487b1..673834f 100644 --- a/R/userdetails.r +++ b/R/userdetails.r @@ -1,21 +1,27 @@ -userdetails <- function( - api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), - ... -){ - if(!is.null(api_key)) { - u <- paste('https://api.surveymonkey.net/v2/user/get_user_details?', - 'api_key=', api_key, sep='') - } else - stop("Must specify 'api_key'") - if(!is.null(oauth_token)) - token <- paste('bearer', oauth_token) - else - stop("Must specify 'oauth_token'") - out <- POST(u, config = add_headers(Authorization=token), ...) - stop_for_status(out) - content <- content(out, as='parsed') - if(content$status != 0) - warning("An error occurred: ",content$errmsg) - structure(content$data$user_details, class='sm_userdetails') -} +#' userdetails +#' +#' Obtains information about SurveyMonkey user. +#' +#' This function calls the SurveyMonkey API using the current oauth token and returns +#' information about the SurveyMonkey user and account associated with the token. It can be used +#' as a "Hello World" after \code{smlogin} +#' +#' @param oauth_token Your OAuth 2.0 token, as generated by \code{\link{smlogin}}. By default, retrieved from \code{getOption('sm_oauth_token')}. +#' @return An object of class \code{sm_userdetails}. +#' @references SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#users-me} +#' @export userdetails + + +userdetails <- function(oauth_token = getOption('sm_oauth_token'), ...) { + u <- 'https://api.surveymonkey.net/v3/users/me' + if (!is.null(oauth_token)) + token <- paste('bearer', oauth_token) + else + stop("Must specify 'oauth_token'. Try smlogin() first to get a token.") + out <- httr::GET(u, config = httr::add_headers(Authorization = token, + 'Content-Type' = 'application/json')) + httr::stop_for_status(out) + parsed_content <- httr::content(out, as='parsed') + structure(parsed_content, class = "sm_userdetails") + return(parsed_content) +} \ No newline at end of file diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..27b0bf8 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,118 @@ +--- +title: "README" +author: "Thomas" +author: "Sean Fahey" +date: "3/30/2017" +output: html_document +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +**Rmonkey** provides access to [Survey Monkey](https://www.surveymonkey.com/), for the complete integration of survey data collection and analysis into a single, easily reproducible workflow. + +## Installation ## + +This version of **Rmonkey** is updated to interface with the SurveyMonkey API v3. The latest development version, available here, can be installed directly using [devtools](http://cran.r-project.org/web/packages/devtools/index.html): + +```{r} +if(!require("devtools")) { + install.packages("devtools") + library("devtools") +} +install_github("seanofahey/Rmonkey") +library("Rmonkey") +``` + +## Setup ## + +To use Rmonkey, the user must first have a Survey Monkey account which can be obtained at https://www.surveymonkey.com/user/sign-in/. Next, within the SurveyMonkey account, the user must create an app that can be used to access data via the api. This can be done at https://developer.surveymonkey.com/apps/. In the app configuration, set OAuth Redirect URL as `http://localhost:1410`. Finally set the user permissions for creating and viewing data within SurveyMonkey with the scopes options. + +Once the app is configured, click on settings to reveal the Client ID and Secret keys. These can be loaded into R using `options`: + +```{r} +options(sm_client_id = 'YourClientID') +options(sm_secret = 'YourAPISecret') +``` + +Rmonkey uses these values inside `smlogin` to initiate an OAuth2.0 login. Calling `smlogin()`, you will redirected to your web browser, where you will login with your regular Survey Monkey account information. `sm_login` will then store a durable OAuth token in `options('sm_oauth_token')`, which is automatically retrieved in subsequent Rmonkey operations. + +This token is currently long-lived (meaning it is valid indefinitely). This means that saving the OAuth token between R sessions will prevent you from having to login each time you load **Rmonkey** and allow you to use the package in non-interactive R sessions. If you have trouble logging in, it is also possible to copy the OAuth access token from the [App Settings](https://developer.surveymonkey.com/apps), which can then be manually stored in `options('sm_oauth_token')`. + +## Code Examples ## + +Below are some code examples showing how to use the package. + +### Establish and Test the API Connection ### + +To establish a connection between R and SurveyMonkey use the `smlogin()` function. This will open an interactive session in your browser to present the API permissions and request authorization. This function completes the OAuth handshake and saves a long lasting token on the computer. + +```{r} +smlogin() +``` + +To verify that the connection is functional you can retrieve information about the user with the `userdetails()` function. + +```{r} +userdetails() +``` + +## Get a list of Surveys ### + +**RMonkey** provides several options for retrieving information about the surveys in the account. + +One can retrieve a list of surveys using the `surveylist()` command. This will return a list with details of each survey. + +```{r} +sl <- surveylist() +head(sl) +``` + +To retrieve a list of surveys that have been modified since a certain date one can use the `start_modified_at` parameter within the `surveylist()` function. + +```{r} +sl <- surveylist(start_modified_at = '2017-03-25') +head(sl) +``` + +Additional parameters can be used to change the number of responses, add fields to the survey list response, and sort the responses. + +```{r} +sl <- surveylist(per_page = 100, include = 'response_count', sort_by = 'num_responses', sort_order = 'desc') +head(sl) +``` + +## Get Details about a survey ## + +To see details about a single survey use the `surveydetails()` function. This will return basic information about the survey including the title, nickname, ID, number of questions, number of respondents, etc... + +```{r} +s1.d <- surveydetails(sl[[1]]) +s1.d +``` + +## Preview a Survey in the Browser ## + +To see a preview of a survey use the `surveypreview()` function. In the function, pass a survey object retrieved using the survey list function. This will open a tab in your browser to display the survey preview. + +```{r} +surveypreview(sl[[1]]) +``` + +## Retrieve Survey Responses ## + +To get a list of responses for a survey use the `surveyresponses()` function. In the function, pass a survey object retrieved using the survey list function. This will return a data frame with one row per response and one column per question. (NOTE: This can take a long time to run.) + +```{r} +s1.r <- surveyresponses(sl[[5]]) +head(s1.r) +``` + +To get the survey results into a columnar format use the response_format = 'column' parameter. (This can be useful if exporting the data to systems that ingest data in this format.) + +```{r} +s1.r <- surveyresponses(sl[[5]], response_format = 'column') +head(s1.r) +``` + diff --git a/README.md b/README_old.md similarity index 100% rename from README.md rename to README_old.md diff --git a/RMonkey Demo.R b/RMonkey Demo.R new file mode 100644 index 0000000..560cd29 --- /dev/null +++ b/RMonkey Demo.R @@ -0,0 +1,118 @@ +# RMonkey library demo +# +# Sean Fahey +# 2016-12-28 +# +# This program shows how the RMonkey library can be used to access SurveyMonkey data +# via API V3. +# + +# load needed libraries +# library(curl) +# library(httr) +# library(jsonlite) +library(dplyr) +library(tidyr) + +# Load the latest Rmonkey library from github +if(!require("devtools")) { + install.packages("devtools") + library("devtools") +} +install_github("seanofahey/Rmonkey") +library("Rmonkey") + +# Create a SurveyMonkey App to enable the API +# 1) go to https://developer.surveymonkey.com/apps/ to create an app +# 2) set the OAuth redirect URL as http://localhost:1410 +# 3) set the scope permissions (I used all the view ones but no create ones) +# 4) note the following values from the App screen: clientID, Secret + + +# Enter your app API info into R +options(sm_client_id = 'YourClientID') +options(sm_secret = 'YourAPISecret') + +# Get a long lasting oauth token. This function completes the OAuth handshake +# and saves a long lasting token on the computer. It needs to be done only once +smlogin() + +### USER FUNCTIONS + +# Lookup userdetails to test API +userdetails() + +### SURVEY FUNCTIONS + +# Get and display a list of surveys +sl <- surveylist() +# print the sm_survey object using the print.sm_survey function +sl +# show the structure of the sm_survey object +str(sl[[1]]) + +# Return a specific list of surveys +sl <- surveylist(per_page = 100, include = 'response_count', sort_by = 'num_responses', sort_order = 'desc') +sl + +# Return surveys that have been modified since a certain date +sl <- surveylist(start_modified_at = '2016-12-25') +sl + + +# Get and display survey deatils without the details of the survey questions +s1.d <- surveydetails(sl[[1]], question_details = FALSE) +# (This uses the same print.sm_survey function but has more data to display) +s1.d +# show the expanded details for the survey +str(s1.d) + + +# Get and display more details for the first survey on the list +s1.dq <- surveydetails(sl[[1]]) +# show the survey summary +s1.dq +# show the expanded details for the survey with all the question data +str(s1.dq) + + +# Show just the questions for a survey +sl1.q <- surveyquestions(sl[[1]]) +sl1.q + +# Open browser to a web preview of the survey +surveypreview(sl[[1]]) + +# Get a dataframe with details on each question in the survey +s1_df <- surveyquestiondf(sl[[1]]) +str(s1_df) + +### SURVEY RESPONSE FUNCTIONS + +# Show the list of response ids to a survey +s1.r <- getresponses(sl[[1]]) +s1.r + +# Show the expanded list of responses including answers to all questions +s1.rd <- getresponses(sl[[1]], bulk = TRUE) + +# Generate a data frame with response data +s1.r_df <- as.data.frame.surveyresponses(sl[[1]]) +str(s1.r_df) + +### CREATE A CLEAN DATA FRAME (to move into a function) + +# Join response data with question data to decode responses +s1.r_decode <- left_join (s1.r_df, s1_df) + +# Combine the two question headers to make one +s1.r_decode$question_text_full <- ifelse(!is.na(s1.r_decode$subquestion_text), + paste(s1.r_decode$question_text, " - ", s1.r_decode$subquestion_text), + paste(s1.r_decode$question_text) +) + +# Select only the columns for the final dataframe +s1.r_decode_sm <- select(s1.r_decode, response_id, survey_id, collector_id, recipient_id, question_text_full, answerchoice_text) + +# Spread from column to tablular form +s1.r_table <- spread(s1.r_decode_sm, question_text_full, answerchoice_text) \ No newline at end of file diff --git a/Rmonkey.Rproj b/Rmonkey.Rproj new file mode 100644 index 0000000..21a4da0 --- /dev/null +++ b/Rmonkey.Rproj @@ -0,0 +1,17 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/man/getresponses.Rd b/man/getresponses.Rd index 983a212..da42ada 100644 --- a/man/getresponses.Rd +++ b/man/getresponses.Rd @@ -1,52 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getresponses.r \name{getresponses} \alias{getresponses} -\alias{getallresponses} -\alias{print.sm_response} -\title{Get responses} -\description{Get responses for a survey} +\title{getresponses} \usage{ -getresponses(respondents, survey, - api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), ...) - -getallresponses(survey, api_key, oauth_token, wait = 0, ...) +getresponses(survey, collector = NULL, bulk = FALSE, page = 1, + all_pages = FALSE, per_page = NULL, start_created_at = NULL, + end_created_at = NULL, start_modified_at = NULL, end_modified_at = NULL, + sort_order = "DESC", sort_by = "date_modified", + oauth_token = getOption("sm_oauth_token"), ...) } \arguments{ -\item{respondents}{A vector containing up to 100 respondent ID numbers, possibly returned by \code{\link{respondentlist}}.} -\item{survey}{A Survey Monkey survey ID number (or an object of class \dQuote{sm_survey} from which it can be extracted), possibly returned by \code{\link{surveylist}}. If missing, the function will try to find an appropriate value in \code{respondents}.} -\item{api_key}{Your API key. By default, retrieved from \code{getOption('sm_api_key')}.} -\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{\link{smlogin}}. By default, retrieved from \code{getOption('sm_oauth_token')}.} -\item{wait}{A time, in seconds, to wait between API calls. This can be used to throttle API request in order to avoid going over limits.} -\item{...}{Other arguments passed to \code{\link[httr]{POST}}.} -} -\details{Retrieves response data for requested respondents to a specified survey. \code{getresponses()} retrieves a list structure that can be further parsed using an \code{as.data.frame} method. \code{getallresponses()} returns a data.frame of all responses for a survey automatically using just the survey ID. +\item{survey}{A sm_survey object, as retrieved by \code{surveylist()}.} -Note: Text responses returned are truncated after 32,768 characters. +\item{collector}{A sm_collector object, as retrieved by \code{collectorlist}. By default = NULL} -Note: Surveys with over 500,000 responses are not available via the API currently.} -\value{ -For \code{getresponses()}, a list (of class \code{sm_response_list}) containing one or more objects of class \code{sm_response}. +\item{bulk}{A logical variable to indicate if list response should include a list of full expanded responses, including answers to all questions. By default = FALSE} + +\item{page}{Integer number to select which page of resources to return. By default is 1.} + +\item{per_page}{Integer number to set the number of surveys to return per page. By default, is 50 surveys per page.} + +\item{start_created_at}{Date string used to select surveys created after this date. By default is NULL.} + +\item{end_created_at}{Date string used to select surveys modified before this date. By default is NULL.} + +\item{start_modified_at}{Date string used to select surveys last modified after this date. By default is NULL.} -For \code{getallresponses()}, a data.frame. +\item{end_modified_at}{Date string used to select surveys modified before this date. By default is NULL.} + +\item{sort_order}{String used to set the sort order for returned surveys: 'ASC’ or 'DESC’. By default, DESC.} + +\item{sort_by}{String value of field used to sort returned survey list: ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified.} + +\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}.} } -\references{ -\url{https://developer.surveymonkey.com/mashery/get_responses} +\value{ +A list of object of class {sm_response} } -\author{Thomas J. Leeper} -%\note{} -%\seealso{} -\examples{ -\dontrun{ -smlogin() -s <- surveylist() -r <- respondentlist(s[[1]]) - -# get one response -getresponses(r[[1]]) - -# get all responses (up to 100) -g <- getresponses(r) -as.data.frame(g) # convert to data.frame +\description{ +Get responses for a SurveyMonkey survey } +\references{ +SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#survey-responses} } -%\keyword{} + diff --git a/man/sm_login.Rd b/man/sm_login.Rd deleted file mode 100644 index 5d65851..0000000 --- a/man/sm_login.Rd +++ /dev/null @@ -1,29 +0,0 @@ -\name{smlogin} -\alias{smlogin} -\title{OAuth Login} -\description{Login into Survey Monkey to generate an OAuth 2.0 token} -\usage{ -smlogin(client_id = getOption('sm_client_id'), - api_key = getOption('sm_api_key'), - secret = getOption('sm_secret'), - redirect_uri = 'http://localhost:1410', - response_type='code') -} -\arguments{ -\item{client_id}{Your Mashery developer account username. By default, retrieved from \code{getOption('sm_client_id')}.} -\item{api_key}{Your API key. By default, retrieved from \code{getOption('sm_api_key')}.} -\item{secret}{Your API secret key. By default, retrieved from \code{getOption('sm_secret')}.} -\item{redirect_uri}{Default value is \samp{http://localhost:1410}. No other value is allowed. This must be the redirect URL registered for your application in your Survey Monkey developer account.} -\item{response_type}{Default value is \dQuote{code}. No other values are allowed.} -\item{...}{Other arguments passed to \code{\link[httr]{POST}}.} -} -\details{Initiate an interactive OAuth 2.0 authentication process by logging into Survey Monkey via a web browser.} -\value{An OAuth 2.0 token object as returned by \code{oauth2.0_token}.} -%\references{} -\author{Thomas J. Leeper} -%\note{} -%\seealso{} -\examples{ -\dontrun{smlogin()} -} -%\keyword{} diff --git a/man/smlogin.Rd b/man/smlogin.Rd new file mode 100644 index 0000000..025e7d5 --- /dev/null +++ b/man/smlogin.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/smlogin.r +\name{smlogin} +\alias{smlogin} +\title{smlogin} +\usage{ +smlogin(client_id = getOption("sm_client_id"), + secret = getOption("sm_secret"), redirect_uri = "http://localhost:1410", + response_type = "code") +} +\arguments{ +\item{client_id}{Your SurveyMonkey App client_id. By default, retrieved from \code{getOption('sm_client_id')}.} + +\item{secret}{Your API secret key. By default, retrieved from \code{getOption('sm_secret')}.} + +\item{redirect_uri}{Default value is \url{http://localhost:1410}. No other value is allowed. This must be the redirect URL registered for your application in your Survey Monkey developer account.} + +\item{response_type}{Default value is \code{code}. No other values are allowed.} +} +\value{ +oauth_token +} +\description{ +Obtains a long lasting oauth token for API access. +} +\details{ +This function takes as input a SurveyMonkey API account client ID and +secret code and conducts the oauth2 authentication process to return +an oauth token. The client_id and secret values can be obtained from the settings +section of the appropriate SurveyMonkey apps page at https://developer.surveymonkey.com/apps/ +} + diff --git a/man/surveydetails.Rd b/man/surveydetails.Rd index 5664151..ed70a54 100644 --- a/man/surveydetails.Rd +++ b/man/surveydetails.Rd @@ -1,50 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/surveydetails.r \name{surveydetails} \alias{surveydetails} -\alias{surveyquestions} -\alias{surveypreview} -\title{Get survey details} -\description{Get details about a specific survey} +\title{surveydetails} \usage{ -surveydetails(survey, api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), ...) +surveydetails(survey, question_details = TRUE, + oauth_token = getOption("sm_oauth_token"), ...) +} +\arguments{ +\item{survey}{A sm_survey object, as retrieved by \code{surveylist()}.} -surveyquestions(survey, details, api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), ...) +\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}.} -surveypreview(details) +\item{question_detail}{A logical value to indicate whether to include details on questions and answer choices. By default = TRUE.} } -\arguments{ -\item{survey}{A Survey Monkey survey ID number (or an object of class \dQuote{sm_survey} from which it can be extracted), possibly returned by \code{\link{surveylist}}. For \code{surveyquestions}, either \code{survey} or \code{details} must be supplied.} -\item{details}{For \code{surveyquestions}, either \code{survey} or \code{details} must be supplied. \code{details} must be supplied as an object of class \code{sm_surveydetails}. If missing, a \code{\link{surveydetails}} request will be executed for the survey supplied in the \code{survey} argument.} -\item{api_key}{Your API key. By default, retrieved from \code{getOption('sm_api_key')}.} -\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{\link{smlogin}}. By default, retrieved from \code{getOption('sm_oauth_token')}.} -\item{...}{Other arguments passed to \code{\link[httr]{POST}}.} +\value{ +A list of objects of class \code{sm_survey}. +} +\description{ +Get detailed information about a survey } \details{ -\code{surveydetails} retrieves details of a specified survey (e.g., question metadata). Surveys with over 200 survey pages will not be returned. Surveys with over 200 questions will not be returned. +\code{sureydetails()}This function calls the SurveyMonkey API using the current oauth token and returns +details about a survey including the number of pages, questions, answer choices, +urls, etc... -\code{surveyquestions} extracts a named character vector of question wordings from a \dQuote{sm_surveydetails} object. This can be useful for creating a codebook of responses or for mapping responses (from \code{\link{getresponses}}) to the original question wordings. +\code{surveyquestions()}This function extracts a named character vector of question wordings +from a \dQuote{sm_survey} object. This can be useful for creating a codebook of responses or for mapping +responses (from \code{\link{getresponses}}) to the original question wordings. \code{surveypreview} opens a survey preview url in a web browser via \code{\link[utils]{browseURL}}. } -\value{For \code{surveydetails}, a list of objects of class \code{sm_survey}. For \code{surveyquestions}, a character vector with Survey Monkey question ID values as names.} \references{ -\url{https://developer.surveymonkey.com/mashery/get_survey_details} +SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} } -\author{Thomas J. Leeper} -%\note{} -%\seealso{} -\examples{ -\dontrun{ -smlogin() -s <- surveylist() +\keyword{} -# retrieve all survey details -d <- surveydetails(s[[1]]$survey_id) -d - -# retrieve question wordings -surveyquestions(d) -} -} -%\keyword{} diff --git a/man/surveylist.Rd b/man/surveylist.Rd index dc90c6b..8449230 100644 --- a/man/surveylist.Rd +++ b/man/surveylist.Rd @@ -1,44 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/surveylist.r \name{surveylist} \alias{surveylist} -\alias{print.sm_survey} -\title{Get survey list} -\description{Get the list of the user's survey} +\title{surveylist} \usage{ -surveylist(page = NULL, page_size = NULL, - start_date = NULL, end_date = NULL, - title = NULL, recipient_email = NULL, - order_asc = NULL, fields = NULL, - api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), ...) +surveylist(page = NULL, per_page = NULL, sort_by = NULL, + sort_order = NULL, start_modified_at = NULL, end_modified_at = NULL, + title = NULL, include = NULL, oauth_token = getOption("sm_oauth_token"), + ...) } \arguments{ -\item{page}{A number indicating which page of results to return.} -\item{page_size}{The number of results to return per API call. Default is 1000.} -\item{start_date}{A start datetime to restrict result to. Any returned surveys must have been created on or after this datetime. Required format is \code{YYYY-MM-DD HH:MM:SS}, implicitly in UTC; if argument is of class \code{POSIXct}, formatting is handled automatically.} -\item{end_date}{An end datetime to restrict result to. Any returned surveys must have been created strictly before this datetime. Required format is \code{YYYY-MM-DD HH:MM:SS}, implicitly in UTC; if argument is of class \code{POSIXct}, formatting is handled automatically.} -\item{title}{A character string containing the title of a survey to search for.} -\item{recipient_email}{A character string containing an email adddress. Only surveys sent to this email will be returned.} -\item{order_asc}{A boolean indicating whether results should be sorted in ascending or descending (the default) order.} -\item{fields}{A character vector containing the names of fields to return in each \code{sm_collector} class object. See Details.} -\item{api_key}{Your API key. By default, retrieved from \code{getOption('sm_api_key')}.} -\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{\link{smlogin}}. By default, retrieved from \code{getOption('sm_oauth_token')}.} -\item{...}{Other arguments passed to \code{\link[httr]{POST}}.} -} -\details{Retrieves the list of surveys available to the user. +\item{page}{Integer number to select which page of resources to return. By default is 1.} + +\item{per_page}{Integer number to set the number of surveys to return per page. By default, is 50 surveys per page.} + +\item{sort_by}{String used to sort returned survey list: ‘title’, 'date_modified’, or 'num_responses’. By default, date_modified.} + +\item{sort_order}{String used to set the sort order for returned surveys: 'ASC’ or 'DESC’. By default, DESC.} + +\item{start_modified_at}{Date string used to select surveys last modified after this date. By default is NULL.} + +\item{end_modified_at}{Date string used to select surveys modified before this date. By default is NULL.} -The \code{fields} argument accepts one or more of the following values: \code{title}, \code{analysis_url}, \code{preview_url}, \code{date_created}, \code{date_modified}, \code{language_id}, \code{question_count}, \code{num_responses}. +\item{title}{String used to select survey by survey title. By default is NULL.} + +\item{include}{Comma separated strings used to filter survey list: 'shared_with’, 'shared_by’, or 'owned’ (useful for teams) or to specify additional fields to return per survey: 'response_count’, 'date_created’, 'date_modified’, 'language’, 'question_count’, 'analyze_url’, 'preview’. By default is NULL.} + +\item{oauth_token}{Your OAuth 2.0 token, as generated by \code{smlogin}. By default, retrieved from \code{getOption('sm_oauth_token')}.} } -\value{A list of objects of class \code{sm_survey}.} -\references{ -\url{https://developer.surveymonkey.com/mashery/get_survey_list} +\value{ +A list of objects of class \code{sm_survey}. } -\author{Thomas J. Leeper} -%\note{} -%\seealso{} -\examples{ -\dontrun{ -smlogin() -surveylist() +\description{ +Get the list of the user's surveys. } +\details{ +This function calls the SurveyMonkey API using the current oauth token and returns +a list of surveys filtered by the parameters entered. } -%\keyword{} +\references{ +SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#surveys} +} + diff --git a/man/surveyquestions.Rd b/man/surveyquestions.Rd new file mode 100644 index 0000000..874c665 --- /dev/null +++ b/man/surveyquestions.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/surveyquestions.R +\name{surveyquestions} +\alias{surveyquestions} +\title{surveyquestions} +\usage{ +surveyquestions(survey) +} +\arguments{ +\item{survey}{A sm_survey object, as retrieved by \code{surveylist()}.} +} +\value{ +A data frame with one row per question/subquestion/answer choice +} +\description{ +Creates a data frame from the survey questions and answers +} + diff --git a/man/surveyresponses.Rd b/man/surveyresponses.Rd new file mode 100644 index 0000000..1fe4141 --- /dev/null +++ b/man/surveyresponses.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/surveyresponses.r +\name{surveyresponses} +\alias{surveyresponses} +\title{surveyresponses} +\usage{ +surveyresponses(survey) +} +\arguments{ +\item{survey}{A sm_survey object, as retrieved by \code{surveylist()}.} +} +\value{ +A data frame with survey responses +} +\description{ +Extracts data from the survey responses data set and formats it as a data frame for analysis +} + diff --git a/man/userdetails.Rd b/man/userdetails.Rd index a76aa42..2185ba9 100644 --- a/man/userdetails.Rd +++ b/man/userdetails.Rd @@ -1,28 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/userdetails.r \name{userdetails} \alias{userdetails} -\title{Get User Details} -\description{Once logged in, get basic details about the user account.} +\title{userdetails} \usage{ -userdetails(api_key = getOption('sm_api_key'), - oauth_token = getOption('sm_oauth_token'), ...) +userdetails(oauth_token = getOption("sm_oauth_token"), ...) } \arguments{ -\item{api_key}{Your API key. By default, retrieved from \code{getOption('sm_api_key')}.} \item{oauth_token}{Your OAuth 2.0 token, as generated by \code{\link{smlogin}}. By default, retrieved from \code{getOption('sm_oauth_token')}.} -\item{...}{Other arguments passed to \code{\link[httr]{POST}}.} } -\details{This function retrieves basic details about a user. It can be used as a hello world test after \code{\link{smlogin}}.} -\value{An object of class \code{sm_userdetails}.} -\references{ -\url{https://developer.surveymonkey.com/mashery/get_user_details} +\value{ +An object of class \code{sm_userdetails}. +} +\description{ +Obtains information about SurveyMonkey user. } -\author{Thomas J. Leeper} -%\note{} -%\seealso{} -\examples{ -\dontrun{ -smlogin() -userdetails() +\details{ +This function calls the SurveyMonkey API using the current oauth token and returns +information about the SurveyMonkey user and account associated with the token. It can be used +as a "Hello World" after \code{smlogin} } +\references{ +SurveyMonkey API V3 at \url{https://developer.surveymonkey.com/api/v3/#users-me} } -%\keyword{} +