R/asdataframe.R

Defines functions as.data.frame.HITs as.data.frame.Assignments as.data.frame.QualificationRequirements as.data.frame.QualificationTypes as.data.frame.QualificationRequests as.data.frame.Qualifications as.data.frame.QuestionForm as.data.frame.HTMLQuestion as.data.frame.ExternalQuestion as.data.frame.AnswerKey as.data.frame.QuestionFormAnswers as.data.frame.ReviewResults as.data.frame.BonusPayments as.data.frame.WorkerBlock

Documented in as.data.frame.AnswerKey as.data.frame.Assignments as.data.frame.BonusPayments as.data.frame.ExternalQuestion as.data.frame.HITs as.data.frame.HTMLQuestion as.data.frame.QualificationRequests as.data.frame.QualificationRequirements as.data.frame.Qualifications as.data.frame.QualificationTypes as.data.frame.QuestionForm as.data.frame.QuestionFormAnswers as.data.frame.ReviewResults as.data.frame.WorkerBlock

# HITs

as.data.frame.HITs <-
function(xml.parsed,
         return.hit.xml = FALSE, 
         return.qual.list = TRUE, 
         sandbox = getOption('MTurkR.sandbox')) {
    hit.xml <- xpathApply(xml.parsed, "//HIT")
    if (!is.null(length(hit.xml))) {
        quals <- list()
        HITs <- emptydf(length(hit.xml), 19, c("HITId", "HITTypeId", "CreationTime", 
            "Title", "Description", "Keywords", "HITStatus", 
            "MaxAssignments", "Amount", "AutoApprovalDelayInSeconds", 
            "Expiration", "AssignmentDurationInSeconds", "NumberOfSimilarHITs", 
            "HITReviewStatus", "RequesterAnnotation", "NumberOfAssignmentsPending", 
            "NumberOfAssignmentsAvailable", "NumberOfAssignmentsCompleted", 
            "Question"))
        for (i in 1:length(hit.xml)) {
            q <- xpathApply(xml.parsed, "//HIT")[[i]]
            HITs[i, 1] <- xmlValue(xmlChildren(q)$HITId)
            HITs[i, 2] <- xmlValue(xmlChildren(q)$HITTypeId)
            HITs[i, 3] <- xmlValue(xmlChildren(q)$CreationTime)
            HITs[i, 4] <- xmlValue(xmlChildren(q)$Title)
            HITs[i, 5] <- xmlValue(xmlChildren(q)$Description)
            HITs[i, 6] <- xmlValue(xmlChildren(q)$Keywords)
            HITs[i, 7] <- xmlValue(xmlChildren(q)$HITStatus)
            HITs[i, 8] <- xmlValue(xmlChildren(q)$MaxAssignments)
            if (!is.null(xmlChildren(q)$Reward)) {
                HITs[i, 9] <- xmlValue(xmlChildren(xmlChildren(q)$Reward)$Amount)
            }
            HITs[i, 10] <- xmlValue(xmlChildren(q)$AutoApprovalDelayInSeconds)
            HITs[i, 11] <- xmlValue(xmlChildren(q)$Expiration)
            HITs[i, 12] <- xmlValue(xmlChildren(q)$AssignmentDurationInSeconds)
            HITs[i, 13] <- xmlValue(xmlChildren(q)$NumberOfSimilarHITs)
            HITs[i, 14] <- xmlValue(xmlChildren(q)$HITReviewStatus)
            HITs[i, 15] <- xmlValue(xmlChildren(q)$RequesterAnnotation)
            HITs[i, 16] <- xmlValue(xmlChildren(q)$NumberOfAssignmentsPending)
            HITs[i, 17] <- xmlValue(xmlChildren(q)$NumberOfAssignmentsAvailable)
            HITs[i, 18] <- xmlValue(xmlChildren(q)$NumberOfAssignmentsCompleted)
            HITs[i, 19] <- xmlValue(xmlChildren(q)$Question)
            if (return.qual.list == TRUE) {
                quals.nodeset <- xpathApply(xml.parsed, paste("//HIT[", i,
                    "]/QualificationRequirement", sep = ""))
                if (!is.null(quals.nodeset) && length(quals.nodeset) > 0) {
                    quals[[i]] <-
                        as.data.frame.QualificationRequirements(xmlnodeset = quals.nodeset, 
                                                                hit.number = i,
                                                                sandbox = sandbox)
                    if (!is.null(quals[[i]])) {
                        quals[[i]]$HITId <- HITs$HITId[i]
                    }
                } else {
                    quals[[i]] <- emptydf(0, 6, c('HITId', 'QualificationTypeId', 'Name', 'Comparator', 'Value', 'RequiredToPreview'))
                }
            }
        }
        return(list(HITs = HITs, QualificationRequirements = quals))
    } else {
        return(list(HITs = emptydf(0, 19, c("HITId", "HITTypeId", "CreationTime", 
                               "Title", "Description", "Keywords", "HITStatus", 
                               "MaxAssignments", "Amount", 
                               "AutoApprovalDelayInSeconds", "Expiration", 
                               "AssignmentDurationInSeconds", "NumberOfSimilarHITs", 
                               "HITReviewStatus", "RequesterAnnotation", 
                               "NumberOfAssignmentsPending",
                               "NumberOfAssignmentsAvailable", 
                               "NumberOfAssignmentsCompleted", "Question")),
                    QualificationRequirements = list()))
    }
}


