R/apps_of_direction.R

Defines functions upstreamtofrom riverdirectiontofrom plotseq mouthdistbysurvey mouthdist upstreammat plotmatbysurveylist matbysurveylist upstreammatbysurvey upstreamseq riverdirectionmat riverdirectionmatbysurvey riverdirectionseq upstream riverdirection isflowconnected

Documented in isflowconnected matbysurveylist mouthdist mouthdistbysurvey plotmatbysurveylist plotseq riverdirection riverdirectionmat riverdirectionmatbysurvey riverdirectionseq riverdirectiontofrom upstream upstreammat upstreammatbysurvey upstreamseq upstreamtofrom

#' Check Flow-Connectedness
#' @description Checks to see if two segments are flow-connected.  Called internally within \link{riverdirection} and \link{upstream}.
#' @param seg1 First input segment
#' @param seg2 Second input segment
#' @param rivers The river network object to use
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return Logical \code{TRUE} if the two segments are flow-connected, \code{FALSE} if they are not
#' @note The river mouth must be specified (see \link{setmouth}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#' plot(Gulk)
#'
#' Gulk <- setmouth(seg=1, vert=1, rivers=Gulk)
#'
#' isflowconnected(seg1=13, seg2=14, rivers=Gulk)
#' isflowconnected(seg1=13, seg2=1, rivers=Gulk)
#' @export
isflowconnected <- function(seg1,seg2,rivers,stopiferror=TRUE,algorithm=NULL) {
  connected <- FALSE
  if(is.na(rivers$mouth$mouth.seg)|is.na(rivers$mouth$mouth.vert)) stop("River mouth must be specified.")
  route1 <- detectroute(start=rivers$mouth$mouth.seg,end=seg1,rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
  route2 <- detectroute(start=rivers$mouth$mouth.seg,end=seg2,rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
  if(is.na(route1[1]) | is.na(route2[1])) connected <- NA
  if(!is.na(route1[1]) & !is.na(route2[1])) {
    if(any(route1==seg2)) connected <- TRUE
    if(any(route2==seg1)) connected <- TRUE
  }
  return(connected)
}

#' River Direction
#' @description Calculates direction of travel between two points.  Only works
#'   if river mouth (lowest point) has been specified (see \link{setmouth}).
#' @param startseg Segment number of the start of the route
#' @param endseg Segment number of the end of the route
#' @param startvert Vertex number of the start of the route
#' @param endvert Vertex number of the end of the route
#' @param rivers The river network object to use
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @param flowconnected If \code{TRUE}, only returns direction if the two input segments are flow-connected.  Defaults to \code{FALSE}.
#' @return Direction: "up", "down", or "0" (character).  Returns NA if \code{flowconnected==TRUE} and the two segments are not flow-connected.
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' plot(x=Gulk)
#' riverdirection(startseg=6, endseg=3, startvert=40, endvert=40, rivers=Gulk)
#' @seealso \link{setmouth}
#' @export
riverdirection <- function(startseg,endseg,startvert,endvert,rivers,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(max(c(startseg,endseg),na.rm=T)>length(rivers$lines) | min(c(startseg,endseg),na.rm=T)<1) {
    stop("Invalid segments specified.")
  }
  if(startvert>dim(rivers$lines[[startseg]])[1] | startvert<1 | endvert>dim(rivers$lines[[endseg]])[1] | endvert<1) {
    stop("Invalid vertex specified.")
  }
  
  if(is.na(rivers$mouth$mouth.seg) | is.na(rivers$mouth$mouth.vert)) {
    stop("Error - Need to specify segment & vertex of river mouth")
  }
  direction <- "0"
  flowc <- isflowconnected(seg1=startseg,seg2=endseg,rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
  if(!stopiferror & is.na(flowc)) direction <- NA
  if(!is.na(flowc)) {
    if(flowconnected & !flowc) direction <- NA
    if(!flowconnected | flowc) {
      if(riverdistance(startseg=rivers$mouth$mouth.seg,endseg=startseg,startvert=rivers$mouth$mouth.vert,endvert=startvert,
                       rivers=rivers,stopiferror=stopiferror,algorithm=algorithm) <
         riverdistance(startseg=rivers$mouth$mouth.seg,endseg=endseg,startvert=rivers$mouth$mouth.vert,endvert=endvert,
                       rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)) {
        direction <- "up"
      }
      if(riverdistance(startseg=rivers$mouth$mouth.seg,endseg=startseg,startvert=rivers$mouth$mouth.vert,endvert=startvert,
                       rivers=rivers,stopiferror=stopiferror,algorithm=algorithm) >
         riverdistance(startseg=rivers$mouth$mouth.seg,endseg=endseg,startvert=rivers$mouth$mouth.vert,endvert=endvert,
                       rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)) {
        direction <- "down"
      }
    }
  }
  return(direction)
}

#' Upstream River Distance
#' @description Calculates river network distances as +/-, defined as
#'   upriver/downriver.
#'  
#'   Specifying \code{net=TRUE} will compute net upriver distance (3 river km
#'   down a tributary and then 15 river km up the mainstem will mean 12 rkm net.
#'   Otherwise the function will return 18 rkm upriver travel.)
#'  
#'   The mouth (lowest point) segment and vertex must be specified (see
#'   \link{setmouth}).
#' @param startseg Segment number of the start of the route
#' @param endseg Segment number of the end of the route
#' @param startvert Vertex number of the start of the route
#' @param endvert Vertex number of the end of the route
#' @param rivers The river network object to use
#' @param flowconnected If \code{TRUE}, only returns distance if the two input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param net Whether to calculate net distance (\code{net=TRUE}) or total
#'   distance (\code{net=FALSE})
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return Upstream distance (numeric).  Returns NA if \code{flowconnected} has value \code{TRUE} and the two segments are not flow-connected.
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' plot(x=Gulk)
#' riverpoints(seg=c(6,4), vert=c(140,140), pch=16, col=2, rivers=Gulk)
#' upstream(startseg=6, endseg=4, startvert=140, endvert=40, rivers=Gulk, net=TRUE)
#' upstream(startseg=6, endseg=4, startvert=140, endvert=40, rivers=Gulk, net=FALSE)
#' upstream(startseg=6, endseg=4, startvert=140, endvert=40, rivers=Gulk, flowconnected=TRUE)
#' @seealso \link{setmouth}
#' @export
upstream <- function(startseg,endseg,startvert,endvert,rivers,flowconnected=FALSE,net=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(max(c(startseg,endseg),na.rm=T)>length(rivers$lines) | min(c(startseg,endseg),na.rm=T)<1) {
    stop("Invalid segments specified.")
  }
  if(startvert>dim(rivers$lines[[startseg]])[1] | startvert<1 | endvert>dim(rivers$lines[[endseg]])[1] | endvert<1) {
    stop("Invalid vertex specified.")
  }
  
  if(is.na(rivers$mouth$mouth.seg) | is.na(rivers$mouth$mouth.vert)) {
    stop("Error - Need to specify segment & vertex of origin")
  }
  flowc <- isflowconnected(seg1=startseg,seg2=endseg,rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
  if(!stopiferror & is.na(flowc)) distance <- NA 
  if(!is.na(flowc)) {
    if(flowconnected & !flowc) distance <- NA
    if(!flowconnected | flowc) {
      if(net) {
        distance <- riverdistance(startseg=rivers$mouth$mouth.seg,endseg=endseg,startvert=rivers$mouth$mouth.vert,endvert=endvert,
                                  rivers=rivers,stopiferror=stopiferror,algorithm=algorithm) -
          riverdistance(startseg=rivers$mouth$mouth.seg,endseg=startseg,startvert=rivers$mouth$mouth.vert,endvert=startvert,
                        rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
      }
      if(!net) {
        rawdist <- riverdistance(startseg=startseg,endseg=endseg,startvert=startvert,endvert=endvert,
                                 rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
        updown <- riverdirection(startseg=startseg,endseg=endseg,startvert=startvert,endvert=endvert,
                                 rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
        distance <- NA
        distance <- rawdist*(updown=="up") - rawdist*(updown=="down")
        if(rawdist==0) distance <- 0
      }
    }
  }
  return(distance) 
}


#' River Travel Direction Between Sequential Observations
#' @description Returns a matrix of directions traveled by unique fish between
#'   sequential surveys.  The mouth (lowest point) segment and vertex must be
#'   specified (see \link{setmouth}).
#' @param unique A vector of identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param logical A boolean vector that can be used for subsetting - if used,
#'   \code{riverdirectionseq()} will only return pairwise distances in which a
#'   specified condition is met.
#' @param flowconnected If \code{TRUE}, only returns direction if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A data frame of directions (character), with rows defined by unique
#'   fish and columns defined by observation increment (1 to 2, 2 to 3, etc.)  See \link{riverdirection} for additional information.
#' @seealso \link{riverdirection}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' riverdirectionseq(unique=fakefish$fish.id, survey=fakefish$flight, seg=fakefish$seg,
#'    vert=fakefish$vert, rivers=Gulk)
#'
#' riverdirectionseq(unique=fakefish$fish.id, survey=fakefish$flight.date, seg=fakefish$seg,
#'    vert=fakefish$vert, rivers=Gulk)
#' @export
riverdirectionseq <- function(unique,survey,seg,vert,rivers,logical=NULL,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(is.null(logical)) logical <- rep(T,length(unique))
  
  unique<-unique[logical]
  survey<-survey[logical]
  seg<-seg[logical]
  vert<-vert[logical]
  tab <- table(unique,survey)
  if(max(tab)>1) cat("Warning: multiple entries exist for at least one unique/survey combination (first one used)")
  dists <- matrix(NA,nrow=dim(tab)[1],ncol=(dim(tab)[2]-1))
  for(i in 1:dim(tab)[1]) {
    for(j in 1:(dim(tab)[2]-1)) {
      if(tab[i,j]*tab[i,(j+1)]!=0) {
        dists[i,j] <- riverdirection(startseg=seg[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                                     endseg=seg[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j+1]][1],
                                     startvert=vert[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                                     endvert=vert[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j+1]][1],
                                     rivers=rivers,flowconnected=flowconnected,stopiferror=stopiferror,algorithm=algorithm)
      }
    }
  }
  dists<-as.data.frame(dists)
  row.names(dists) <- row.names(tab)
  col.name<-NA
  for(j in 1:(length(dimnames(tab)$survey)-1)) col.name[j] <- paste(dimnames(tab)$survey[j],"to",dimnames(tab)$survey[j+1])
  names(dists) <- col.name
  dists <- dists[rowSums(is.na(dists)) != ncol(dists),]
  return(dists)
}


#' River Direction Matrix of All Observations of an Individual
#' @description Returns a matrix of travel direction between all observations of
#'   one unique fish.
#' @param indiv The unique identifier of the fish in question.
#' @param unique A vector of identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to
#'   use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param full Whether to return the full matrix, with \code{NA} values for
#'   missing data (\code{TRUE}), or a the subset of rows and columns
#'   corresponding to successful observations.  Defaults to \code{TRUE}.
#' @param flowconnected If \code{TRUE}, only returns direction if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found, the
#'   function will return \code{NA} in the appropriate entry.  Defaults to
#'   \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of directions (character), with rows and columns defined by
#'   survey.  In the resulting matrix, the element with the row identified as
#'   \code{A} and column identified as \code{B} is defined as the direction
#'   traveled from survey A to survey B.  Therefore, it is likely that only the
#'   upper triangle of the matrix will be of interest.
#' @seealso \link{riverdirection}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#' riverdirectionmatbysurvey(indiv=1, unique=fakefish$fish.id, survey=fakefish$flight,
#'       seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#'      
#' riverdirectionmatbysurvey(indiv=1, unique=fakefish$fish.id, survey=fakefish$flight,
#'       seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk, full=FALSE)
#' @export
riverdirectionmatbysurvey <- function(indiv,unique,survey,seg,vert,rivers,full=TRUE,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  surveys <- sort(unique(survey))
  surveys_indiv <- sort(unique(survey[unique==indiv]))
  
  outmat <- matrix(NA,nrow=length(surveys),ncol=length(surveys))
  for(ii in 1:length(surveys)) {
    for(jj in 1:length(surveys)) {
      outmat[ii,jj] <- ifelse((length(seg[unique==indiv & survey==surveys[ii]])==0) | (length(seg[unique==indiv & survey==surveys[jj]])==0),NA,
                              riverdirection(startseg=seg[unique==indiv & survey==surveys[ii]], endseg=seg[unique==indiv & survey==surveys[jj]],
                                             startvert=vert[unique==indiv & survey==surveys[ii]], endvert=vert[unique==indiv & survey==surveys[jj]],
                                             rivers=rivers,flowconnected=flowconnected,stopiferror=stopiferror,algorithm=algorithm))
    }
  }
  dimnames(outmat)[[1]] <- dimnames(outmat)[[2]] <- as.character(surveys)
  if(!full) {
    if(!all(is.na(outmat))) {
      whichnotna <- NA
      iwhichnotna <- 1
      for(i in 1:dim(outmat)[1]) {
        if(!all(is.na(outmat[,i]))) {
          whichnotna[iwhichnotna] <- i
          iwhichnotna <- iwhichnotna+1
        }
      }
      outmat <- outmat[whichnotna,whichnotna]
    }
    if(all(is.na(outmat))) outmat <- NA
  }
  return(outmat)
}

#' River Direction Matrix
#' @description Returns a matrix of calculated travel direction between every
#'   point and every other point of given river locations (segment and
#'   vertex), or of a subset.  The mouth (lowest point) segment and vertex must
#'   be specified (see \link{setmouth}).
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use
#' @param logical A boolean vector that can be used for subsetting - if used,
#'   \code{riverdirectionmat()} will only return pairwise distances in which a
#'   specified condition is met.
#' @param ID a vector of observation IDs for aid in interpreting the output
#'   table
#' @param flowconnected If \code{TRUE}, only returns direction if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of directions (character) with rows and columns labeled by
#'   corresponding values of \code{ID}.  See \link{riverdirection} for additional information.
#' @seealso \link{riverdirection}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' logi1 <- (fakefish$flight.date==as.Date("2015-11-25"))
#'
#' riverdirectionmat(seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk, logical=logi1)
#' @export
riverdirectionmat <- function(seg,vert,rivers,logical=NULL,ID=NULL,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(is.null(logical)) logical <- rep(T,length(unique))
  
  len <- length(vert)
  seg<-seg[logical]
  vert<-vert[logical]
  if(is.null(ID)) ID <- 1:len
  ID <- ID[logical]
  dists <- matrix(NA,nrow=length(vert),ncol=length(vert))
  for(i in 1:length(vert)) {
    for(j in  1:length(vert)) {
      dists[i,j] <- riverdirection(startseg=seg[i],endseg=seg[j],startvert=vert[i],endvert=vert[j],
                                   rivers=rivers,flowconnected=flowconnected,stopiferror=stopiferror,algorithm=algorithm)
    }
  }
  dimnames(dists)[[1]] <- dimnames(dists)[[2]] <- ID
  return(dists)
}

#' Upstream Distance Between Sequential Observations
#' @description Returns a matrix of distance with direction by unique fish
#'   between sequential surveys.  The mouth (lowest point) segment and vertex
#'   must be specified (see \link{setmouth}).  A plotting method is provided for the output; see \link{plotseq}.
#' @param unique A vector of identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param logical A boolean vector that can be used for subsetting - if used,
#'   \code{upstreamseq()} will only return pairwise distances in which a
#'   specified condition is met.
#' @param flowconnected If \code{TRUE}, only returns distance if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param net Whether to calculate net upstream distance (net=TRUE) or total
#'   distance (net=FALSE, default).
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A data frame of upstream distances (numeric), with rows defined by
#'   unique fish and columns defined by observation increment (1 to 2, 2 to 3,
#'   etc.)  See \link{upstream} for additional information.
#' @seealso \link{upstream}, \link{plotseq}
#' @author Matt Tyers
#' @note Returns either net upstream distance (net=TRUE) or total distance
#'   (net=FALSE, default).  See \link{upstream}.
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @examples
#' data(Gulk, fakefish)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' upstreamseq(unique=fakefish$fish.id, survey=fakefish$flight, seg=fakefish$seg,
#'       vert=fakefish$vert, rivers=Gulk)
#'
#' seqbysurvey <- upstreamseq(unique=fakefish$fish.id, survey=fakefish$flight.date, seg=fakefish$seg,
#'       vert=fakefish$vert, rivers=Gulk)
#' seqbysurvey
#' plotseq(seqbysurvey)
#' @export
upstreamseq <- function(unique,survey,seg,vert,rivers,logical=NULL,flowconnected=FALSE,net=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(is.null(logical)) logical <- rep(T,length(unique))
  
  unique<-unique[logical]
  survey<-survey[logical]
  seg<-seg[logical]
  vert<-vert[logical]
  tab <- table(unique,survey)
  if(max(tab)>1) cat("Warning: multiple entries exist for at least one unique/survey combination (first one used)")
  dists <- matrix(NA,nrow=dim(tab)[1],ncol=(dim(tab)[2]-1))
  for(i in 1:dim(tab)[1]) {
    for(j in 1:(dim(tab)[2]-1)) {
      if(tab[i,j]*tab[i,(j+1)]!=0) {
        dists[i,j] <- upstream(startseg=seg[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                               endseg=seg[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j+1]][1],
                               startvert=vert[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                               endvert=vert[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j+1]][1],
                               rivers=rivers,net=net,flowconnected=flowconnected,stopiferror=stopiferror,algorithm=algorithm)
      }
    }
  }
  dists<-as.data.frame(dists)
  row.names(dists) <- row.names(tab)
  col.name<-NA
  for(j in 1:(length(dimnames(tab)$survey)-1)) col.name[j] <- paste(dimnames(tab)$survey[j],"to",dimnames(tab)$survey[j+1])
  names(dists) <- col.name
  dists <- dists[rowSums(is.na(dists)) != ncol(dists),]
  return(dists)
}


#' Upstream Distance Matrix of All Observations of an Individual
#' @description Returns a matrix of upstream travel distance between all observations of
#'   one unique fish.
#' @param indiv The unique identifier of the fish in question.
#' @param unique A vector of identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to
#'   use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param full Whether to return the full matrix, with \code{NA} values for
#'   missing data (\code{TRUE}), or a the subset of rows and columns
#'   corresponding to successful observations.  Defaults to \code{TRUE}.
#' @param flowconnected If \code{TRUE}, only returns direction if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param net Whether to calculate net upstream distance (net=TRUE) or total
#'   distance (net=FALSE, default).
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found, the
#'   function will return \code{NA} in the appropriate entry.  Defaults to
#'   \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of upstream distances (numeric), with rows and columns defined by
#'   survey.  In the resulting matrix, the element with the row identified as
#'   \code{A} and column identified as \code{B} is defined as the upstream distance
#'   traveled from survey A to survey B.  Therefore, it is likely that only the
#'   upper triangle of the matrix will be of interest.
#' @seealso \link{upstream}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#' upstreammatbysurvey(indiv=1, unique=fakefish$fish.id, survey=fakefish$flight,
#'       seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#'      
#' upstreammatbysurvey(indiv=1, unique=fakefish$fish.id, survey=fakefish$flight,
#'       seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk, full=FALSE)
#' @export
upstreammatbysurvey <- function(indiv,unique,survey,seg,vert,rivers,full=TRUE,flowconnected=FALSE,net=FALSE,stopiferror=TRUE,algorithm=NULL) {
  surveys <- sort(unique(survey))
  surveys_indiv <- sort(unique(survey[unique==indiv]))
  
  outmat <- matrix(NA,nrow=length(surveys),ncol=length(surveys))
  for(ii in 1:length(surveys)) {
    for(jj in 1:length(surveys)) {
      outmat[ii,jj] <- ifelse((length(seg[unique==indiv & survey==surveys[ii]])==0) | (length(seg[unique==indiv & survey==surveys[jj]])==0),NA,
                              upstream(startseg=seg[unique==indiv & survey==surveys[ii]], endseg=seg[unique==indiv & survey==surveys[jj]],
                                       startvert=vert[unique==indiv & survey==surveys[ii]], endvert=vert[unique==indiv & survey==surveys[jj]],
                                       rivers=rivers,flowconnected=flowconnected,net=net,stopiferror=stopiferror,algorithm=algorithm))
    }
  }
  dimnames(outmat)[[1]] <- dimnames(outmat)[[2]] <- as.character(surveys)
  if(!full) {
    if(!all(is.na(outmat))) {
      whichnotna <- NA
      iwhichnotna <- 1
      for(i in 1:dim(outmat)[1]) {
        if(!all(is.na(outmat[,i]))) {
          whichnotna[iwhichnotna] <- i
          iwhichnotna <- iwhichnotna+1
        }
      }
      outmat <- outmat[whichnotna,whichnotna]
    }
    if(all(is.na(outmat))) outmat <- NA
  }
  return(outmat)
}


#' Generate List of Distance Matrix Between Observations, for All Individuals
#' @description Returns a list of matrices, each giving the river distance, direction, or upstream travel distance between all observations of
#'   one unique fish.  This function is principally intended for producing an object to plot in \link{plotmatbysurveylist}.
#' @param unique A vector of unique identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to 
#'   use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param indiv A vector of unique individuals to use.  Accepting the default (\code{NULL}) will result in a matrix being returned for all unique individuals.
#' @param method Which general method to use.  Setting \code{method="distance"} will compute distance for each pair of observation, setting \code{method="direction"} will compute direction between each pair of observation, and setting \code{method="upstream"} will compute directional (upstream) distance between each pair of observation.  Defaults to \code{"upstream"}.
#' @param flowconnected Optional parameter to pass to the distance or direction calculation.  Defaults to \code{FALSE}.
#' @param net Optional parameter to pass to the distance or direction calculation.  Defaults to \code{FALSE}.
#' @param stopiferror Optional parameter to pass to the distance or direction calculation.  Defaults to \code{TRUE}.
#' @param algorithm Optional parameter to pass to the distance or direction calculation.  Defaults to \code{NULL}.
#' @seealso \link{riverdistance}, \link{riverdirection}, \link{upstream}, \link{riverdistancematbysurvey}, \link{riverdirectionmatbysurvey}, \link{upstreammatbysurvey}, \link{plotmatbysurveylist}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @return A list with each element corresponding to a unique fish.  Each list element is the output from either \link{riverdistancematbysurvey}, \link{riverdirectionmatbysurvey}, or \link{upstreammatbysurvey}.
#' @author Matt Tyers
#' @examples
#' data(Gulk, smallset)
#' matbysurveylist <- matbysurveylist(unique=smallset$id, survey=smallset$flight, seg=smallset$seg, 
#'    vert=smallset$vert, rivers=Gulk)
#' plotmatbysurveylist(matbysurveylist)
#' plotmatbysurveylist(matbysurveylist,type="confint")
#' plotmatbysurveylist(matbysurveylist,type="dotplot")
#'    
#' data(fakefish)
#' # matbysurveylist <- matbysurveylist(unique=fakefish$fish.id, survey=fakefish$flight, 
#' #   seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#' # plotmatbysurveylist(matbysurveylist)
#' @export
matbysurveylist <- function(unique,survey,seg,vert,rivers,indiv=NULL,method="upstream",flowconnected=FALSE,net=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(is.null(indiv)) indiv <- sort(unique(unique))
  iindiv <- 1
  mats <- list()
  for(indivi in indiv) {
    if(method=="upstream") {
      mats[[iindiv]] <- upstreammatbysurvey(indiv=indivi,unique=unique,survey=survey,seg=seg,vert=vert,rivers=rivers,full=TRUE,flowconnected=flowconnected,net=net)
    }
    if(method=="direction") {
      mats[[iindiv]] <- riverdirectionmatbysurvey(indiv=indivi,unique=unique,survey=survey,seg=seg,vert=vert,rivers=rivers,full=TRUE,flowconnected=flowconnected)
    }
    if(method=="distance") {
      mats[[iindiv]] <- riverdistancematbysurvey(indiv=indivi,unique=unique,survey=survey,seg=seg,vert=vert,rivers=rivers,full=TRUE)
    }
    iindiv <- iindiv+1
  }
  names(mats) <- indiv
  return(mats)
}


#' Plot Upstream Distance Between Observations of All Individuals
#' @description Produces a matrix of plots (boxplots are default), with plot \code{[i,j]} giving the
#'   distribution of upstream distances from observation \code{i} to observation
#'   \code{j}, for all individuals.  
#' @param matbysurveylist A list of distance matrices returned from \link{matbysurveylist}.
#' @param type If \code{type} is set to \code{"boxplot"}, boxplots will be 
#'   produced for each cell.  If \code{type} is set to \code{"confint"}, lines 
#'   denoting an approximate 95 percent confidence interval for the mean will be 
#'   produced instead.  If \code{type} is set to \code{"dotplot"}, a jittered
#'   dotplot will be produced for each cell, which will be the most appropriate
#'   if sample sizes are small.  Defaults to \code{"boxplot"}.
#' @param showN Whether to display the sample size for each cell.  Defaults to
#'   TRUE.
#' @param ... Additional plotting arguments.
#' @seealso \link{upstream}, \link{upstreammatbysurvey}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @importFrom graphics rect
#' @importFrom stats var
#' @importFrom stats t.test
#' @examples
#' data(Gulk, smallset)
#' matbysurveylist <- matbysurveylist(unique=smallset$id, survey=smallset$flight, seg=smallset$seg, 
#'    vert=smallset$vert, rivers=Gulk)
#' plotmatbysurveylist(matbysurveylist)
#' plotmatbysurveylist(matbysurveylist,type="confint")
#' plotmatbysurveylist(matbysurveylist,type="dotplot")
#'    
#' data(fakefish)
#' # matbysurveylist <- matbysurveylist(unique=fakefish$fish.id, survey=fakefish$flight, 
#' #   seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#' # plotmatbysurveylist(matbysurveylist)
#' @export
plotmatbysurveylist <- function(matbysurveylist,type="boxplot",showN=TRUE,...) {
  if(!is.numeric(matbysurveylist[[1]][1])) stop("Plotting methods do not yet exist for direction") 
  if(!any(type==c("boxplot","confint","dotplot"))) stop("Invalid plot type")
  mats <- matbysurveylist
  maxall <- max(unlist(mats),na.rm=T)
  minall <- min(unlist(mats),na.rm=T)
  dims <- dim(mats[[1]])[1]
  plot(NA,xlim=c(0,dims+.5),ylim=c(0,dims),xaxt='n',yaxt='n',xlab="",ylab="",...=...)
  for(i in 1:(dims-1)) {
    lines(rep(dims-i,2),c(i,dims))
    lines(c(i,dims),rep(dims-i,2))
    lines(c(i,dims),rep(dims-i+.55,2),lty=3)
    text(dims,i+.55,labels="0",pos=4,cex=.6)
  }
  for(i in 1:dims) text(i-.5,dims-i+.5,row.names(matbysurveylist[[1]])[i],cex=.7)
  if(type=="boxplot") {
    for(i in 1:(dims-1)) {
      for(j in (i+1):dims) {
        cell <- NA
        for(k in 1:length(mats)) {
          cell[k] <- mats[[k]][i,j]
        }
        box <- boxplot(cell,plot=F)
        box5num <- (box$stats-minall)/(maxall-minall)*.7+.2
        boxout <- (box$out-minall)/(maxall-minall)*.7+.2
        rect(xleft=(j-.65),ybottom=(dims-i+box5num[2]),xright=(j-.35),ytop=(dims-i+box5num[4]),col="white")
        lines((j-c(.575,.425)),rep((dims-i+box5num[1]),2))
        lines((j-c(.575,.425)),rep((dims-i+box5num[5]),2))
        lines(rep(j-.5,2),(dims-i+box5num[1:2]))
        lines(rep(j-.5,2),(dims-i+box5num[4:5]))
        lines((j-c(.35,.65)),(dims-i+rep(box5num[3],2)),lwd=1,lend=1)
        points(rep(j-.5,length(boxout)),(dims-i+boxout))
        if(showN) text(j-.5,dims-i+.1,paste0("n = ",length(cell[!is.na(cell)])),cex=.6)
      }
    }
  }
  if(type=="confint") {
    cilist <- list()
    ici <- 1
    for(i in 1:(dims-1)) {
      for(j in (i+1):dims) {
        cell <- NA
        for(k in 1:length(mats)) {
          cell[k] <- mats[[k]][i,j]
        }
        if(length(cell[!is.na(cell)])>1) {
          if(var(cell,na.rm=T)>0) {
            cilist[[ici]] <- t.test(cell)$conf.int
          }
        }
        ici <- ici+1
      }
    }
    maxall <- max(unlist(cilist),na.rm=T)
    minall <- min(unlist(cilist),na.rm=T)
    for(i in 1:(dims-1)) {
      for(j in (i+1):dims) {
        cell <- NA
        for(k in 1:length(mats)) {
          cell[k] <- mats[[k]][i,j]
        }
        if(length(cell[!is.na(cell)])>1) {
          if(var(cell,na.rm=T)>0) {
            ci <- t.test(cell)$conf.int
            ciplot <- (ci-minall)/(maxall-minall)*.7+.2
            lines(rep(j-.5,2),dims-i+ciplot,lwd=3,lend=1)
          }
        }
        if(showN) text(j-.5,dims-i+.1,paste0("n = ",length(cell[!is.na(cell)])),cex=.6)
      }
    }
  }
  if(type=="dotplot") {
    for(i in 1:(dims-1)) {
      for(j in (i+1):dims) {
        cell <- NA
        for(k in 1:length(mats)) {
          cell[k] <- mats[[k]][i,j]
        }
        cell1 <- (cell-minall)/(maxall-minall)*.7+.2
        points(jitter(rep(j-.5,length(cell1)),amount=.1),(dims-i+cell1))
        if(showN) text(j-.5,dims-i+.1,paste0("n = ",length(cell[!is.na(cell)])),cex=.6)
      }
    }
  }
}



#' Upstream Distance Matrix
#' @description Returns a matrix of upstream distance between every point and
#'   every other point of given river locations (segment and vertex), or of a
#'   subset.  The mouth (lowest point) segment and vertex must be specified
#'   (see \link{setmouth}).
#' @param seg A vector of river locations (segment component).
#' @param vert A vector of river locations (vertex component).
#' @param rivers The river network object to use.
#' @param logical A boolean vector that can be used for subsetting - if used,
#'   riverdirectionseq() will only return pairwise distances in which a
#'   specified condition is met.
#' @param ID a vector of observation IDs for aid in interpreting the output
#'   table
#' @param flowconnected If \code{TRUE}, only returns distance if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param net Whether to calculate net upstream distance (net=TRUE) or total
#'   distance (net=FALSE, default).  See \link{upstream}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of upstream distances (numeric) with rows and columns
#'   labeled by corresponding values of \code{ID}.  See \link{upstream} for additional information.
#' @seealso \link{upstream}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' logi1 <- (fakefish$flight.date==as.Date("2015-11-25"))
#'
#' upstreammat(seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk, logical=logi1)
#' @export
upstreammat <- function(seg,vert,rivers,logical=NULL,ID=NULL,flowconnected=FALSE,net=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(is.null(logical)) logical <- rep(T,length(unique))
  
  len <- length(vert)
  seg<-seg[logical]
  vert<-vert[logical]
  if(is.null(ID)) ID <- 1:len
  ID <- ID[logical]
  dists <- matrix(NA,nrow=length(vert),ncol=length(vert))
  for(i in 1:length(vert)) {
    for(j in  1:length(vert)) {
      dists[i,j] <- upstream(startseg=seg[i],endseg=seg[j],startvert=vert[i],endvert=vert[j],
                             rivers=rivers,net=net,flowconnected=flowconnected,stopiferror=stopiferror,algorithm=algorithm)
    }
  }
  dimnames(dists)[[1]] <- dimnames(dists)[[2]] <- ID
  return(dists)
}

#' Distance From Mouth
#' @description Calculates distance from river locations (given as vectors of segment and
#'   vertex) and the specified mouth of the river network.  The mouth must first
#'   be specified (see \link{setmouth}).
#' @param seg Vector of segments
#' @param vert Vector of vertices
#' @param rivers The river network object to use
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return Distance (numeric)
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#'
#' # Mouth must be specified
#' Gulk$mouth$mouth.seg <- 1
#' Gulk$mouth$mouth.vert <- 1
#'
#' mouthdist(seg=4, vert=40, rivers=Gulk)
#' mouthdist(seg=c(4,5), vert=c(40,20), rivers=Gulk)
#' @export
mouthdist <- function(seg,vert,rivers,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(any(is.na(seg)) | max(seg)>length(rivers$lines) | min(seg)<1) {
    stop("Invalid segments specified.")
  }
  # if(vert>dim(rivers$lines[[seg]])[1] | vert<1) {
  #   stop("Invalid vertex specified.")
  # }
  
  if(is.na(rivers$mouth$mouth.seg) | is.na(rivers$mouth$mouth.vert)) {
    stop("Error - Need to specify segment & vertex of origin",'\n')
  }
  dists <- rep(NA,length(seg))
  for(i in 1:length(seg)) {
    if(any(is.na(vert)) | vert[i]>dim(rivers$lines[[seg[i]]])[1] | vert[i]<1) stop("Invalid vertex specified.")
    dists[i] <- riverdistance(startseg=seg[i],endseg=rivers$mouth$mouth.seg,startvert=vert[i],endvert=rivers$mouth$mouth.vert,
                              rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
  }
  return(dists)
}


#' Distance From Mouth for All Observations of Individuals
#' @description Calculates distance from the mouth of a river network to all 
#'   observations of each individual (given as segment and vertex). and the 
#'   specified mouth of the river network.  The mouth must first be specified 
#'   (see \link{setmouth}).  Returns a matrix of distances, with a row for each 
#'   unique individual and a column for each survey.
#'   
#'   A plotting method is provided for the output; see \link{plotseq}. 
#' @param unique A vector of identifiers for each fish.
#' @param survey A vector of identifiers for each survey.  It is recommended to
#'   use a numeric or date format (see \link{as.Date}) to preserve survey order.
#' @param seg A vector of river locations (segment)
#' @param vert A vector pf rover coordinates (vertex)
#' @param rivers The river network object to use
#' @param logical A boolean vector that can be used for subsetting - if used, 
#'   \code{mouthdistbysurvey()} will only return distances in which a specified
#'   condition is met.
#' @param stopiferror Whether or not to exit with an error if a route cannot be 
#'   found.  If this is set to \code{FALSE} and a route cannot be found, the 
#'   function will return \code{NA} in the appropriate entry.  Defaults to 
#'   \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"}, 
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the 
#'   default), the function will automatically make a selection.  See 
#'   \link{detectroute} for more details.
#' @return A vector of river network distances (numeric), with each row
#'   corresponding to a unique fish and each column corresponding to a unique
#'   survey.  Values of \code{NA} indicate the individual not being located
#'   during the survey in question.
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @seealso \link{plotseq}
#' @author Matt Tyers
#' @examples
#' data(Gulk, fakefish)
#' 
#' seqbysurvey <- mouthdistbysurvey(unique=fakefish$fish.id, survey=fakefish$flight.date, 
#'     seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#' seqbysurvey
#' plotseq(seqbysurvey)
#' @export
mouthdistbysurvey <- function(unique,survey,seg,vert,rivers,logical=NULL,stopiferror=TRUE,algorithm=NULL) {
  if(!inherits(rivers, "rivernetwork")) stop("Argument 'rivers' must be of class 'rivernetwork'.  See help(line2network) for more information.")
  if(is.null(logical)) logical <- rep(T,length(unique))
  
  unique<-unique[logical]
  survey<-survey[logical]
  seg<-seg[logical]
  vert<-vert[logical]
  tab <- table(unique,survey)
  if(max(tab)>1) cat("Warning: multiple entries exist for at least one unique/survey combination (first one used)")
  dists <- matrix(NA,nrow=dim(tab)[1],ncol=(dim(tab)[2]))
  for(i in 1:dim(tab)[1]) {
    for(j in 1:(dim(tab)[2])) {
      if(tab[i,j]!=0) {
        dists[i,j] <- mouthdist(seg=seg[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                                vert=vert[unique==sort(unique(unique))[i] & survey==sort(unique(survey))[j]][1],
                                rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
      }
    }
  }
  dists<-as.data.frame(dists)
  row.names(dists) <- row.names(tab)
  col.name<-NA
  names(dists) <- dimnames(tab)$survey
  dists <- dists[rowSums(is.na(dists)) != ncol(dists),]
  return(dists)
}


#' Plot Sequence of Observations
#' @description Plots the sequence of observations or movements of each individual (given as 
#'   segment and vertex).  This function is primarily intended for use with 
#'   \link{mouthdistbysurvey}, but will also work with \link{riverdistanceseq} and 
#'   \link{upstreamseq}.
#' @param seqbysurvey A matrix returned from \link{mouthdistbysurvey}, 
#'   \link{riverdistanceseq}, or \link{upstreamseq}.
#' @param type The type of plot to generate.  Options are 
#'   \code{"boxplot"},\code{"dotplot"},\code{"boxline"},or \code{"dotline"}. 
#'   Defaults to \code{"boxplot"}.
#' @param xlab X-axis label
#' @param ylab Y-axis label
#' @param main Plot title
#' @param cex.axisX Character expansion factor for X-axis labels
#' @param lowerbound An optional vector of lower survey bounds
#' @param upperbound An optional vector of upper survey bounds
#' @param boundtype Method of plotting survey bounds.  Options are
#'   \code{"positive"}, \code{"negative"} (default), and \code{"lines"}.
#' @param surveysareDates If surveys are in Date format (see \link{as.Date}), a
#'   value of \code{TRUE} allows the x-coordinates points to be spaced apart
#'   according to date, not equidistantly.  Defaults to \code{FALSE}.  Any formatting of 
#'   the survey variable must be done within the original call to \link{mouthdistbysurvey}, 
#'   \link{riverdistanceseq}, or \link{upstreamseq}.  Dates must already be formatted as dates,
#'   or in the form \code{"YYYY-MM-DD"} or \code{"YYYY/MM/DD"}.
#' @param ... Additional plotting parameters
#' @note Plots are intended as descriptive only.  Any ANOVA-like inference that 
#'   is suggested from these plots is strongly discouraged.  The user is instead
#'   advised to use a mixed-effects model or some other inferential tool that 
#'   accounts for repeated-measures and/or temporal autocorrelation.
#' @author Matt Tyers
#' @importFrom graphics polygon
#' @importFrom graphics boxplot
#' @importFrom graphics axis
#' @examples
#' data(Gulk, fakefish)
#' 
#' x <- mouthdistbysurvey(unique=fakefish$fish.id, survey=fakefish$flight.date, 
#'     seg=fakefish$seg, vert=fakefish$vert, rivers=Gulk)
#'     
#' plotseq(seqbysurvey=x)
#' plotseq(seqbysurvey=x, type="boxline")
#' plotseq(seqbysurvey=x, type="dotplot")
#' plotseq(seqbysurvey=x, type="dotline")
#' 
#' plotseq(seqbysurvey=x, type="dotline", surveysareDates=TRUE)
#' 
#' from_upstreamseq <- upstreamseq(unique=fakefish$fish.id, 
#'    survey=fakefish$flight, seg=fakefish$seg, vert=fakefish$vert, 
#'    rivers=Gulk)
#' plotseq(seqbysurvey=from_upstreamseq)
#' @export
plotseq <- function(seqbysurvey,type="boxplot",xlab="",ylab="",main="",cex.axisX=.8,lowerbound=NULL,upperbound=NULL,boundtype="negative",surveysareDates=F,...) {
  if(surveysareDates) xplot <- as.Date(names(seqbysurvey))
  if(!surveysareDates) xplot <- 1:(dim(seqbysurvey)[2])
  if(is.numeric(seqbysurvey[1,1])) {
    plot(NA,xlim=c(xplot[1],xplot[length(xplot)]),ylim=c(min(seqbysurvey,na.rm=T),max(seqbysurvey,na.rm=T)),xaxt='n',xlab=xlab,ylab=ylab,main=main,...=...)
    if(!is.null(lowerbound)&!is.null(upperbound)) {
      if(boundtype=="negative") {
        polygon(x=c(xplot[1],xplot,xplot[length(xplot)]),y=c(par("usr")[3],lowerbound,par("usr")[3]),col="grey90",border=NA)
        polygon(x=c(xplot[1],xplot,xplot[length(xplot)]),y=c(par("usr")[4],upperbound,par("usr")[4]),col="grey90",border=NA)
        lines(par("usr")[1:2],par("usr")[c(4,4)])
      }
      if(boundtype=="positive") {
        polygon(x=c(xplot,xplot[(length(xplot)):1]),y=c(lowerbound,(upperbound[(length(upperbound)):1])),col="grey90",border=NA)
      }
      if(boundtype=="lines") {
        del <- .4*min(xplot[2:length(xplot)] - xplot[1:(length(xplot)-1)])
        for(i in 1:length(lowerbound)) {
          lines(xplot[i]+c(-1,1)*del,rep(lowerbound[i],2),lwd=2)
          lines(xplot[i]+c(-1,1)*del,rep(upperbound[i],2),lwd=2)
        }
      }
    }
    if(type=="dotline" | type=="boxline") {
      for(i in 1:(dim(seqbysurvey)[1])) {
        lines(xplot[!is.na(seqbysurvey[i,])],seqbysurvey[i,][!is.na(seqbysurvey[i,])],col="grey60",lty=3)
        lines(xplot,seqbysurvey[i,],col="grey30")
      }
    }
    for(i in 1:(dim(seqbysurvey)[2])) {
      if((type=="boxplot" | type=="boxline") & !all(is.na(seqbysurvey[,i]))) boxplot(seqbysurvey[,i],at=xplot[i],add=T,yaxt='n',col=NA)
      if(type=="dotplot") points(jitter(rep(xplot[i],(dim(seqbysurvey)[1])),amount=.1),seqbysurvey[,i])
      if(type=="dotline") points(rep(xplot[i],(dim(seqbysurvey)[1])),seqbysurvey[,i])
    }
    axis(side=1,at=xplot,labels=names(seqbysurvey),cex.axis=cex.axisX,las=2)
  }
  if(is.character(seqbysurvey[1,1])|is.factor(seqbysurvey[1,1])) {
    stop("Plotting methods do not yet exist for matrices returned from riverdirectionseq().")
  }
}


#' River Direction Matrix between Two Datasets
#' @description Returns a matrix of directions between each river location in two datasets, with one expressed as rows and the other expressed as columns.
#' @param seg1 First vector of river locations (segment component).  These are expressed as rows in the output matrix.
#' @param vert1 First vector of river locations (vertex component).  These are expressed as rows in the output matrix.
#' @param seg2 Second vector of river locations (segment component).  These are expressed as columns in the output matrix.
#' @param vert2 Second vector of river locations (vertex component).  These are expressed as columns in the output matrix.
#' @param rivers The river network object to use.
#' @param logical1 A boolean vector that can be used for subsetting.  If used,
#'   \code{riverdirectiontofrom} will only return directions in which a
#'   specified condition is met for the first dataset.
#' @param logical2 A boolean vector that can be used for subsetting.  If used,
#'   \code{riverdirectiontofrom} will only return directions in which a
#'   specified condition is met for the second dataset.
#' @param ID1 a vector of observation IDs for the first dataset that will be used as row names in the output matrix.
#' @param ID2 a vector of observation IDs for the second dataset that will be used as column names in the output matrix.
#' @param flowconnected If \code{TRUE}, only returns distance if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of directions (character) with rows and columns labeled by corresponding values of \code{ID}.  See \link{riverdirection} for additional information.
#' @seealso \link{riverdirection}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#'
#' streamlocs.seg <- c(1,8,11)
#' streamlocs.vert <- c(50,70,90)
#' streamlocs.ID <- c("A","B","C")
#'
#' fish.seg <- c(1,4,9,12,14)
#' fish.vert <- c(10,11,12,13,14)
#' fish.ID <- c("fish1","fish2","fish3","fish4","fish5")
#'
#' Gulk <- setmouth(seg=1, vert=1, rivers=Gulk)
#'
#' riverdirectiontofrom(seg1=streamlocs.seg, vert1=streamlocs.vert,
#'   seg2=fish.seg, vert2=fish.vert, rivers=Gulk,
#'   ID1=streamlocs.ID, ID2=fish.ID)
#'
#' logi1 <- streamlocs.ID=="B" | streamlocs.ID=="C"
#' logi2 <- fish.ID!="fish3"
#'
#' riverdirectiontofrom(seg1=streamlocs.seg, vert1=streamlocs.vert,
#'   seg2=fish.seg, vert2=fish.vert, rivers=Gulk, logical1=logi1,
#'   logical2=logi2, ID1=streamlocs.ID, ID2=fish.ID)
#' @export
riverdirectiontofrom <- function(seg1,vert1,seg2,vert2,rivers,logical1=NULL,logical2=NULL,ID1=NULL,ID2=NULL,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(is.null(logical1)) logical1 <- rep(T,length(seg1))
  if(is.null(logical2)) logical2 <- rep(T,length(seg2))
  
  if(length(logical1) != length(seg1)) stop("logical1 must be the same length as its location vectors")
  if(length(logical2) != length(seg2)) stop("logical2 must be the same length as its location vectors")
  
  if(is.null(ID1)) ID1 <- 1:length(seg1)
  if(is.null(ID2)) ID2 <- 1:length(seg2)
  
  seg1 <- seg1[logical1]
  vert1 <- vert1[logical1]
  seg2 <- seg2[logical2]
  vert2 <- vert2[logical2]
  ID1 <- ID1[logical1]
  ID2 <- ID2[logical2]
  
  dists <- matrix(NA,nrow=length(seg1),ncol=length(seg2))
  
  for(i in 1:length(seg1)) {
    for(j in 1:length(seg2)) {
      dists[i,j] <- riverdirection(startseg=seg1[i],startvert=vert1[i],endseg=seg2[j],endvert=vert2[j],
                                   flowconnected=flowconnected,rivers=rivers,stopiferror=stopiferror,algorithm=algorithm)
    }
  }
  
  class(ID1) <- "list"
  class(ID2) <- "list"
  dimnames(dists)[[1]] <- ID1
  dimnames(dists)[[2]] <- ID2
  return(dists)
}


#' Upstream Distance Matrix between Two Datasets
#' @description Returns a matrix of upstream distances between each river location in two datasets, with one expressed as rows and the other expressed as columns.
#' @param seg1 First vector of river locations (segment component).  These are expressed as rows in the output matrix.
#' @param vert1 First vector of river locations (vertex component).  These are expressed as rows in the output matrix.
#' @param seg2 Second vector of river locations (segment component).  These are expressed as columns in the output matrix.
#' @param vert2 Second vector of river locations (vertex component).  These are expressed as columns in the output matrix.
#' @param rivers The river network object to use.
#' @param logical1 A boolean vector that can be used for subsetting.  If used,
#'   \code{upstreamtofrom} will only return upstream distances in which a
#'   specified condition is met for the first dataset.
#' @param logical2 A boolean vector that can be used for subsetting.  If used,
#'   \code{upstreamtofrom} will only return upstream distances in which a
#'   specified condition is met for the second dataset.
#' @param ID1 a vector of observation IDs for the first dataset that will be used as row names in the output matrix.
#' @param ID2 a vector of observation IDs for the second dataset that will be used as column names in the output matrix.
#' @param net Whether to calculate net upstream distance (\code{TRUE}) or signed total distance (\code{FALSE}).  See \link{upstream}.
#' @param flowconnected If \code{TRUE}, only returns distance if the input segments are flow-connected.  Defaults to \code{FALSE}.
#' @param stopiferror Whether or not to exit with an error if a route cannot be
#'   found.  If this is set to \code{FALSE} and a route cannot be found,
#'   the function will return \code{NA} in the appropriate entry.  Defaults to \code{TRUE}.  See \link{detectroute}.
#' @param algorithm Which route detection algorithm to use (\code{"Dijkstra"},
#'   \code{"sequential"}, or \code{"segroutes"}).  If left as \code{NULL} (the
#'   default), the function will automatically make a selection.  See
#'   \link{detectroute} for more details.
#' @return A matrix of upstream distances (numeric) with rows and columns labeled by corresponding values of \code{ID}.  See \link{upstream} for additional information.
#' @seealso \link{upstream}
#' @note Building routes from the river mouth to each river network segment and/or distance lookup tables will
#'   greatly reduce computation time (see \link{buildsegroutes}).
#' @author Matt Tyers
#' @examples
#' data(Gulk)
#'
#' streamlocs.seg <- c(1,8,11)
#' streamlocs.vert <- c(50,70,90)
#' streamlocs.ID <- c("A","B","C")
#'
#' fish.seg <- c(1,4,9,12,14)
#' fish.vert <- c(10,11,12,13,14)
#' fish.ID <- c("fish1","fish2","fish3","fish4","fish5")
#'
#' Gulk <- setmouth(seg=1, vert=1, rivers=Gulk)
#'
#' upstreamtofrom(seg1=streamlocs.seg, vert1=streamlocs.vert,
#'   seg2=fish.seg, vert2=fish.vert, rivers=Gulk,
#'   ID1=streamlocs.ID, ID2=fish.ID)
#'
#' logi1 <- streamlocs.ID=="B" | streamlocs.ID=="C"
#' logi2 <- fish.ID!="fish3"
#'
#' upstreamtofrom(seg1=streamlocs.seg, vert1=streamlocs.vert,
#'   seg2=fish.seg, vert2=fish.vert, rivers=Gulk, logical1=logi1,
#'   logical2=logi2, ID1=streamlocs.ID, ID2=fish.ID)
#' @export
upstreamtofrom <- function(seg1,vert1,seg2,vert2,rivers,logical1=NULL,logical2=NULL,ID1=NULL,ID2=NULL,net=FALSE,flowconnected=FALSE,stopiferror=TRUE,algorithm=NULL) {
  if(is.null(logical1)) logical1 <- rep(T,length(seg1))
  if(is.null(logical2)) logical2 <- rep(T,length(seg2))
  
  if(length(logical1) != length(seg1)) stop("logical1 must be the same length as its location vectors")
  if(length(logical2) != length(seg2)) stop("logical2 must be the same length as its location vectors")
  
  if(is.null(ID1)) ID1 <- 1:length(seg1)
  if(is.null(ID2)) ID2 <- 1:length(seg2)
  
  seg1 <- seg1[logical1]
  vert1 <- vert1[logical1]
  seg2 <- seg2[logical2]
  vert2 <- vert2[logical2]
  ID1 <- ID1[logical1]
  ID2 <- ID2[logical2]
  
  dists <- matrix(NA,nrow=length(seg1),ncol=length(seg2))
  
  for(i in 1:length(seg1)) {
    for(j in 1:length(seg2)) {
      dists[i,j] <- upstream(startseg=seg1[i],startvert=vert1[i],endseg=seg2[j],endvert=vert2[j],
                             flowconnected=flowconnected,rivers=rivers,net=net,stopiferror=stopiferror,algorithm=algorithm)
    }
  }
  
  class(ID1) <- "list"
  class(ID2) <- "list"
  dimnames(dists)[[1]] <- ID1
  dimnames(dists)[[2]] <- ID2
  return(dists)
}

Try the riverdist package in your browser

Any scripts or data that you put into this service are public.

riverdist documentation built on Aug. 22, 2023, 5:06 p.m.