From aabd92654030d87bc8e85c899f44fc27483dc32f Mon Sep 17 00:00:00 2001 From: Sven Verweij <37927107+SvenVw@users.noreply.github.com> Date: Fri, 3 May 2024 15:17:53 +0200 Subject: [PATCH 1/3] Add p_app_cost and p_app_capacity to fertilizers --- data-raw/fertilizers.R | 3 +++ data/fertilizers.rda | Bin 2788 -> 2852 bytes 2 files changed, 3 insertions(+) diff --git a/data-raw/fertilizers.R b/data-raw/fertilizers.R index 1bbeb3a..0a62fbd 100644 --- a/data-raw/fertilizers.R +++ b/data-raw/fertilizers.R @@ -19,6 +19,9 @@ fertilizers[p_type_compost == TRUE, p_p_wcl := 0.25] fertilizers[p_name_nl == 'Champost', p_p_wcl := 0.75] fertilizers[p_name_nl == 'Rundvee vaste mest', p_p_wcl := 0.75] +fertilizers[, p_app_cost := 100] +fertilizers[, p_app_capacity := 15000] +fertilizers[p_type_artificial ==TRUE, p_app_capacity := 1000] # Export table ------------------------------------------------------------ usethis::use_data(fertilizers, overwrite = TRUE, version = 3, compress = 'xz') diff --git a/data/fertilizers.rda b/data/fertilizers.rda index 5b860b78a34e0aad1552e6d54fd65b92062fb960..c1fd51f86e34a39e82ee874f4dbee726bffc74da 100644 GIT binary patch delta 2804 zcmVc z?tqe-wc)S{6EXl?#IVqG0N*|w%pyK+kEc+)Fq7L(f{*!0D(&?wD)@e*Mt_!r2!NPT z9eR{a*T}ge`%edcF}$1`3FJaR15az0^ksCKyo(m&#KN6Z2?}D~X3e=k;PJOoX8ho4 zk>1L9e?FOzQ<#nX=&M5(7xZY3M47e#8P;!C7OjLK9~{kmRr5c8rU|I`!WD&Gm(~th zI=hra=eHY2gb@gDT-rP+L{t$udN<`%1fil zHE`I_r;KVB_Qf6vWic{7A0@s2Q1|%M;T)l3H;@ZIJnhNm)g2_Lr+L4> z>A(D>oPnoVvuQCjWvw$22epht-Y6X+k)eQCL)G*GIL#*U29+&@i-)7R~4Z;#Nwpn1+M!Tu zUb;bpX`W_SC?{lD;x!(e%SVEoN`xb54)PG#aWH{nO{MD0wtvchOplO_Q+5!nuyaHvc92kfOjtT$Odk0A z$Jo)tN7X@7R&Tceas?B7a z6N!}F)S+U%Ie*#MSUZLmB`8h+i_p!e1ek8kQkuZ{odPM}nmo;WXZ#hEN&x%L8YM3c z|AkuCqG_C-OugrUQ}}j3WV5OK_d^fThc1%pn=w~DwA9+&GZa~$Z2Y?J7YXzy>3!IT zw}B$MEuj<@+ZZRv=;tXSPk>Wzr|%|3AJ%&mdv*QiMSo6u!#YMxyLwIolP{o8;kU&g z;CPZi+DK!%lQrrUXel-q2-dXo=htP z*MZKrDSwA?(0M8$h~|yu&eWxAK$h&JV{+?kU!zhuI>LT8!qzQu>D|rPZ#d;T6oZrU zCx5#VO%s08mhkWxBg{$>2)#RS|P#di48=3#Wy%J$Aal~=XJV26ci0vy|TiW zf{}m3@m?Njp60oc}~m@@K$4MCsM%Naz)nz}Zw>J!O1**B{uUdghjN`*sBBa%=H2IK_#d zjuCEjTYr!pFd~rl4^P_VgqI4!cs#}o4{}OA-?5}1<$fs(wC%n30R7qKlXr}NJ+iwO zTi(`b^D=t!QkI_0R#^R){&CXazBIdkV<1&8oOqk zWA;}Goc7GCh?ka(aG+*kFz81(jaQh!9cyRI@${sqEC5<);=7CY?RqXd$9k=}C%wgq zi)zf*rTyQ|e7|Xa;}<)3QsWX&dVjQ(M{+5kwNd~`MZQ#;@3`kCj6)j_bwyv{g`TZB z4+Q2MSz)<)8z2fcm?BV^r{NC`)tavo{^j;; zv??}6oRNg+z>_m0y(;=zau8_G6`^Kn^pN}+9su`vU)3QRc!DzqS>!&C?|@Q-kAA^I z(gmc0&!1CS-+*uhL4N&4f2+JXGJR@OU5!t@u&s-=r}#-ItbK!hSRnAc08YN)@iFDg zWk7-mQkzi?ii*Q(bbq+%FjFVV@RmtX7AqD`wccxH1S5n0ht?TK@!JC8%>uqvkTV`i zQOx;f7E=ST^GkJ^jN;JLKe(``;I=GPIq*xrE;X}2nAUEV`#D#XQm`WjqY%)``iM5% zz{w?+i~c|UGAQLAEh@!Pb%qpu?X1f$6&VGqoR+hIA}*R4yMNCJ6-Pko4Y(RKXsaw4 zL(zB~4E-X3`=-RV6 z@G8iBvfu|-XMgbh?zNbv8A+$PRCxeq_Y#SXqW9Q3aji}_an<`Vh#kRMd;>J{CNwzjD1kLnREL zx?^%Q9}tGuSIKu|l=wP-U-fb+I=dan^plkJR0$-6b$>Fxs^IZ3AM8*j%bzSxLU%o6 z!J;|-xorE$lVz3M(;@*dnDf8fNz{vB$0)*eqNz46={pRPZIj_u8MphA51?+aY4O<> zedLik9t%8^*EW%y7oZ(_6U`Fhk0@2Q8lO)_(yU|QluJ(uq4HZ`C^&38>tABf!B5PU zSJ>6#GiBY?n$@mp)!Ro31y!mZK+^|Jp7OBXjFb#_W00000 G0a;ouUTF#d delta 2740 zcmV;l3QP5*7UUI>83a4z3a61BH-8JX7vocM`6~!jkUAwlj&mJjr~Atfb>05(J$%kgReN3z6y0ORuez&^-&(YbQhUhoK9kUrsv^6 zZx7+d|KjD5{|kZMT#|A0VGnRfOfi;vPiJcbj-;7}WTjLfqD#Ku*#ZUo1%H`NE{^JF zQ&DwiBkh!p{^@iQZiGAUO`YXBFlY!~6)P|gog@ProFO=qTz7fx*^J7>jYMyhm$f@Ww3Kzj=-I!nz8h>IO3ft#9>DF60Rg-kvzv7b>FX53Mwe9v9><_O!mW(@< zrAdiStBI}~geOgHN@XOMj}>AmnRF^lB5s zsV;BMicRa3$fLK@E?e`&3Y644jInR=ecF<;zib;YF)y*#9!R za!sX(DS-}BQd3!1g^2_zPM-bsnq5&d>63P`cpgP6{D9)Z#(x+eVN)nF@xzQ{dYZa? zjwwV%-3RS*i6f5IT2&rd2o8Hux_{zz zV{u^M^8rh&A0*IQ$TVPTx02FFz3(lXV8n~?Le7Zdhnj;v=i~i@=FS+J#-@hjyR669 zy7!7_Os*p9^nVz2@Ru9lVECb{H5yV0YrwO|e~vB3kA;B5zqN9GsHoSpAD zXd<&D%5oKjUE)gt3SCS@du$lYs2yuXnyJoWTu)ffh{0iPce&FNF|E{(U8IUBJBd*U zDKoQdfiP?_W%u-|!?j-`2+OeRX2~+q{=GjQ*|> zW6YJOwlK(z00+-TD?Cdv+WyOG@&+{NWs25|kAH8sVYi=h3%sRpS*ja|e=(oD8{VXh zX2Z5s1wSRQj@?6=j!%O_c6V{v8QrVp8&V-_0SudWf>4aZ{V@_$K0#nmu)V)$O1OKC z(4Zrp*wlxQR56r_yR-y>`zScxVo4|KwW$1+emT|NM6B61&`uLYpMasQ55seNi8Lw7YRf6VqL9($i5Te}x$Ec>uqM|N2s%-s|>yux`-tH!44FF*n_(>Y=qg?}ti z`?AJyTFpi00w!Wp=QR^}#7NwY%e5Jl29R?3PdCXNU>@TtL~-Fzgp(|;Kmj4eJaPaY z9)+m3yR?;~e)*?kS@AAC-nSz+IKWB6QRfA_$F+0JYcB#GL*4gT_;P?75LhZJSlj$6 zd$jf9ZEWq^D?46n!lgaasIyp|i+^lUF4Fcagvl#^o8M!xInr5%j4sJ#CaC2T>~E1p zD|+MurTYU>{Xz3DYII88X2*MlJ|5*r>n}P$C4$Xe0Q+u8>(*fKL|pgydn+HRnAj8b z$AWQ6el}^_w?(t&o8+Sj95B(t70XjDK|qO*=y7^M#Ez%70&p^5D;dRWbbocLv?ufH z@`MP>>Qpe9=H24Bt(C8I4gEBG;t75=&SBi1DG~a*f#_sP7ya_*OMYM-tqsDKP|N|IsZ=Vmy5V!$AsyC%xT8 zIz&u=(JYxFuCC5D*C{V%ul%Wm58zlZDCV{86T*m9G+X-O5p85}Ju&3>fxkq!GPZ_s zz#CW`Ia3NQopUD&7Ul*w8ZI(hm_F{*icZF73KtMtl3G#`Huif;xqo)tu>t}+1u%U{ zzQ@YH)z{O|DpHSOEDBkN7}79`UN2R}{D7&%G~xD8qIhB!eG$spp_})#MlSiEgVUfR zx>}1m!t(zo&zGOnOn$Gmu=%C2`JtRT_yjWo% zN|zACW8$>vais1?^r~x)m6}_^qOWK61WvJ(QA2#Q&&&0fSdvPq4(fB$m;VAhGEAUj zs%e+Poi(oHufgcI7ENR1T&es|ie_M=lcH1i+ z{ARkwI&?>HR8j_3Lz)4)M{~Rd8ANNF+i)ef( z@j$$B^0kJPk}A33xfe?Yhc(wM%W3V=gs7o#1v)>-f2jdV&UvwyL(qtt*txao_7NmZ z1&9UV#u=>7g`oW|ApiV7s+q|AJ4ucGv0{USM^W`_3m>`LB)oIG#s&+{FrUTB5K>cO uYUQM2Y$cA~{uxMbh5!Kc6zDww0lyXHcK`rTqSi1zFb#_W000000a;o%@-hVg From 730e66d9e28a2bba968106e88ccd62376aed2b9e Mon Sep 17 00:00:00 2001 From: Sven Verweij <37927107+SvenVw@users.noreply.github.com> Date: Fri, 3 May 2024 15:55:25 +0200 Subject: [PATCH 2/3] Add module 4: Cost of applying fertilizers --- R/dataset.R | 2 +- R/model.R | 35 ++++++++++++++++++++++++++++++- README.md | 2 +- man/fertilizers.Rd | 2 +- tests/testthat/test-001-dataset.R | 2 +- tests/testthat/test-002-model.R | 8 +++++++ 6 files changed, 46 insertions(+), 5 deletions(-) diff --git a/R/dataset.R b/R/dataset.R index 4c3525b..e3a5972 100644 --- a/R/dataset.R +++ b/R/dataset.R @@ -53,7 +53,7 @@ createApusDataset <- function(farms = NULL, cultivations, fertilizers, fines, fi fertilizers[, p_stored := 0] fertilizers[, p_price := 1] - fertilizers <- fertilizers[, c('p_stored', 'p_price', 'p_n_rt', 'p_n_wc', 'p_p_rt', 'p_k_rt', 'p_type_manure', 'p_p_wcl')] + fertilizers <- fertilizers[, c('p_stored', 'p_price', 'p_n_rt', 'p_n_wc', 'p_p_rt', 'p_k_rt', 'p_type_manure', 'p_p_wcl', 'p_app_cost', 'p_app_capacity')] self$fertilizers <- torch::torch_tensor(as.matrix(fertilizers), device = device) }, diff --git a/R/model.R b/R/model.R index c128aee..48956de 100644 --- a/R/model.R +++ b/R/model.R @@ -168,6 +168,10 @@ calculateCost <- function(doses, fields, fertilizers, fines, reduce_batches = TR module1 <- calculateCostModule1(doses, fields, fertilizers) + # Module 4: Cost of applying fertilizers ---------------------------------- + module4 <- calculateCostModule4(doses, fields, fertilizers) + + # Module 5: Revenue from harvested crops ---------------------------------- module5 <- calculateRevenueModule5(doses, fields, fertilizers) @@ -177,7 +181,7 @@ calculateCost <- function(doses, fields, fertilizers, fines, reduce_batches = TR # Combine the modules ----------------------------------------------------- - cost <- torch::torch_zeros(dim(module1)) + module1 - module5 + module6 + cost <- torch::torch_zeros(dim(module1)) + module1 + module4 - module5 + module6 # Convert to € / ha ------------------------------------------------------- @@ -215,6 +219,35 @@ calculateCostModule1 <- function(doses, fields, fertilizers) { return(module1) } +# Module 4: Cost of applying fertilizers ----------------------------------- +calculateCostModule4 <- function(doses, fields, fertilizers) { + + # Sum dose per fertilizer per field -------------------------------------- + fields.b_area <- torch::torch_unsqueeze(fields[,,1], -1) + fields.fertilizers.dose <- fields.b_area * doses + + + # Calculate number of applications per field ------------------------------ + fertilizers.p_app_capacity <- fertilizers[,,10] + fields.fertilizers.p_app_capacity <- torch::torch_unsqueeze(fertilizers.p_app_capacity, 2) + fields.fertilizers.p_app_capacity <- torch::torch_repeat_interleave(fields.fertilizers.p_app_capacity, repeats = dim(fields.fertilizers.dose)[2], dim =2) + fields.fertilizers.applications <- torch::torch_ceil(fields.fertilizers.dose / fields.fertilizers.p_app_capacity) + + + # Calculate cost of applications ------------------------------------------- + fertilizers.p_app_cost <- fertilizers[,,9] + fields.fertilizers.p_app_cost <- torch::torch_unsqueeze(fertilizers.p_app_cost, 2) + fields.fertilizers.p_app_cost <- torch::torch_repeat_interleave(fields.fertilizers.p_app_cost, repeats = dim(fields.fertilizers.dose)[2], dim =2) + fields.fertilizers.cost <- fields.fertilizers.applications * fields.fertilizers.p_app_cost + + + # Sum cost for farm ------------------------------------------------------- + fields.cost <- torch::torch_sum(fields.fertilizers.cost, dim = 3L) + module4 <- torch::torch_sum(fields.cost, dim = 2L) + + return(module4) +} + # Module 5: Revenue from harvested crops ------------------------------------ calculateRevenueModule5 <- function(doses, fields, fertilizers) { diff --git a/README.md b/README.md index 379aae3..17c6975 100644 --- a/README.md +++ b/README.md @@ -78,7 +78,7 @@ For the v1 version of `apus` we plan to develop to following features: * [x] Include cost function for module 1: Purchase of fertilizers * [ ] Include cost function for module 2: Disposal of manure * [ ] Include cost function for module 3: Cost of storing fertilizers -* [ ] Include cost function for module 4: Cost of applying fertilizers +* [x] Include cost function for module 4: Cost of applying fertilizers * [x] Include cost function for module 5: Revenue of harvest * [x] Include cost function for module 6: Penalties in case of exceeding legal limits * [ ] Include cost function for module 7: Cost of greenhouse gas emissions diff --git a/man/fertilizers.Rd b/man/fertilizers.Rd index 938d509..56c8e8f 100644 --- a/man/fertilizers.Rd +++ b/man/fertilizers.Rd @@ -5,7 +5,7 @@ \alias{fertilizers} \title{Fertilizers table} \format{ -An object of class \code{data.table} (inherits from \code{data.frame}) with 47 rows and 46 columns. +An object of class \code{data.table} (inherits from \code{data.frame}) with 47 rows and 48 columns. } \usage{ fertilizers diff --git a/tests/testthat/test-001-dataset.R b/tests/testthat/test-001-dataset.R index fac499b..2c91832 100644 --- a/tests/testthat/test-001-dataset.R +++ b/tests/testthat/test-001-dataset.R @@ -30,7 +30,7 @@ test_that("Create validation/test dataset", { expect_contains(class(batch$fields), 'torch_tensor') expect_equal(dim(batch$fields), c(farms_count, fields_max, 9)) - expect_equal(dim(batch$fertilizers), c(farms_count, nrow(apus::fertilizers), 8)) + expect_equal(dim(batch$fertilizers), c(farms_count, nrow(apus::fertilizers), 10)) }) diff --git a/tests/testthat/test-002-model.R b/tests/testthat/test-002-model.R index 4f92774..cb13625 100644 --- a/tests/testthat/test-002-model.R +++ b/tests/testthat/test-002-model.R @@ -36,6 +36,14 @@ test_that("Calculate cost for module 1: Purchase of fertilizers", { expect_length(as.numeric(module1), farms_count) }) + +module4 <- calculateCostModule4(doses, fields, fertilizers) + +test_that("Calculate cost for module 4: Cost of applying fertilizers", { + expect_contains(class(module4), 'torch_tensor') + expect_length(as.numeric(module4), farms_count) +}) + module5 <- calculateRevenueModule5(doses, fields, fertilizers) test_that("Calculate revenue for module 5: Revenue of harvested crops", { From d7a7c3c708485408653b7c4cb164f3c7a88b22f9 Mon Sep 17 00:00:00 2001 From: Sven Verweij <37927107+SvenVw@users.noreply.github.com> Date: Fri, 3 May 2024 15:55:49 +0200 Subject: [PATCH 3/3] Update changelog --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ef905da..05aebb3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,5 +2,5 @@ ## Added * Adds `apus` object with the functions `addField`, `trainModel` and `optimizeFertilizerChoice` -* Adds for the cost function module 1,5 and 6 +* Adds for the cost function module 1,4, 5 and 6 * Adds default table for `cultivations`, `fertilizers`, `parameters` and `fines`