# ASSIGNMENTS

as.data.frame.Assignments <- function(xml.parsed, return.assignment.xml = FALSE) {
    assignments <- xpathApply(xml.parsed, "//Assignment", function(x){
        children <- xmlChildren(x)
        return(list(
            AssignmentId = xmlValue(children$AssignmentId),
            WorkerId = xmlValue(children$WorkerId),
            HITId = xmlValue(children$HITId),
            AssignmentStatus = xmlValue(children$AssignmentStatus),
            AutoApprovalTime = xmlValue(children$AutoApprovalTime),
            AcceptTime = xmlValue(children$AcceptTime),
            SubmitTime = xmlValue(children$SubmitTime),
            ApprovalTime = xmlValue(children$ApprovalTime),
            RejectionTime = xmlValue(children$RejectionTime),
            RequesterFeedback = xmlValue(children$RequesterFeedback),
            Answer = xmlValue(children$Answer)
        ))
    })
    assignments <- do.call(rbind.data.frame, assignments)
    assignments$HITId <- xmlValue(xpathApply(xml.parsed, paste("//HITId", sep = ""))[[1]])
    assignments$ApprovalRejectionTime <-
        ifelse(!is.na(assignments$ApprovalTime),
            assignments$ApprovalTime, assignments$RejectionTime)
    assignments$SecondsOnHIT <- as.double(strptime(assignments$SubmitTime, 
            format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")) - 
            as.double(strptime(assignments$AcceptTime, 
              format = "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"))

    # return answers and merge
    answers <- as.data.frame.QuestionFormAnswers(xml.parsed = xml.parsed)
    values <- reshape(answers, timevar = "QuestionIdentifier",
                      direction = "wide", idvar = "AssignmentId",
                      drop=c("WorkerId","HITId","FreeText","SelectionIdentifier",
                             "OtherSelectionField","UploadedFileKey","UploadedFileSizeInBytes"))
    names(values) <- gsub("Combined.Answers.","",names(values),fixed=TRUE)
    assignments <- merge(assignments,values,by="AssignmentId",all=TRUE)
    return(list(assignments = setRownames(assignments), 
                answers = answers))
}




# QUALIFICATION STRUCTURES

as.data.frame.QualificationRequirements <-
function(xml.parsed = NULL,
         xmlnodeset = NULL, 
         hit.number = NULL, 
         sandbox = getOption('MTurkR.sandbox')){
    if (is.null(xmlnodeset) & is.null(xml.parsed)) {
        stop("Must supply XML (parsed or unparsed) xor XMLNodeSet")
    }
    batch <- function(xmlnodeset) {
        quals <- emptydf(nrow = length(xmlnodeset), ncol = 6,
                         c("HITId", "QualificationTypeId", "Name", "Comparator", "Value", "RequiredToPreview"))
        for (i in 1:length(xmlnodeset)) {
            quals$QualificationTypeId[i] <- xmlValue(xmlChildren(xmlnodeset[[i]])$QualificationTypeId)
            if (quals$QualificationTypeId[i] %in% ListQualificationTypes()$QualificationTypeId) {
                qlist <- ListQualificationTypes()
                quals$Name[i] <- qlist[qlist$QualificationTypeId == 
                  quals$QualificationTypeId[i], "Qualification"]
            } else {
                quals$Name[i] <- NA
            }
            quals$Comparator[i] <- xmlValue(xmlChildren(xmlnodeset[[i]])$Comparator)
            if ("LocaleValue" %in% names(xmlChildren(xmlnodeset[[i]]))) {
                w <- which(names(xmlChildren(xmlnodeset[[i]])) == "LocaleValue")
                locales <- sapply(xmlChildren(xmlnodeset[[i]])[w], xmlValue)
                quals$Value[i] <- paste0(locales, collapse=",")
            }
            if ("IntegerValue" %in% names(xmlChildren(xmlnodeset[[i]]))) {
                w <- which(names(xmlChildren(xmlnodeset[[i]])) == "IntegerValue")
                locales <- sapply(xmlChildren(xmlnodeset[[i]])[w], xmlValue)
                quals$Value[i] <- paste0(locales, collapse=",")
            }
            quals$RequiredToPreview[i] <- xmlValue(xmlChildren(xmlnodeset[[i]])$RequiredToPreview)
        }
        return(quals)
    }
    if (!is.null(xmlnodeset)) {
        return(batch(xmlnodeset))
    } else if (!is.null(xml.parsed)) {
        if (!is.null(hit.number)) {
            xmlnodeset <- xpathApply(xml.parsed, paste("//HIT[", 
                hit.number, "]/QualificationRequirement", sep = ""))
        } else if (is.null(hit.number)) {
            xmlnodeset <- xpathApply(xml.parsed, "//QualificationRequirement")
        }
        if (!is.null(xmlnodeset)) {
            return(batch(xmlnodeset))
        } else {
            return(emptydf(0, 6, c('HITId', 'QualificationTypeId', 'Name', 'Comparator', 'Value', 'RequiredToPreview')))
        }
    } else {
        return(emptydf(0, 6, c('HITId', 'QualificationTypeId', 'Name', 'Comparator', 'Value', 'RequiredToPreview')))
    }
}


as.data.frame.QualificationTypes <- function(xml.parsed) {
    out <- xpathApply(xml.parsed, "//QualificationType", function(x){
        children <- xmlChildren(x)
        return(list(
            QualificationTypeId = xmlValue(children$QualificationTypeId),
            CreationTime = xmlValue(children$CreationTime),
            Name = xmlValue(children$Name),
            Description = xmlValue(children$Description),
            Keywords = xmlValue(children$Keywords),
            QualificationTypeStatus = xmlValue(children$QualificationTypeStatus),
            AutoGranted = xmlValue(children$AutoGranted),
            AutoGrantedValue = xmlValue(children$AutoGrantedValue),
            IsRequestable = xmlValue(children$IsRequestable),
            RetryDelayInSeconds = xmlValue(children$RetryDelayInSeconds),
            TestDurationInSeconds = xmlValue(children$TestDurationInSeconds),
            Test = xmlValue(children$Test),
            AnswerKey = xmlValue(children$AnswerKey)
        ))
    })
    if (!length(out)) {
        return(emptydf(0, 13, c("QualificationTypeId", "CreationTime", "Name", "Description", "Keywords",
                                "QualificationTypeStatus", "AutoGranted", "AutoGrantedValue", "IsRequestable",
                                "RetryDelayInSeconds", "TestDurationInSeconds", "Test", "AnswerKey")))
    } else {
        return(setRownames(do.call(rbind.data.frame, out)))
    }
}

as.data.frame.QualificationRequests <- function(xml.parsed){
    out <- xpathApply(xml.parsed, "//QualificationRequest", function(x){
        children <- xmlChildren(x)
        return(list(
            QualificationRequestId = xmlValue(children$QualificationRequestId),
            QualificationTypeId = xmlValue(children$QualificationTypeId),
            SubjectId = xmlValue(children$SubjectId),
            SubmitTime = xmlValue(children$SubmitTime),
            Answer = xmlValue(children$Answer)
        ))
    })
    if (!length(out)) {
        return(emptydf(0, 5, c("QualificationRequestId","QualificationTypeId","SubjectId","SubmitTime","Answer")))
    } else {
        return(setRownames(do.call("rbind.data.frame", out)))
    }
}

as.data.frame.Qualifications <- function(xml.parsed) {
    quals.xml <- xpathApply(xml.parsed, "//Qualification")
    if (length(quals.xml) > 0) {
        quals <- emptydf(length(quals.xml), 5, c("QualificationTypeId", "WorkerId", "GrantTime", "Value", "Status"))
        for (i in 1:length(quals.xml)) {
            if ("IntegerValue" %in% names(xmlChildren(quals.xml[[1]]))) {
                value.type <- "IntegerValue"
            }
            if ("LocaleValue" %in% names(xmlChildren(quals.xml[[1]]))) {
                value.type <- "LocaleValue"
            }
            qual <- xpathApply(xml.parsed,
                paste("//Qualification[", i, "]/QualificationTypeId", sep = ""))
            if (length(qual) == 1) {
                quals[i, 1] <- xmlValue(qual[[1]])
            }
            subj <- xpathApply(xml.parsed,
                paste("//Qualification[", i, "]/SubjectId", sep = ""))
            if (length(subj) == 1) {
                quals[i, 2] <- xmlValue(subj[[1]])
            }
            time <- xpathApply(xml.parsed,
                paste("//Qualification[", i, "]/GrantTime", sep = ""))
            if (length(time) == 1) {
                quals[i, 3] <- xmlValue(time[[1]])
            }
            valu <- xpathApply(xml.parsed,
                paste("//Qualification[", i, "]/", value.type, sep = ""))
            if (length(valu) == 1) {
                quals[i, 4] <- xmlValue(valu[[1]])
            }
            stat <- xpathApply(xml.parsed,
                paste("//Qualification[", i, "]/Status", sep = ""))
            if (length(stat) == 1) {
                quals[i, 5] <- xmlValue(stat[[1]])
            }
        }
        return(Qualifications = quals)
    } else {
        return(list(Qualifications = NULL))
    }
}


# QUESTION/ANSWER STRUCTURES

as.data.frame.QuestionForm <- function(xml.parsed) {
    qform <- xmlChildren(xmlChildren(xml.parsed)$QuestionForm)
    n <- names(qform)
    out <- mapply(function(x, name, elementnumber){
        if (name=='Question'){
            list(ElementNumber = elementnumber,
                 Element = 'Question',
                 QuestionIdentifier = xmlValue(xmlChildren(x)$QuestionIdentifier),
                 DisplayName = xmlValue(xmlChildren(x)$DisplayName),
                 IsRequired = xmlValue(xmlChildren(x)$IsRequired),
                 QuestionContent = toString.XMLNode(xmlChildren(x)$QuestionContent),
                 AnswerSpecification = toString.XMLNode(xmlChildren(x)$AnswerSpecification) )
        } else if (name=='Overview'){
            append(list(ElementNumber = elementnumber, 
                        Element = 'Overview'),
                lapply(xmlChildren(x), xmlValue))
        }
    }, qform, n, elementnumber = seq_along(n))
    return(list(Question = do.call('rbind.data.frame',out[names(out)=="Question"]), 
                Overview = do.call('rbind.data.frame',out[names(out)=="Overview"])))
}

as.data.frame.HTMLQuestion <- function(xml.parsed) {
    removeXMLNamespaces(xml.parsed, all = TRUE)
    if (length(xmlChildren(xml.parsed)) > 0) {
        html.content <- xmlValue(xmlChildren(xml.parsed)$HTMLContent)
        frame.height <- xmlValue(xmlChildren(xml.parsed)$FrameHeight)
        return(list(html.content = html.content, frame.height = frame.height))
    } else {
        return(list(html.content = NULL, frame.height = NULL))
    }
}

as.data.frame.ExternalQuestion <- function(xml.parsed) {
    removeXMLNamespaces(xml.parsed, all = TRUE)
    if (length(xmlChildren(xml.parsed)) > 0) {
        external.url <- xmlValue(xmlChildren(xml.parsed)$ExternalURL)
        frame.height <- xmlValue(xmlChildren(xml.parsed)$FrameHeight)
        return(list(external.url = external.url, frame.height = frame.height))
    } else {
        return(list(external.url = NULL, frame.height = NULL))
    }
}

as.data.frame.AnswerKey <- function(xml.parsed) {
    nodes <- xmlChildren(xmlChildren(xml.parsed)$AnswerKey)
    # need to change this to an xpath expression:
    answerkey <- emptydf(nrow = length(strsplit(toString.XMLNode(xml.parsed),'/AnswerOption')[[1]])-1,
                         ncol = 3, c("QuestionIdentifier", "SelectionIdentifier", "AnswerScore"))
    k <- 1
    for (i in 1:length(nodes[names(nodes) == "Question"])) {
        question <- xmlChildren(nodes[names(nodes) == "Question"][[i]])
        qid <- xmlValue(question$QuestionIdentifier)
        answeroptions <- question[names(question) == "AnswerOption"]
        for (j in 1:length(answeroptions)) {
            answerkey$QuestionIdentifier[k] <- qid
            answerkey$SelectionIdentifier[k] <- xmlValue(xmlChildren(answeroptions[[j]])$SelectionIdentifier)
            answerkey$AnswerScore[k] <- xmlValue(xmlChildren(answeroptions[[j]])$AnswerScore)
            k <- k + 1
        }
    }
    if (!is.null(nodes$QualificationValueMapping)) {
        map <- xmlChildren(nodes$QualificationValueMapping)
        mapping <- list()
        if ("PercentageMapping" %in% names(map)) {
            mapping$Type <- "PercentageMapping"
            mapping$MaximumSummedScore <- xmlValue(xmlChildren(map$PercentageMapping)$MaximumSummedScore)
        } else if ("ScaleMapping" %in% names(map)) {
            mapping$Type <- "ScaleMapping"
            mapping$SummedScoreMultiplier <- xmlValue(xmlChildren(map$PercentageMapping)$SummedScoreMultiplier)
        } else if ("RangeMapping" %in% names(map)) {
            mapping$Type <- "RangeMapping"
            ranges.xml <- xmlChildren(map$RangeMapping)
            scoreranges <- ranges.xml[names(ranges.xml) == "SummedScoreRange"]
            mapping$Ranges <- emptydf(length(scoreranges), 3, c("InclusiveLowerBound", "InclusiveUpperBound", "QualificationValue"))
            for (i in 1:length(scoreranges)) {
                mapping$Ranges[i, ] <- c(xmlValue(xmlChildren(scoreranges[[i]])$InclusiveLowerBound), 
                  xmlValue(xmlChildren(scoreranges[[i]])$InclusiveUpperBound), 
                  xmlValue(xmlChildren(scoreranges[[i]])$QualificationValue))
            }
            mapping$OutOfRangeQualificationValue <- xmlValue(ranges.xml$OutOfRangeQualificationValue)
        }
        return(list(Questions = answerkey, Scoring = mapping))
    } else {
        return(list(Questions = answerkey))
    }
}

as.data.frame.QuestionFormAnswers <- function(xml.parsed) {
    answers <- xpathApply(xml.parsed, "//Answer")
    # estimate length of dataframe:
    total <- length(answers)
    extractQuestionFormAnswersElement <- function(i) {
        z <- xmlChildren(xmlParse(xmlValue(i)))$QuestionFormAnswers
        removeXMLNamespaces(z, all = TRUE)
        return(z)
    }
    z <- extractQuestionFormAnswersElement(answers[[1]])
    questions <- xmlChildren(z)
    iterations <- total * length(questions)
    # create dataframe
    values <- emptydf(iterations, 10, c("AssignmentId", "WorkerId", "HITId", "QuestionIdentifier", 
                                        "FreeText", "SelectionIdentifier", "OtherSelectionField", 
                                        "UploadedFileKey", "UploadedFileSizeInBytes", "Combined.Answers"))
    convertxml <- function(node){
        questions <- xmlChildren(extractQuestionFormAnswersElement(node))
        out <- emptydf(length(questions), 10, names(values))
        out$AssignmentId <- xmlValue(xpathApply(node, "../AssignmentId")[[1]])
        out$WorkerId <- xmlValue(xpathApply(node, "../WorkerId")[[1]])
        out$HITId <- xmlValue(xpathApply(node, "../HITId")[[1]])
        for (z in 1:length(questions)) {
            if (length(xmlChildren(questions[[z]])$QuestionIdentifier) == 1) {
                out$QuestionIdentifier[z] <- xmlValue(xmlChildren(questions[[z]])$QuestionIdentifier)
            }
            if (length(xmlChildren(questions[[z]])$FreeText) == 1) {
                out$FreeText[z] <- xmlValue(xmlChildren(questions[[z]])$FreeText)
                out$Combined.Answers[z] <- xmlValue(xmlChildren(questions[[z]])$FreeText)
            } else if (length(xmlChildren(questions[[z]])$UploadedFileKey) == 1) {
                out$UploadedFileKey[z] <- xmlValue(xmlChildren(questions[[z]])$UploadedFileKey)
                out$UploadedFileSizeInBytes[z] <- xmlValue(xmlChildren(questions[[z]])$UploadedFileSizeInBytes)
                out$Combined.Answers[z] <- paste(out$UploadedFileKey[z], 
                    out$UploadedFileSizeInBytes[z], sep = ":")
            } else if (sum(names(xmlChildren(questions[[z]])) == "SelectionIdentifier") == 1) {
                out$SelectionIdentifier[z] <- xmlValue(xmlChildren(questions[[z]])$SelectionIdentifier)
                out$Combined.Answers[z] <- xmlValue(xmlChildren(questions[[z]])$SelectionIdentifier)
                if (length(xmlChildren(questions[[1]])$OtherSelectionField) == 1) {
                    multiple <- paste(out$SelectionIdentifier[z], 
                                xmlValue(xmlChildren(questions[[z]])$OtherSelectionField), 
                                sep = ";")
                    out$Combined.Answers[z] <- multiple
                    rm(multiple)
                }
            } else if (sum(names(xmlChildren(questions[[z]])) == "SelectionIdentifier") > 1) {
                multiple <- ""
                n <- names(xmlChildren(questions[[z]])) == "SelectionIdentifier"
                multiple <- paste(unname(sapply(xmlChildren(questions[[1]])[n], xmlValue)), collapse = ";")
                if (any(names(xmlChildren(questions[[z]])) == "OtherSelectionField")) { 
                    multiple <- paste(multiple,
                                xmlValue(xmlChildren(questions[[z]])$OtherSelectionField), 
                                sep = ";")
                }
                out$SelectionIdentifier[z] <- multiple
                out$Combined.Answers[z] <- multiple
                rm(multiple)
            } else if (length(xmlChildren(questions[[z]])$OtherSelectionField) == 1) {
                out$OtherSelectionField[z] <- xmlValue(xmlChildren(questions[[z]])$OtherSelectionField)
                out$Combined.Answers[z] <- xmlValue(xmlChildren(questions[[z]])$OtherSelectionField)
            }
        }
        return(out)
    }
    out <- do.call(rbind,lapply(answers,FUN=convertxml))
    out[] <- lapply(out, function(x) if (is.character(x)) type.convert(x, as.is = TRUE) else x)
    return(setRownames(out))
}



# REVIEW RESULTS

as.data.frame.ReviewResults <- function(xml.parsed) {
    hit.xml <- xpathApply(xml.parsed, "//GetReviewResultsForHITResult")
    out <- list(AssignmentReviewResult = NULL, 
                AssignmentReviewAction = NULL, 
                HITReviewResult = NULL, 
                HITReviewAction = NULL)
    if (!is.null(hit.xml) && length(hit.xml) >= 1) {
        hit <- xmlValue(xpathApply(xml.parsed, "//HITId")[[1]])
        if (length(xpathApply(xml.parsed, "//AssignmentReviewPolicy")) > 0)  {
            assignment.policy <- 
              xmlValue(xpathApply(xml.parsed, "//AssignmentReviewPolicy")[[1]])
            out$AssignmentResults <- as.numeric(xmlValue(xpathApply(xml.parsed, "//AssignmentReviewReport/NumResults")[[1]]))
            out$AssignmentTotalResults <- as.numeric(xmlValue(xpathApply(xml.parsed, "//AssignmentReviewReport/TotalNumResults")[[1]]))
        } else {
            assignment.policy <- NA
            out$AssignmentResults <- 0
            out$AssignmentTotalResults <- 0
        }
        if (length(xpathApply(xml.parsed, "//HITReviewPolicy")) > 0) {
            hit.policy <- xmlValue(xpathApply(xml.parsed, "//HITReviewPolicy")[[1]])
        } else {
            hit.policy <- NA
        }
        if (!is.na(assignment.policy)) {
            assignment.report <- 
              xmlChildren(xpathApply(xml.parsed, "//AssignmentReviewReport")[[1]])
            if (!is.null(assignment.report) && length(assignment.report) >= 1) {
                AssignmentReviewResult <- emptydf(nrow = sum(names(assignment.report) == "ReviewResult"), ncol=7,
                                                  c("AssignmentReviewPolicy", "ActionId", "SubjectId",
                                                    "ObjectType", "QuestionId", "Key", "Value"))
                AssignmentReviewAction <- emptydf(nrow = sum(names(assignment.report) == "ReviewAction"), ncol = 9,
                                                  c("AssignmentReviewPolicy", "ActionId", "ActionName", "ObjectId",
                                                    "ObjectType", "Status", "CompleteTime", "Result", "ErrorCode"))
                r <- 1
                a <- 1
                for (i in 1:length(assignment.report)) {
                    if (xmlName(assignment.report[[i]]) == "ReviewResult") {
                        AssignmentReviewResult$AssignmentReviewPolicy[r] <- assignment.policy
                        AssignmentReviewResult$ActionId[r] <- xmlValue(xmlChildren(assignment.report[[i]])$ActionId)
                        AssignmentReviewResult$SubjectId[r] <- xmlValue(xmlChildren(assignment.report[[i]])$SubjectId)
                        AssignmentReviewResult$ObjectType[r] <- xmlValue(xmlChildren(assignment.report[[i]])$ObjectType)
                        AssignmentReviewResult$QuestionId[r] <- xmlValue(xmlChildren(assignment.report[[i]])$QuestionId)
                        AssignmentReviewResult$Key[r] <- xmlValue(xmlChildren(assignment.report[[i]])$Key)
                        AssignmentReviewResult$Value[r] <- xmlValue(xmlChildren(assignment.report[[i]])$Value)
                        r <- r + 1
                    } else if (xmlName(assignment.report[[i]]) == "ReviewAction") {
                        AssignmentReviewAction$AssignmentReviewPolicy[a] <- assignment.policy
                        AssignmentReviewAction$ActionId[a] <- xmlValue(xmlChildren(assignment.report[[i]])$ActionId)
                        AssignmentReviewAction$ActionName[a] <- xmlValue(xmlChildren(assignment.report[[i]])$ActionName)
                        AssignmentReviewAction$ObjectId[a] <- xmlValue(xmlChildren(assignment.report[[i]])$ObjectId)
                        AssignmentReviewAction$ObjectType[a] <- xmlValue(xmlChildren(assignment.report[[i]])$ObjectType)
                        AssignmentReviewAction$CompleteTime[a] <- xmlValue(xmlChildren(assignment.report[[i]])$CompleteTime)
                        AssignmentReviewAction$Status[a] <- xmlValue(xmlChildren(assignment.report[[i]])$Status)
                        AssignmentReviewAction$Result[a] <- xmlValue(xmlChildren(assignment.report[[i]])$Result)
                        AssignmentReviewAction$ErrorCode[a] <- xmlValue(xmlChildren(assignment.report[[i]])$ErrorCode)
                        a <- a + 1
                    }
                }
                out$AssignmentReviewResult <- AssignmentReviewResult
                out$AssignmentReviewAction <- AssignmentReviewResult
            } else {
                out$AssignmentReviewResult <- emptydf(0, 7, c("AssignmentReviewPolicy", "ActionId", "SubjectId",
                                                              "ObjectType", "QuestionId", "Key", "Value"))
                out$AssignmentReviewAction <- emptydf(0, 9, c("AssignmentReviewPolicy", "ActionId", "ActionName", "ObjectId",
                                                              "ObjectType", "Status", "CompleteTime", "Result", "ErrorCode"))
            }
        }
        if (!is.na(hit.policy)) {
            hit.report <- 
              xmlChildren(xpathApply(xml.parsed, "//HITReviewReport")[[1]])
            if (!is.null(hit.report) && length(hit.report) >= 1) {
                HITReviewResult <- emptydf(nrow = sum(names(hit.report) == "ReviewResult"), ncol = 7,  
                                           c("HITReviewPolicy", "ActionId", "SubjectId", "ObjectType",
                                             "QuestionId", "Key", "Value"))
                HITReviewAction <- emptydf(nrow = sum(names(hit.report) == "ReviewAction"), ncol = 9,
                                           c("HITReviewPolicy", "ActionId", "ActionName", "ObjectId",
                                             "ObjectType", "Status", "CompleteTime", "Result", "ErrorCode"))
                r <- 1
                a <- 1
                for (i in 1:length(hit.report)) {
                    if (xmlName(hit.report[[i]]) == "ReviewResult") {
                        HITReviewResult$HITReviewPolicy[r] <- hit.policy
                        HITReviewResult$ActionId[r] <- xmlValue(xmlChildren(hit.report[[i]])$ActionId)
                        HITReviewResult$SubjectId[r] <- xmlValue(xmlChildren(hit.report[[i]])$SubjectId)
                        HITReviewResult$ObjectType[r] <- xmlValue(xmlChildren(hit.report[[i]])$ObjectType)
                        HITReviewResult$QuestionId[r] <- xmlValue(xmlChildren(hit.report[[i]])$QuestionId)
                        HITReviewResult$Key[r] <- xmlValue(xmlChildren(hit.report[[i]])$Key)
                        HITReviewResult$Value[r] <- xmlValue(xmlChildren(hit.report[[i]])$Value)
                        r <- r + 1
                    } else if (xmlName(hit.report[[i]]) == "ReviewAction") {
                        HITReviewAction$HITReviewPolicy[a] <- hit.policy
                        HITReviewAction$ActionId[a] <- xmlValue(xmlChildren(hit.report[[i]])$ActionId)
                        HITReviewAction$ActionName[a] <- xmlValue(xmlChildren(hit.report[[i]])$ActionName)
                        HITReviewAction$ObjectId[a] <- xmlValue(xmlChildren(hit.report[[i]])$ObjectId)
                        HITReviewAction$ObjectType[a] <- xmlValue(xmlChildren(hit.report[[i]])$ObjectType)
                        HITReviewAction$CompleteTime[a] <- xmlValue(xmlChildren(hit.report[[i]])$CompleteTime)
                        HITReviewAction$Status[a] <- xmlValue(xmlChildren(hit.report[[i]])$Status)
                        HITReviewAction$Result[a] <- xmlValue(xmlChildren(hit.report[[i]])$Result)
                        HITReviewAction$ErrorCode[a] <- xmlValue(xmlChildren(hit.report[[i]])$ErrorCode)
                        a <- a + 1
                    }
                }
                out$HITReviewResult <- HITReviewResult
                out$HITReviewAction <- HITReviewAction
            } else {
                out$HITReviewResult <- emptydf(0, 7, c("HITReviewPolicy", "ActionId", "SubjectId", "ObjectType","QuestionId", "Key", "Value"))
                out$HITReviewAction <- emptydf(0, 9, c("HITReviewPolicy", "ActionId", "ActionName", "ObjectId",
                                                       "ObjectType", "Status", "CompleteTime", "Result", "ErrorCode"))
            }
        }
    }
    return(out)
}


# MISC STRUCTURES

as.data.frame.BonusPayments <- function(xml.parsed){
    out <- xpathApply(xml.parsed, "//BonusPayment", function(x){
        children <- xmlChildren(x)
        bonus <- xmlChildren(children$BonusAmount)
        return(list(
            AssignmentId = xmlValue(children$AssignmentId),
            WorkerId = xmlValue(children$WorkerId),
            Amount = xmlValue(bonus$Amount),
            CurrencyCode = xmlValue(bonus$CurrencyCode),
            FormattedPrice = xmlValue(bonus$FormattedPrice),
            Reason = xmlValue(children$Reason),
            GrantTime = xmlValue(children$GrantTime)
        ))
    })
    if (!length(out)) {
        return(emptydf(0, 7, c("AssignmentId","WorkerId","Amount","CurrencyCode","FormattedPrice","Reason","GrantTime")))
    } else {
        return(setRownames(do.call(rbind.data.frame,out)))
    }
}

as.data.frame.WorkerBlock <- function(xml.parsed) {
    out <- xpathApply(xml.parsed, "//WorkerBlock", function(x){
        children <- xmlChildren(x)
        return(list(
            WorkerId <- xmlValue(children$WorkerId),
            Reason = xmlValue(children$Reason)
        ))
    })
    if (!length(out)) {
        return(emptydf(0, 2, c("WorkerId", "Reason")))
    } else {
        return(setRownames(do.call(rbind.data.frame,out)))
    }
}

Try the MTurkR package in your browser

Any scripts or data that you put into this service are public.

MTurkR documentation built on May 29, 2017, 11:09 p.m.