diff --git a/Projects/Rbook/Designs/design1.RDS b/Projects/Rbook/Designs/design1.RDS new file mode 100644 index 0000000000000000000000000000000000000000..a8a4542cb2073b93b4d59dbc55563047599de62e Binary files /dev/null and b/Projects/Rbook/Designs/design1.RDS differ diff --git a/Projects/Rbook/design-chapter-05.rds b/Projects/Rbook/design-chapter-05.rds new file mode 100644 index 0000000000000000000000000000000000000000..b8d21d0cea6f7838a60f4df4deaacb64ee47fd94 Binary files /dev/null and b/Projects/Rbook/design-chapter-05.rds differ diff --git a/Projects/Rbook/parameters_Rbook.R b/Projects/Rbook/parameters_Rbook.R new file mode 100644 index 0000000000000000000000000000000000000000..d2a0b25262a634d0ae38dce8a12ea6dc480b2a0a --- /dev/null +++ b/Projects/Rbook/parameters_Rbook.R @@ -0,0 +1,47 @@ + + +designpath<- "Projects/Rbook/Designs/" + +#notes <- "This design consists of different heuristics. One group did not attend the methan attribute, another group only decided based on the payment" + +notes <- "No Heuristics" + +resps =240 # number of respondents +nosim=500 # number of simulations to run (about 500 is minimum) + +#betacoefficients should not include "-" +bsq=0.00 +bredkite=-0.05 +bdistance=0.50 +bcost=-0.05 +bfarm2=0.25 +bfarm3=0.50 +bheight2=0.25 +bheight3=0.50 + + +destype <- "spdesign" + + + + + + + + + +#place your utility functions here +u<- list(u1= list( + v1 =V.1 ~ bsq * alt1.sq, + v2 =V.2 ~ bfarm2 * alt2.farm2 + bfarm3 * alt2.farm3 + bheight2 * alt2.height2 + bheight3 * alt2.height3 + bredkite * alt2.redkite + bdistance * alt2.distance + bcost * alt2.cost, + v3 =V.3 ~ bfarm2 * alt3.farm2 + bfarm3 * alt3.farm3 + bheight2 * alt3.height2 + bheight3 * alt3.height3 + bredkite * alt3.redkite + bdistance * alt3.distance + bcost * alt3.cost + ) +) + + + +## logBonus + + + + diff --git a/Projects/Rbook/readdesign.R b/Projects/Rbook/readdesign.R new file mode 100644 index 0000000000000000000000000000000000000000..abc37b0bc2cf12273d8262d6012cb20111cc6b88 --- /dev/null +++ b/Projects/Rbook/readdesign.R @@ -0,0 +1,21 @@ + + +saveRDS(readRDS(file = "Projects/Rbook/design-chapter-05.rds")$design, "Projects/Rbook/Designs/design1.RDS") + +library(spdesign) + +design <- readRDS(file = "Projects/Rbook/design-chapter-05.rds") + +ufunction <- spdesign::clean_utility(design$utility) + + + +ufunction3 <- map(ufunction,~ str_replace_all(., "(alt[1-9]_)", "\\1.") %>% str_replace_all("_","") ) +ufunction3 + +priors <-design$prior_values[[1]] + +names(priors) <- str_replace_all(names(priors), "_","") +names(priors) +priors +cat(paste(names(priors), "=", sprintf("%.2f", priors), "\n", sep = ""), sep = "") diff --git a/Projects/ValuGaps/parameters_valugaps.R b/Projects/ValuGaps/parameters_valugaps.R index 8e3e7fce927cd0a00f1c9c66cb18fb86ddb71598..7a36bba63ae66d6fbda1c996f301cc50b494ed16 100644 --- a/Projects/ValuGaps/parameters_valugaps.R +++ b/Projects/ValuGaps/parameters_valugaps.R @@ -10,7 +10,12 @@ library("exactextractr") designpath<- "Projects/ValuGaps/Designs/" +### you need some external data. you can download it from here. Make sure there is no folder called data in the ValuGaps project +url <- "https://portal.idiv.de/nextcloud/index.php/s/48YSKBy4roq8c26/download/valugapsgisdata.zip" +dest_folder <- "Projects/ValuGaps/" + +download_and_extract_zip(url, dest_folder) hnv <- rast("Projects/ValuGaps/data/gis/hnv_germany.tif") diff --git a/functions.R b/functions.R index 5bc7ebb131c4f6fe9237d2090bde004c2a584f60..b5a7abfb9305b42f797512d0afe42d75bb35a7df 100644 --- a/functions.R +++ b/functions.R @@ -236,3 +236,39 @@ plot_multi_histogram <- function(df, feature, label_column) { #function to creat labs(x=feature, y = "Density") plt + guides(fill=guide_legend(title=label_column)) } + + + + + +download_and_extract_zip <- function(url, dest_folder = ".", zip_name = NULL) { + # If zip_name is not provided, extract it from the URL + if (is.null(zip_name)) { + zip_name <- basename(url) + } + folder <- paste0(dest_folder,"/data") + + + # Check if the folder is empty + if (length(list.files(folder)) > 0) { + warning("Destination folder is not empty. Nothing copied.") + return(invisible(NULL)) + } + + + # Download the zip file + download.file(url, zip_name, method = "auto", quiet = FALSE, mode = "w", cacheOK = TRUE) + + # Extract the contents + unzip(zip_name, exdir = dest_folder) + + + # Return the path to the extracted folder + return(file.path(dest_folder, tools::file_path_sans_ext(zip_name))) +} + + + + + + diff --git a/generatemd.R b/generatemd.R index 89222f8bdde9f43d1f6c3725491f0c06389a53c8..6de0494776b99356dfbc3c26e0425a6f35050045 100644 --- a/generatemd.R +++ b/generatemd.R @@ -1,8 +1,8 @@ rm(list=ls()) -#file <- "Projects/ValuGaps/parameters_valugaps.R" - file <- "Projects/CSA/parameters_csa.R" +file <- "Projects/Rbook/parameters_Rbook.R" +# file <- "Projects/CSA/parameters_csa.R" rmarkdown::render("simulation_output.rmd", diff --git a/simulation_output.rmd b/simulation_output.rmd index 301b9a5de0ed2bdb449c8325768b13b84feb2350..fa5967279aaacdc95d27beeffa2d0ad79b90d758 100644 --- a/simulation_output.rmd +++ b/simulation_output.rmd @@ -67,7 +67,7 @@ designs_all <- readRDS("output/330_5000runs_4designs_mixl.RDS") ```{r} -cat(notes) +if (exists("notes")) cat(notes) ```