From 173515584c61c7cdbc334ee59c3f7342b8a6d2ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=89L=C3=88NE=20BLANCHETEAU?= Date: Tue, 30 Apr 2024 08:14:13 +0200 Subject: [PATCH] Switch gamSpline to gamLoess --- R/biomod2_data.R | 4 ++-- R/bm_Tuning.R | 23 +++++++++++++++-------- R/sysdata.rda | Bin 8536 -> 399 bytes 3 files changed, 17 insertions(+), 10 deletions(-) diff --git a/R/biomod2_data.R b/R/biomod2_data.R index f523a262..85c7c9e8 100644 --- a/R/biomod2_data.R +++ b/R/biomod2_data.R @@ -38,10 +38,10 @@ # , 'earth', 'MAXENT', 'maxnet', 'randomForest', 'biomod2', 'xgboost') # , func = c('nnet', 'rpart', 'fda', 'gam', 'bam', 'gam', 'gbm', 'glm' # , 'earth', 'MAXENT', 'maxnet', 'randomForest', 'bm_SRE', 'xgboost') -# , train = c('avNNet', 'rpart', 'fda', 'gamSpline', 'bam', 'gam', 'gbm', 'glm' +# , train = c('avNNet', 'rpart', 'fda', 'gamLoess', 'bam', 'gam', 'gbm', 'glm' # , 'earth', 'ENMevaluate', 'maxnet', 'rf', 'bm_SRE', 'xgbTree')) -# usethis::use_data(ModelsTable, overwrite = TRUE) +# usethis::use_data(ModelsTable, overwrite = TRUE, internal = TRUE) #' Bigboss pre-defined parameter values for single models #' diff --git a/R/bm_Tuning.R b/R/bm_Tuning.R index 93301394..0912ba56 100644 --- a/R/bm_Tuning.R +++ b/R/bm_Tuning.R @@ -207,6 +207,8 @@ bm_Tuning <- function(model, FDA.nprune = 2:38, GAM.select = c(TRUE, FALSE), GAM.method = c('GCV.Cp', 'GACV.Cp', 'REML', 'P-REML', 'ML', 'P-ML'), + GAM.span = c(0.3,0.5,0.7), + GAM.degree = 1, GBM.n.trees = c(500, 1000, 2500), GBM.interaction.depth = seq(2, 8, by = 3), GBM.shrinkage = c(0.001, 0.01, 0.1), @@ -375,8 +377,7 @@ bm_Tuning <- function(model, mySpExpl[, PA.i] == TRUE)] mySpExpl <- mySpExpl[which(calib.lines[, calib.i] == TRUE), ] mySpExpl <- mySpExpl[which(mySpExpl[, PA.i] == TRUE), ] - mySpExpl[, 1] <- as.factor(ifelse(mySpExpl[, 1] == 1 & !is.na(mySpExpl[, 1]) - , "Presence", "Absence")) + mySpExpl[, 1] <- as.factor(ifelse(mySpExpl[, 1] == 1 & !is.na(mySpExpl[, 1]), "presence", "absence")) myResp <- mySpExpl[, 1] myExpl <- mySpExpl[, 4:(3 + ncol(bm.format@data.env.var))] @@ -402,7 +403,7 @@ bm_Tuning <- function(model, if (model != "GLM") { cat("\n\t\t\t> Tuning parameters...") eval(parse(text = paste0("try(tuned.mod <- ", cmd.tuning))) - + ## GET tuned parameter values ------------------------------------------------------------- if (!is.null(tuned.mod)) { tmp <- tuned.mod$results @@ -540,7 +541,7 @@ bm_Tuning <- function(model, scope = .scope(head(myExpl), "gam::s", 6), direction = "both", trace = FALSE)) - if (!is.null(tuned.AIC)) { argstmp$formula <- deparse(tuned.AIC$formula) } + if (!is.null(tuned.AIC)) { argstmp$formula <- formula(deparse(tuned.AIC$formula)) } } } } @@ -591,6 +592,8 @@ bm_Tuning <- function(model, FDA.nprune = 2:38, GAM.select = c(TRUE, FALSE), GAM.method = c('GCV.Cp', 'GACV.Cp', 'REML', 'P-REML', 'ML', 'P-ML'), + GAM.span = c(0.3,0.5,0.7), + GAM.degree = 1, GBM.n.trees = c(500, 1000, 2500), GBM.interaction.depth = seq(2, 8, by = 3), GBM.shrinkage = c(0.001, 0.01, 0.1), @@ -632,7 +635,7 @@ bm_Tuning <- function(model, ## get tuning function and parameters --------------------------------------- - all.fun <- c('avNNet', 'rpart', 'rpart2', 'fda', 'gamSpline', 'bam', 'gam', 'gbm', 'glm', 'earth', 'rf', 'xgbTree') + all.fun <- c('avNNet', 'rpart', 'rpart2', 'fda', 'gamLoess', 'bam', 'gam', 'gbm', 'glm', 'earth', 'rf', 'xgbTree') all.params <- foreach (fi = all.fun) %do% { params <- caret::getModelInfo(model = fi) return(list(pkg = params[[fi]]$library, params = params[[fi]]$parameters$parameter)) @@ -644,12 +647,16 @@ bm_Tuning <- function(model, ## get tuning grid through params.train ------------------------------------- tuning.grid <- NULL if (model %in% c("ANN", "FDA", "GAM", "GBM", "MARS", "RF", "XGBOOST")) { - if (!(model == "GAM" && tuning.fun == "gamSpline")) { + if (!(model == "GAM")) { params.train = params.train[grep(model, names(params.train))] .fun_testIfIn(TRUE, "names(params.train)", names(params.train), paste0(model, ".", train.params$params)) - names(params.train) = sub(model, "", names(params.train)) - tuning.grid <- do.call(expand.grid, params.train) + } else if (tuning.fun == "gamLoess"){ + params.train = params.train[c('GAM.span',"GAM.degree")] + } else { + params.train = params.train[c('GAM.select','GAM.method')] } + names(params.train) = sub(model, "", names(params.train)) + tuning.grid <- do.call(expand.grid, params.train) } ## get tuning length -------------------------------------------------------- diff --git a/R/sysdata.rda b/R/sysdata.rda index c360dbc49bebae58f9ae0881de4d9c434fc1ab02..61adfad39854662db8acdde8543b313410effc7a 100644 GIT binary patch literal 399 zcmV;A0dW38T4*^jL0KkKS^l8WG5`Uef589$NB{r<5CA`ioIt4GlEVGEFJsdZRSSbS2ATn*M$#H> zL#tY*uiV-<;f1I*GDzCvfFkBdQ{v^*&}j`DZk+XjnEhfVu1P6A zv&9X^6e!oK^6GOTHq2H^dPF~qaaK~(9D$XR1=;|HNK74Wh=)KVwbJ4VXy1I+dwZ$# zp~vU>4bnN*wlIJ_BDv2Go4bH&=-6fI;`%t%=5b1MW4C;AMftTS&?)nqOL`9oWjW*cMVgZye#D`kkAC)+6!P69( zAhkYZmH655kszRKgWN-zRS>Hsey5mVM2Vs2#VnVH`9NB_bR8g#Q_M0{OJL(pB*Fw^ t(umm}`2-MvbtMae3eH6@cZ6xmA1W=CGy-e6`f)}6F64@Ep&|W2qGW!!YiVp7(yo?B|vCWrI`>VNE4(82nr&I z2_+!C8H^xZPyzX) zDgpp}i<}uGg#SywtTBLe(2$XIM*4WN?19(DProyAkK>PCG-F)Oy|dr)^wC^D-9A1! znNx|!j_JqH^l*`)qCx3^maj&7`a-c z(?tOwTpo_1OHu-W^`-Q5zv=>%1rpx8y`q|zj?AOy|3Aq90I=?U4NMVL0sw$niH1=m z7lX(7z(idD2>=xZ0HA<IQl5&TH{dJ26^D4dk~;yUzD`kVAOld2}) zei@N&Ue>41-Pe=CmA=fyG9JiE|LJY}D_O-nf!pxXQNTx)7MC;bkmS!Wflu?j4c8AW zJ;butL49x{ma;Rt2besur_+pjz76>K!;@+HL`$3+r;FZ$fcTn`X$kp`Z8OUv&36Ya_ zaziIyiE%(!xu%4KIx+CFdiXC8h$}^G`YCM$9gV`0noSfM1)fNvE)k#Sgi$v*sTdr& zm?CcXcC0ir>jh5@5~zdGUiN_JAy5J+d38?UJq>SD{A0Z#I0h@&uL&H2Re3?t}RGkz<3Rc{i~22U5ynuMXZaEp*M zf)}QH4A$?j7bCxFOE;};HnHecN-C2DnweRc>Ixk+mt^3s2*t~t6jsNx%@3S-`ZpF` zJzG$r81qqRi15<5Ab%=3+XGZPMavCc480`r)lGK#~P4y`f67cC0>W#xu@ToGFW1zy1W%bI zsSuDLTyn?|W4jj2=mk@DMVTMcbY9BoAg}#!y#1aoByL!OpRlJjX~XC4yxKCmW1j3} z7}dd4ye0BT-#*V#I?Ytr@YjdwLvsXxn|LFiq>Uy^5E~?qt?5OI|2QKC>4m3?gSI%s z;N?Gp{Teh%Fm41k;}62|j#zs%-Dtg*$Jb|ulGNaoiNeLTfE^N9l?MlkQnk&(@<|%B zNVTuo7m^Qs(`~($p$;1N-2>am{ITdf*h*dJ5a%K4ez-byOIio4+n*EQr5#krwT;rQ zC&)2okf-wJQL^jsa{L0aBsO5-d!_$h(gyc#nLk|j9%Inpjv76Ykc89?0A*pK>P72L z-0xX^!h_51N^O8vKjkq;8B6#Fe8IFeNI__Np@Ab|2qn0i^Yh6o9ao))+POByVJsiH zB`{=rZmphC0cNb6m`A1;hXixn2?ar)ikJ=9wqoMGO^XBo|8WY}77=_TBP^10>D|ZZ z44FGUCem>aDOJ4BsF(lzd*%4>0a4pqoVNA#J71I(ZySY}BAd6D##XY89xriz(4Kd| zywGS2km?Jmh2PQ4?h?o@M6!P45^flly020)5>OvM4MUG)dmPan1GC2<#>&FW zQ?PEQFNL&>i@zH%Lp8@<9d>^wokncFe40jv3PNJ2U(hPuuy{YtBAo%t_XqAavi22T za4aqnxX4Ko2Ue+qmxH^vM)%@ZHMaHQQXw(o>_xh)FAem4|9td9N2x7h9Nav;2F`;= ziBtSEGotR%v#+IMbZ;)eC@UNgQH>55l3=Zah}}f*2vE8@4L3!9At5>P2R#Xe$a;by z4w|Ds>74zZe$rVI=uMDUfL<0hegzV#bt)^Ew?t2sc(oe7d{Wj2avp@1*uHV|R+@|0 ziznN`VhPnMA4ST@0Sk?_2Zr?PwJbNmIi`JLz3;h!9@Z!y=aV|+p7qmq4Wquak8nW` z7|$2d1Y0J`#HFcPBDM749OgNA6dFIJEo1 z*e{TRlS3wNz8u4A2Hyi?(XC$XYoH3zXCc}E*KO)EE*#*qev{9z0$wL>*NtMs`F+5k z8QQaFDMiNPu=r3wsNmR`H~yzL1mRgfL&6IF(u*4}VxJp_09L{$1fVn?L^crQ6{6ei zOKXM$LYGHG;j(D)&e35ANsIELKLCWoE(hUSVB7%>P6tGnsM$C{!+nRvhXDE|h(95K z4bA|ZjAboD5L#4f;OKY+?Gv1zj5PCrb@Z#ziP{M4vcFyx5*dxBJbzl180Rw#z~0|0fGxYd ztY3lKnXEs8Y@Rr^TLSn6{z8n_0d4FMg|x%6f~YJj>Q4ximOlkEzCXGL9{x4l zH+UQZh1T3Z@B3U2zM;AhCOav?s5TBVuIg})Zh9ys(Bmi3@Y8O6Wv0BC0K8*%hrd?2j|*%F{vAjVnO4L-HY z>wYjKvAhS^6Z~zrK#xQnM_=6B*M}_zw_3KzkkJFbUAPiyf!PyAj9_te?Ggh( zz)&=Mi%Qkd19pkgaM=Dp>h9=51aCK+8p>ktPwO7|;726O6B@odO4-6u)WJNi?Heiy zAaW5#7!ucBmg&Mb%P9=PtMB$up4K$=o( zzLGCg3=MaB%+3#3@IGE{NzqP7i#S~Ut z)|SZJ*@VdCJ$l$4ljzMIzV!M_Yu?nj;oO&~53U)mzW$S%)6V&Ndb&@$P!IYDmuwTY z0^UK+XQaJ5?P1T+=o{}`(C2;!E;REw=SIuTGue4gPDZePbOfG=8BS?SWqx|$!c|V} zXw0w=iZMTulXLM&^7G=(=PBsaq*svxc>OO7)#O`cjJUF1XL%Lk?b-Gd|Fr6#J~Jem z5}zm?CHJA^c7e=60U4q5hoYj)03T0WFcY-dJ)TQqKTZ4ax>*|WQN}BaiO8pa2A{sp zbH^(m@iXC1XUYoW5m%EPu2!1^Tu{0TZ0P=n)+C z+5t8+l3fU-u+R#4Gognh(Zk<}P%xj1DD=Q{DV&nBC{!9PbBH8`qqvJgK|o3>LNtl3 zEC4LWXOUF!`|L#5LU2zZjTj@q&ou+Lu=oA3FDYQ!{xhOLfRD|R0UtC&K&3!9ifhV2 z21}K}l8y%9T$#9JqQYCECHNqflAg5hlwFqsmRo|UE<|MnI0b~GqS2BAXfb)PJn$*e zUIhw1+THDt5}|jvG!Yj+R0!tCRgwzP*H1k1XcIa@|1yw%N3hcV--HJ9y*T%xn|BRY z?AEpF>PLFT8;OsJSKLH(OI(!gELLJ(bqm#J<=l95;Buq@c*Mne_QSn<)YsE3@AR$t zIew`pO^D=kDJ}_-GwzONxk0KT>f<*;2L51`Yf3D=-g~sy&3UJDyo+DHAP>!@_4Rgk zZzxTT#43=}l` z@iZ5vsa?jgS7w4y2s>@QHqp!Zk*wRV`Jc+-fd6DjU+xC3NQ<7m?8kRef{Brd>jH zWc}y~>kzpFtZ_6j>IyYVn6K3oe4FTqR>aGI^^e~A)3Z6N((Be_eY~TIT&lhy(Gf>! zJTC=w7A&|;w9f;}Ik@OuwHI6NI4)WueJog749pkH1ilxHbvj%is2C-anx()we3)r; zRYvit!-r8rupQa+@^1!l2%%hj&8+9iHWZ!&iJ9@)0?WnB1H1sHkFGp9-jQ^oo)b|A2 z5~@M@W383&gVm9q>_kB7k^i3FM4~D93XzCLBM>nHht$C!T!M+yB|w|`0Y{NTy1)-+ zNzJO4^lxR0s@=Wq{M`A@VDjXQJoLqCC*YR?QB09yuxi62e3-=dhm$JV?j1tmcHcVyd%IuygMn7FJGO7cdSmhV6~Cb%w2l)SI~;J!i%Im;KlqVd z8x_poq}djV8k*gEykrfZTE_PTPi+=$e@-WFccQRsgQ^}rHtqHJU>jjEq(MfoU#O+! zvRa5K>M?%OYoTO8W0!zkQ`l9j?r-iaI`OsMjceKU+$ZwhzypJp!Q8@336Wmaj)jWv z&gr%~{wbBoHDR=C!8N>rp0x6>%46-B_~udnwv8Bku;QIqd~4R=7lVl(1SoGNETotn1Jy#SfHx7BwV%@3)Un}*-tVcs&wqmN9KD(QozXQH$okCMF`e>@RJOK@Fl4oEZ=pc4({rp{7U$0rU zsCbffBh5BReu>lkb%W8^#$`oIMvx#5H$+ucbx@AgIg=sK44dj*RPwq^^X6c{>Duh5q8A#BG(U5{g?2ns zLHKaHbF0)8H&5G}p;GMhh`Z{$DZSRr*mn9+w4ziPTm06_vD(_=eb|YO5%FG^XTt&C z6Yc9Vv^CYxoYIOEq=CGtyw!lgPw}J*qYACXwO3mCLmBLOYwZuS1@CLP!?g*&-c9Vh zv<&weuTl%F`DG_>+S-3@{dz)8!HqW=imP&Mg;Cb6jRn6KF1UD_W6p+?rQZ|;jgGMy ze;>X$;x;*~H67sb_tALHXC3zqPw1x*eBR4bR*u09?*ra{$X~0EAM+dUs$2XrJ<>g{ z*jG#9aO=lVdN(ETr9(~H&uJG`wB~DooxYZu=R0@m`KN1~jN%ycIi7=cwN~e|N4?44 zAA5TQ7Tpg$Ymh>SelE9I5gYfohHHat<>XmkNKb24v@`P`LR7ITSR)vrrt02)Wb9C- zf0>&Ir?tXr+d`qRrRjAs$e?<$B;ZEg(Uo^d4`;}e_illM(xD2wqQ3Z`-%tDU7!pR9 zbj&4uaO^6#!q4s7+RYRXg~CKwuT6!-#p4?b%lEM-U;Y@z2ZeeF&+m9wiVKj-oyF7o zE;TYU%Pp-H=9zf14{OHB?pYV1^?Yw(xoKfhP&>?oTVXk^w@@GOs-`?-q3aUHvAcRY zt#SqtD1P(&Fu8CwHTCY>wb$-%?ss+ibW9s{?5bg461L(iqv_v^OZvNJCkjSWUVJit z-mWQJRA2*1ewI6x)LyHoLhybT)K;O1?`@j?bg3}XU99r{Z|WQb*`0ju4VZOJ`mYO_x0V}n&>395A-zkXeEC8^5q=? zHlD23yFKci)NWPLG8M&vPi6F}3?&a2Ugt6k>fBO?_t$EV28W$hNfIm*nDp0YVOF<=%FmZ?yj-6_@8U*zcX*4d3_ zjfKX%bze2)#QeZIlspND{#3s}Hnn~rHO2HTT02~vQc~XObK05yXzKJtg^iJ#l~8Zh z*TY1)0jPC!lfTf?#Y^{o6~twJqqPq7*)0Ejn}N>*cX1rLXVKi;24E;Sjghir>?7w+UyiwIZ>WEV z8jv>JS>|SY+{z}SPn4C*d{|hNg7`R&t@fPquZ>kyy&-&t+t00?YOe~ED{C_KrO~1? zF^p#Gp8nDcbnIdT_ph_PfnHsR+}41OoPP~MtHWP2kvK~@=xt{bHRv~du1I9oYi_l~ zJHSUJZ$M2UWvUBkub`kHgEW6J^2FPEdouo0{ds)1pS=h%@SP) z^Lf5SZdqsf3%@!Q23ZDlel52!oUHj!V~bL4TPP+#9@B4fmac^oBuehx{-suTwC1yd zbx2+9uYkLUo)=1IwK7ktlvhh^4MoSbyA?Gl`}xOgtQ6gt?ONT~TS~WG2ed9`MyC zyEUi!*9>FEo#nMv?9Agx8lH?g(@E8u0K*#VcRsKik(p%ASbUFW(YNQnQ5Mrp%k>4< zW6+~poiz&IxX+&Yzfd#KOW3I#SKVEdTgArR6tkZgcFwI}NNhIQq%-@5)T-|MI62|i zzs#L;c@&gc*gZ6+)RoMv_9K_ue;5`KK?uak(@sW=D0B0s1YiUdx;o9NCr+o%@FOki@d@Glj zV^-h5?tNd>%+!)6XuZr-I;mMiE~$(Zpewe&ntqrP)u5pPi&cTu#G%%C&Ir<^}4ZB2=Z zC;#{{=<#zn&q80_;-ERWH_c%|>bj!CceP69$q8*jxVsl`vh{l-Gc9ZB`~)HT(eQdm zzyB_lH9fzP?m2|~ky$H})>NxkQgoqtp*+1rY$ZpeE7`0M(K_jwmgfH4rk4{8PH9&9 z$T|EO44!JIK|P@EDe{I>G%HipyW%0D9#w^l%})AqEshCM?eYq3E*2JPfdMWakEcp` z(HAd9R;PKyou}tc{qkXPQWgy&W^c9m&({ur(ju@|HC?z}8|c~80EwM+xdrFl-(thp zi{0c_ijP^0WRA$!aznw*<*`dg42&w^&nFGE!G9M0@+uM^y7c)6UC5raIbPki)D`AO zIQD(SOQGjJ^RQLrV7g+2*amaMd-j^EAFJpW*A_J5bHhSL>yTeqMU;dEr59;2>w~%-`34wJN{7LruI) zsmZY0cKH2xxOl0^{LkCA3u=GMS3Qf*a&LHzzoqV>`bgRf+vh`~f15QW7;InNHlbkS z*+v2o76SQO70O3O0Q%9uFpHM+{#WNGZ~rbRjd^vOgq%?VQmJ7iB4HYgm*KIA0${}q zsW|1NiI&DFa}l}917iY*y#!#A>~2SMQzy9;o)Op(qpq%GMNS%yape0iTbK;(dF&B` z_t2NlZ?bT3RZ8heD02{qiS0BY4aAn>Go(>95K36G$?9A&TS-&yeIL9Afyzgj=^#S0 z_KH8Eywo|w-@u*GKjrrzf@Cocv8^&>^=0&@eS*qDELbU(2fTfimGIQ|=ap2?#d??@RIgn8|7Mi@)*50~(DVW~qp z%^L8HSl9R8w3lZk+KOMRFggj(2tV;umcQ$kiYK&jjnN&l(_q#_ND6bC+k3eMVLiBR zJ7#2Lj(lsCJYx`xLTcafeBy_E7`SWD6%*UT+Ui-(3B5=|9man1F<8};N>_#J=Pu(h z<%IZ9#g(|8A%eR#V?pL|pcEtxS#SI0*;ACDHYEu71y%)nQ@TJB)9bt<`XV^OVbkeb z>ez();;9S0A_bm