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

Merge branch 'devel' of gitlab.idiv.de:dj44vuri/simulatedce into devel

parents 574258db 82161121
No related branches found
No related tags found
No related merge requests found
...@@ -3,3 +3,5 @@ ...@@ -3,3 +3,5 @@
^LICENSE\.md$ ^LICENSE\.md$
^data-raw$ ^data-raw$
^README\.Rmd$ ^README\.Rmd$
^doc$
^Meta$
.Rproj.user .Rproj.user
.Rhistory .Rhistory
inst/doc
/doc/
/Meta/
...@@ -26,7 +26,9 @@ Imports: ...@@ -26,7 +26,9 @@ Imports:
tictoc, tictoc,
tidyr tidyr
Suggests: Suggests:
knitr,
testthat (>= 3.0.0) testthat (>= 3.0.0)
Config/testthat/edition: 3 Config/testthat/edition: 3
Depends: Depends:
R (>= 3.6.0) R (>= 3.6.0)
VignetteBuilder: knitr
...@@ -16,9 +16,9 @@ sim_all(nosim = 2, resps, destype = "ngene", designpath, u, bcoeff) ...@@ -16,9 +16,9 @@ sim_all(nosim = 2, resps, destype = "ngene", designpath, u, bcoeff)
\item{designpath}{The path to the folder where the designs are stored. For example "c:/myfancydec/Designs"} \item{designpath}{The path to the folder where the designs are stored. For example "c:/myfancydec/Designs"}
\item{u}{A list with utility functions. The list can incorporate as many decision rule groups as you want. However, each group must be in a list in this list. If you just use one group (the normal), this group still has to be in a list in the u list.} \item{u}{A list with utility functions. The list can incorporate as many decision rule groups as you want. However, each group must be in a list in this list. If you just use one group (the normal), this group still has to be in a list in the u list. As a convention name beta coefficients starting with a lower case "b"}
\item{bcoefficients}{List of coefficients for the utility function. List content/length can vary based on application, but item names should be in namespace: {bsq, bredkite, bdistance, bcost, bfarm2, bfarm3, bheight2, bheight3}} \item{bcoefficients}{List of initial coefficients for the utility function. List content/length can vary based on application, but should all begin with b and be the same as those entered in the utility functions}
} }
\value{ \value{
A list, with all information on the simulation. This list an be easily processed by the user and in the rmarkdown template. A list, with all information on the simulation. This list an be easily processed by the user and in the rmarkdown template.
......
...@@ -14,14 +14,15 @@ resps =240 # number of respondents ...@@ -14,14 +14,15 @@ resps =240 # number of respondents
nosim=2 # number of simulations to run (about 500 is minimum) nosim=2 # number of simulations to run (about 500 is minimum)
#betacoefficients should not include "-" #betacoefficients should not include "-"
bsq=0.00 bcoeff<-list(
bredkite=-0.05 bsq=0.00,
bdistance=0.50 bredkite=-0.05,
bcost=-0.05 bdistance=0.50,
bfarm2=0.25 bcost=-0.05,
bfarm3=0.50 bfarm2=0.25,
bheight2=0.25 bfarm3=0.50,
bheight3=0.50 bheight2=0.25,
bheight3=0.50)
destype <- "spdesign" destype <- "spdesign"
...@@ -38,7 +39,7 @@ ul<- list(u1= list( ...@@ -38,7 +39,7 @@ ul<- list(u1= list(
rbook <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype, rbook <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
designpath = designpath, u= ul) designpath = designpath, u= ul, bcoeff = bcoeff)
designpath<- system.file("extdata","agora" ,package = "simulateDCE")
resps =360 # number of respondents
nosim=2 # number of simulations to run (about 500 is minimum)
#betacoefficients should not include "-"
#design priors parameters
bcoeff <- list(
basc = -1.2,
basc2 = -1.4,
baction = 0.1,
badvisory = 0.4,
bpartner = 0.3,
bcomp = 0.02)
# from survey
# basc = -2.2
# basc2 = -2.7
# baction = -0.15
# badvisory = 0.26
# bpartner = -0.09
# bcomp = 0.004
#place your utility functions here
ul<-list( u1 =
list(
v1=V.1 ~ basc + baction*alt1.b + badvisory * alt1.c + bpartner * alt1.d + bcomp * alt1.p , #Utility of alternative 1
v2=V.2 ~ basc2 + baction*alt2.b + badvisory * alt2.c + bpartner * alt2.d + bcomp * alt2.p , #Utility of alternative 2
v3=V.3 ~ 0)
)
destype="ngene"
agora <- sim_all(nosim = nosim, resps=resps, destype = destype,
designpath = designpath, u=ul, bcoeff = bcoeff)
No preview for this file type
...@@ -152,7 +152,45 @@ test_that("Simulation results are reasonable", { ...@@ -152,7 +152,45 @@ test_that("Simulation results are reasonable", {
result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff) result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
expect_gt(result1$est_bsq, -1) ## The function below is intended to find a dataframe called $coef in the output
expect_lt(result1$est_bsq, 1) ## regardless of the output data structure which can vary
find_dataframe <- function(list_object, dataframe_name) {
# Check if the current object is a list
if (is.list(list_object)) {
# Check if the dataframe_name exists in the names of the current list object
if (dataframe_name %in% names(list_object)) {
# Check if the object corresponding to dataframe_name is a data frame
if (is.data.frame(list_object[[dataframe_name]])) {
return(list_object[[dataframe_name]]) # Return the data frame if found
}
}
# Recursively search through each element of the current list object
for (element in list_object) {
result <- find_dataframe(element, dataframe_name)
if (!is.null(result)) {
return(result) # Return the data frame if found in any nested list
}
}
}
return(NULL) # Return NULL if dataframe_name not found
}
# Now access the coef data frame to compare to the input
coeffNestedOutput <- find_dataframe(result1, "coefs")
for (variable in names(bcoeff)){
### Compare singular input value (hypothesis) with the average value of all iterations. ###
### This could be made more rigorous by testing each iteration or by changing the ###
### tolerance around the input value considered valid.
input_value <- bcoeff[[variable]]
mean_output_value <- mean(coeffNestedOutput[[paste0("est_", variable)]]) ## access the mean value of each iteration
##change this depending on how rigorous you want to be
expect_gt(mean_output_value, input_value - 1)
expect_lt(mean_output_value, input_value + 1)
}
}) })
*.html
*.R
---
title: "SE_drive-vignette"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{SE_drive-vignette}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
<!-- There is an issue when creating these vignettes using usethis::use_vignette and
devtools::build_vignettes() where the compilied vignette HTML files are placed in /doc
rather than inst/doc
Best Practice is to follow these steps
1. Create vignette using usethis::use_vignette("my-vignette")
2. After making changes run devtools::build_vignettes()
3. Rebuild using devtools::install(build_vignettes = TRUE)
4. Check that it is in the vignette environment using browseVigettes()
If vignette does not appear in gitHub, it is possibly due to a file heirarchy problem where rendered files
appear in /doc instead of /inst/doc
To avoid this run:
tools::buildVignettes(dir = ".", tangle=TRUE)
dir.create("inst/doc")
file.copy(dir("vignettes", full.names=TRUE), "inst/doc", overwrite=TRUE)
More info here: https://community.rstudio.com/t/browsevignettes-mypackage-saying-no-vignettes-found/68656/7
-->
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
# Introduction
This vignette demonstrates how to use the `simulateDCE` package to simulate discrete choice experiments (DCEs). We will use a sample dataset and utility functions to generate simulated data and analyze the results.
```{r setup}
library(simulateDCE)
rm(list=ls())
devtools::load_all()
library(rlang)
```
# Inititalize Variables
sim_all is the highest level function in the package and will run simulations for all designs contained in the specified design folder. Accordingly, this is generally the function the user will want to call. To prepare for using this function, a hypothesized utility function with cooresponding beta coefficients representing the weight of each term must be declared in R like so:
```{r initialize}
decisiongroups=c(0,0.7,1)
# pass beta coefficients as a list
bcoeff <- list(
bpreis = -0.01,
blade = -0.07,
bwarte = 0.02)
manipulations = list(alt1.x2= expr(alt1.x2/10),
alt1.x3= expr(alt1.x3/10),
alt2.x2= expr(alt2.x2/10),
alt2.x3= expr(alt2.x3/10)
)
#place your utility functions here
ul<-list( u1 =
list(
v1 =V.1~ bpreis * alt1.x1 + blade*alt1.x2 + bwarte*alt1.x3 ,
v2 =V.2~ bpreis * alt2.x1 + blade*alt2.x2 + bwarte*alt2.x3
)
,
u2 = list( v1 =V.1~ bpreis * alt1.x1 ,
v2 =V.2~ bpreis * alt2.x1)
)
```
# Other parameters
Besides these arguments the user must also specify the number of respondents in there simulated survey and the number of times to run the model. The number of respondents (resps) should be selected based on experimental design parameters, while the number of simulations (nosim) should be large enough to glean statistically significant data. It is best to use a small number for this while learning to use the package and a large number (at least 500) once the other parameters have been settled.
The simulation can be ran using spdesign or NGENE design files which will be contained in the design path. The design path and design type, must also be specified:
```{r other}
designpath<- system.file("extdata","SE_DRIVE" ,package = "simulateDCE")
resps =120 # number of respondents
nosim= 2 # number of simulations to run (about 500 is minimum)
destype="ngene"
```
# Output
The sim_all function returns a multidimensional R list containing graphs, simulated observations and a dataframe containing sumaries of estimated b coefficients. In general these will be printed to the console, but the entire results can also be assigned to an r variable.
```{r output}
sedrive <- sim_all(nosim = nosim, resps=resps, destype = destype,
designpath = designpath, u=ul, bcoeff = bcoeff)
```
# Accessing the Output in R
The beta cofficients for each simulation are contained in a dataframe called coeffs located within {result}->olddesign->coefs. and a summary table is contained in ->olddesign->summary
```{r accessOutput}
## nested results are hard coded, if the design changes this must aswell
simulationCoeff <- sedrive$olddesign$coefs
coeffSummary <- sedrive$olddesign$summary
print(simulationCoeff)
print(coeffSummary)
```
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment