From d367be3d5871133510b272b8f2bd0114c0859dbc Mon Sep 17 00:00:00 2001
From: Sam <s.dumble@stats4sd.org>
Date: Mon, 24 Jan 2022 12:07:45 +0000
Subject: [PATCH] Updates to app

---
 app.R                      |  58 ++++++++++++++++++++++++++-----------
 scheduleFile_template.xlsx | Bin 14741 -> 14744 bytes
 2 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/app.R b/app.R
index 718fa35..7293f80 100644
--- a/app.R
+++ b/app.R
@@ -8,12 +8,13 @@ library(lubridate)
 ui <- fluidPage(
 
     # Application title
-    titlePanel("DayCentScheduler"),
+    titlePanel("Create DayCent Scheduler File From Input"),
 
     # Sidebar with a slider input for number of bins 
     sidebarLayout(
         sidebarPanel(
-          fileInput("file1", "Upload Schedule File",
+          htmlOutput("downloader"),
+          fileInput("file1", "Upload Completed Excel Schedule Template",
                     multiple = FALSE,
                     accept = c(".xlsx")),
           uiOutput("fn"),
@@ -23,9 +24,9 @@ ui <- fluidPage(
         # Show a plot of the generated distribution
         mainPanel(
           tabsetPanel(
-            tabPanel("Schedule",
+            tabPanel("View Schedule",
           htmlOutput("schedule")),
-           tabPanel("Input",
+           tabPanel("View Inputs",
           DTOutput("data1"))
         )
     )
@@ -35,33 +36,52 @@ ui <- fluidPage(
 # Define server logic required to draw a histogram
 server <- function(input, output) {
 
+  output$downloader<-renderText(
+    
+    HTML('Download Blank Excel Template File: <a href="https://github.com/stats4sd/DayCentSchedule/raw/main/scheduleFile_template.xlsx">Here</a><br><br>')
+    
+  )
   observeEvent(input$file1,{
     
   
-  schedule<-read.xlsx(input$file1$datapath,1)
+    nms<-getSheetNames(input$file1$datapath)
+    nms<-nms[nms!="lookups"]
+    
+    schedule<-NULL
+    for(i in nms){
+      tmp<-read.xlsx(input$file1$datapath,i)
+      if(colnames(tmp)[1]=="fecha"){
+        schedule<-rbind(tmp,schedule)
+      }
+    }
+    
   lookups<-read.xlsx(input$file1$datapath,"lookups")
 
   out1<-schedule %>%
+    arrange(fecha) %>%
     mutate(siembra=ifelse(is.na(cultivo),
                           NA,"FRST"),
-           doy=yday(as.Date(schedule$fecha,origin="1899-12-30"))
+           date=as.Date(fecha,origin="1899-12-30"),
+           doy=yday(date),
+           year=as.numeric(ceiling((date-
+                                      min(date)+1)/365.25))
     ) %>%
-    select(-fecha) %>%
+    select(-fecha,-date) %>%
     pivot_longer(cols=labranza:siembra,
                  names_to="parameter",values_to = "val",values_drop_na = TRUE) %>%
     left_join(lookups,by=c("parameter"="variable","val"="text")) %>%
     mutate(code=ifelse(parameter=="siembra",val,code),
-           daycent=paste(doy,code)) %>%
-    select(daycent,doy) 
-
-  output$fn <- renderUI({
+           daycent=paste(year,doy,code)) %>%
+    select(daycent,year,doy)
+  
+output$fn <- renderUI({
     req(is.null(out1)==FALSE)
     textInput("filename","Enter Output File Name",value="myschedule")
   })
     
   output$dl <- renderUI({
     req(is.null(out1)==FALSE)
-    downloadLink('downloadData', 'Download Schedule')
+    downloadLink('downloadData', 'Download Daycent Schedule File')
   })
   
   
@@ -72,15 +92,19 @@ server <- function(input, output) {
   output$data1<-DT::renderDT({
     
     out1 %>%
-      group_by(doy) %>%
+      group_by(year,doy) %>%
        summarise(daycent=paste(daycent,collapse=" "))->out2
     
     schedule %>%
+      arrange(fecha) %>%
       mutate(siembra=ifelse(is.na(cultivo),
                             NA,"FRST"),
-             date=as.Date(schedule$fecha,origin="1899-12-30"),
-             doy=yday(as.Date(schedule$fecha,origin="1899-12-30"))) %>%
-      select(date,doy,labranza:siembra) %>%
+             date=as.Date(fecha,origin="1899-12-30"),
+             doy=yday(date),
+             year=as.numeric(ceiling((date-
+                                        min(date)+1)/365.25))
+      ) %>%
+      select(date,doy,year,labranza:siembra) %>%
       full_join(out2,by="doy") %>%
       filter(is.na(daycent)==FALSE)
   },options = list(pageLength = 100))
@@ -91,7 +115,7 @@ server <- function(input, output) {
       paste(input$filename, '.txt', sep='')
     },
     content = function(con) {
-      write.table(select(out1,-doy),con,row.names=FALSE,quote = FALSE,col.names = FALSE)
+      write.table(select(out1,-doy,-year),con,row.names=FALSE,quote = FALSE,col.names = FALSE)
     }
 )
   })  
diff --git a/scheduleFile_template.xlsx b/scheduleFile_template.xlsx
index bcdf6a5215ef46d7ca89a3233c69e1e76564def7..fc6af480276ea91019070b784e12c100b870c825 100644
GIT binary patch
delta 2642
zcmV-Y3a#~(bC`3m>;?s5ZH><3lko-|e_d~*I23(fY5xOjRhroc3MN1jlw?#OXeza%
zs>!r3ks=42VihoJOp~aZ|Gw7{(sZ&~WjkA?CjQ9rx%ZxP8GYI2nf5|O#dtAB_|ilg
zEn=Rq;%SV&&m(<+v`Ug9AsH{|80~0<zD$1qZM5OydByp&1^`7hMyZsgXBbtSf6|;(
zm%O9}?5w%SiG-<mGOAKgl2j?BGS3XlG+iSntUxV-C(gm(>otpM$m2Svg=|3t&4>j0
zRm#e$L(AiH;Bq3K>r#(-UIN65WlZiGP^9Itcl}gwK~@=ry~U2U74UK4ADb{(-A%A{
za#hY^!7IL&mjG?Fq)+0<rh)Ohe-vy_b8sG#Z3z0pR1FWTg!@5O?g7hv1H<MoqhXL%
zqZJR5_dzu0z|BIF(VAuSp_Q&i%JLh@Ri!edWu%hRgh`r=Q6Hv!L*Ffky7X(7!LDWZ
ztsycd2RYvfEum{tXL1fg?%=^0t~<0GbrOVel}RcJB5A-22|C=z^{bj|f3Sm;gTl3Y
z`d7^a1!IA}AXXSj?2%P<M`WtiA{(Q?TYRq|{6&@2`DzggUat67`#hV4e=dUH{!R<Y
zE>`ru(yXLn0n-4cGq7k<XLNC-U~+1g|Da(KtHc<PnU;O~{pTz}5W?$pdMAYj-><_P
zsMU<TK;=Lm$==x4P#WA@e-^Ru@bc9U?Z~m+fgXmIuiMzR^efl2b;t3Yem^j=ZAL#J
z7~y&`C$&uXqEOIdWP<`uwr<I`+rg$+v*eA&tGWNv)$^yJ+xwvcR_*VB(M|OxA2rps
zkE}@eW{h-eFti}7UAKUH4$?Nw?juWN3IZIOHk@eJzEbv-0%hzBf7BxQL{S@~*J<bn
z18a!&0rnl;9t5@yC;GbYU-`Yjcf-EvH<XMcPEDr;Zp~9G8h7j{5gLY;uDWoOWuysD
z-65_Mtb#f|ok4)L>Zyn0(De?-t)}SRE#Mkf&_tOK?mU|9Z(eS*BEMWlOnE0HlB`HY
zl{aIO%{n#^bjp&1f2vmzntW>6e){9$>H>Qg(M7*EGLDczX76tWs2B{a9!+dRY_{&E
zTX|E-$q1g{9R?W%&0O`(p{<+Kp33OZf{gYoJ+MP->h!1K)OVDo)XUBLKU#caVXu2@
zDwZh`axO^x4DZ@|y7nO-Ds1H>;CW2ecLu)M1B!NpBQU_wVuZ@OV1O{{Iei=kQ>QUN
zOIC%y{$PV07|pLKku@|Q)pwe?r^aZ%dRSby3;P1U>lfaAr~=vl`ri)DAo`4+c{qAF
z^I-7pc7A*2*_-Kn`4}~M|Ho+CYN)Z%kkQp}@;3mJF%1;6`wB_|2~Se5DTECG0IZWv
z4IqD%+m6~W5Qgt7^&KML=N!mEgcX9K-J7cF_Hb<+hgigMYMTXG?Ynmzl7NJS&`Kem
z1pnXs;~AJe9eHiNQK^_{a^yQ6vS>p@!J2K3e*Re739^*NO@V9C&>WqpLQnJ0pJoRk
zcdDXPTR>=3jw-F&%ykv1D96eXEp6bNQb>P}H9X3#t6E8M(TRBN2A(%{Ic5zy6EgV-
zLzE>WbS221(?*{mlGa#*e^s$o4Kz+3!Er2i`_?9cw}9BNn(0#qMHVO7%eD~`Z)&Lf
z=tr1XM+sK|pKwUiy}!xC8IeMXQaeC)&z^6~Pu<kTWF+0z{}9HHTuI-UY2XDFe9V86
zKN(rU1r~k~HXUK+xMa3xMUMVWqIkIsJ>QO#MQTUuWMQY?WNLe>aFs->IEcT5?`S?N
z7<AZFWl37*XyIqiv4`CGtQ(+Tj2_fgY-zlCr8Om*LJ}WYe}&+$1e@NaFx2DYS2K|H
z`K6iRjSxEndjXjTX;lX?X))34jV^y_4ZGJqoQL|;IWaNVa7Q24@!)CQ&HXoN6|}_r
zT7MUZXUevf26K@UOyEGwL}kTkMHPWjhU`u>F<>HUpupYY%={){6!EcJ53JA?L{lf3
zhC$*RjM67lBSd7cwBWz{Jw55n0P`IK)`1Z_VVXo?d|wES>x8gt5T;kj@1z}^_DWbU
zN`G*DM;P})_~Yq?sWa;OYW=PO-9h~avxX0N3kop-h1cE#001ivlTQs9e=;t3ZET#A
z+m72H5Qgt7^&JrRF*ZJ|W5roTIjDPARXto2jAImITp%Y^efJK|VONT@jaD)qF#5ll
zF+Y>%qiWG!7%O#G;wT6)5*^o->^3F-@qIPQF|v+z6>D`TN_-L)KTkh@njEy*+C~V6
zfY8|zH_r71A(l5nF&pS!e{`@@YonNhrP&bM8^NkUq*_A5Fe8e|4xb5yd4!?sT5_?_
ze5XX`&JZJ7=AeGt$lhLQia&x=%xri4h-=jYVl7+gP6HGp#fz6srwv=T(DyM)7)M6~
z4}}q5(+uD5GAYT8wz_r!kjc5``}W6VOc=kB?)!fT6D7omz4Qn8e~O|XD=A8EEcyzI
zKM2ciF#o$uv6EGa|14&CGGC^2w2Ys|qa;q}qx=b$voK7Ti#(@U6#m82NhRTgeOJhc
zy2P`nm`6{TOeceZeoAq$Z|2DRajo^%Z@fUB5D-?hf_rBm24OGeqHRmOpwOHBJy87|
zkmSaEJHPT*gNMHwe^iN@?OOLuAHE2=X&hXbB%moY=iO0Mr-iT_Yzf(eB=umfTcE%j
zDe3PQ*oqy8c#xHAN=)M*&tjTK9>aImY4z*86J7LYC6qiUAzqXb4Z<u-!ptkz!n&38
z1-(mwa~LQPuaqc=V;aW)%b#475U<MjD<?zi{{R30|Nj60vm70G69mti{6n*tFew3l
z!Y~xY-v|2+CGTyTREC7M!X`dV7})(`Z&`BHVw096TK)D*t9F%*JtpVeU(UHCogGyb
z9KhJJ))^vEi~`W2mZjcg=(SjcQxsUowd7T;AwwsyXqMmKrJ`Y?Ht=HV28=7g2A-rX
z6HSJ;&NU2UE4HAxjl4s9aa|k5oj;m?4Q{yD@eN=a#}8P6<B~g$J7CxhM07z)F(8}0
zsd|7E7%EVpoy8;~_{ZzODEsF?uZ*0kbf?C5y2Kr`r8tX&`)JF-*tTudCVdQ_pWu(>
z^Qx~Jmb%-O0F<XvFkyhZ+T<$-2hhPA*RV_RNa&VWaqE_T-|G_O<0)Tp70mZb>Z^hj
z|5iP<FL6eL416qhE^$@flc#yHKsk*m2?-4oQpA)I%97->d;Dg;i+R3Kmk9q8X&94`
zP6|TUWXfVPB3=P`pZoS}<lg|3F%1;69y37$1!8TD&f}A0Hc|xc3IG6;3kw>P)HV<s
zPg1Wbgbe@ytUdq$7ytkO00000000000020X|28WeF#(0w-U9#tD-Hkv7ytkO00000
z00000008nDk~bBTTQ@HP1|O3j9~G0KH!1;zlgu|d0e+JQI6(n=lSw#G0eq91I8*^a
zlkYeq8_$~jLsJ0&0A~UK01*HH00000000000001qlPx(u0TYvKIU@$xH2?qr0JF*A
Aj{pDw

delta 2641
zcmZ8jc{J1w8=c|JmSt>{S*(%QKFKn6qbxJF$T0S$v1F35llX<PYr-Ir$Yg0M6sbmD
zBqU{*HIx=h8oRQ7z2|)A>zwcT<DTc7d+uNN-se1pVfkTo-#LyjzPvR3L|f%R0ztua
zG~^(DaG#SOKhZ28Vs#ZVOcb4N$e+NE5GU1gWH@j6h@$+hXw?&k@#ncNFm*~oKV%9C
zPqxqb``w0l#*IUtubD(!JL@<ORNPU#Yem5IR6W{>lOWYFhS_c?^g3fZ7pcRGH@aCZ
z?m=RJ$H}b+AY<q2BUWi|hBkG9Zi|E^OUE3c$oE;t2(5WW3lSaMHcMF$yU)xEVpI<=
z7lwFZS6`dglBTuA>)cAIig{yn_ao3wgxP(jxl(S}EYI80Vw@$x4*V+PtHXDfvv>s|
z*3La5vNn_)n|aZ<=i^eV01Q>QkFARcb-)Ps1~x)(fF4HOwcRsMq4on!kc+nG$r8C0
zVQVJ7`~nZ2tz#T}!96kTr#sc?(%FvpMFkSKF&ewA?;PZvNJX?%8zxT;BlubN%{O?t
zt|w{siWa(#sVHB>+NA{T{F#1aq%|pk>JS&2y)N!#|G3jy^{dop2?@pa5VJ}Z6^z)B
z8^ps0!{*4-|8ct3a|Ce96eseE)J)M@;BUA^pz}wsBn!$*c#K35h`9FkNAT!OmgcjT
z>Y+-4ib*d+bW*X@zka396f!lVAU!RYJMEO~L{amCw}x}b6=~@>BNfC-3wnTllnv1<
zJk6@>pWVZ-yjJcXo4U=yZV88@ANf89rg%z)m0b__92?Ds0~&+^?(P0HO|7H^gf06!
z@)f806z{vgE(HYA(QDE`f{|vw069g^<0bj{<L19*HwaIR!Sb$8qbFHX?WBMmv$>Hm
zK;zfmh57Axi&Wp;*fQd|mTq&K{N>{+=Ne)6ix#L>WYVZwS;9lb;>hisN*Q)AmG`JJ
z^GPkm(AO9SjMunPbaRF~7fB*J2_$OvSDBgj%Gz}rbz*`47;SPUuqdb7gB2FcZ%x=7
zotmh!Zyb4ayikeDh57wuP#!)xc8xc_L}p?5Q3OA~*5fLPw|ADr-@emY*jG5K*&usQ
z*#x~F&}bC%{9VtdP}n(VJ!xokGD(JXs_oYUe|8&x4Zu46MaFP<6?M7FNVW3V>!vid
zlq98nE*Np^z~L&c?CKZ#W)LN-hS}{nHS805#I{<TN6@t3q&WPz<*D+7tohfJG=3|U
zI+Ih6Q|-ilH4f*!n0j$Y?|3Tree-E0@us)xSEPI&d32igL|`@hQV)*pb{8>ja`PJa
zY=e&o3F-}pWyf?4en&}+ofhH95pT)K|50l+=H=cTSL`)lyq*(RRT3MTwS7OeBjRbD
z?MhSp#}BE4Is21`erR@9SZHO)9=XzcWjQiFwsP58!_%-cXzFlaQWX(;QS<J$&aFMZ
zTuG7oJsunz_fJGwauOd1#Gu*oNddG;>I4ds!cy84mznv73^k^RCYOIGW-M-zgOI6&
zS0RDLM_e{P=<#EXO-uqRAhwBz!3V2WezxWwuE7q9CyJ22sHw^m5W70RV!GtaXk><R
zMaa2X7Yz+_c}D-x-dyT9=5-0<?-3{jo=?XuMJ_Tk9P-Y8Nh{D=u~m=-y5JID-s2zM
zeKvpQMI?J)raRR+sh4u^3Pt)&t{_v0*mr^62f>maw6!n@_c`G5*JsfMO>rdQHdo_|
zgm)YFl4LSz3q6g3LcxL6yYuFS1aodDPz%{&sJW&46)eXj-CoZ)vhQ|qPv6wr4x;Rb
z_lJ<q>u%VY!V9xUL|^m)xkfPOwj<DggrV0_VQ!&Je^cs#O*!#7ufdGXpsAnvQn<JO
zv}|KD{uz#r7m_V)2LcS0#KOlMe6cQH13uc83JW}6ch)vGf*Dlb9~+Eb$B}Rv$+Cuz
z54hSqxwV>mysEpp)cmBD)-6x9Bcvlaw%F7K1{wT5gFfZs2zOu*9to(Iwy}D-C|)nc
z-QBv9=n>kRo)!3hAr@)h8hKk`(h>f^)CQF>hg#QAu~A}h@v480EKdgu+p!<{0rmfy
zNx{78x@1si;soiifu~{?5m|%s=cLaNYa3=;b_@&_-d=T#<Rx&LeWEzSle^=j8y*V3
zticqz%eBzdkw5b5Jn{}^cc`d^Wb$+~D$LB?^WltUnO^lFs6I^~`Y2ClGOXnTI|!t}
zPdm#81JqTcgD&2pO=e8~8=IqXob+9SVeR=(%F>+7sEQ5p!`E|!SC8GWI(9oh#C1~L
zxh}RRF6XEm1pDc?oai$jzZ~0dR$U`|M-n2STcbD-gj<{24a^hnBfQ5yz>DX7{wqb_
z)(9v<=1muIv|hHDx5C0nyNUMgi0rpN8L9k0RA7Z%{ZEGW@CKZqnMSmvOTDfpmLK;w
zxg+Ua&4ePM87$fGE#85C^~}v;vyHDf+MeJo;^n3#bGL2@LDB$EEWGR$?M3u>IIcb-
zGfuLd62hup%~+w<UPxg@-Ml;N0>isXc5k??$L*fit<0LS*xomya0@fM)uuq6cECUv
zj%Ns=bUC?0lH#jfxa-awOJ~Re(0cuwYC{1HS*4wHS(|V4J#J5bOt$K=7ztnRl^a&_
z`K{bdHTrxJSU>NR0;OCfHXQ8xB4kwX``hbtF83ZzMz`sMWq2D}OHS#hcngFDOy(-9
zH*B!L8J2$yB374oaGrep2aIMOAh40NtR3-_&1Z<9ubM7dF;=v0W>*6BLKg{z?P3>O
z-JV#qRmmsoxd$jlB0pgq8Wpf2yD?Dnn0eF{{|C7(y?P%_0mn}$4!O=u^{hRqo?NN0
zH=1HiLN#Sk3h3m7#8n*kKAM{N6Zl2T6q>{TivJQGurCP$fesIUL%o!El<;36)+grc
zi%|+-APFVXF~hmbpBr^8-8ZWY+BjGx$`JvKxfV<{+6&8JNxRF(o`e-#GdS^W%Cq;m
zY)PquD6(zr@q3tzT^3t^c|par-+TojW&7_sDyjRv%juL}uL1p*W~^!ZnV{M6VLmaZ
zL_U42>xm-X<y$1NPRH-YA&8jNtxuI&8G3*Q;5tQq^v$(ZgUYI7>ynE?Mzz+#(&rQN
ze9mZbp4$W|pd8AK^)j(%R<4gG*lqPCc-%ze7kaO;!qfG9El;M=cZod%V~s(>C*pWZ
zOJ}!7hM2YR0_J2sD6h&M<$bkj;xmcUyuVFpw9a<*%zObMWXUmprda56yN+j=s4_op
zu|84c(9z(D+Q~8uhanV!yP_1_Jy%XBztx#Xp`>st_`Kor#jXt)#B0uUAXSIuULKx-
zcgo(aPlRY$irutMo4NX;FK%CRO^tRaAzCke3d8>2ugqV|9=uFrYN;Upcd-pYAhF*b
z{26T;o3;}2PecEoUxCy35pdcO9SBWC5_0s9kex==HU=ls`m}Yyu{0hu1{_7RLZ1c4
u&`Qt_U_;s(`Z(fWlh1)cAb&OxNbryJ_m)CK=@^0`v|yd%93z_lQvU((9niV}