In tbep-tech/tbepRSparrow: RSPARROW: An R system for SPARROW modeling

knitr::opts_chunk$set(echo = FALSE,eval=TRUE, echo=FALSE,warning=FALSE, message = FALSE)

#unpack params
file.output.list<-params$file.output.list
mapping.input.list<-params$mapping.input.list
DAreaFailCheckObj<-params$DAreaFailCheckObj
data1<-params$data1
existGeoLines<-params$existGeoLines
commonvar<-params$commonvar
map.vars.list<-params$map.vars.list
GeoLines<-params$GeoLines
lineShape<-params$lineShape
title_name<-params$title_name
filename<-params$filename
path_checkDrainageareaErrorsChild<-params$path_checkDrainageareaErrorsChild

unPackList(lists = list(file.output.list = file.output.list,
                        mapping.input.list = mapping.input.list),
           parentObj = list(NA, NA)) 

#setup plotly marker options
pnch<-as.character(pchPlotlyCross[pchPlotlyCross$pch==diagnosticPlotPointStyle,]$plotly)
markerSize<-diagnosticPlotPointSize*10
markerCols<-colorNumeric(c("black","white"), 1:2)
markerList = paste0("list(symbol = pnch,
                       size = ",markerSize,",")

if (regexpr("open",pnch)>0){
  markerList<-paste0(markerList,"color = markerCols(1))")
}else{
  markerList<-paste0(markerList,"line = list(color = markerCols(1), width = 0.8),color = markerCols(1))")
}

# plot comparison for mis-matched reaches
markerText<-"~paste('</br> Pre-calc Total Drainage Area: ',preCalc,
                   '</br> Newly-calculated Total Drainage Area: ',Calc"

data<-data.frame(preCalc = DAreaFailCheckObj$demtarea, Calc = DAreaFailCheckObj$demtarea_new)

data1sub<-data1[which(data1$waterid %in% DAreaFailCheckObj$waterid),]
data1sub<-data1sub[match(DAreaFailCheckObj$waterid,data1sub$waterid),]

markerText<-addMarkerText(markerText,add_plotlyVars,data, data1sub)$markerText
data<-addMarkerText(markerText,add_plotlyVars, data,data1sub)$mapData

p <- plotlyLayout(data$preCalc,data$Calc, log = "xy", nTicks = 5, digits = 0,
                  xTitle ="Pre-calculated Total Drainage Area", xZeroLine = TRUE,
                  yTitle = "Newly-calculated Total Drainage Area",  yZeroLine = TRUE,
                  plotTitle = "Comparison of Total Drainage Areas",
                  legend = FALSE,showPlotGrid = showPlotGrid)


p <- p %>% add_trace(data = data, x = ~preCalc, y = ~Calc, 
                     type = "scatter", 
                     mode = "markers",
                    marker = eval(parse(text = markerList)),
                     hoverinfo = 'text',
                     text = eval(parse(text = markerText)))
p <- p %>% add_trace(data = data, x = ~preCalc, y = ~preCalc, 
                     type = "scatter", 
                     mode = "lines",
                     color = I("red"),
                     hoverinfo = 'text',
                     text = "Pre-calculated Total Drainage Area")
p

cat("<P style='page-break-before: always'>") 

rmd <- sapply(
  1:(length(map.vars.list)),
  function(k) {
   knit_expand(path_checkDrainageareaErrorsChild, k = k)
  }
)
rmd <- paste(rmd, collapse = "\n")

rendered <- knit(text = rmd, quiet = TRUE)
cat("\n \n")
cat(rendered, sep = "\n")

tbep-tech/tbepRSparrow documentation built on Oct. 9, 2020, 6:24 a.m.