Skip to content
Snippets Groups Projects
Commit b1774cd0 authored by dj44vuri's avatar dj44vuri
Browse files

added improvments and tests for createSets function

parent 7d27f59a
No related branches found
No related tags found
No related merge requests found
* text=auto
*.R text eol=lf
Package: choiceTools
Type: Package
Title: Various tools to work with choice experiment data in R
Version: 0.1.0
Version: 0.2.0
Author: Julian Sagebiel
Maintainer: Julian Sagebiel <julian.sagebiel@idiv.de>
Description: Most functions are made for use with apollo.
License: MIT
Description: This is a random set of functions that make your life as a choice modeller easier. Some functions are made for use with apollo so that you can more easily do choice modelling in apollo. The package includes some tests like Poetest and zTest and some functions to generate publication-ready tables.
License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
Suggests:
knitr,
rmarkdown
rmarkdown,
testthat (>= 3.0.0)
VignetteBuilder: knitr
Imports:
texreg
apollo,
dplyr,
janitor,
magrittr,
methods,
purrr,
readxl,
rlang,
stats,
texreg,
tidyr,
tidyselect,
zoo
RoxygenNote: 7.3.1
Config/testthat/edition: 3
MIT License
Copyright (c) 2023 Julian Sagebiel
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
YEAR: 2024
COPYRIGHT HOLDER: Julian Sagebiel
# MIT License
Copyright (c) 2024 Julian Sagebiel
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
......@@ -9,15 +9,14 @@
#' @param attributes A selection condition for attribute columns (tidyselect compatible).
#' @param uniquerow A string specifying the unique row identifier column.
#' @param prefix A string specifying the prefix for renaming (default is "a").
#' @param delimiter A string specifying the delimiter for renaming (default is "_").
#'
#' @return A list of tibbles representing the sets.
#'
#' @export
#'
#' @examples
#' @examples \dontrun{
#' # Given a package dataset 'sample_data':
#' createSets(sample_data, choice = "choice_col", attributes = starts_with("attr"), uniquerow = "id")
#' createSets(sample_data, choice = "choice_col", attributes = starts_with("attr"), uniquerow = "id") }
......@@ -26,9 +25,9 @@
createSets <- function(.data, choice, attributes , uniquerow, prefix="a") {
require("dplyr")
require("tidyr")
require("purrr")
# require("dplyr")
# require("tidyr")
# require("purrr")
if (!is.data.frame(.data)) {
stop("The input data (.data) must be a data frame or tibble.")
......@@ -36,7 +35,7 @@ createSets <- function(.data, choice, attributes , uniquerow, prefix="a") {
if (!all(c(choice, uniquerow) %in% names(.data))) {
stop("Both choice and uniquerow columns must exist in the input data.")
}
attribute_cols <- select(.data, {{ attributes }}) %>% names()
attribute_cols <- dplyr::select(.data, {{ attributes }}) %>% names()
if (length(setdiff(attribute_cols, names(.data))) > 0) {
stop("Some columns specified in attributes do not exist in the input data.")
}
......@@ -45,16 +44,18 @@ createSets <- function(.data, choice, attributes , uniquerow, prefix="a") {
stop("The columns choice, uniquerow, and attributes should not have missing values.")
}
sets <- .data %>%
select({{ attributes }}, {{ choice }}, {{ uniquerow }} ) %>%
group_by(!!rlang::sym(uniquerow), !!rlang::sym(choice)) %>%
add_count() %>% ungroup %>%
group_by(!!rlang::sym(uniquerow)) %>%
distinct(n, .keep_all=TRUE) %>%
mutate(perc = round((n / sum(n) * 100))) %>%
arrange({{ uniquerow }}, {{ choice }}) %>%
group_split() %>%
set_names(map(., ~ unique(as.character(.x[[rlang::as_string(uniquerow)]]))))
dplyr::select({{ attributes }}, {{ choice }}, {{ uniquerow }} ) %>%
dplyr::group_by(!!rlang::sym(uniquerow), !!rlang::sym(choice)) %>%
dplyr::add_count() %>% dplyr::ungroup() %>%
dplyr::group_by(!!rlang::sym(uniquerow)) %>%
dplyr::distinct(n, .keep_all=TRUE) %>%
dplyr::mutate(perc = round((n / sum(n) * 100))) %>%
dplyr::arrange({{ uniquerow }}, {{ choice }}) %>%
dplyr::group_split() %>%
purrr::set_names(purrr::map(., ~ unique(as.character(.x[[rlang::as_string(uniquerow)]]))))
......@@ -62,29 +63,29 @@ createSets <- function(.data, choice, attributes , uniquerow, prefix="a") {
.data %>%
pivot_wider(
id_cols = c({{ uniquerow }}, everything()),
tidyr::pivot_wider(
id_cols = c({{ uniquerow }}, tidyselect::everything()),
names_from = {{ choice }},
values_from = c(n, perc),
names_sep = "."
) %>%
select(- {{ uniquerow }}) %>%
rename_with(
dplyr::select(- {{ uniquerow }}) %>%
dplyr::rename_with(
~ gsub(paste0("^(", prefix, "(\\d+))_(.*)$"), "\\3.\\2", .),
matches(paste0("^", prefix, "\\d+_"))
dplyr::matches(paste0("^", prefix, "\\d+_"))
) %>%
pivot_longer(
cols = everything(),
tidyr::pivot_longer(
cols = tidyselect::everything(),
names_to = c("name", "suffix"),
names_pattern = "(.*)\\.(.*)"
) %>%
pivot_wider(
tidyr::pivot_wider(
names_from = suffix,
values_from = value
)
}
finalsets <- map(sets, ~makesets(.x ))
finalsets <- purrr::map(sets, ~makesets(.x ))
......
Source diff could not be displayed: it is too large. Options to address this: view the blob.
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/createSets.R
\name{createSets}
\alias{createSets}
\title{Create sets from given data}
\usage{
createSets(.data, choice, attributes, uniquerow, prefix = "a")
}
\arguments{
\item{.data}{A data frame or tibble containing the data.}
\item{choice}{A string specifying the choice column.}
\item{attributes}{A selection condition for attribute columns (tidyselect compatible).}
\item{uniquerow}{A string specifying the unique row identifier column.}
\item{prefix}{A string specifying the prefix for renaming (default is "a").}
}
\value{
A list of tibbles representing the sets.
}
\description{
This function creates sets based on given attributes and choice columns.
It groups data by unique rows, calculates counts, and pivots the data for a
comprehensive overview.
}
\examples{
\dontrun{
# Given a package dataset 'sample_data':
createSets(sample_data, choice = "choice_col", attributes = starts_with("attr"), uniquerow = "id") }
}
rm(list = ls())
devtools::load_all()
model_path <- system.file("extdata", "csasimdata.csv", package = "choiceTools")
data <- read.csv(model_path)
sets <- createSets(data,choice = "CHOICE", uniquerow = "Choice_situation" ,attributes =c("alt1_x1" , "alt2_x1", "alt1_x2" , "alt2_x2") ,prefix = "alt" )
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment