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

added functionality to download and unzip valugaps data and added new project Rbook

parent fd9633a7
Branches
No related tags found
No related merge requests found
File added
File added
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
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 = "")
...@@ -10,7 +10,12 @@ library("exactextractr") ...@@ -10,7 +10,12 @@ library("exactextractr")
designpath<- "Projects/ValuGaps/Designs/" 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") hnv <- rast("Projects/ValuGaps/data/gis/hnv_germany.tif")
......
...@@ -236,3 +236,39 @@ plot_multi_histogram <- function(df, feature, label_column) { #function to creat ...@@ -236,3 +236,39 @@ plot_multi_histogram <- function(df, feature, label_column) { #function to creat
labs(x=feature, y = "Density") labs(x=feature, y = "Density")
plt + guides(fill=guide_legend(title=label_column)) 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)))
}
rm(list=ls()) rm(list=ls())
#file <- "Projects/ValuGaps/parameters_valugaps.R" file <- "Projects/Rbook/parameters_Rbook.R"
file <- "Projects/CSA/parameters_csa.R" # file <- "Projects/CSA/parameters_csa.R"
rmarkdown::render("simulation_output.rmd", rmarkdown::render("simulation_output.rmd",
......
...@@ -67,7 +67,7 @@ designs_all <- readRDS("output/330_5000runs_4designs_mixl.RDS") ...@@ -67,7 +67,7 @@ designs_all <- readRDS("output/330_5000runs_4designs_mixl.RDS")
```{r} ```{r}
cat(notes) if (exists("notes")) cat(notes)
``` ```
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment