R/utils.R

Defines functions removeColonDate_ISO8601 validDate_ISO8601 createSingleDataFrame searchFormIdByName prepareAnswerDF auxFunction requestFunction

requestFunction <- function(query, token) {
  # Request function
  # Is used to make all the requests to the webservice.

  # API's URL
  url <- "http://www.coletum.com/api/graphql"

  # Request
  resp <- httr::GET(url = url,
                    config = httr::add_headers(Token = token),
                    query = list(query = query),
                    encode = "json")

  # Get the status code
  status_code <- toString(resp$status_code)
  # Get the json content from the response
  jsonContent <- httr::content(resp, "text", encoding = "UTF-8")

  # Convert the response to useful object
  resp <- jsonlite::fromJSON(
    txt = jsonContent,
    simplifyVector = TRUE,
    simplifyDataFrame = TRUE
  )

  # Catch some error from API
  if (!identical(status_code, "200")) {
    if (!is.null(resp$code)) {
      stop(paste0("Error ", status_code, ": ", resp$message, "\n"))
    } else {
      if (!is.null(resp$errors)) {
        stop(paste0("Error ", status_code, ": ", resp$errors$message, "\n"))
      } else {
        stop(paste0("Error ", status_code, ": ", resp$error$message, "\n"))
      }
    }

  }

  # Catch some another existing error or warning
  if (!is.null(resp$errors$message)) {
    warning(paste0("\nCheck careful the result, because something may wents ",
                   "wrong: \n", resp$errors$message))
  }

  return(resp$data[[1]])
}

auxFunction <- function(dataFrame, idComponentsString = NULL) {
  # Auxiliar function
  # Is used to get the idComponents and create a dictionary with the componentId
  # and the question name of each answer from the answer schema.
  #
  # The idComponents is necessary to be possible use to get the answers after.
  # The dictionary is necessary to rename the columns from idComponents to
  # labels.
  #
  # Recursively, gets the idComponentes and the question name of all components,
  # including from the nested components.

  dictionary <- data.frame(matrix(ncol = 3, nrow = 0), stringsAsFactors = FALSE)
  names(dictionary) <- c("idComponent", "label", "order")
  i <- 1
  nrow <- nrow(dataFrame)
  while (i <= nrow) {

    if (identical(dataFrame$type[i], "group")) {
      idComponentsString <- paste0(
        idComponentsString,
        dataFrame$componentId[i],
        "{")

      dictionary <- rbind(dictionary,
                          data.frame("idComponent" = dataFrame$componentId[i],
                                     "label" = dataFrame$label[i],
                                     "order" = dataFrame$order[i],
                                     stringsAsFactors = FALSE),
                          stringsAsFactors = FALSE)

      aux <- auxFunction(dataFrame$components[i][[1]],
                         idComponentsString)

      idComponentsString <- aux[[1]]
      idComponentsString <- paste0(idComponentsString, "}")

      dictionary <- rbind(dictionary, aux[[2]],
                          stringsAsFactors = FALSE)

    } else {
      idComponentsString <- paste0(idComponentsString,
                                   dataFrame$componentId[i], ",")

      dictionary <- rbind(dictionary,
                          data.frame("idComponent" = dataFrame$componentId[i],
                                     "label" = dataFrame$label[i],
                                     "order" = dataFrame$order[i],
                                     stringsAsFactors = FALSE),
                          stringsAsFactors = FALSE)
    }

    i <- i + 1
  }
  return(list(idComponentsString, dictionary))
}

prepareAnswerDF <- function(dataFrame, dataFrameName) {
  # This function separeted the questions N from the principal data frame
  #
  # The main loop, pass through all the register in the data frame and verify if
  # is another data frame or a list. In both cases, this element is moved to the
  # another list called complementaryDF. All elements in the complementary DF
  # pass through this procediment too.

  dictionary <- data.frame(matrix(ncol = 2, nrow = 0), stringsAsFactors = FALSE)
  names(dictionary) <- c("dfName", "parentDfName")

  complementaryDF <- list()

  first <- TRUE
  otherI <- 1
  while (first || otherI <= length(complementaryDF)) {
    otherDF <- list()

    if (!first) {
      dataFrame <- complementaryDF[[otherI]]
      dataFrameName <- names(complementaryDF[otherI])
    }

    # Moving N question to another place
    i <- 1
    nRow <- nrow(dataFrame)
    aux <- NULL
    while (i <= nRow) {

      j <- 1
      nCol <- length(dataFrame[i, ])
      while (j <= nCol) {

        if (is.list(dataFrame[i, j])) {
          aux <- NULL
          columnId <- paste0(dataFrameName, "_id")
          if (is.data.frame(dataFrame[i, j][[1]])) {
            # aux[[1]] <- dplyr::mutate(dataFrame[i,j][[1]],
            #                           parent_cod = dataFrame[i,"id"])
            if (nrow(dataFrame[i, j][[1]]) != 0) {
              aux[[1]] <- cbind(dataFrame[i, j][[1]],
                                "temp" = dataFrame[i, columnId],
                                stringsAsFactors = FALSE)
              # Rename just the temp column
              names(aux[[1]])[names(aux[[1]]) == "temp"] <-
                paste0(dataFrameName, "_id")
            }

          } else {
            if (length(dataFrame[i, j][[1]]) != 0) {
              aux[[1]] <- data.frame(dataFrame[i, columnId], dataFrame[i, j],
                                     stringsAsFactors = FALSE)
              names(aux[[1]]) <- c(paste0(dataFrameName, "_id"),
                                   names(dataFrame[j]))
            }
          }

          otherDF[[names(dataFrame[j])]] <-
            append(otherDF[[names(dataFrame[j])]],
                   aux)
          dictionary <- rbind(dictionary,
                              data.frame("dfName" = names(dataFrame[j]),
                                         "parentDfName" = dataFrameName,
                                         stringsAsFactors = FALSE),
                              stringsAsFactors = FALSE)

        }

        j <- j + 1
      }

      i <- i + 1
    }
    ###################
    # Binding all iqual data frames
    i <- 1
    n <- length(otherDF)
    dfNames <- paste0(names(otherDF), "_id")

    while (i <= n) {
      # Registering the order of the names, because in next step, will lost
      ordered <- lapply(otherDF[[i]], names)
      # Unnesting the data frames
      ## The function flatten changes the original orders of the columns
      otherDF[[i]] <- lapply(otherDF[[i]], jsonlite::flatten)

      # Reordening the columns names
      j <- 1
      nDF <- length(ordered)
      while (j <= nDF) {
        reordered <-
          unlist(lapply(ordered[[j]],
                        grep,
                        names(otherDF[[i]][[j]]),
                        value = TRUE))

        otherDF[[i]][[j]] <- dplyr::select(otherDF[[i]][[j]], reordered)

        j <- j + 1
      }

      # Bind the data frames
      otherDF[[i]] <- do.call(dplyr::bind_rows, otherDF[[i]])
      # Add the id
      otherDF[[i]][dfNames[i]] <- rownames(otherDF[[i]])
      i <- i + 1
    }

    # Removing the columns with N answers from the principal Data Frame
    if (length(otherDF) != 0) {
      dataFrame <- dplyr::select(dataFrame, -dplyr::one_of(names(otherDF)))
    }

    if (first) {
      DFPrincipal <- dataFrame
      complementaryDF <- otherDF
      first <- FALSE
    } else {
      complementaryDF[[otherI]] <- dataFrame
      complementaryDF <- append(complementaryDF, otherDF)
      otherI <- otherI + 1
    }

  }
  dictionary <- dplyr::distinct(dictionary)
  return(list(dictionary = dictionary, DFPrincipal, complementaryDF))
}

searchFormIdByName <- function(nameForm, token) {
  forms <- GetForms(token)
  idForm <- forms$id[forms$name == nameForm]

  switch(format(length(idForm)),
         "0" = {
           stop("Name not found.")
         },
         "1" = {
           idForm <- as.numeric(idForm)
         },
         "2" = {
           stop("More than one result found. FormIds: ", toString(idForm))
         }

  )

  return(idForm)
}

createSingleDataFrame <- function(dataFrame, dictionary) {
  dataFrame <- append(list(answer = dataFrame[[1]]), dataFrame[[2]])
  names(dataFrame[[1]]) <- paste0(names(dataFrame[1]),
                                  ".",
                                  names(dataFrame[[1]]))
  singleDataFrame <- dataFrame[[1]]
  i <- 2
  n <- length(dataFrame)

  while (i <= n) {
    names(dataFrame[[i]]) <- paste0(names(dataFrame[i]),
                                    ".",
                                    names(dataFrame[[i]]))
    parentKey <- paste0(
      dictionary$parentDfName[dictionary$dfName == names(dataFrame[i])],
      ".",
      dictionary$parentDfName[dictionary$dfName == names(dataFrame[i])],
      "_id")
    dFKey <- paste0(
      names(dataFrame[i]),
      ".",
      dictionary$parentDfName[dictionary$dfName == names(dataFrame[i])], "_id")

    singleDataFrame <- dplyr::full_join(singleDataFrame,
                                        dataFrame[[i]],
                                        # Using setNames, is necessery invert
                                        # the order
                                        by = stats::setNames(dFKey, parentKey))

    i <- i + 1
  }

  return(singleDataFrame)

}

validDate_ISO8601 <- function(userDate) {
  if (is.na(userDate)) {
    return(FALSE)
  }
  userDateSize <- nchar(userDate)
  if (userDateSize == nchar("YYYY/MM/DD")) {
    error <- try(as.Date(userDate))
    if (identical(class(error), "try-error")) {
      return(FALSE)
    } else {
      return(TRUE)
    }
  } else {
    if (identical(substr(userDate, userDateSize - 2, userDateSize - 2), ":")) {
      userDate <- paste0(
        substr(userDate, 1, userDateSize - 3),
        substr(userDate, userDateSize - 1, userDateSize))
      userDateSize <- nchar(userDate)
    } else {
      if (identical(substr(userDate, userDateSize, userDateSize), "Z")) {
        userDate <- paste0(
          substr(userDate, 1, userDateSize - 1),
          "+0000")
        userDateSize <- nchar(userDate)
      }
    }

    userDate <- try(
      as.POSIXlt(userDate, format = "%Y-%m-%dT%H:%M:%S%z"))
    if (is.na(userDate)) {
      return(FALSE)
    } else {
      return(TRUE)
    }
  }
}

removeColonDate_ISO8601 <- function(apiDate) {

  n <- length(apiDate)
  i <- 1

  while (i <= n) {

    if (!is.na(apiDate[[i]])) {
      apiDateSize <- nchar(apiDate[i])
      apiDate[i] <- paste0(
        substr(apiDate[i], 1, apiDateSize - 3),
        substr(apiDate[i], apiDateSize - 1, apiDateSize))
    }

    i <- i + 1

  }

  return(apiDate)
}
HuenderBr/RColetum documentation built on March 29, 2024, 12:20 a.m.