From b03aabac39ac0c30e568d567a88fe993887266f3 Mon Sep 17 00:00:00 2001
From: dj44vuri <julian.sagebiel@idiv.de>
Date: Tue, 12 Dec 2023 01:34:30 +0100
Subject: [PATCH] added functionality to download and unzip valugaps data and
 added new project Rbook

---
 Projects/Rbook/Designs/design1.RDS      | Bin 0 -> 1279 bytes
 Projects/Rbook/design-chapter-05.rds    | Bin 0 -> 15903 bytes
 Projects/Rbook/parameters_Rbook.R       |  47 ++++++++++++++++++++++++
 Projects/Rbook/readdesign.R             |  21 +++++++++++
 Projects/ValuGaps/parameters_valugaps.R |   5 +++
 functions.R                             |  36 ++++++++++++++++++
 generatemd.R                            |   4 +-
 simulation_output.rmd                   |   2 +-
 8 files changed, 112 insertions(+), 3 deletions(-)
 create mode 100644 Projects/Rbook/Designs/design1.RDS
 create mode 100644 Projects/Rbook/design-chapter-05.rds
 create mode 100644 Projects/Rbook/parameters_Rbook.R
 create mode 100644 Projects/Rbook/readdesign.R

diff --git a/Projects/Rbook/Designs/design1.RDS b/Projects/Rbook/Designs/design1.RDS
new file mode 100644
index 0000000000000000000000000000000000000000..a8a4542cb2073b93b4d59dbc55563047599de62e
GIT binary patch
literal 1279
zcmb2|=3oE==C{#j{cbx5#Lcl6nyM9K`Q(6NSCMYe$))B+uY|V*<!h)cRA5@+xg_ql
zLal_HV*iBX{>r8x;qz<W<lDZf+MB1p=1E_A*|XU<Ki)bf|0Ua9Gc@?CM$lHbnpINq
zcJ)>N4Y%#>o|;#)r?>y+PrtXvSJzBke`!kBJK@lxCl9KQdhg1Xi>}kWw>aOgZ1#K;
zr{A81`#$cgSh%kE=EI5RpY1k26y005tv2oS^Q`r&=3nBtx_;63+6?>qRW;umvt@<+
zE><zw<#X-zKlSeTrdqz*|Ds<%@6`)^t9}2s+Lz+hS#vIYUwiz-UjLZiF=apARfpf%
z^ey1?r1|fwPXGJ!yes^Q{*_Xmuk$wi6u)u(_wSUNIU0|v!t6HH%~_vq?d5I5cjVxo
zs3cjjns3KHYFx=*6CCkg;+3THJ;NtQt(Mrh?a%p|9JfaN`okOgE6*p%ZmW9z^Ygmj
ze7}3YX4*vCJS)6!e)9WCv%quaD)s4eBd*u&cYG)Fc1`}L(z*T5TX*$5zZSOF!i4XK
z;yj7-busKut`<#yuYWahjsJnGAEmoxf31IBu2n8kd#tM9Zo+koOQnfB1>a2YKQj4)
zp!jvgSoRh1w<XW7(XO1&Bb<6i{U&Rz!>1M%)_(qj=f1xe_@ehCP-eaV^T5d6^U~)q
z-q@+PZaMqsnD$&-+Yir63*(Nt%UolBaNg>%$KO^PH~WIx8|i)T8&j;GIm)b={d{A7
zj=N0X;XOO<)s@v&%~fyu&*>3!pF!o_ZoL;f^aa9GA8(OAtId7?sPdKXMWOd?7w&WK
zTDN)C`)vW0wXb!4?@d0eYjrBl{dSeitE!LI|Ke-Ehn334e#}u0smZvv=tU|2*SoQz
zeiv;*`$Oc^_jzv$KkEL&ZoAWa^Z2{w>vR9r?_Hm}_{HbwF8x>GTjVnDDf&ON<NSN)
zYwf<9uL_Uq&c0v%V_*L2UzTcD&a1nA{&nr~tmUh|7xmfx>|>YfZ9npU(flLt75P3D
zTirWmZ}q87=)Cr)MPmDIN3<XK-u5U^_1~pw{$Io^5~BAXv3ZgIaI>nN#ADZaF*njJ
zmfV+4n3FwkPR-7G_LI)H%@f??COmVUm#_VUabNFulTV)icCWenK$Nv+;`eDk!npIJ
zW|VLHuv5u?Kl5+CCvF><`y%d(sXX%7WAD8%u2=u7;Nxuu{eN#Y^;tx$H{suP=)N)2
z{1bI-=iC0I_;*NiS)5QeUe{FlM6y!u=k>a4@z0a3ueaAMZmR5@|I}*2a#uOYA7O8r
zj~%vgo)9}hVEO9<`yN=S{+sf5<Ng9!Ub}7Fg=@4E<tk&|*st~e?%3G(^_ybcgU;U9
z$A#+SCVXT3EgWal7xJk#sJmaoZeIA0KgWNRPHIodKjv<27iIGOO})csU#t8HdtD7>
zXC>ceOf)&UeeSIF%Zs)K@4RuWRCdx{M?=B6#%V4UvQ|+`ig|q}y$w0X{3&<xnu&Y;
z*w=6NecmHEQEut89p$`MJH*e1oMZdB?C-3VKYr|)mvH^NVeiYNO;IbK*gIW0aU&*P
zPcJQe$<?G@KkLmWtBR_&&bf1zarxewAB9!&x5G;wE}s9<-rwJUzk#B4>38>}9AB~5
z{Nk(M&ru6IueVO^^lszBMoOn=?|oWT_xWvA?X=|6zjU8(zCHWvoE-P++i%jg&b#A(
z^Ts{t<@~ElwVt0?k(3f*cxq+Rl;EQp%ew;OL>HHc_MSd^_=}m{&(Go?mwB8!X~e()
E0BV7vRsaA1

literal 0
HcmV?d00001

diff --git a/Projects/Rbook/design-chapter-05.rds b/Projects/Rbook/design-chapter-05.rds
new file mode 100644
index 0000000000000000000000000000000000000000..b8d21d0cea6f7838a60f4df4deaacb64ee47fd94
GIT binary patch
literal 15903
zcma#xVqjokVqjrrVqjusU|?VtW?*38Vqjnb(I5c<1_lO31{MZR1_lQHr1;{(XoFY<
zErsI3Xv0_r1_os54@vQ9iAA~bDW$o&mC?x>26{%OItm7QrkWrfAgSnN4MQCTBOL`}
z%~%C(g{1h5)XemZ5*#`pk{Ei5Qd6=sOH!kC4fG65K_<flk~MTqbrf`s^gy=iD1d2@
z-5`rnGK)(R^O94e4fMcz;QV9_1CSe`E(I~oO?4Cuq3%o0FD^k?1m+c|7J@usXrPJi
z|HsJwS3m_?3LyWZh=H61@gl_kD3S^aS_%+J6k(7asCQxFS_)_aFbOyf(ggD_L{Lis
zl@Ad`BSG3gK86ZwDS$W(3@l7YDS|aGF*mgsnhuzu$%G{_r^FD6ZG^-&W?*3W2Tfi~
z3=GVCAj2GQ2HL*Y5`Kbicydl+G0bo#s3GhD{=uFR$t6%O8<<-HF%@oF<@7Io-yx<k
z{fD}a7z03lV?@`$Rg#&T8ed$JSX2VFlmjf1nwJ8x79|rf=jP=wFff3!4<iEu6UcuY
z3{bFt<xCKmW&Z#o0OwzT@L}TiXncrI;11(}I)eq29ieQ_q<CmDfC_LW#lzwlD#Df&
z4~{`dUS@|RR#@CXxyDenoUp73lZOjHBM@9pfHFVGgDLhOpdJ{d!2vNE9^hbL7!3zV
zI503Ufb$8QM<xS3JV`YMrXQvcosTX~NFJshordXy(J*-!pI91~K6G((KFoZWI4+vn
z>d@_hnGd7U<w@nk%z@Fk^rOq8^I`g6;xHN}PAwXjxiE1UjbtA<pI{LOD?t}W=Ytht
zAz<oo(O9&Ag<$Hz93+B}I4*f4BdE&6WgogYIv?E;FnJh_OCBapZFMknVKmHq7!4DL
z(J*ls4HL&j!_>iOm^ySmOdJ=DOFc{+Mx*P;B~FGqa6UoThl@|Fy@d1=YYt2uu{0rj
zammBPVfMiI=rl|oM&ptvRvec)bo0^qFnz>|qpO4QVKmG<bQ+gDx;Q$Y+UDRgA0`f?
z(d|X&6RQqgAFg&6x_N~7Sj;6#2xcxWnkYlCD1w=XE=8(1Og}Dt#LDAR2QwE&!_*O?
z(bdEFFdC+x5TDxWVD_QYFnfrl3F(K)lWHEidUSKp`AF))^@)QBM8tswl|BIDL*>!=
zFntGL@-P~z4_!Ts53vP7qMHMA2TVPjMl&C#4z3?+FU(|^yI_164HJj!gPIHHL(M@q
zA0`hIhnoXc4>KR84#tP6gYjYVFn__#gPH@Ehq?=<4@SexgXx2b!}u`$a6Zgj7!5TS
zW<N|n%v?APQxBzK>R>cX9n3x$A0`i@VfLWQ!}OuM6Q&+r9;P2oqqz%a4o>}0^>B3r
z!U5)fSbc&qQ1=2!1p@<vJ(Leu2jjzN*f<%C52Mk=VSLztAQ~TLEBb&ToR4lUOh0r0
z5~d%WhPxY09o%0~bI|p{_;7XT?uMENHy>&ax_Y=d=;~p70_MW?!_-0bVTi-R2TH@`
zq3(k5VKh8kq2|H;0ka2c4qP3YINThVI;cIcav4s;^r6ec?1jqXG!K{gP<?QFVCKPS
zm_DdFbn{_+7!CI)Og};&q&`uBsB}<((x4Gz1_lN=UkNHM1EnDpg9CKP+yN#I&7Tf1
z^I&|Kc`$WQeK7yQ?SYyL6Nl08as}!RxHy#W0M+Lp0b#)9VeWw05Az>PAIv>aeQ<X}
z-3PZ9Vl0CLx;ZdD%siNXVSJc5Fn7T0hv|dKL-oPk4O0g*2WCIay-@Y=@Q1k{M#IcS
zw+G!EnE5dCVDd2c!t}$$Vdld4Fn#Fu!t}%Z0i|L7gVFGGgRUOtPZ$j|A4bF64WnW1
zfSChxH;fO}hhZ;N9G-rl`rzuI^6>fun$Mx$$Dm;PU^IpTr~s+*=<3n=P-6*Fxb%@L
zj!PfRAuxFujV=!3Q=5j_2cu!;qw~?l(dE(kF!eARCJ&?0#c}ar;<#vZ^Khv{7ssWK
zkT^^poral@OB^PTM1$)SBtDo)NIy&-tQZSHsyw=SbUwNjFnJgalSk(h5{JnXqH&o^
zNFPidrk@ZEQ%@`nGY_U7#)r``aTtv*4&$TKF!i`-n0lBzjE_#k<Z;n3^~B1<)Wc|8
z`luz2WDnkaf^Hv@KCl!zA1ny!&k(4eVCrBrx;cdSFn#DWx;}JyTzqtWl=5-egD#G4
z4<UI<)f3W>Za=Ynn7O!Um^m<c7#~KXi=*>#se_55(=h$$G)x^XaddeYAJ*=I@nQO5
zd{Sw2{V+a^MmG;#oDd(TAEpjQ!^B}UOdOqt$-`)vJT5*=oKza!Ty*`o<Z+3k>xc1)
zRgX&@OdJ=D%O03|m^`U8F8%1@=zMg0VDjiRx;jF9n0|D1NaEo71U60v>$k$x!^YQO
zG)x{w!_>j}aC4yJZ!medeyBK%50l5G4<-*&4^s!{!}@Pfb7Ag)jT^%FFnw?ust=|P
z!#t=wOg-EkP;qoVhB;98z|_HLm^zrdV0@T7%s#k#(9D6Uhtp7boa&+SaQk3<7!CCg
z%sjX{G;x^uFm*5*!@UIb!TgD?A8s$qT~HdP4yF&L4#tPk8194WhsneA!DyIzxci~*
zhN*|qF!iwd1eR}LG)x_g4;wFoi$llT;C$%#8Tz;)Tpn$l4XzH_K7*MLr=jZM`l05d
z^Kq(&nF}=sK2D1!j$t0UdZ<6)`k{QdJ}4jV4yZfP)x*LOrVpJ)R}Yg%*9TXJ?oKp+
z!Sumtn7d%=U^JRJFniHycznUs!}P;wSUAA=F#BLMOdpy$m_2ZR!PLWObbT;BOde_;
z+#IMpoDWk66^DlhR3ALv(B;wiuzUi`H}G*r^zkt$A3kmh8?S@rL)dsMY}^#)9+-MK
zA7&10d=X|2Z2S)DLAX0$>d@t3_QJ*mq2rD)eQ^6=;?VIu_&6lYUYLC_d8oM<`eE*X
z*$2}Ha~Dh=W-e46+#HxXn0wIefyu*YSUACGG<^<G^I_o&AJ>HW1I-<9^-z1^>S6AN
z*$dMTvlqsP(J*nCJ{TVs9xy&k9;OfGUYNUJG}K@4aDtix=cBt9svaJX=;lN1f$N8<
zhtV+eU^L7fP<!F&7^WU-9s>gdF9QPuXnz4{4-RO@1;~e>y*i+p3q*tXAaOPZ2Jqe-
zb_NCpkQ_)oBLf2iNFF2yVzYua_AoFofYgBWfb@gpKx#o^AT^-<Js>fVS{NH74>A*E
z7DyjR9E3r7U}7K|WFCkHiG%cm^nlcZ*f29ee2{q{wIB>q3*v(?hz(K)qCw_^^n=U;
zxeKHgBnF~EYC+;4c@PH4gZLnM5F4Z)qy}Uch!3J+av=R6Js>xMFi0&(9%L^_4NMNC
z55@+m1IdHLK>FDr8!_NpN?;pa*h-Re;#1O~dncGnl5(I-u9U=*M7^}4#N1SfR`^yb
z&Z7KsJ=o?MP+T)LFfcIu|NnmuL?L{$hXB+lcF?Ap_~Jq+mn$)+#0b3I3bsQ7Ap+aP
z!2?zU*+m3Xg)D}u4t4toFIX?y4iZkVAkrohke$XDu7HRjn{FJB=?a(_s=6Y`<}Ro&
zL9Q@H-^T)Sg)#D07S^Pk{N!xNUL5d-8y5S06I#vX^fuSS>e0ndxh75R7J>26!k7hW
z9ebi~YEe;s5saIR%1uG#7DKs^4Nahal7s!ljlE`9Bre%+RH}KZZ!B%UK|$NzWYYxu
zt<@#0>-%2YZ<&~2S@-49{&aaUs|ywy_FKhGHZ5_VZ{Mr-M$x=r0#u)r{ek0GdvBEs
z*l#X+=zHOrynW;J;uiufi|u>Exr2>t7VMAk%VfUFxO;!Gc*Lo9eQNt79y52Y;NJ?h
zuNSIM&i>#%?%r2TANG5yY_&3G4X~e7_<-enm-7Dbu-VHk<LdXv)tg#%aK7H3S|#b$
zctjTNPKbTWq52H$_Zv*(zFx*{zv14abm41p`(xMK&D2rNw{Kk#*gtKFj(w7)NSLQi
z64Zb9pzd4(wNDAEFWUY9r$<>>n*9FQQV+MHC`bE_a6O)VHFNiy+GPsfE1Lxk7h|aZ
z_Cej*47INgsxQetMzb=fIGJm|%hRUljGHd|nM-QZ4KG}ThUaW(xadRt$HfSBrxMh@
zSx|jS_D7g5oJiTdXTO(F{@H`muS4TuGBi9_L&HTJ>c1SQJLRGFy@%>sZl5mE_UP07
z3y^dL&*aQ0nYqxS98}bRiYg8?B^)W4xv*jYv}X*Y4pgZP_#Ur8;fR0G1|y@r+u9DP
zPrEsx8&vsW;*bo@z6i#*&kKH_cK6Us7=QnyFF6ukGdG~|*TeYsOKz@`+EIEP#^1lv
zw2Q5CnJA2Jzifkkj>mdX%z!dD<Nn!xjayzw`@rP)&y$+Gy6k&6oWGD?PxQ{-E*Kx`
zo^>$({<eKDWYvN|6%5!s`xdP$m)LiJ0vp0F0rLf6>Y?ofP~FbNz(7I8!wlNhh+NP7
zha^OJJ;M(x^hWC$Xh<N{GvFc~yoHO=QCsK|Bvw#1i*i9Vv6q%)=46&sLb)uUouW`S
zYi@o@Dy(I|Q&5zdUld=Km{Xcs3{}9El3JXZo(JU#r>3Q4CTFJRC0E8L7iE^D7G)+v
zrC7?6^UI)Y9&qJX3^55RCIl5r&MzuT%}FfD%!e7u4V3{I2T1_%GzHt_%~4zcbq52(
FKLA<#FP#7Y

literal 0
HcmV?d00001

diff --git a/Projects/Rbook/parameters_Rbook.R b/Projects/Rbook/parameters_Rbook.R
new file mode 100644
index 0000000..d2a0b25
--- /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 0000000..abc37b0
--- /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 8e3e7fc..7a36bba 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 5bc7ebb..b5a7abf 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 89222f8..6de0494 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 301b9a5..fa59672 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)
 ```
 
 
-- 
GitLab