From 0c7559aa3e8ae07f59911e5691df19ce79cf1561 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lorena=20Gonz=C3=A1lez=20P=C3=A9rez?= Date: Fri, 4 Oct 2019 14:09:30 -0700 Subject: [PATCH] arranging --- ... sobre un archivo con clic derecho W7.docx | Bin 0 -> 14546 bytes r/ROTOPIXELS/legacy/GRAFICAS_ROTOPIXELS.R | 126 -------- .../arrangeDBFTablestoExcel_rotopixels.R | 95 ------ .../arrangeDBFTables toExcel_groupByCamDate.R | 95 ------ ... toExcel_groupUniqueName_SQ_calculateVIs.R | 92 ------ .../joinExcels_cmd(WorkInProgress).R | 65 ----- r/arrangeTables/.Rhistory | 0 .../VIs_TableCalculationMCA_cmd.R | 0 .../VIs_TableCalculationSequoia_cmd.R | 0 ...arrangeDBFTables toExcel_groupUniqueName.R | 0 ...oExcel_groupByCamDateTrial(workprogress).R | 0 ...lStatisticsOneBandOneExperimentManyDates.R | 0 .../splitCodeName521.R | 0 .../check => arrangeTables}/stackCVStoXLSX.R | 0 r/{ => examples}/ROTOPIXELS/SCRIPT_UNIDO.R | 0 .../ROTOPIXELS/graficas_rotopixels.R | 0 .../get_daily_solarRad_CHECKvALIDITY.R | 0 .../kelvin100toCelsiusInsideFolder.R | 0 .../kelvinx100toCelsius.R | 0 .../Extract image data script - notes.docx | Bin r/functions_ImgProcessing.R | 83 +++++- r/image_processing_aux/.Rhistory | 58 ++++ r/image_processing_aux/NDVIFromMCA-6Images.R | 42 --- ...older_based_on_autopano_file_slantrange3.R | 16 -- .../stack3Slantrangebands_insideFolder.R | 57 ---- .../{check => }/stack6MCAbands_cmd.R | 0 .../{check => }/stackBandsRedEdge_cmd.R | 0 .../{check => }/stackBandsSequoia.R | 0 .../{check => }/stackBandsSequoia_cmd.R | 4 +- .../stackMCAbandsAsExportedFromAutopano.R | 0 ...tackMCAbandsAsExportedFromAutopanoFolder.R | 0 .../stackMCAbandsAsExportedFromAutopano_cmd.R | 0 r/moisture/.Rhistory | 0 ...stureSamplingDataFromExcel_710comparison.R | 115 -------- ...etMoistureSamplingDataFromExcel_trial200.R | 166 ----------- ...etMoistureSamplingDataFromExcel_trial521.R | 109 ------- ...DataFromExcel_trialAE521_graficasHumedad.R | 270 ------------------ ...l.R => getMoistureSamplingDataFromExcel.R} | 27 -- 38 files changed, 137 insertions(+), 1283 deletions(-) create mode 100644 WindowsShell/Ejecutar un script sobre un archivo con clic derecho W7.docx delete mode 100644 r/ROTOPIXELS/legacy/GRAFICAS_ROTOPIXELS.R delete mode 100644 r/ROTOPIXELS/legacy/arrangeDBFTablestoExcel_rotopixels.R delete mode 100644 r/arrangeTables(check)/arrangeDBFTables toExcel_groupByCamDate.R delete mode 100644 r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName_SQ_calculateVIs.R delete mode 100644 r/arrangeTables(check)/joinExcels_cmd(WorkInProgress).R create mode 100644 r/arrangeTables/.Rhistory rename r/{arrangeTables(check) => arrangeTables}/VIs_TableCalculationMCA_cmd.R (100%) rename r/{arrangeTables(check) => arrangeTables}/VIs_TableCalculationSequoia_cmd.R (100%) rename r/{arrangeTables(check) => arrangeTables}/arrangeDBFTables toExcel_groupUniqueName.R (100%) rename r/{arrangeTables(check) => arrangeTables}/arrangeDBFTablestoExcel_groupByCamDateTrial(workprogress).R (100%) rename r/{arrangeTables(check) => arrangeTables}/mergeZonalStatisticsOneBandOneExperimentManyDates.R (100%) rename r/{arrangeTables(check) => arrangeTables}/splitCodeName521.R (100%) rename r/{image_processing_aux/check => arrangeTables}/stackCVStoXLSX.R (100%) rename r/{ => examples}/ROTOPIXELS/SCRIPT_UNIDO.R (100%) rename r/{ => examples}/ROTOPIXELS/graficas_rotopixels.R (100%) rename r/{weather => examples}/get_daily_solarRad_CHECKvALIDITY.R (100%) rename r/{image_processing_aux => examples}/kelvin100toCelsiusInsideFolder.R (100%) rename r/{image_processing_aux => examples}/kelvinx100toCelsius.R (100%) rename Extract image data script - notes.docx => r/extract/Extract image data script - notes.docx (100%) create mode 100644 r/image_processing_aux/.Rhistory delete mode 100644 r/image_processing_aux/NDVIFromMCA-6Images.R delete mode 100644 r/image_processing_aux/separate_images_in_folder_based_on_autopano_file_slantrange3.R delete mode 100644 r/image_processing_aux/stack3Slantrangebands_insideFolder.R rename r/image_processing_aux/{check => }/stack6MCAbands_cmd.R (100%) rename r/image_processing_aux/{check => }/stackBandsRedEdge_cmd.R (100%) rename r/image_processing_aux/{check => }/stackBandsSequoia.R (100%) rename r/image_processing_aux/{check => }/stackBandsSequoia_cmd.R (93%) rename r/image_processing_aux/{check => }/stackMCAbandsAsExportedFromAutopano.R (100%) rename r/image_processing_aux/{check => }/stackMCAbandsAsExportedFromAutopanoFolder.R (100%) rename r/image_processing_aux/{check => }/stackMCAbandsAsExportedFromAutopano_cmd.R (100%) create mode 100644 r/moisture/.Rhistory delete mode 100644 r/moisture/171020_getMoistureSamplingDataFromExcel_710comparison.R delete mode 100644 r/moisture/180528_getMoistureSamplingDataFromExcel_trial200.R delete mode 100644 r/moisture/archive/171020_getMoistureSamplingDataFromExcel_trial521.R delete mode 100644 r/moisture/archive/171031_getMoistureSamplingDataFromExcel_trialAE521_graficasHumedad.R rename r/moisture/{171020_getMoistureSamplingDataFromExcel.R => getMoistureSamplingDataFromExcel.R} (56%) diff --git a/WindowsShell/Ejecutar un script sobre un archivo con clic derecho W7.docx b/WindowsShell/Ejecutar un script sobre un archivo con clic derecho W7.docx new file mode 100644 index 0000000000000000000000000000000000000000..ff51fb5ef4a43378a492a9e16545041c4ba417ad GIT binary patch literal 14546 zcmeHug@N5vaI$Vex{125XD~0;1kd~d zB!c~e=#6lG%S+ofH%lQo3;SRn@%W18I5bP(@BT0vYa5yWZ%0JMwMaZv+}b7F*JSxVrY|N)yR4KaFB$3B5}?i z_0Ifd&QKeYikAWrpqLcGgQXUKWcYBAqrlf3H(Hd}N>d6mYek4Uw>cfjOSj2TOE#W# zHX^!7AVd+#meBQsxild)Wt3nT8=*`$SI_jSzoV^e(a})CEVf3pd-yVis^xuxnV0G( z>1rc4sa8H=Gwz$z&2WrPO2dRSrR6GYu!P+)jKqGT<%7mN6 zE1}i|^b)W|uV&*=!8gu&eFXz3{7pOw<8kZH-g-W~Ngv#scmvrrh;En*%;ztyVh!SdsL1R8(5<)X>RCot(ci8vf_c|u(;2KQNW$6lCy&0+hmXAxxl>2-b0Kn!w0D$uLP+V;t zjG2sWjhwCDY}jwc>sUv|5w8)Yt(f)|1gDqed;HG?>dBD=J?)y-N-f(`de6J+6)S%> z;_w@IW)S9rGzrz0Aw8vJN1MinoSoDHypD4cB~~fTkAvS3+3@*2ngqSf*-bsJck?63 zDMgCdQ}ZxXWRm@uQHH`Iedye-9u|Gbh?f*lCN*H^VEbgDVwc*VM^p1n$-C(dyO5Dd zoE(!vDhv!{m*`WSxeZ`u3xh(XEf?7e6(~&>e_X^RODKu$Y87gIZC9cYDdJc;3yL6_ z^~b`}E2m^oastm*+%V+9S1?)VRS|c#Cb_xnb}&*@um%${Fsx{zJ~FUYlrWjG6q?u+ z4|rb&A$2oK&cJeN&L;I;OsYRqidQ3PWQobs!hYyd+ zYa$iE_8$&M*@53%$~E9MBtJv(XOEm4D_bb=3sS1+?y4(bnTmTc0YX}NK*DM zD>=K62NvJopq3?Lh=YsCdX(pNJqb9SI7rtS)ZEUu--Rq(J5|3rm}v*w?w;y-m!- zYa)=*3;FS=_$KrQZCQD<^IOi#NY{vh7^{#|iJN6uif-?D#uvMe&;)b}skP@kSD0ui zaJlZZP;y{IFxa7X`(r&PJSct_u#0gD`&(>5fcTClBPq|6e#(W7o62n(qxp$*v(`s_ zN0-64>yeCvPnq`c0FF?08wfM$NkR`3L>4uLK1fm-9T`HT?G{}Vr90B0;V&9$pPb&C z=t@B0#JDIIvj=rbVNA;+XimIyT?kf+<5Av>({?Iiw6Iz7D3?*W2~BO*aU^RHBbAb# zZPrIMO%jdj^aopWiY<_(Sg{iWW?<=+BGO)!>s4{aw6IPVrs&eFZ)JEQUNcX?JxfAJ z2u*;iJRCN933t~ccC?%*`!hGC)OAfq#gnM&9Azofoqx91a-S+;-0t>@-VJ1GVj((S zsOpEx5{6;^RA9sw2P`!#!h1~o0VB9K#ler~z4=j_ldYQ4Ny7JTLd3|HONgqedSSEG zyBkTER&a)o&*xM3Q@$u0Kh3p!V;Mis>zJny7LDXOHK>Q5pfPuLBe~HJYG4`?n0RNR zrFJG4LxliO%4Yp-l;SD6^5i&8Z_i7nV{CE7Cz97G&njA|lWiDmgyB(*vv>sjF7G-V z9Vy;5+DMFLL`PSbHbdFn7Xv=47>!tL_uG@QJe+F6*hL#hk#5_Dz4d`}P22X2O?7Z{ z`)V_0&*F#85xfr@)`T7QTwOo=3OV_VyAS-&Z;F5 z=c@RgO0f6NfHj%5BmL6t2|2xI&{?kza~FhRb)j(tE+;~1hB1}zzJa$S-^m@NOWXcK1YI%)0b_y|O*xXa->PiDwwyX5h>&R32k?-dw58o>+k{lvmPaOc67C|~=g+n;NmOH7 zXFStbl>J_P`+mI}pFm`4g?r}K|Gm3sC*(gWKLjEL*JMhDTz4Apa-4XcPQU0+cO z?mvC^>4TqsXW_Eu$G$q~6arI_-EZL`jd0SEz`mKc?w(Gi;p&xVzrS*MJ>6O74Xiig z7bd1k50N=({?0y)#aV&HCXIw-w)E3jW_gFvG_MQQ>li(Yu2Pk72}lKW4>;n7(qTNJ zXG`7BBUHt`fp9x++LgK@fj+RfNS13)ZCyK2TwNQC!5yI~(r^-gJPrq5SK!^aU{}Qv zI2@ij)_P4Zy5^gk%ynVpW27$2br59Jrn~Hl?c;lmh0)I03uT@*P-ZJ2eXPC^aCg^| z?%(Oes^{m;#T~t_*^!oM{@9>ZF;BS0tNskI`ymLN3uNr)z)RP0aGd{o?ECsOU(tLe zFC?Nvi;9=g83E@6-W9|0&htEYSiQgL-pP3sh$$>e#w@hzqX8spmlvezEG{VvacvLq zHXCp@ivk3vcVQy{XGpr!lJd4b2fokWgA@!!8QY<&IKKjyue4gM+p2_ulY!b!zaTRCGSP zbYPIObI#bs3!wT7p}LjTRC3>dvDS%O#(Wc$Y{zoMGkPHvMN#!$>hs8gjBm3-AFi}_ zLzK0ZJ-G?>@>CM}OOy2b~4C1ul3p@L7w%#5>aX>uBGB7<)d8 z+!z(eX|;QcNu!2BP6x)Y0nOTiXFaYeF!*w>S~);#$RR?CYMgDgK!|#8HzCrfEG$dQ zg+RzW7IyAje{iWJbj6)Lbk@cJTl`|oHSABz5WioC6HEl9_VF^%NX}mhspZs&wMkA> zxK6_lRIx5rVs5zHkW~Zm&jlCjEFNI>t-sHkABaQTNuqOJktjD|N_7lM31glwLr0cC zv(sjQ;@{|aW7e)6JBKq`d695yJ0cIKA)}jKfZ8Rsn{xJ_<0pRp8Um~N1*U&7BhW1Z z<|26aF()xAjSAW4X8DrnZSDViW5A6?#zqGT07T;g02ps0erF>ma}#S5rr*yjzi$pS zx+!@mbVn29+l!cj_<>b zQZEQKf_d0<$@U5kf(!!`GvYKdYDQiRo5VLy~WVt`+@{37BpH_QHXwnI8Z z9!`ynQ-sna*Jn-8#u8ISo{^2O=b3R16-pLKXkp4w1z;$j^EL)4hrUfMbfzqA1Hv|3*3}5lukFVoT2TO)_qDPQcqS9-9QY;a9%^Nj;0)hswVDM zUbBCPsYiftxwji@tM?A7I94y~-NWwn#rCv>pmup>C;L=|p6_e#y1XESufXf+O=8ut zThX@f>tXG>&+`=G4)6Kw{P>I8#qlgx&g*?Q8eB_e=T}6cO>h=FFoM8kb`-Q)c)z~I z_FC*-_Fz=slEWh^M&{8X(FHu4TP*@Zd_=rhG2Txt6b1TJ&RFBaOWOb*d5-| zQn99UJi4hyhl**1@!scFMcXzaZpL`a`om`ioESd{mUSLjSk2c+Nq3orX|~?qPKpH4 zo8B>VZZ*XQMzQj4ZV*BWgjJB>Y<~Tkp(Z|WM|#OxkAi;B39R+Sx~Bfxc$QCwM&klO z&Y2p9ZP)^9hEJ*1$4tWOfONSaerfOtLc9Y9D?JAJvjH+`pA{!pZKKd#QyiA((%m3G zOFT}0DCZ7gfr`ZK;b)?5W6RyBX^noL9>iYM;0?@OHPo3Ek{ZTKz;wl7TV#CvY3sq@$TormdLZInOOnvBJ1UAk@dY!PP;Wd;KEOU{%xtJcT>;psi)SD_fHU>g_B39`Z}}8nZ`d_y#ru) zHXH+P)0A8(i?9&I^1o2$?;3TnWA^siK{5{I(gsFd$}`6z0l6`{Rc4`4v>Rfu)08O3 zpk}RZ82AS07mE$ov??&=i@E@ps?FT`5ia()7cJi>bp!$!R?D;s2$SJJr*7BdCLr0Q zW*Epb#I|wBXGX??#g@DBC{}GvKDS|NqC6tKzpoA1-;3(;2m}vim2dQpUv(V6t~1D( zuGB1=Pth5tnudh2ZcHctW`f;~T)~y&Sh-x5gnMmF&1u1|eMUO3Bs%xazrYj$KT<&b zE+`Z5fp1K71zwCL9oAR&h>~1!$sV)~`r219#iGxRsD?YVw9@MZW{(;SoC;X+!-DuQ zLi_t%l4DEm&QfwD7SBx~6^LM-A2rmwa1+3{+Ai5 zI337rZBeFSY}WQwc@326krn1oz`CWpI9a0xZbc`S@y#zS1^J^QEV?<#n)I9+@y8RQj>90N@^Z~SEzKf&M&GBr163JUe`w7!ezRGoxwwT25Vz(?6Ov=CQ_%jN zF*9}{oQqJeld(J&cJ&TnPQ8MkIKs2=i*-vz?)D>a_paC3S)5y0Wis4N{5+B<*^xq_ zBDg8bj(OOw-(BINsZ#&yNvUubLE2`uB1ucHUhl|5ua)=wOR`VZtpa#(ztrq-KVif^ z4y%5Pr{W3TnSR1nhBr;FRQeZBJ58LjJEqx;ix-M^s=)YTR{&gvn=1#v}3n8(S53B zUi~h0LdePEqEj>(n4QcxoXUh}zu0~NcHpiX^D$e^zOETjed<8eWzju>TiEC0BJ%C0 zvRxNoSz0zK4Btp3Zh{FU+$$`BUjGoVJ|F3WdHqeOMOej-A0|cv>deOXY4e0+egRuy zTEMQ;d2C3knoWE!(4WyYjl`Rbd=Fp~1RUs4vxb5%?bo`M=_F?@AWll#CPwU5oM=Kx z%vIyJ)xE}{NuB^2l}j;l;wf$2j%$~E+~TBkRGfo%+$KdtFNzD?@Q^6DU0Zm)f!rA5 zTl76a_7rbjBY~~rJ{2lCTHMOGF85c->(T0lU^zk~Z-L8dvAf29gap=0I8}D=!>%5& zUtK#RZebycQ8nZ&IB}PJfhMevee3Aj#2V{bOk8$!9oN z7$Vpyw@rXraoohr*SfEMf;}hLpjCwNE3H4zguNj)JiWpu!k1Fbe4t4Xc(Oo1P@myk zM|1v);pxEx7JFWQBDeLqLnt~ef*M`8bi;M}hB(a84edoFGn+XtM3y;&4xCGw>hzdF zCrTh$*7pM?l?mI>7PXxREp0F?0qGASJ~)ycSNW2`^L0*ijs-MU`hU0-5e9! z_Owwb$0GfOwo!cCg(xF&(vQ8i!q`=~A&30liDMbE3`-=2oMWc>G6TNL##eS3-}m21 z6uEA1W*$-)ry#6TZOaTi*`OmZ^=TGZBk(ws% zr=Nu(?~C5CxuCz2V)0c-gF5LDXig%eXHwcrv-69h?!}`F842>xOJ7PS-AzbUTS6}A zW{f1T+iYCpe8Bs8w&+C|(`T`wKT=zr6O~sYNFc81i$ZZ|hdGK>%l%kvE&3|t@yPU# zdO=`{g-h;DFML7<08sz%I&GY-fhG=bn&CIa(30}ec8M81q+Nc=H;nYeD3gvPTDr`o zT)EgLqwW+ctp~ZRO*97P{LD2A4qaFgmAuUW_{jgR>iNOJv)y!tx_Tsh18usoP7dr! zgFJ|da<6^9xNL&mA=oXTWWx<;V`sCr?)~D_9Pu+@v^ppTlG%;0qQ(taByAFJvTGlK zGgO5WUO3RJquU>#34BMzQl}#g8}xSbz)z)q+TXE zBH8!jo+U^uoV^KdtOOE>90x-d^7WKO3_rGlfhdJM&W>+^kb%&?cyTDA)-WS79%y}- zXfQ>3QwlvjI?{x*7wXGy*&Zsr^I~Wu%?DM&MWlMHBdVn<329wA(4UIQmrw0DlOUrl zz-T^%Q)62{RInCryWAhRWvD4Pg1JbwfASSC8<9sNXzq?M@8QgofqgXMOlP*+wAm0+ zzOr%1j)9T{v(xq?rX*lkW&W}VE`WR=leq1ZrWiQLWmP|`zPQC-@0AKnKQZ6oU%Ik6 ztGeb`2~=%9ef}^oF0*GF!OD%QfiJ++5N9q;XL9dS5 zdo-Vb_#Hy{agGndrW6rdyAgB_L#pUgbXqv4+)DS7V%Y?_|9Y717Lo?@_) z!f@||D5}bY=klH!l}*?ww#jd*I4aW+&m>$Ik2!f4_4Fkev&sLxA_YciR9C!h=xw0& zvb+hRNsL^Ba&M>1LAW&?8a`UcQK#Qc#Qbs{)7VYji^R%|62H2t^R4z#fL(>My8Osj z?V<$IHfkahJ%b-@YO9O1nxTt)Z(lBg+G1evE}R!*|v3k z>((4_&9SMlUe;ZzM66G8K9ASqzE2O=EW`T1PY}3qrbLP7#x(<1yZt98^g8E3CTBYd z#Sh($Dlo%0GB?%P%r_eJ^}^}&nvABTnD@iCYhz=R1zja1=sY=*ary(*l5QExKdpO> z%kkq(w`NDfjRBR@1(SV-|M1x*qFG zwLs!;0XzYA=n>HU++VPld22ccxe*;TjA~MY1my$BpWLqEqqIQ;;H<9yBN zdUx1~GI$;^u8Fdr?p}JTa#Q1B^4gqW@d-knND~v*zKSkCJbdE($22<{+B1xqrccIO z7ICxdY4TnwZ8y4pT$G%0xv1yZ_IXntGe`FJ_Q-Wi4ngazm)^T%eS2~4Bxf|^pnj_2 zO!;a~)={2P)>=+pZo_4^`tnuWF||s6F(8#5y$+vqypiy(S%MD|7tW}*wHxUs(l+?e zTy3X@wg+_RReiyFVtWa334eMj|3UfPD}A>Fp`7D$=U`7t;rf%0V{wqmQYcj-Ql0Gc zUJ})omMDrmp1v#=>6RcS|MRB{^XHc{^*NbYywCJX&v!2uUkM=WF?HXCdRb(Z3d*HV z?nJ_bjn>0`Wn2k)Rqb}6qiEW~%1S?^S@4doo|PcEl@*;cx8|yKn{|0)P!W2xRh{V6 z#&G(n20_rOD%AgW`B+ao0DQ@T2xs3KFGMk9@oNg-wj;~fX2#3dK1a>iu7=Inwgb)B z#y&8QF~ZO1i7|}W*kN^w?&>pGca6IBIo;#vifwk6I^VX@19@u5r1BCx-Me3XYvR4z zw)xch{MPi5zkbCMf@{gt;@y&oBh8h{9{<4ol^d=M$MBvNJAdtgz1Wl_s4P#dD%^#+ z*1++PQL>(l8DD{MIW?>ScV;Z4;HlD=g@~(bs#xbKf@k?XleZJU ztpD~yl|9d=%zXRtL~rM7_Eu(d%<5+U>6np4OigTMzY2eWtSz9AiEEZ+dLxGBHg~}R zB`tqyb-^_A>u%QI0YyWx#_OPH&Y(j%2Sd9V1&;Ck zuyLb7dUc}`9E(?J)%ZA6y%kTBkShxsO|(s_HVm5m`})9!w)SWImEl4uHo5)@z_{_J z;h-o@0+^>=sGR4>qJUyvm=F44TAtEQZUbFo5S^sT3C5zLQ_HgPun8P9moMG=rU|8C zAuh#k?ozU2;bF=t^uuyc{`J=_KMVGW0#@U8pF5M7`-4klo#jD4;&YBfEc&{0`+RvM z1xp|k(T`jq^!=u-izgR~*Dhzi*=LJVp5funyq%i+m0{&)U!9#wv_Pz83d}x@iY=k4 z<3~bg&weUj4Ea8#(a5w)u#d!=NOSLN7?bSd3vfDgtDQzTaPx=4)N!9#cG&(@_y zje#22$*7p(6oJ8t76yg|pi%9@#UOaT=^wy2U$nAO#lJzAca-$u9A3&hr4)nY%1er>3Dc)IG zp(B~TB((u8;1MT4v#FE8PaY8b8C7l>BBsd{K$b@zQ%KHRSEpy!q?pfWO1F9I6FZ5~ z8mT#e#TwJ#@NI>ltoF#l{i^Q==b|M%FZY8cKmDaalSVe0IWWeBQ+&?Co6gG7|2u0% z^+RQ9Wwkb8IB6*ztZgIr5)q+Qzc<}a1IKfZ_Q?o-d~BFu{w4gzHJN(SSSax>)^(() zZ#Fh!J_q3~21j2ViSh5Eb5to0u)X@d^UX0EHw?&iE)2@y9Mf^-jT@~0lsBC79VxIF*48xw!31lbC1iJe(Hpot@cHp= z=3Kko=K7X))NNvLk;uoRjAOXr(f-_NTO9tA>q=NBS{xpWIi*8Lei1pB$@$98TXVq* z^tBa)I{1ne#I}7cM$}z;1#z!g9qv~+J2FUHs1@jMiX@=cGbnrzT%aZ@$fqVMl0tYG zq!Z%7Z#|ok@MbF5v23(acPz98Kd~{C{?-15Pzihg`>>mpWxnp#C|DZvd|~jV5@dhQ zFRM&3%(PMcI2e78ZwRly_R)&wM#G}~Hgu?jcxAXGE`alorW7vn2Rw|v?I_r7?>ERh z@nH1dr}oEzXZlS|hj+sL5dVzflK)iDXCkAk^oTbr*C8D}oRX!qT~nx6YQLyd zHPc`<$iTsHkjP zZ89JJxOu7i8{DZ(1iTYTOb)H+((hD#w^FliVDV=T^V28VPlG?HVnLURd?@cvS}KAn4PzZ91|Z7#x^x4WTLe2Os%kn;{W;xV3Gu3MVD zU#}6xgN}s7YAUaO7^Ig_R1dDCi~XrY!m0! zY4pugA208U9tm4r)#~?;nx?8be0)H%HC-A$jH)vZ`p4wMgf`q%FuqR9Gj%Nd^5`PI zcW9>I3*)XXh)jrr_@7eOzYrc!9YeD`WWWV}QKe#U-#gF3qOY{UVZzfE?6OUSSPInZ z?g|j2r3Wq?I2^L{AM@g^I7OGuCTpCe=;;uioYrf@66!8^*==?niQNUlE!XiT(ryiX zNG`OtD&3>%DntCKZ3})()Fj*HF_5dLJHL}$+5%J$xr(SfIl!P-TAhCK(D_N^v$;D` zee_Zpp7%occ>T{snXNO??No0`$Jn=`O!PlC8m=Zl<-Y^~lcq*3L0OOi8=jxfkR9gB zl?v%Ag=tdsq(7g4^&FRnn6i?fH7^z0u2}k>Z|MnB4tfm+r8Br3^gxN$?a=YyVk-G@ zsc5%X?kxXsu%m;ZI{A1qAVP81;lR?~mhs&Lt_(|(CdW7)W1J#G+C~YsP|1qZFC!Ga zV}CS+^eCyjL9Jx_krN)?aAL5syw;+sPmCp5f>JL}VOj(1&bSWxo%20yz%Z%%+Cm3a zMXTsXnmLjLkUbrwCR?QMH-aMvd+@>^Nm)27(js}=A{2CSv1ZX^~iv@-Onz@r>};tx0MZ-#HS6BI@flxmqDXPY`>Ak%@4P*9s{? z9A4tF%*i2i$bI=f`2_b*NxLdFfr7rb2OIfTjQ*eSiRoKGx{4vt%H+53$x6by(8noi(>&(u9P zQf!rYV*Yh*R)s~IL6Rihir!*fQM+DU{aw=g4VUrnwKYXlFxU2uSBHirxMpC;<@E|U ziqniiZ9}Zc+3fh3m8qD4(N`f*{12RLE3faa>$}oFL48-&3RYHQt}8<8^9|a{5Qn*+ z4G)axEO;1^i54~ctSpda(Jf&fc=fo(M*>o9mM`&Xb4ZW*{s`7M=^Rl94Rc}SIxnc} zGOI9q($>#`Ft-7;Ja}o`sGLeXB-z*g{aAOB8GKfhS7A@sk@m;zeZFY&Zy^S*?aV+uC4&BjH z#kH`3px9uouz7qxBu-VmHnBlxfg1omwds8fquwhQ83~I1c@`BlSNTMxp601Lccm1p zU@%{ySAWKQWJ`@V4q6Z{mdVmhpc}^D8*m z+Bq^A**g5b=x>$I|Ci=}(=%QPx*r4IVuxo?k4Oogax;p&ljw7b*s|CoUt^o&vg!;e zL&%>W?v$68TR1d~!Lhzkp0L`$e!E^X#^!4S@70+>Z9>?ORvoFAXzmEPu&o1R zA+vVD@}rHgt-y$|VNVLt{LE#i)4l`kWSPl*?-{yH-A6SSsCs%7{Emk#`I-+*ebR_~ zLYoT8u69v0^P9x-3(E_2j{c*fNNKaK{d;yS{%y=OTYB9_jM|#Pi^X~yUk=AMD|LZX zVnP?E2bGi@)tFaG0xLs?W{Esk0T%qL?jBFJuw3hmlYL&wv%~AJ86+8TZs-a2l2f!K znhB;sUe1M#r#V4K3LC!L-jb)?ZaNh9;yyTU7MQE;N&Dcp;Lv}wp)>mUH_taV9Did& z@a?g^9a&1lAKr>hTF5St6i+J>l|Y2G)k`q8I%F(!&4$;=F=MP3 z8S{L{L*7GgiGOIWUAq|RsrEUOy$vC;G*fryVY-B`aFSj&O%_z=svYK!l+vJxs%;pG z#lGSY6!0(J;14NaF%>o3rnObRRF4u{1X68f^`%gLhs&0n2?=RznnSJsK*;+ooFQT> zYtvJ>Okwm%G7Tw8-S)7(U}#WJ->Wp{(@$=d1$Q#k%TS-`kz^TyYLwt13Paje5+<3h ze#B3rf$>a!2oT4*3h_C~LGTn-S|~xX=p;-`m=M)4fcZ5%2C+P+`_`0BG4fOG4eVZDuo&JVDGc+!6JU83N(U>$wV zdKz0sMq*x77mMmP%b^$FFY&S#R({N!w#0ce_HH>?y0Hcjd@dR2EHMP%Nb!+jeunt= z5l>~^>;>@wT0i7&aQMnyXx+?o9UF&;2=UJ(BnT+Oo6GUfFK_*8dHy{A!>e2hGJhxV z_t#7QgaQCLZ>st)FPr=d{I%}>PiXsF(anEV;r|N%dy&_lU;rTgEpzfem3;k5>DM}+ zKWQzzc@Y0t_46xDP4FCi(0|5VJ%YTLc jUF-f84$Jlz_`h|qf(*nPdjSCOZy%614sGW6?dtylj^if! literal 0 HcmV?d00001 diff --git a/r/ROTOPIXELS/legacy/GRAFICAS_ROTOPIXELS.R b/r/ROTOPIXELS/legacy/GRAFICAS_ROTOPIXELS.R deleted file mode 100644 index f376152..0000000 --- a/r/ROTOPIXELS/legacy/GRAFICAS_ROTOPIXELS.R +++ /dev/null @@ -1,126 +0,0 @@ -#CÓDIGO PARA GRAFICAR Y CORRELACIONES ROTOPIXELS - -source("C:/Dropbox/Software/Scripts/r/ROTOPIXELS/arrangeDBFTablestoExcel_rotopixels.R") - -################################################################ -###################### SCRIPT ########################################## -################# Check these inputs######################### -#wd<-("C:\\Users\\CIMMYT\\Documents\\ArcGIS") -wd <- "I:\\rotopixels2018\\1_INDICES\\0_estadisticas" -getwd() - -#read tables -## Rread extra data that will be merged to the VI data, needs to have the "id" field or will fail the script -##read metadatos -m <- read.csv("metadatos_rotopixels.csv") -##read n content table, needs to have the "boleta" field. lab table -lab <- read.csv("DATOS_DEL_LABORATORIO.csv",stringsAsFactors=FALSE) -##Get table -table <- getTable(wd,m,lab) - -##Separate in columns the VIs for each date -- Wide table format -#atributos por fecha en columnas added -table_complete <- separateInColumnsbyTheVIs(table,'MEAN') -table_complete_norm <- separateInColumnsbyTheVIs(table,'MEAN_NORM_DIAS') - -####################Grafica con R cuadrado######################## -#Agregar columna de "num_medicion" a "table_complete"# -#Esto para poder cambiar de simbolo/color cada fecha# -#Tambien investigar como colocar linea a cada grupo de datos# - -x <- 1:100 #Investigar este calculo de abajo. -y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4) -my.data <- data.frame(x = x, y = y, - group = c("A", "B"), - y2 = y * c(0.5,2), - w = sqrt(x)) -# Dar nombre a la formula -formula <- y ~ poly(x, 3, raw = TRUE) -#ggplot -ggplot(table[table$VI=="NDVI" & table$num_medicion==3,], aes(MEAN, N_PERCENT)) + - geom_point(color="red") + geom_smooth(method = lm, se = FALSE)+ - stat_poly_eq(formula = formula,rr.digits=4, parse = TRUE)+stat_fit_glance(method = 'lm', - method.args = list(formula = formula),geom = 'text',aes(label = paste("P-value = ", - signif(..p.value.., digits = 4), sep = "")), - label.x.npc = 'right', label.y.npc = 0.35, size = 3)+ - xlab("NDVI fecha 3") + ylab("PROTEIN") + - ggtitle("PROTEIN-VI CORRELATION ") - -#Graficas con indices estandarizados -x <- 1:100 #Investigar este calculo de abajo. -y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4) -my.data <- data.frame(x = x, y = y, - group = c("A", "B"), - y2 = y * c(0.5,2), - w = sqrt(x)) -# Dar nombre a la formula -formula <- y ~ poly(x, 3, raw = TRUE) -#ggplot -ggplot(table[table$VI=="NDVI" & table$num_medicion==3,], aes(MEAN_NORM_DIAS, N_PERCENT)) + - geom_point((aes(color= factor(Campos))))+ - stat_poly_eq(formula = formula,rr.digits=4, parse = TRUE)+xlab("NDVI VALUE (3)") + ylab("PROTEIN") + - ggtitle("PROTEIN-VI CORRELATION ") - - -#Grafica sin estandarizar con distincion de los campos.Se grafica por cada indice en determinada toma -x <- 1:100 #Investigar este calculo de abajo. -y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4) -my.data <- data.frame(x = x, y = y, - group = c("A", "B"), - y2 = y * c(0.5,2), - w = sqrt(x)) -# Dar nombre a la formula -formula <- y ~ poly(x, 3, raw = TRUE) -#ggplot -ggplot(table[table$VI=="NDVI" & table$num_medicion==3,], aes(MEAN, N_PERCENT,shape=factor(Campos), fill=factor(Campos), col=factor(Campos))) + - geom_point(size=2)+ stat_poly_eq(formula = formula,rr.digits=4, parse = TRUE)+xlab("NDVI fecha3") + ylab("PROTEIN") + - ggtitle("PROTEIN-VI CORRELATION ")+scale_shape_manual(values=rep(c(21:25), times=8)) - - - - - - - - -##############R cuadrado de un indice con la 3 fechas de diferente color################ -###https://ggplot2.tidyverse.org/reference/scale_manual.html### -x <- 1:100 #Investigar este calculo de abajo. -y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4) -my.data <- data.frame(x = x, y = y, - group = c("A", "B"), - y2 = y * c(0.5,2), - w = sqrt(x)) -# Dar nombre a la formula -formula <- y ~ poly(x, 3, raw = TRUE) -#ggplot usando table y filtrando por fila -ggplot(table[table$VI=="NDVI",], aes(MEAN, N_PERCENT)) + - geom_point((aes(colour = factor(num_medicion)))) + - scale_color_manual(values=c("blue","green","red"))+ - geom_smooth(method = lm, se = TRUE)+ - stat_poly_eq(formula = formula,rr.digits=4, parse = TRUE)+ - xlab("NDVI") + ylab("PROTEIN") + - ggtitle("PROTEIN-VI CORRELATION ") - -#check elimination of outliers - -#Ejemplo para filtrar -table[table$num_medicion==2,] -table[table$VI=="NDVI" & table$num_medicion==2,] #filas,columnas -table[table$VI=="R675" | table$VI=="NDVI",] - - -#Graficas separadas con r2 y p-value.Me dijo el doc que preferia por separado. -x <- 1:100 #Investigar este calculo de abajo. -y <- (x + x^2 + x^3) + rnorm(length(x), mean = 0, sd = mean(x^3) / 4) -my.data <- data.frame(x = x, y = y, - group = c("A", "B"), - y2 = y * c(0.5,2), - w = sqrt(x)) -ggplot(table[table$VI=="NDVI",], aes(MEAN, N_PERCENT, colour = factor(num_medicion))) + - geom_point() + facet_grid(. ~ num_medicion, scales = "free")+geom_smooth(method = lm, se = FALSE)+ - stat_poly_eq(formula = formula,rr.digits=4, parse = TRUE)+ stat_fit_glance(method = 'lm', - method.args = list(formula = formula),geom = 'text',aes(label = paste("P-value = ", signif(..p.value.., digits = 4), sep = "")), - label.x.npc = 'right', label.y.npc = 0.35, size = 3)+ - xlab("NDVI") + ylab("PROTEIN") + ggtitle("PROTEIN-VI CORRELATION ") - diff --git a/r/ROTOPIXELS/legacy/arrangeDBFTablestoExcel_rotopixels.R b/r/ROTOPIXELS/legacy/arrangeDBFTablestoExcel_rotopixels.R deleted file mode 100644 index 2452ea4..0000000 --- a/r/ROTOPIXELS/legacy/arrangeDBFTablestoExcel_rotopixels.R +++ /dev/null @@ -1,95 +0,0 @@ -#Arrange tables from zonalStatistics Extraction -#Take all the tables from a in different DBF files of zonal statistics and put in one same table all the rowsdate-cam and put in one Excel table -#Input should be dbf files - -# Used Packages -library(foreign) -#library(xlsx) -library(stringr) -library(plyr) -#library(gtools) -library(reshape2) -library(corrplot) -library(psych) -library(ggplot2) -library(plotly) -library(ggpmisc) - -####################################################### -### FUNCTIONS -####################################################### - -readTables <- function (f){ - ##read dbFfile - t <- read.dbf(f) - - ##know name of the file without extention - f_noExt <- gsub(".dbf","",f) - #Separate the Field name, date and VI from the table name - metadata <- unlist(strsplit(f_noExt, "_")) - ##Add the data to new columns - t$id <- paste0(metadata[1],"_",metadata[2]) #Field - t$field <- metadata[1] #Field - t$date <- metadata[2] #Date - t$VI <- gsub('B1','',metadata[3]) #VI - return (t) -} - -#value_field can be 'MEAN_NORM_DIAS' or 'MEAN' -separateInColumnsbyTheVIs <- function(table,value_field){ - ##Separate in columns the VIs for each date -- Wide table - #Change back from long to wide table - # a "formula object" is used in the form: varDependent ~ varIndependent - wtable <- dcast(table, boleta+Campos+WG+DG+W400+HT+PB+PN+N_PERCENT+rich_strip ~ - VI+num_medicion, value.var=value_field) - - #tabla temporal para anadir atributos por fecha en columnas - #Days from sowing to image capture - t_dias <- dcast(table, boleta ~ num_medicion, value.var='dias_siembra_a_imagen',fun=mean) - t_dias[is.na(t_dias)] <- NA #and remove NaNs - colnames(t_dias)[2:4] <- paste0("dias_siembra_a_img",colnames(t_dias)[2:4]) - - #ISSUES in images - t_issues <-dcast(table, boleta ~ num_medicion, value.var='ISSUES',fun=mean) - t_issues[is.na(t_issues)] <- NA #and remove NaNs - colnames(t_issues)[2:4] <- paste0("ISSUES_img",colnames(t_issues)[2:4]) - - #Fecha de toma de imagen - table$date <- as.numeric(table$date) #Use the date as numeric to be able to summarize it - t_date_img <-dcast(table, boleta ~ num_medicion, value.var='date',fun=mean) - t_date_img[is.na(t_date_img)] <- NA #and remove NaNs - colnames(t_date_img)[2:4] <- paste0("date_img",colnames(t_date_img)[2:4]) - - #Join to wtable - table_complete <-merge(wtable,t_dias,by="boleta") #Add dias_siembra_a_imagen - table_complete <-merge(table_complete,t_issues,by="boleta") # Add issues column - table_complete <-merge(table_complete,t_date_img,by="boleta") # Add capture date -} - -getTable <- function(wd,m,n){ - setwd(wd) - - n[is.na(n)] <- NA #remove no data(.) - n <-n[ ! n$N_PERCENT %in% '.', ] - n$N_PERCENT<-as.numeric(n$N_PERCENT) - #Get all the names of the DBFs to read - allDbfFiles <-list.files(pattern="\\.dbf$") - - ## Put together all the rows of the different tables with the custom function "readTables" into a list - #Read all the files to a list - tables.list = lapply(allDbfFiles,readTables) - #Merge with row bind tool into one table - table_ <- Reduce(rbind, tables.list) - #Merge VIs table with metadata - table_m <-merge(table_,m,by="id") - #Merge VIs table with the Nitrogen content data - table <-merge(table_m,n,by="boleta") - #dividir los indices entre dias de siembra y dia a la toma - table$MEAN_NORM_DIAS <- table$MEAN/table$dias_siembra_a_imagen - #Edicion de boletas de JASP para que no se combinen con las de Lupita14 - table$boleta[table$Campos=='jasp']<-paste0('0',table$boleta[table$Campos=='jasp']) - #return the table - return(table) -} -##Save table -#write.csv(wtable,"Tabla.csv", row.names=FALSE) diff --git a/r/arrangeTables(check)/arrangeDBFTables toExcel_groupByCamDate.R b/r/arrangeTables(check)/arrangeDBFTables toExcel_groupByCamDate.R deleted file mode 100644 index 6e2cf55..0000000 --- a/r/arrangeTables(check)/arrangeDBFTables toExcel_groupByCamDate.R +++ /dev/null @@ -1,95 +0,0 @@ -#Arrange tables from zonalStatistics Extraction -#Take all the tables from a date-cam and put in one Excel table -# Used Packages -options(java.parameters = "-Xmx30000m") #available RAM for JAVA -library(foreign) -library(xlsx) -library(stringr) -library(plyr) -library(gtools) - -### FUNCTIONS -###############InputInputInputInputInputInputInputInputInputInputInput -#InputInputInputInputInputInputInputInput -#Input should be a dbf file - -id = "Name" # For most of the cases -feature = "buf" ##buf for the BW trials - -####################################################### - -addBandToColumn <- function (f){ - t <- read.dbf(f) - t <- subset(t, select=c(id,"MEAN")) - band <- str_extract(f, "B[0-9][0-9]*[0-9]*") #Get the band # - origFields <- colnames(t) - colnamesB <- origFields - #Next put the band number in the column but not in the id column - for (i in 1:length(colnamesB) ){ - if (colnamesB[i] != id) - colnamesB[i]<- paste(colnamesB[i],"_",band,feature, sep="") - } - colnames(t)<- colnamesB - return (t) -} -#Merge to use with reduce sucessively by "id" -merge.all <- function(x, y) { - merge(x, y, all=TRUE, by=id) -} -#stack by-band-dbf statistics in excel -arrangeDbf <- function(pattern) { - #Name of the workbook will be the camera+date - cam_date <- substr(pattern, 1, 7) - wbookName <- paste(cam_date,".xlsx",sep="") - wbook <- createWorkbook() - wbSheet <- createSheet(wb = wbook, sheetName = toString(cam_date)) - file_list = list.files(pattern=pattern)#list and filter dbf from ws - #get mentioned trial names to group them - trials <- unique(lapply(file_list, function(x) substr(x,8,10))) - t1=TRUE - for (tr in trials){ - patt_tr = paste(cam_date,tr,feature,".*",sep="") - fileListTr <- grep(patt_tr, file_list, value=TRUE) - fileListTr <- mixedsort(fileListTr)#Natural sorting - # batch read all into a list - t.list = lapply(fileListTr, addBandToColumn) - #merge them into a single data frame - tables <- Reduce(merge.all, t.list) - #Next remove the duplicate "id" column - tables <- tables[,!duplicated(colnames(tables), fromLast = TRUE)] - if (t1==TRUE){ - startRow<-1 - print(paste("Escribiendo",nrow(tables),"registros en",tr)) - addDataFrame(x=tables, sheet=wbSheet,row.names=FALSE,startRow = startRow) - t1<-FALSE - startRow = startRow+nrow(tables) + 1 #We count that we printed the header line - }else{ - print(paste("Escribiendo",nrow(tables),"registros en",tr)) - addDataFrame(x=tables,sheet=wbSheet, - row.names=FALSE,col.names=FALSE,startRow=startRow) - startRow = startRow+nrow(tables) - } - } - saveWorkbook(wbook, wbookName) - print(paste("Se guardó el archivo",wbookName)) - return (wbook) -} -#read tables -################# Check these inputs######################### -#wd<-("C:\\pruebas\\") -wd <- "C:\\Users\\CIMMYT\\Documents\\ArcGIS" -setwd(wd) -getwd() - -#change inputs on top - -#Get the unique date and camera to stack the tables -allDbfFiles <-list.files(pattern="\\.dbf$") -date_and_cam <- unique(str_extract(allDbfFiles, "[:alpha:]{1}[:digit:]{6}")) -## Sets the pattern of name in files to be stacked -for (i in date_and_cam){ - print(paste("Fecha y cámara:",i)) - pattern= paste(i,".*dbf$",sep="") - xlsx <-arrangeDbf(pattern) -} - diff --git a/r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName_SQ_calculateVIs.R b/r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName_SQ_calculateVIs.R deleted file mode 100644 index fc19cab..0000000 --- a/r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName_SQ_calculateVIs.R +++ /dev/null @@ -1,92 +0,0 @@ -#Arrange tables from zonalStatistics Extraction -#Take all the tables from and put in one Excel table -#Ment to be used in data of one unique experiment -# Used Packages -options(java.parameters = "-Xmx30000m") #available RAM for JAVA -library(foreign) -library(xlsx) -library(stringr) -library(plyr) -library(gtools) -#get the data processing functions -source((file.path("F:","Dropbox","Software","Scripts","r","functions_data.R", fsep = .Platform$file.sep))) - -###############InputInputInputInputInputInputInputInputInputInputInput -#InputInputInputInputInputInputInputInput -#Input should be a dbf file - - - -id = "plot" # For most of the cases -feature = "b2s" ##buf for the BW trials - - -### FUNCTIONS -####################################################### - -addBandToColumn <- function (f){ - t <- read.dbf(f) - t <- subset(t, select=c(id,"MEAN")) - band <- str_extract(f, "B[0-9][0-9]*[0-9]*") #Get the band # - origFields <- colnames(t) - colnamesB <- origFields - #Next put the band number in the column but not in the id column - for (i in 1:length(colnamesB) ){ - if (colnamesB[i] != id) - colnamesB[i]<- paste(colnamesB[i],"_",band,feature, sep="") - } - colnames(t)<- colnamesB - return (t) -} -#Merge to use with reduce sucessively by "id" -merge.all <- function(x, y) { - merge(x, y, all=TRUE, by=id) -} - -#read tables -################# Check these inputs######################### -#wd<-("C:\\pruebas\\") -wd <- "C:\\Users\\CIMMYT\\Documents\\ArcGIS" -setwd(wd) -getwd() - -#Sequoia band wl -bandWl <- c( - "R550", - "R660", - "R735", - "R790") - -#change inputs on top - -#Get all the dbf names in the directory -allDbfFiles <-list.files(pattern="\\.dbf$") -#Get the unique name if disregarging the Band # and extention -unames <- unique(gsub("B[0-9][0-9]*[0-9]*.dbf", "", allDbfFiles)) -#Name of the workbook -wbookName <- paste("data_sq_vi",".xlsx",sep="") -wbook <- createWorkbook() -## Siterate through the unique filenames to put in excel -for (i in unames){ - print(paste("Nombres únicos:",i)) - pattern= paste(i,".*dbf$",sep="") - wbSheet <- createSheet(wb = wbook, sheetName = toString(i)) - file_list = list.files(pattern=pattern)#list and filter dbf from ws - file_list <- mixedsort(file_list)#Natural sorting - # batch read all into a list - t.list = lapply(file_list, addBandToColumn) - #merge bands into a single data frame - tables <- Reduce(merge.all, t.list) - #Next remove the duplicate "id" column - tables <- tables[,!duplicated(colnames(tables), fromLast = TRUE)] - #Assign bandname wavelength - colnames(tables) <- c("Plot",bandWl) - ### Calculate the VIS! (append them to the table) - table_vi <- VI_sequoia_tab(tables) - startRow<-1 - print(paste("Escribiendo",nrow(tables),"registros en",i)) - addDataFrame(x=table_vi, sheet=wbSheet,row.names=FALSE,startRow = startRow) -} -saveWorkbook(wbook, wbookName) -print(paste("Se guardó el archivo",wbookName)) - diff --git a/r/arrangeTables(check)/joinExcels_cmd(WorkInProgress).R b/r/arrangeTables(check)/joinExcels_cmd(WorkInProgress).R deleted file mode 100644 index e11040f..0000000 --- a/r/arrangeTables(check)/joinExcels_cmd(WorkInProgress).R +++ /dev/null @@ -1,65 +0,0 @@ -##################################################################### -# Title: Merge excels in one excel- to be executed from the command line (right clic and send to script with a bat file). - - - - - -#WORK IN PROGRESSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS - - - - - - -#It can accept multiple input files to execute the tool on all of them -##################################################################### - -### Load required libraries -library(xlsx) -#get the data processing functions -source((file.path("F:","Dropbox","Software","Scripts","r","functions_data.R", fsep = .Platform$file.sep))) - -### set filename of INPUT files -#file<-"" ### get file name fixed mode (this could be actually a list of files) -args <- commandArgs(TRUE) #Get from the command line -#TODO: Filter for only Excel files - -### nos posicionamos en el directorio de trabajo ### -#work.dir <- "C:\\pruebas" ### To Change the input directory manually -work.dir <-dirname(normalizePath(args[1])) #get the WD from the input files -setwd(work.dir) #Set the working directory -getwd() # show the working directory - - -print("Files to process") - -xl <-(0) -for (arg in 1:length(args)) { - print(paste0("##### Current file processing... ", args[arg])) #Print name of file - #Open the excel file to get the data, read the entire first sheet - xl[arg] <- read.xlsx2(args[arg], sheetIndex = 1, stringsAsFactors=FALSE) - - ## Write the excel file - print(paste0("writing: xls",".xlsx")) - write.xlsx(x = xl[arg], file = ,paste("xls",".xlsx",sep=""), - sheetName = as.character(arg), row.names = FALSE) - -} -print("########## Success in execution!") - - - - -################################## Manually join... - -xls <- choose.files(default = (file.path("F:","Dropbox","data","AE","seed", fsep = .Platform$file.sep)), caption = "Select Excel files", - multi = TRUE, filters = Filters, - index = nrow(Filters)) -xls_data <-list() -for (x in 1:length(xls)) { - xls_data[[x]] <- read.xlsx2(xls[x], sheetIndex = 1, stringsAsFactors=FALSE) -} - -xs <- lapply(xls_data,rbind) - \ No newline at end of file diff --git a/r/arrangeTables/.Rhistory b/r/arrangeTables/.Rhistory new file mode 100644 index 0000000..e69de29 diff --git a/r/arrangeTables(check)/VIs_TableCalculationMCA_cmd.R b/r/arrangeTables/VIs_TableCalculationMCA_cmd.R similarity index 100% rename from r/arrangeTables(check)/VIs_TableCalculationMCA_cmd.R rename to r/arrangeTables/VIs_TableCalculationMCA_cmd.R diff --git a/r/arrangeTables(check)/VIs_TableCalculationSequoia_cmd.R b/r/arrangeTables/VIs_TableCalculationSequoia_cmd.R similarity index 100% rename from r/arrangeTables(check)/VIs_TableCalculationSequoia_cmd.R rename to r/arrangeTables/VIs_TableCalculationSequoia_cmd.R diff --git a/r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName.R b/r/arrangeTables/arrangeDBFTables toExcel_groupUniqueName.R similarity index 100% rename from r/arrangeTables(check)/arrangeDBFTables toExcel_groupUniqueName.R rename to r/arrangeTables/arrangeDBFTables toExcel_groupUniqueName.R diff --git a/r/arrangeTables(check)/arrangeDBFTablestoExcel_groupByCamDateTrial(workprogress).R b/r/arrangeTables/arrangeDBFTablestoExcel_groupByCamDateTrial(workprogress).R similarity index 100% rename from r/arrangeTables(check)/arrangeDBFTablestoExcel_groupByCamDateTrial(workprogress).R rename to r/arrangeTables/arrangeDBFTablestoExcel_groupByCamDateTrial(workprogress).R diff --git a/r/arrangeTables(check)/mergeZonalStatisticsOneBandOneExperimentManyDates.R b/r/arrangeTables/mergeZonalStatisticsOneBandOneExperimentManyDates.R similarity index 100% rename from r/arrangeTables(check)/mergeZonalStatisticsOneBandOneExperimentManyDates.R rename to r/arrangeTables/mergeZonalStatisticsOneBandOneExperimentManyDates.R diff --git a/r/arrangeTables(check)/splitCodeName521.R b/r/arrangeTables/splitCodeName521.R similarity index 100% rename from r/arrangeTables(check)/splitCodeName521.R rename to r/arrangeTables/splitCodeName521.R diff --git a/r/image_processing_aux/check/stackCVStoXLSX.R b/r/arrangeTables/stackCVStoXLSX.R similarity index 100% rename from r/image_processing_aux/check/stackCVStoXLSX.R rename to r/arrangeTables/stackCVStoXLSX.R diff --git a/r/ROTOPIXELS/SCRIPT_UNIDO.R b/r/examples/ROTOPIXELS/SCRIPT_UNIDO.R similarity index 100% rename from r/ROTOPIXELS/SCRIPT_UNIDO.R rename to r/examples/ROTOPIXELS/SCRIPT_UNIDO.R diff --git a/r/ROTOPIXELS/graficas_rotopixels.R b/r/examples/ROTOPIXELS/graficas_rotopixels.R similarity index 100% rename from r/ROTOPIXELS/graficas_rotopixels.R rename to r/examples/ROTOPIXELS/graficas_rotopixels.R diff --git a/r/weather/get_daily_solarRad_CHECKvALIDITY.R b/r/examples/get_daily_solarRad_CHECKvALIDITY.R similarity index 100% rename from r/weather/get_daily_solarRad_CHECKvALIDITY.R rename to r/examples/get_daily_solarRad_CHECKvALIDITY.R diff --git a/r/image_processing_aux/kelvin100toCelsiusInsideFolder.R b/r/examples/kelvin100toCelsiusInsideFolder.R similarity index 100% rename from r/image_processing_aux/kelvin100toCelsiusInsideFolder.R rename to r/examples/kelvin100toCelsiusInsideFolder.R diff --git a/r/image_processing_aux/kelvinx100toCelsius.R b/r/examples/kelvinx100toCelsius.R similarity index 100% rename from r/image_processing_aux/kelvinx100toCelsius.R rename to r/examples/kelvinx100toCelsius.R diff --git a/Extract image data script - notes.docx b/r/extract/Extract image data script - notes.docx similarity index 100% rename from Extract image data script - notes.docx rename to r/extract/Extract image data script - notes.docx diff --git a/r/functions_ImgProcessing.R b/r/functions_ImgProcessing.R index 37d4bef..be096a9 100644 --- a/r/functions_ImgProcessing.R +++ b/r/functions_ImgProcessing.R @@ -80,6 +80,31 @@ multibandStack6 <- function(b1,b2,b3,b4,b5,b6,roi) }) } +#require(rgdal) +#require(raster) +#Script to unstack the Multispectra bands from the MCA 3-band-pack +multibandUnStack <- function(img_3) +{ + tryCatch({ + print(paste("Dividir primeras 3 bandas",img_3)) + wd<-dirname(normalizePath(img_3)) + #print(wd) + setwd(wd) + #Img basename without extention + imgBasename<-gsub(".tif", "", img_3) + #print(imgBasename) + #separate the bands + img1=raster(img_3, band = 1) + img2=raster(img_3, band = 2) + img3=raster(img_3, band = 3) + #Write the 3 tif to disk + writeRaster(img1, file=paste(imgBasename,"_1.tif",sep = ""),datatype='INT2U',format="GTiff",overwrite=FALSE) + writeRaster(img2, file=paste(imgBasename,"_2.tif",sep = ""),datatype='INT2U',format="GTiff",overwrite=FALSE) + writeRaster(img3, file=paste(imgBasename,"_3.tif",sep = ""),datatype='INT2U',format="GTiff",overwrite=FALSE) + print(paste("Imagen escrita: ",imgBasename,".tif",sep = "")) + }) +} + #Function multibandStack slantrange3bandStack <- function(imgBasename, wd) { @@ -161,11 +186,6 @@ getTop5percInsideROIandRemoveFR <- function (i,roi){ } -## Choose file interactively | *tif file -chooseTif <- function() { - choose.files(default = "", caption = "Selecciona la imagen", - multi = FALSE, filters = matrix(c("tif", "*.tif")), - index = nrow(Filters))} ### function to separate the files from the thermal imagery that correspond to a specific area, based on the autopano mosaic file. ### The output folder is created based on the name of the autopano file, at the same level as the folder of the images @@ -246,4 +266,55 @@ get_filenames_from_pano_file_slantrange3 <- function(pano_file_name){ ) message("moved a total of ", total, " images to: ", full_output_folder) -} \ No newline at end of file +} + +##################################################################################################################################### +#### Imageraster calc +##################################################################################################################################### +#Function Kelvin 100 to raster +k2cel <-function(x){(x/100)-273.15} + +###################################################################################################################################### +#### Save and load images +###################################################################################################################################### +## Choose file interactively | *tif file +chooseTif <- function() { + choose.files(default = "", caption = "Selecciona la imagen", + multi = FALSE, filters = matrix(c("tif", "*.tif")), + index = nrow(Filters))} + +## Choose multiple files interactively | *tif file +chooseTifs <- function() { + choose.files(default = "", caption = "Selecciona la imagen", + multi = TRUE, filters = matrix(c("tif","tiff", "*.tif", "*.tiff")), + index = nrow(Filters))} + + +#function to save Gtiff Int to disk +tiffSaveInt <- function(img, name) +{ + tryCatch({ + #Write the tif to disk + writeRaster(img, file=name,datatype='INT2U',format="GTiff",overwrite=FALSE) + }) +} + + +#function to save Gtiff float to disk +tiffSaveFloat <- function(img, name) +{ + tryCatch({ + #Write the tif to disk + writeRaster(img, file=name,datatype='FLT4S',format="GTiff",overwrite=FALSE) + }) +} + +#function to save Gtiff float to disk +pasteExt <- function(basename, ext) +{ + #PAste name and extention + name=paste0(basename,ext) + + return(name) +} + diff --git a/r/image_processing_aux/.Rhistory b/r/image_processing_aux/.Rhistory new file mode 100644 index 0000000..9c206a6 --- /dev/null +++ b/r/image_processing_aux/.Rhistory @@ -0,0 +1,58 @@ +#### + B. Separated bands +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +#source("functions_extract.R") #Check that this file is in the working directory +#require(raster) +algo <- function(){ +tryCatch({ ## Put it all inside a handle error function Trycatch +print ("################# Inicio de script ##################") +## Read inputs. +args <- commandArgs(TRUE) +## Ask user the list of rasters and zone vectors +#in_mode <- menu(c("Stack bands", "Unstack bands"), title="What do you want to do with the images?",graphics = TRUE); +in_mode <- readline("Select 1: stack, 2:unstack"); +if (in_mode == 1){ #### Stack bands +#Process every set of band to join in one raster +for (i in 1:1) { +#s <- stackSeq(name,path) +print("opt 1") +} +} else if (in_mode == 2){ #### Unstack bands +for (i in 1:1) { +## unstack +print("opt2") +} +} +print("Finish") +}, +error = function(e){print(c("Se produjo un error: ",e$message))}, +warning = function(e){print(paste("Hay advertencias: ", e$message))} +) +} +algo() +source('F:/Dropbox (RSG)/Software/Scripts/r/image_processing_aux/stack_unstack_bands_cmd.R') +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +source("..\functions_ImgProcessing.R") #Check that this file is in the working directory +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +source("../functions_ImgProcessing.R") #Check that this file is in the working directory +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +source("../functions_ImgProcessing.R") #Check that this file is in that directory +imgs <- chooseTifs() +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +source("../functions_ImgProcessing.R") #Check that this file is in that directory +imgs <- chooseTifs() +imgs <- chooseTifs() +#### setwd() You can set the Working directory to the source file location +#### Get functions and libraries +source("../functions_ImgProcessing.R") #Check that this file is in that directory +imgs <- chooseTifs() +imgs +imgs <- chooseTifs() +imgs +imgs <- chooseTifs() +imgs <- chooseTifs() +imgs diff --git a/r/image_processing_aux/NDVIFromMCA-6Images.R b/r/image_processing_aux/NDVIFromMCA-6Images.R deleted file mode 100644 index a75307a..0000000 --- a/r/image_processing_aux/NDVIFromMCA-6Images.R +++ /dev/null @@ -1,42 +0,0 @@ -#Script to calculate the NDVI from a folder of MCA-6 images BSQ format -#Files should be named as follows: -# [camera(1 char)]yymmdd[AOI(3 char)][imageProcessingStage(3 char)].bsq -#Example: m151216jfxgeo.bsq -# The required input is: the working directory -#0. First step : load packages -#install.packages(c("rgdal","raster")) -require(raster) -require(rgdal) -#NDVI function on a 6 band multispectral image -f_NDVI <- function(r,n) { - (n-r)/(n+r) -} - -#Function multibandStack (folder, nband_red, nband_nir) -nDVIFromMCA6 <- function(wd,red_band=2,nir_band=6) -{ - tryCatch({ - setwd(wd) - #Make a list of all files in the wd - im <- list.files(wd, full.names=TRUE) - #Select the *geo.bsq files - im.bsq <- im[grep("geo.bsq$", im)] - #generate NDVI of all rasters - for (img in im.bsq) { - img="C:/vuelos/temp/ad_nut_MCA/m151216jfxgeo.bsq" #Fixed testing - r_red=raster(img, band=red_band) - r_nir=raster(img, band=nir_band) - NDVI <- f_NDVI(r_red,r_nir) - #plot(NDVI) plot if we want to see it - #Save the NDVI replacing the suffix of the images - writeRaster(NDVI, file=gsub("geo.bsq$", "nvi.tif$", img),datatype='FLT4S', format="GTiff",overwrite=FALSE) - } - }) - -} - -#Working directory -wd = "C:/vuelos/temp/ad_nut_MCA" -#Call NDV maker -n = nDVIFromMCA6(wd,2,6) -print ("Finished generating the NDVI for all the images") diff --git a/r/image_processing_aux/separate_images_in_folder_based_on_autopano_file_slantrange3.R b/r/image_processing_aux/separate_images_in_folder_based_on_autopano_file_slantrange3.R deleted file mode 100644 index af0908c..0000000 --- a/r/image_processing_aux/separate_images_in_folder_based_on_autopano_file_slantrange3.R +++ /dev/null @@ -1,16 +0,0 @@ -### Script to separate the files from the thermal imagery that correspond to a specific area, based on the autopano mosaic file. -### The output folder is created based on the name of the autopano file, inside the -### TODO: implement error catching in the script - -####################################################### FUNCTIONS DEFINITION -source(file.path("C:","Dropbox","Software","Scripts","r","functions_imgProcessing.R", fsep = .Platform$file.sep)) - - - -### INPUTS -panoF <- choose.files(caption = "Selecciona el archivo de autopano",filters = matrix(c("pano", "*.pano")), - index = nrow(Filters)) # Choose the autopano *.pano file that is using the images of interest - -### SCRIPT -setwd(dirname(panoF)) #set WD tot he location of the autopano file (that should be in the same directory as the indivitual band images) -get_filenames_from_pano_file_slantrange3(panoF) diff --git a/r/image_processing_aux/stack3Slantrangebands_insideFolder.R b/r/image_processing_aux/stack3Slantrangebands_insideFolder.R deleted file mode 100644 index 31a4b98..0000000 --- a/r/image_processing_aux/stack3Slantrangebands_insideFolder.R +++ /dev/null @@ -1,57 +0,0 @@ -#Script to stack the Multispectra bands from the slantrange 4 bands to be able to open in autopano to estimate coordinates later. -#Names are expected like: -# 1517337077.532nm.tif -# 1517337077.570nm.tif -# 1517337077.650nm.tif -# 1517337077.850nm.tif -# Saves in integer format to make it lighter, can be changes easily when wrinting the raster - -#0. First step : load packages -#install.packages(c("rgdal","raster")) -require(raster) -require(rgdal) -library(stringr) - -#Function multibandStack -slantrange3bandStack <- function(imgBasename, wd) -{ - tryCatch({ - setwd(wd) - #Input file with bands 1 : 532 nm - img_basename<-imgBasename - img_1<-paste(img_basename,'.532nm.tif',sep = "") - imported_raster_1=raster(img_1) - - #Input file with bands 3: 650 nm - img_3<-paste(img_basename,'.650nm.tif',sep = "") - imported_raster_3=raster(img_3) - - #Input file with bands 4: 850 nm - img_4<-paste(img_basename,'.850nm.tif',sep = "") - imported_raster_4=raster(img_4) - - - #plot(imported_raster_0) #see image just to test - #stack 6 bands in one pile - img=stack(list(img_1,img_3,img_4)) - img[img==0] <- NA #Set 0 as no data - - #Write the tif to disk - writeRaster(img, file=paste(imgBasename,"stack.tif",sep = ""),datatype='FLT4S',format="GTiff",overwrite=FALSE) - }) -} -########### START ########################## -#Working directory -wd=choose.dir() -setwd(wd) - -imgFilesList <-list.files(pattern="\\.tif$") -##Next the names of the images, collapse to get one entry per pair(-0.tif and -1.tif) -#imgsPairNames <- unique(str_extract(imgFilesList, "TTC[:digit:]{5}")) #For individual frames -basenames <- unique(str_extract(imgFilesList, ".{0,10}")) #For mosaics {0,13} -## Sets the pattern of name in files to be stacked -for (i in basenames){ - print(paste("Image:",i)) - slantrange3bandStack(i, wd) -} -print(paste("Finished merging",toString(length(basenames)),"images")) diff --git a/r/image_processing_aux/check/stack6MCAbands_cmd.R b/r/image_processing_aux/stack6MCAbands_cmd.R similarity index 100% rename from r/image_processing_aux/check/stack6MCAbands_cmd.R rename to r/image_processing_aux/stack6MCAbands_cmd.R diff --git a/r/image_processing_aux/check/stackBandsRedEdge_cmd.R b/r/image_processing_aux/stackBandsRedEdge_cmd.R similarity index 100% rename from r/image_processing_aux/check/stackBandsRedEdge_cmd.R rename to r/image_processing_aux/stackBandsRedEdge_cmd.R diff --git a/r/image_processing_aux/check/stackBandsSequoia.R b/r/image_processing_aux/stackBandsSequoia.R similarity index 100% rename from r/image_processing_aux/check/stackBandsSequoia.R rename to r/image_processing_aux/stackBandsSequoia.R diff --git a/r/image_processing_aux/check/stackBandsSequoia_cmd.R b/r/image_processing_aux/stackBandsSequoia_cmd.R similarity index 93% rename from r/image_processing_aux/check/stackBandsSequoia_cmd.R rename to r/image_processing_aux/stackBandsSequoia_cmd.R index ce19df1..96e31e1 100644 --- a/r/image_processing_aux/check/stackBandsSequoia_cmd.R +++ b/r/image_processing_aux/stackBandsSequoia_cmd.R @@ -11,7 +11,7 @@ ################### Functions source(file.path("C:","Dropbox","Software","Scripts","r","functions_ImgProcessing.R", fsep = .Platform$file.sep)) -data############### Script +############### Script tryCatch({ #Call function with the images as parameters print ("################# Inicio de script ##################") @@ -27,7 +27,7 @@ tryCatch({ name <- basename(args[1]) ext <- ".tif" name<-gsub(ext, "", name) - ##Base image name of all the bands (separate by the "_" and get the first element) + ##Base image name of all the bands (separate by the "_" and get the first element) ej Imagename: "basename_transparent_reflectance_green.tif" name <- unlist(strsplit(name,"_"))[1] ## STACK BANDS OF SEQUAOIA: s <- stackSeq(name,path,ext) diff --git a/r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopano.R b/r/image_processing_aux/stackMCAbandsAsExportedFromAutopano.R similarity index 100% rename from r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopano.R rename to r/image_processing_aux/stackMCAbandsAsExportedFromAutopano.R diff --git a/r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopanoFolder.R b/r/image_processing_aux/stackMCAbandsAsExportedFromAutopanoFolder.R similarity index 100% rename from r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopanoFolder.R rename to r/image_processing_aux/stackMCAbandsAsExportedFromAutopanoFolder.R diff --git a/r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopano_cmd.R b/r/image_processing_aux/stackMCAbandsAsExportedFromAutopano_cmd.R similarity index 100% rename from r/image_processing_aux/check/stackMCAbandsAsExportedFromAutopano_cmd.R rename to r/image_processing_aux/stackMCAbandsAsExportedFromAutopano_cmd.R diff --git a/r/moisture/.Rhistory b/r/moisture/.Rhistory new file mode 100644 index 0000000..e69de29 diff --git a/r/moisture/171020_getMoistureSamplingDataFromExcel_710comparison.R b/r/moisture/171020_getMoistureSamplingDataFromExcel_710comparison.R deleted file mode 100644 index 82b9ef8..0000000 --- a/r/moisture/171020_getMoistureSamplingDataFromExcel_710comparison.R +++ /dev/null @@ -1,115 +0,0 @@ -#### -# GET MOISTURE SAMPLING FROM THE EXCEL FIle indicated (names of the sheets should be in eg. AR20-11-2015_conv-pre format). used to save the wet and dry weight of the sampling cans -#Calculates the water depth in mm based on the % moisture and using a given formula -#check that the excel sheets's names are formated as: -# DR16-08-2017_all-4 -# DR o AR > is after or before irrigation -# dd-mm-yyyy -# which plots were sampled: all, conv, 2aux, 4aux, pb -# the # of current irrigation, after or before the sampling was performed (or the preplanting irrigation): 1 2 3 4 pre -# -# -# Execute a new instance of R to every new file to be processed, to avoid re-using variables -# -# STORE TO local file -# -# # # # #Check conditions and quality check needed to be implemented -# -# # # # # check Harcoded inputs every time. -# -#### - -#library(xlsx) #preferred to read XLSX? -library("XLConnect") -library(reshape2) - - - -####################################################### FUNCTIONS DEFINITION -source(file.path("C:","Dropbox","Software","Scripts","r","moisture","methods_moisture.R", fsep = .Platform$file.sep)) - -###################################################### EXECUTE SCRIPT -############################### INPUTS -#set WDir -setwd("C://Dropbox//Software//Scripts//r//moisture") - -file="C://Dropbox//Bascula (1)//Muestras suelo//AF//AF-710COMPASS.xlsx" -trial <- "710" -col_names<-c('id', - 'depth', - 'canType', - 'can', - 'wSoilw', #wet soil weight - 'dSoilw', #dry soil weight - 'moisture') -colTypes <- c('numeric', 'character','numeric', 'numeric','numeric','numeric','numeric') -##Check this for every excel read -startRow<- 6 #Skip the fisrt 5 rows because it has other ancillary data -startSheet <- 2 -endSheet <- 10 -endCol <- 7 -endRow <- 66 - -csvfile <- "C://Dropbox//Bascula (1)//Muestras suelo//AF//AF-710COMPASS.csv" - -################################# END INPUTS - -##Edit next -##getMoistreFromExcel <- function (file, startSheet,endCol,endRow,colTypes,col_names,maxsamplepointID) -mData <- getMoistreFromExcel(file, startSheet,endSheet,endCol,endRow,colTypes,col_names,startRow) #get the raw moisture data[[1]] and sheetnames[[2]] - -##Resulting data -dates<-unlist(mData[[2]]) -moistData <-mData[[1]] - -#Calculate water table based on the moisture frome each measurement -samplings = length(dates) - -## Function to get the date in the column -mTable <- moistData -for (s in 1:samplings) { - #Calculate the water layer for each sample - sPoints = length(mTable[[s]]$moisture) #total samples per date - for (i in 1:sPoints) { - mTable[[s]]$sheetName[i] <- as.character(dates[s]) #add date info in column - } -} - -##Bind all samplings in one table (stack the rows, keep the columns) -mTable <- Reduce(rbind,mTable) - -##FORMATTING -#Format the headers (use if needed) -# wLTable$depth <- gsub('0-15', '1w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('15-30', '2w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('30-60', '3w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('60-90', '4w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('0-15', 'depth1', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('15-30', 'depth2', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('30-60', 'depth3', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('60-90', 'depth4', wLTable$depth) #replace the depth by an ordered index - -###########Separate the sheets name into columns (maybe change after the filtering thing?) -#The format should be something like: dr30-11-2015_pre-conv -#sheetname should be in a format dd-mm-yyyy and will have a prefix of 2 char: AR or DR or DT or MV (indicating the kind of sampling: after/before iirgation, etc) -#and a suffix indicating _[pre]/[2R]/[4R]-[1/2/3/4/5]/[pb]/[conv]) -#date column - get what has the format of a date dd-mm-yyyy -mTable$date <- as.Date(regmatches(mTable$sheetName, regexpr("[0-9]{2}-[0-9]{2}-[0-9]{4}", mTable$sheetName)),"%d-%m-%Y") -#sampling type column - what looks like [dr]/[ar]/[mv]/[dt] ... (antes de riego, despu?s, verano, trilla...) -mTable$irrtype <- regmatches(mTable$sheetName, regexpr("dr", mTable$sheetName)) #espa?ol ar|dr|mv|dt|m1" -#irrarea sampled column - the sampling corresponded to which irrigation instance: pre(siembra), 4R(4 riegos) or 2R(2 riegos) -mTable$irrarea <- gsub('_', '',regmatches(mTable$sheetName, regexpr("_[0-9A-Za-z]+", mTable$sheetName))) -#irrigation sampled column - weather its the first, second.. irrigation etc -mTable$irrnum <- gsub('-', '',regmatches(mTable$sheetName, regexpr("-[0-9A-Za-z]+$", mTable$sheetName))) - -#check for NA's in rows -na_inrow <- apply(mTable, 1, function(x){any(is.na(x))}) # logical vector of the rows with any NA's -#wLTable <- wLTable[complete.cases(wLTable), ] #This iis to remove any row that has a NA on it. -#keep only the rows that dont have NA's and their treatment correspond to the performed sampling -mTable <- mTable[!na_inrow, ] - -#Formate the date column to format the axis labels in ggplot -mTable$date <- as.POSIXct(mTable$date) - -#write the final table to CSV if you want to save to text file -write.csv(mTable,csvfile, row.names=FALSE) diff --git a/r/moisture/180528_getMoistureSamplingDataFromExcel_trial200.R b/r/moisture/180528_getMoistureSamplingDataFromExcel_trial200.R deleted file mode 100644 index 6351a91..0000000 --- a/r/moisture/180528_getMoistureSamplingDataFromExcel_trial200.R +++ /dev/null @@ -1,166 +0,0 @@ -#### -# GET MOISTURE SAMPLING FROM THE EXCEL FIle indicated. used to save the wet and dry weight of the sampling cans -#Calculates the water depth in mm based on the % moisture and using a given formula -# -#There should be a sheet in the Excel that contains the irrigationdates events standard format (see prev years), -#this should not be included in the sheets that are read to get the data -# -# Execute a new instance of R to every new file to be processed, to avoid re-using variables -# -# STORE TO local file -# -# # # # #Check conditions and quality check needed to be implemented -# -# # # # # check Harcoded inputs every time. -# -# -#### - -#library(xlsx) #preferred to read XLSX? -library("XLConnect") -library(reshape2) -library(ggplot2) -library("dplyr") -library(raster) - - -####################################################### FUNCTIONS DEFINITION -source(file.path("C:","Dropbox","Software","Scripts","r","moisture","methods_moisture.R", fsep = .Platform$file.sep)) - -###################################################### EXECUTE SCRIPT -############################### INPUTS - -# EDIT NOW -setwd("C://Dropbox//data//AF//nut//data") #("C://Dropbox//data//AE//nut//521_humedad") -file="C://Dropbox//Bascula (1)//Muestras suelo//AF//AF-200.xlsx" #//AE//AE-521.xlsx - -#AD521 endSheet <- 19 leaves out the summer samplings -trial <- "AF-200" #"AD521" -year <- "2017-2018" #"2016-2017" - -#This is #Fixed for the standard format. Edit otherwise. -col_names<-c('id','type','canType','can','wSoilw','dSoilw','moisture') -colTypes <- c('numeric', 'character','numeric', 'numeric','numeric','numeric','numeric') -startRow<-4 #Skip the fisrt 5 rows because it has other ancillary data -endRow <- 34 #Fixed for the standard format for the trial 521 -endCol <- 7 #Fixed for the standard format -startSheet <- 3 # CHECK THIS EACH TIME. numbar of sheet of the excel file that has sampling data!! ! ! ! ! ! !! !!! !! ! !! !!! !! ! !! ! ! ! ! ! ! -endSheet <- 39 # number of sheets to read starting from the startSheet -#info about the "dates" sheet -datesSheetPosition = 40 -endColdates=2 -endRowdates=38 -startRowdates=1 - - -csvfile <- sprintf("%s_%s.csv",trial,variable) #for the output table with the summary - -#Info about the graph -#I couldnt iterate the variable because of ggplot, so, set manually: -# REVISE WHEN MAKING A NEW PLOT. This is for labels -variable <- "Moisture" #Or: -#variable <- "Water layer" -varUnit <- "%" #"for the moisture #Or: -#varUnit <- "mm"# for the water layer -#after changing there 2 values you actually only need to re-run the ggplot in lines 147 to 204 -######################## # IMPORTANTE # ############ "#$%#$&%(%&/(/)/()) -# Y HAY QUE EDITAR LA LINEA QUE DICE: -# --->>> ggplot(data=tableSum, aes(x=date, y=wlayer,group=interaction(idSum,depth))) -#PARA SELECCIONAR y=wlayer O y=moisture -################################# END INPUTS - -##getMoistreFromExcel <- function (file, startSheet,endCol,endRow,colTypes,col_names,maxsamplepointID) -mData <- getMoistreFromExcel(file, startSheet,endSheet,endCol,endRow,colTypes,col_names,startRow) #get the raw moisture data[[1]] and sheetnames[[2]] - -##Resulting data -sheetNames<-unlist(mData[[2]]) #Names from the excel sheets, but they are not standardized for this trial -moistData <-mData[[1]] - -#Get the date from Excel sheet list -dates1 <- readWorksheetFromFile(file, sheet = datesSheetPosition,header=TRUE,colTypes="character",endCol = endColdates, - endRow=endRowdates,startRow = startRowdates) - -##Obtener el número de muestreo que le corresponde a cada fecha -s <- getMoistreFromExcel(file, startSheet,endSheet,6,3,"character","sampling",2) -s <- s[[1]] #Get only the data matrix (because the function returns you also the sheetnames) -s <- Reduce(rbind,s)[,6] #merge them all in one table, stacking the rows -s <- regmatches(s, regexpr("[0-9]{1,2}$", s)) #Return only what looks like 1 or 2 digits (this is our sampling number) -#Add the sampling data to the list of samplings -moistData_n <- mapply(cbind, moistData, "sampling"=s, SIMPLIFY=F) -#Add also the date -moistData_s <- mapply(cbind, moistData_n, "s_date"=as.vector(dates1), SIMPLIFY=F) - -#Calculate water table based on the moisture frome each measurement -#the dates1 is used to "count" th eiterate times, but also adds the date of the sampling to the tables -waterLayerTable <- calculateWLayer0_15(moistData_n,dates1[["dates"]]) - -##Bind all samplings in one table (stack the rows, keep the columns) -wLTable <- Reduce(rbind,waterLayerTable) - -############# Separate the ID to know the treatments -# Get the number of the repetition from the ID -wLTable$rep <- substr(sapply(wLTable$id,toString), 1,1) -# Get the irrigation scheme from the 2rd digit of the ID -wLTable$irr <- substr(sapply(wLTable$id,toString), 2,2) -# Get the nitrogen level fertilization from the 3rd digit of the ID -wLTable$nlevel <- substr(sapply(wLTable$id,toString), 3,3) - - -# column to summarize the reps, we eliminate the rep ID which is the first char, and also the N level (5th digit) -wLTable$idNoRep <- substr(sapply(wLTable$id,toString), 1,2) # Use for the graphs, dont summarize on the tables - -##########Generate and Save graph -tableSum <- aggregate(cbind(wlayer, moisture) ~ irr+nlevel+dates, data=wLTable, FUN=mean) -#Formate the date column to format the axis labels in ggplot -tableSum$dates <- as.POSIXct(tableSum$date) - -#plot the wlayer, group by 2 different variables with "interaction" function -ggplot(data=tableSum, aes(x=dates, y=moisture,group=nlevel)) + #### EDIT HERE !! wlayer/moisture - geom_line(aes(color=nlevel),size=1)+ #,linetype=till - facet_grid(irr~.,labeller=labeller(irr = c("1" = "Furrow", "2" = "Drip")))+ #Use this to divide into "panels" - #geom_point(aes(fill=depthCol,shape="a"),colour="black",pch=21, size=2)+ - #scale_fill_manual(values=depthColors3,labels=depthLabel)+ - #scale_color_manual(values=tillColors,labels=tillTypeLabel)+ - #scale_linetype_manual(values=tillLType,labels=tillTypeLabel)+ - ###Vertical lines to indicate the irrigation, harvest, trilla - #geom_vline(data = ev, aes(xintercept = as.numeric(fecha)),linetype="dotted")+ - #geom_text(data = ev, mapping = aes(label = info, y = 100), angle = 60, hjust = 0)+ - #Anotate to mark the irrigations and planting and harvesting - #annotate("segment",x = ev[ev$event=="riego","date"],y = 2, xend = ev[ev$event=="riego","date"], - #yend = 4, color="#0052a5", size=1)+ #yend = 8 for wlayer, 4 for moisture - #annotate("segment",x = ev[ev$event=="siembra","date"],y = 2, xend = ev[ev$event=="siembra","date"], - #yend = 4, color="#63a500", size=1)+ - #annotate("segment",x = ev[ev$event=="cosecha","date"],y = 2, xend = ev[ev$event=="cosecha","date"], - #yend = 4, color="orange", size=1)+ - - ##LABELS - labs(title=sprintf("Trial %s, Soil %s (%s)", trial, variable,year), - x = "Soil sampling date", y = sprintf("%s (%s)",variable,varUnit)) + - labs(color="N level")+ #format the legend #,linetype="Tillage" - # #TEMA DE LA GRAFICA - theme(plot.title = element_text(family = "Arial", color="black", face="bold", size=18))+ - theme(plot.subtitle = element_text(family = "Arial", color="black", size=16))+ - theme(axis.title = element_text(family = "Arial", color="black", size=14))+ - theme(panel.background = element_rect(fill = "white", colour = "black"))+ - theme(panel.border = element_rect(linetype = "solid", fill = NA))+ - theme(panel.grid.major.y = element_line(colour = "#cccccc"))+ - theme(panel.grid.minor.y = element_line(colour = "#cccccc",linetype="dotted"))+ - scale_y_continuous(minor_breaks = seq(0 , 160, 10))+ - theme(panel.grid.major.x = element_blank())+ - scale_x_datetime(date_breaks = "15 day",date_labels= "%d-%b-%Y")+ #poner la escala en cada 15 d?as - theme(axis.text.x = element_text(angle = 25, vjust = 1.0, hjust = 1.0))+ - theme(axis.text = element_text(colour = "black", size=12)) -#save image -#output name -namePlot<- paste(trial,variable,".jpg",sep="") -#print(namePlot) -ggsave(namePlot,width = 7, height = 5,dpi=150,units = "in") -#######End of graph - -#check for NA's in rows -na_inrow <- apply(wLTable, 1, function(x){any(is.na(x))}) # logical vector of the rows with any NA's -#keep only the rows that dont have NA's -wLTable <- wLTable[!na_inrow, ] #the summer samplings are removed innecesarily - -#write the final table to CSV if you want to save to text file -write.csv(wLTable,csvfile, row.names=FALSE) diff --git a/r/moisture/archive/171020_getMoistureSamplingDataFromExcel_trial521.R b/r/moisture/archive/171020_getMoistureSamplingDataFromExcel_trial521.R deleted file mode 100644 index 81d0d71..0000000 --- a/r/moisture/archive/171020_getMoistureSamplingDataFromExcel_trial521.R +++ /dev/null @@ -1,109 +0,0 @@ -#### -# GET MOISTURE SAMPLING FROM THE EXCEL FIle indicated. used to save the wet and dry weight of the sampling cans -#Calculates the water depth in mm based on the % moisture and using a given formula - -#check that the excel sheets's names are formated as: -# DR16-08-2017_all-4 -# DR o AR > is after or before irrigation -# dd-mm-yyyy -# which plots were sampled: all, conv, 2aux, 4aux, pb -# the # of current irrigation, after or before the sampling was performed (or the preplanting irrigation): 1 2 3 4 pre -# -# Execute a new instance of R to every new file to be processed, to avoid re-using variables -# -# STORE TO local file -# -# # # # #Check conditions and quality check needed to be implemented -# -# # # # # check Harcoded inputs every time. -# -#### - -#library(xlsx) #preferred to read XLSX? -library("XLConnect") -library(reshape2) - -####################################################### FUNCTIONS DEFINITION -source(file.path("C:","Dropbox","Software","Scripts","r","moisture","methods_moisture.R", fsep = .Platform$file.sep)) - - -###################################################### EXECUTE SCRIPT -############################### INPUTS -setwd("C://Dropbox//data//AF//nut//data") - -file="C://Dropbox//Bascula (1)//Muestras suelo//AF//AF-521.xlsx" -trial <- "521" -col_names<-c('id', - 'depth', - 'canType', - 'can', - 'wSoilw', - 'dSoilw', - 'moisture') -colTypes <- c('numeric', 'character','numeric', 'numeric','numeric','numeric','numeric') -##Check this for every excel read -startRow<- 6 #Skip the fisrt 5 rows because it has other ancillary data -startSheet <- 2 -endCol <- 7 -endRow <- 102 -endSheet <- 17 - -csvfile <- "waterLayer_humedad_AE521.csv" -pnrfile <- "waterLayer_humedad_AE521" -################################# END INPUTS - -##Edit next -##getMoistreFromExcel <- function (file, startSheet,endCol,endRow,colTypes,col_names,maxsamplepointID) -mData <- getMoistreFromExcel(file, startSheet,endSheet,endCol,endRow,colTypes,col_names,startRow) #get the raw moisture data[[1]] and sheetnames[[2]] -##Resulting data -dates<-unlist(mData[[2]]) -moistData <-mData[[1]] - -#Calculate water table based on the moisture frome each measurement -samplings = length(dates) -waterLayerTable <- calculateWLayer(moistData,dates) - -##Bind all samplings in one table (stack the rows, keep the columns) -waterLayerTableBind <- Reduce(rbind,waterLayerTable) - -##FORMATTING -#Format the headers -waterLayerTableBind$depth <- gsub('0-15', '1w', waterLayerTableBind$depth) #replace the depth by an ordered index -waterLayerTableBind$depth <- gsub('15-30', '2w', waterLayerTableBind$depth) #replace the depth by an ordered index -waterLayerTableBind$depth <- gsub('30-60', '3w', waterLayerTableBind$depth) #replace the depth by an ordered index -waterLayerTableBind$depth <- gsub('60-90', '4w', waterLayerTableBind$depth) #replace the depth by an ordered index -#date should be in a format dd-mm-yyyy and will have a prefix of 2 char: AR or DR or DT or MV -waterLayerTableBind$date <- substr(waterLayerTableBind$sheetName,3,12) #Keep only date -waterLayerTableBind$date <- gsub('201', '1', waterLayerTableBind$date) #Replace 4 digits of the year by 2 digit -#format the decimal places of the water layer column to 2 digits, to make cells of same length -#Only format the cells that do have a value, not a NA -waterLayerTableBind$wlayer[!is.na(waterLayerTableBind$wlayer)] <- format(round(waterLayerTableBind$wlayer[!is.na(waterLayerTableBind$wlayer)], 2), nsmall = 2) -#replace Na by a point -waterLayerTableBind[is.na(waterLayerTableBind)] <- "." #use a logical conditional - -#convert table to wide format -#Keep the water layer infomation and the IDs -# a "formula object" is used in the form: varInDependent ~ vardependent -#This fails with duplicate or missing rows -wTable_depth_date <- dcast(waterLayerTableBind, id ~ depth + date, value.var = "wlayer") ## ... means "all other variables" - -##FORMATTING -#split the plot wID into its meaning -wTable_depth_date$rep <- substr(wTable_depth_date$id,1,1) #Repetition -wTable_depth_date$irr <- substr(wTable_depth_date$id,2,2) # irrigation -wTable_depth_date$till <- substr(wTable_depth_date$id,3,3) # till -wTable_depth_date$residue <- substr(wTable_depth_date$id,4,4) #residue -wTable_depth_date$nlevel <- substr(wTable_depth_date$id,5,5) # nitrogen level -#And reorder the columns -n= length(colnames(wTable_depth_date)) #Count the columns -wTable_depth_date <- wTable_depth_date[,c((n-4):n,2:(n-5))] #didnt include the first one -#Replace the scores in the headers -colnames(wTable_depth_date) <- gsub('-', '', colnames(wTable_depth_date)) -colnames(wTable_depth_date) <- gsub('_', '', colnames(wTable_depth_date)) - -#write the final table to CSV if you want to save to text file -write.csv(wTable_depth_date,csvfile, row.names=FALSE) -##write the space delimited file -#How to make the columns stay aligned? -write.table(wTable_depth_date,file = paste(pnrfile,".prn",sep=""),sep = " ",row.names=FALSE,col.names=FALSE,quote = FALSE)#data -# how to treaspose?# write.table(colnames(wTable_depth_date),file = paste(pnrfile,"header.prn",sep="_"),sep = " ",row.names=FALSE,col.names=FALSE,quote = FALSE)#header diff --git a/r/moisture/archive/171031_getMoistureSamplingDataFromExcel_trialAE521_graficasHumedad.R b/r/moisture/archive/171031_getMoistureSamplingDataFromExcel_trialAE521_graficasHumedad.R deleted file mode 100644 index a6c42d8..0000000 --- a/r/moisture/archive/171031_getMoistureSamplingDataFromExcel_trialAE521_graficasHumedad.R +++ /dev/null @@ -1,270 +0,0 @@ -#### -# GET MOISTURE SAMPLING FROM THE EXCEL FIle indicated. used to save the wet and dry weight of the sampling cans -#Calculates the water depth in mm based on the % moisture and using a given formula -#This is intended to keep inly the sampling corresponding to the irrigations (no summer samplings) -#and arrange them to plot the moisture levels, and mm of infiltrated water, across time -# -# regex to split the columns are not robust and the input format should be the same as AD-521 file -#check that the excel sheets's names are formated as: -# DR16-08-2017_all-4 -# DR o AR > is after or before irrigation -# dd-mm-yyyy -# which plots were sampled: all, conv, 2aux, 4aux, pb -# the # of current irrigation, after or before the sampling was performed (or the preplanting irrigation): 1 2 3 4 pre -# -# -# Execute a new instance of R to every new file to be processed, to avoid re-using variables -# -# STORE TO local file -# -# # # # #Check conditions and quality check needed to be implemented -# -# # # # # check Harcoded inputs every time. -# -#Ediciones para leed el AE521 -#### - -#library(xlsx) #preferred to read XLSX? -library("XLConnect") -library(reshape2) -library(ggplot2) -library("dplyr") - - -####################################################### FUNCTIONS DEFINITION -source(file.path("C:","Dropbox","Software","Scripts","r","moisture","methods_moisture.R", fsep = .Platform$file.sep)) - -###################################################### EXECUTE SCRIPT -############################### INPUTS - -# EDIT NOW -setwd("C://Dropbox//data//AD//AD_nut//521_humedad") -file="C://Dropbox//Bascula (1)//Muestras suelo//AD//AD-521.xlsx" -startSheet <- 5 # CHECK THIS EACH TIME. numbar of sheet of the excel file that has sampling data!! ! ! ! ! ! !! !!! !! ! !! !!! !! ! !! ! ! ! ! ! ! -endSheet <- 23#16AE# number of sheets to read starting from the startSheet #!# WTF not working -trial <- "521" -csvfile <- "humedad_AD521.csv" -pnrfile <- "humedad_AD521" - -#This is #Fixed for the standard format. Edit otherwise. -col_names<-c('id', - 'depth', - 'canType', - 'can', - 'wSoilw', - 'dSoilw', - 'moisture') -colTypes <- c('numeric', 'character','numeric', 'numeric','numeric','numeric','numeric') -startRow<- 6 #Skip the fisrt 5 rows because it has other ancillary data -endCol <- 7 #Fixed for the standard format -endRow <- 103 #Fixed for the standard format for the trial 521 -################################# END INPUTS - -##getMoistreFromExcel <- function (file, startSheet,endCol,endRow,colTypes,col_names,maxsamplepointID) -mData <- getMoistreFromExcel(file, startSheet,endSheet,endCol,endRow,colTypes,col_names,startRow) #get the raw moisture data[[1]] and sheetnames[[2]] - -##Resulting data -sheetNames<-unlist(mData[[2]]) -moistData <-mData[[1]] - -#Calculate water table based on the moisture frome each measurement -#length(sheetNames) -waterLayerTable <- calculateWLayer(moistData,sheetNames) - -##Bind all samplings in one table (stack the rows, keep the columns) -wLTable <- Reduce(rbind,waterLayerTable) - -##FORMATTING -#Format the headers (use if needed) -# wLTable$depth <- gsub('0-15', '1w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('15-30', '2w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('30-60', '3w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('60-90', '4w', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('0-15', 'depth1', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('15-30', 'depth2', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('30-60', 'depth3', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('60-90', 'depth4', wLTable$depth) #replace the depth by an ordered index - -###########Separate the sheets name into columns (maybe change after the filtering thing?) -#The format should be something like: dr30-11-2015_pre-conv -#sheetname should be in a format dd-mm-yyyy and will have a prefix of 2 char: AR or DR or DT or MV (indicating the kind of sampling: after/before iirgation, etc) -#and a suffix indicating _[pre]/[2R]/[4R]-[1/2/3/4/5]/[pb]/[conv]) -#date column - get what has the format of a date dd-mm-yyyy -wLTable$date <- as.Date(regmatches(wLTable$sheetName, regexpr("[0-9]{2}-[0-9]{2}-[0-9]{4}", wLTable$sheetName)),"%d-%m-%Y") -#sampling type column - what looks like [dr]/[ar]/[mv]/[dt] ... (antes de riego, despu?s, verano, trilla...) -wLTable$irrtype <- regmatches(wLTable$sheetName, regexpr("ar|dr|mv|dt", wLTable$sheetName)) -#irrarea sampled column - the sampling corresponded to which irrigation instance: pre(siembra), 4R(4 riegos) or 2R(2 riegos) -wLTable$irrarea <- gsub('_', '',regmatches(wLTable$sheetName, regexpr("_[0-9A-Za-z]+", wLTable$sheetName))) -#irrigation sampled column - weather its the first, second.. irrigation etc -wLTable$irrnum <- gsub('-', '',regmatches(wLTable$sheetName, regexpr("-[0-9A-Za-z]+$", wLTable$sheetName))) -############# Separate the ID to know the treatments -# Get the number of the repetition from the ID -wLTable$rep <- substr(sapply(wLTable$id,toString), 1,1) -# Get the irrigation scheme from the 2rd digit of the ID, number of irrigation treatment 1 = 2AUX, 2 = 4AUX -wLTable$irr <- substr(sapply(wLTable$id,toString), 2,2) -#use the names of the tillage codes -wLTable$irr[wLTable$irr == 1] <- "2aux" -wLTable$irr[wLTable$irr == 2] <- "4aux" -# Get the type of tillage from the 3rd digit of the ID, Type of tillage 1 = conv, 2 = PB -wLTable$till <- substr(sapply(wLTable$id,toString), 3,3) -#use the names of the tillage codes -wLTable$till[wLTable$till == 1] <- "conv" -wLTable$till[wLTable$till == 2] <- "pb" -# Get the type of residue treatment from the 4rd digit of the ID, 1= 100%, 2=40% -wLTable$res <- substr(sapply(wLTable$id,toString), 4,4) -wLTable$res[wLTable$res == 1] <- "100%" -wLTable$res[wLTable$res == 2] <- "40%" -# column to summarize the reps, we eliminate the rep ID which is the first char, and also the N level (5th digit) -wLTable$idSum <- substr(sapply(wLTable$id,toString), 2,4) - -#check for NA's in rows -na_inrow <- apply(wLTable, 1, function(x){any(is.na(x))}) # logical vector of the rows with any NA's -#wLTable <- wLTable[complete.cases(wLTable), ] #This iis to remove any row that has a NA on it. -#check if the plot corresponds to the performed sampling -irr_corresponds <- wLTable$irrarea == wLTable$irr | wLTable$irrarea == wLTable$till -#keep only the rows that dont have NA's and their treatment correspond to the performed sampling -wLTable <- wLTable[!na_inrow, ] -##Filter the table as DESIRED -#The following is a harcoded way to generate different filterd tables, -#Fro future development this can be converted to a loop or a swith menu. -#wLFiltered <- wLTable[wLTable$irr %in% c("2aux") & wLTable$till %in% c("pb")& wLTable$res %in% c("40%"),] #one way to filter -#wLFiltered <- wLTable[wLTable$irr %in% c("2aux") & wLTable$till %in% c("conv")& wLTable$res %in% c("40%"),] #one way to filter -wLFiltered <- wLTable[wLTable$irr %in% c("4aux")& wLTable$res %in% c("40%"),] #one way to filter, just keeping the plots/samplings of the 2 auxiliary irrigation scheme - -#Summarize the reps 1,2,3 to get just the mean value, of columns wlayer and mositure (put together with the cbind function) -tableSum <- aggregate(cbind(wlayer, moisture) ~ idSum+depth+date+irr+till+res, data=wLFiltered, FUN=mean) - -#Formate the date column to format the axis labels in ggplot -tableSum$date <- as.POSIXct(tableSum$date) - -### FORMATIING headers ### -#wLTable$date <- substr(wLTable$sheetNames,3,12) #Keep only the date in the column date #!# we actually need the AR/DR -#wLTable$date <- gsub('201', '1', wLTable$sheetNames) #Replace 4 digits of the year by 2 digit -##format the decimal places of the water layer column to 2 digits, to make cells of same length -##Only format the cells that do have a value, not a NA -#wLTable$wlayer[!is.na(wLTable$wlayer)] <- format(round(wLTable$wlayer[!is.na(wLTable$wlayer)], 2), nsmall = 2) -##replace Na by a point -#wLTable[is.na(wLTable)] <- "." #use a logical conditional - - - -#Order the data -#wLFiltered <- wLFiltered[order(wLFiltered$depth),] by depth - - -########convert table to wide format -##Keep the water layer infomation and the IDs -## a "formula object" is used in the form: varInDependent ~ vardependent -##This fails with duplicate or missing rows -####Here the order of the columns will arrange the table as DESIRED to get a useful format table################################### -#wTable_depth_date <- dcast(wLTable, id + depth ~ irr +area + type, value.var = "wlayer") ##arrange rows by id and columns by depth + date -#wTable_depth_date <- dcast(wLFiltered, id ~ irr +area + type +depth, value.var = "wlayer") ## Arrange for the ASCIIs -#wTable_depth_date <- dcast(wLFiltered, id+date+rep ~ depth , value.var = "wlayer") ## Arrange for the plots - -#30251f,#715A4B,#A78772,#E1B79B - -## Plot -## library(ggplot2) - -###Some tricks to format the graph -depthColors <- c(depth1 = "#E1B79B", depth2 = "#A78772", depth3 ="#6d5749", depth4 = "#30251f") -depthColors2 <- c(depth1 = "#8c1a1a", depth2 = "#ed9e36", depth3 ="#008706", depth4 = "#8dc159") -depthColors3 <- c(depth1 = "#ffece0", depth2 = "#ffa474", depth3 ="#db4551", depth4 = "#8b0000") -tillLType <- c(conv = "solid", pb = "longdash") -tillTypeLabel <-c("Conventional","PB") -depthLabel <- c("0-15","15-30","30-60","60-90") -depthPontShape <- c("0-15","15-30","30-60","60-90") -breaks =tableSum$date - -#plot the wlayer, group by 2 different variables with "interaction" function -ggplot(data=tableSum, aes(x=date, y=wlayer,group=interaction(idSum,depth))) + - #geom_line(aes(color="black",linetype=till))+ - geom_line(aes(linetype=till))+ - geom_point(aes(fill=depth,shape="a"),colour="black",pch=21, size=3)+ - scale_fill_manual(values=depthColors3,labels=depthLabel)+ - scale_linetype_manual(values=tillLType,labels=tillTypeLabel)+ - #scale_linetype_manual(values=tillLType,labels=tillTypeLabel)+ #set the linetype according to the till, list defined - # to match the secondary axis, the data is "transformed" and then adapted (divide and *) - ##LABELS - labs(title="Trial AE-521, Soil water content (2016-2017)", - subtitle = "4 auxiliary irrigations treatment, 40% residue", - x = "Soil sampling date", y = "Water content (mm)") + - labs(fill = "Depth (cm)",linetype="Tillage")+ #format the legend - theme(plot.title = element_text(family = "Arial", color="black", face="bold", size=18))+ - theme(plot.subtitle = element_text(family = "Arial", color="black", size=16))+ - theme(axis.title = element_text(family = "Arial", color="black", size=14))+ - #TEMA DE LA GRAFICA - theme(panel.background = element_rect(fill = "white", colour = "black"))+ - theme(panel.border = element_rect(linetype = "solid", fill = NA))+ - theme(panel.grid.major.y = element_line(colour = "#cccccc"))+ - theme(panel.grid.minor.y = element_line(colour = "#cccccc",linetype="dotted"))+ - scale_y_continuous(minor_breaks = seq(0 , 160, 10))+ - theme(panel.grid.major.x = element_blank())+ - scale_x_datetime(date_breaks = "15 day",date_labels= "%d-%b-%Y")+ #poner la escala en cada 15 d?as - theme(axis.text.x = element_text(angle = 25, vjust = 1.0, hjust = 1.0))+ - theme(axis.text = element_text(colour = "black", size=12)) - -#plot the moisture, group by 2 different variables with "interaction" function -ggplot(data=tableSum, aes(x=date, y=moisture,group=interaction(idSum,depth))) + - geom_line(aes(linetype=till))+ #optional color=depth,,size=0.8 - geom_point(aes(fill=depth,shape="a"),colour="black",pch=21, size=3)+ - scale_fill_manual(values=depthColors3,labels=depthLabel)+ - scale_color_manual(values=depthColors3,labels=depthLabel)+ - scale_linetype_manual(values=tillLType,labels=tillTypeLabel)+ #set the linetype according to the till, list defined - # to match the secondary axis, the data is "transformed" and then adapted (divide and *) - ##LABELS - labs(title="Trial AE-521, Soil moisture content (2016-2017)", - subtitle = "4 auxiliary irrigations treatment, 40% residue", - x = "Soil sampling date", y = "moisture (%)") + - labs(fill = "Depth (cm)",linetype="Tillage")+ #optional ,color = "Depth (cm) - theme(plot.title = element_text(family = "Arial", color="black", face="bold", size=18))+ - theme(plot.subtitle = element_text(family = "Arial", color="black", size=16))+ - theme(axis.title = element_text(family = "Arial", color="black", size=14))+ - #TEMA DE LA GRAFICA - theme(panel.background = element_rect(fill = "white", colour = "black"))+ - theme(panel.border = element_rect(linetype = "solid", fill = NA))+ - theme(panel.grid.major.y = element_line(colour = "#cccccc"))+ - theme(panel.grid.minor.y = element_line(colour = "#cccccc",linetype="dotted"))+ - scale_y_continuous(minor_breaks = seq(0 , 160, 2))+ - theme(panel.grid.major.x = element_blank())+ - scale_x_datetime(date_breaks = "15 day",date_labels= "%d-%b-%Y")+ - #limits = as.Date(c('28-11-2015','12-03-2016')))+ #poner la escala en cada 15 d?as - theme(axis.text.x = element_text(angle = 25, vjust = 1.0, hjust = 1.0))+ - theme(axis.text = element_text(colour = "black", size=12)) -#save image -namePlot<- "AE521_4aux_40perc_mmWater_PByConv.jpeg" -namePlot<- "AE521_4aux_40perc_moisture_PByConv.jpeg" -ggsave(namePlot) - - - ###Example -# ggplot(data=tableSum, aes(x=date, y=wlayer,group=interaction(id, depth))) + -# geom_line(aes(color=depth))+ -# geom_point(aes(color=depth))+ -# labs(title = "Soil water content", x = "Date", y = "water layer (mm)")+ -# geom_col(aes(x=date, y=moisture,group=interaction(id, depth)))+ -# scale_y_continuous(sec.axis = sec_axis(~.*2, name = "Moisture (%)")) - - -##FORMATTING -##split the plot wID into its meaning -#wTable_depth_date$rep <- substr(wTable_depth_date$id,1,1) #Repetition -#wTable_depth_date$irr <- substr(wTable_depth_date$id,2,2) # irrigation -#wTable_depth_date$till <- substr(wTable_depth_date$id,3,3) # till -#wTable_depth_date$residue <- substr(wTable_depth_date$id,4,4) #residue -#wTable_depth_date$nlevel <- substr(wTable_depth_date$id,5,5) # nitrogen level - -#And reorder the columns to put the id columns at the begining -#n= length(colnames(wTable_depth_date)) #Count the columns -#wTable_depth_date <- wTable_depth_date[,c((n-4):n,2:(n-5))] #didnt include the first one to omit the full plot name -#FORMATTING: Replace the scores in the headers -#colnames(wTable_depth_date) <- gsub('-', '', colnames(wTable_depth_date)) -#colnames(wTable_depth_date) <- gsub('_', '', colnames(wTable_depth_date)) - -#write the final table to CSV if you want to save to text file -write.csv(wLTable,csvfile, row.names=FALSE) -##write the space delimited file -#How to make the columns stay aligned? -write.table(wTable_depth_date,file = paste(pnrfile,".prn",sep=""),sep = " ",row.names=FALSE,col.names=FALSE,quote = FALSE)#data -# how to treaspose?# write.table(colnames(wTable_depth_date),file = paste(pnrfile,"header.prn",sep="_"),sep = " ",row.names=FALSE,col.names=FALSE,quote = FALSE)#header - diff --git a/r/moisture/171020_getMoistureSamplingDataFromExcel.R b/r/moisture/getMoistureSamplingDataFromExcel.R similarity index 56% rename from r/moisture/171020_getMoistureSamplingDataFromExcel.R rename to r/moisture/getMoistureSamplingDataFromExcel.R index d1645a6..1b858b4 100644 --- a/r/moisture/171020_getMoistureSamplingDataFromExcel.R +++ b/r/moisture/getMoistureSamplingDataFromExcel.R @@ -65,38 +65,11 @@ waterLayerTable <- calculateWLayer(moistData,dates) ##Bind all samplings in one table (stack the rows, keep the columns) wLTable <- Reduce(rbind,waterLayerTable) -##FORMATTING -#Format the headers (use if needed) -# wLTable$depth <- gsub('0-15', '1w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('15-30', '2w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('30-60', '3w', wLTable$depth) #replace the depth by an ordered index -# wLTable$depth <- gsub('60-90', '4w', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('0-15', 'depth1', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('15-30', 'depth2', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('30-60', 'depth3', wLTable$depth) #replace the depth by an ordered index -wLTable$depth <- gsub('60-90', 'depth4', wLTable$depth) #replace the depth by an ordered index - -###########Separate the sheets name into columns (maybe change after the filtering thing?) -#The format should be something like: dr30-11-2015_pre-conv -#sheetname should be in a format dd-mm-yyyy and will have a prefix of 2 char: AR or DR or DT or MV (indicating the kind of sampling: after/before iirgation, etc) -#and a suffix indicating _[pre]/[2R]/[4R]-[1/2/3/4/5]/[pb]/[conv]) -#date column - get what has the format of a date dd-mm-yyyy -wLTable$date <- as.Date(regmatches(wLTable$sheetName, regexpr("[0-9]{2}-[0-9]{2}-[0-9]{4}", wLTable$sheetName)),"%d-%m-%Y") -#sampling type column - what looks like [dr]/[ar]/[mv]/[dt] ... (antes de riego, despu?s, verano, trilla...) -wLTable$irrtype <- regmatches(wLTable$sheetName, regexpr("bi|ai|ah|m1", wLTable$sheetName)) #espa?ol ar|dr|mv|dt|m1" -#irrarea sampled column - the sampling corresponded to which irrigation instance: pre(siembra), 4R(4 riegos) or 2R(2 riegos) -wLTable$irrarea <- gsub('_', '',regmatches(wLTable$sheetName, regexpr("_[0-9A-Za-z]+", wLTable$sheetName))) -#irrigation sampled column - weather its the first, second.. irrigation etc -wLTable$irrnum <- gsub('-', '',regmatches(wLTable$sheetName, regexpr("-[0-9A-Za-z]+$", wLTable$sheetName))) - #check for NA's in rows na_inrow <- apply(wLTable, 1, function(x){any(is.na(x))}) # logical vector of the rows with any NA's #wLTable <- wLTable[complete.cases(wLTable), ] #This iis to remove any row that has a NA on it. #keep only the rows that dont have NA's and their treatment correspond to the performed sampling wLTable <- wLTable[!na_inrow, ] -#Formate the date column to format the axis labels in ggplot -wLTable$date <- as.POSIXct(wLTable$date) - #write the final table to CSV if you want to save to text file write.csv(wLTable,csvfile, row.names=FALSE)