R/mastifFunctions.R

In mastif: Mast Inference and Forecasting

#  TOF


intersectLines <- function (x, y1, y2){
  
  # intersection points and polygons for y1 > y2 and y2 > y1
  
  n <- length(x)
  above <- y1 > y2
  intersectPts <- which(diff(above) != 0) 
  
  y1.diff <- y1[intersectPts+1] - y1[intersectPts]
  y2.diff <- y2[intersectPts+1] - y2[intersectPts]
  x.diff  <- x[intersectPts+1] - x[intersectPts]
  
  slope1 <- y1.diff/x.diff
  slope2 <- y2.diff/x.diff
  intercept1 <- y1[intersectPts] - slope1*x[intersectPts]
  intercept2 <- y2[intersectPts] - slope2*x[intersectPts]
  xPts <- ifelse(slope1 == slope2, NA, 
                 (intercept2-intercept1)/(slope1-slope2))
  yPts <- ifelse(slope1 == slope2, NA,
                 slope1*xPts+intercept1)
  
  jointPts <- which(y1 == y2)
  xPts <- c(xPts, x[jointPts])
  yPts <- c(yPts, y1[jointPts])
  
  ipoints <- cbind( xPts,  yPts)
  pt1  <- rbind( c(x[1], y1[1]), ipoints, c(x[n], y1[n]) )
  pt2  <- rbind( c(x[1], y2[1]), ipoints, c(x[n], y2[n]) )
  
  p1 <- p2 <- numeric(0)
  
  for( k in 2:nrow(pt1) ){
    
    w <- which( x >= pt1[k-1,1] & x <= pt1[k,1] )
    if( above[w[1]] ){
      pk <- rbind( pt1[k-1,], cbind(x[w], y1[w]), pt1[k,] )
      pb <- rbind( pt2[k-1,], cbind(x[w], y2[w]), pt2[k,] ) #bottom
      pk <- rbind( pk, pb[ nrow(pb):1, ] )
      pk <- pk[ !duplicated(pk[,1:2]), ]
      pk <- rbind( pk, pk[1,] )
      p1 <- append( p1, list( pk ) )
    }else{
      pk <- rbind( pt2[k-1,], cbind(x[w], y2[w]), pt2[k,] ) #top
      pb <- rbind( pt1[k-1,], cbind(x[w], y1[w]), pt1[k,] ) #bottom
      pk <- rbind( pk, pb[ nrow(pb):1, ] )
      pk <- pk[ !duplicated(pk[,1:2]), ]
      pk <- rbind( pk, pk[1,] )
      p2 <- append( p2, list( pk ) )
    }
  }
  
  return( list(ipoints = ipoints, poly1 = p1, poly2 = p2) )
}
speciesRegion <- function( spec, reg ){
  
  # can have multiple regions per species
  # generate matching species/region for all regions
  
  #require( stringr )
  
  sc <- stringr::str_count( reg, '_' )
  
  if( sum( sc ) == 0 )return( list( spec = spec, reg = reg ) )
  
  snew <- rnew <- character( 0 )
  ws <- which( sc > 0 )
  for( i in 1:length( spec ) ){
    
    sc <- stringr::str_count( reg[ i], '_' )
    if( sc == 0 ){
      snew <- c( snew, spec[ i] )
      rnew <- c( rnew, reg[ i] )
    }else{
      isp <- as.vector( columnSplit( reg[ i], '_' ) )
      snew <- c( snew, rep( spec[ i], length( isp ) ) )
      rnew <- c( rnew, isp )
    }
  }
  return( list( spec = snew, reg = rnew ) )
}



trimX <- function( form, tdata, maxVIF = 20 ){
  
  # new formula for design where no VIF exceeds maxVIF
  
 # gg <- grep( 'species', as.character( form ) )
 # if( length( gg ) == 0 )ftt <- .specFormula( form, NOINTERCEPT = FALSE )
  
 # xtmp <- .getDesign( ftt, tdata )$x
  xtmp  <- model.matrix( form, tdata )
  terms <- colnames( xtmp )
  w2    <- grep( '^2', colnames( xtmp ), fixed = T )
  wi    <- grep( ':', colnames( xtmp ), fixed = T )
  wl    <- unique( c( wi, w2 ) )
  if( length( wl ) > 0 )xtmp <- xtmp[, -wl]
  
  vif <- .checkDesign( xtmp )$VIF
  dr  <- qr( xtmp )$rank - ncol( xtmp ) 
  
  if( max( vif ) < maxVIF & dr == 0 ){
    return( list( form = form, dontUse = NULL ) )
  }
  
  fnew  <- form
  ft <- columnSplit( fnew, ' + ' )
  ft <- unique( ft )
  ft <- .replaceString( ft, ' ', '' )
  ft <- .replaceString( ft, '~', '' )
  ft <- unique( as.vector( ft ) )
  ft <- ft[ nchar( ft ) > 0]
  w2 <- grep( '^2', ft, fixed = T )
  wi <- grep( ':', ft, fixed = T )
  wl <- unique( c( wi, w2 ) )
  iterms <- ft[ wl]
  if( length( wl ) > 0 ) ft <- ft[ -wl]
  
  fnew <- paste0( ft, collapse = ' + ' )
  fnew <- as.formula( paste( '~', fnew ) )
  
  vvars <- names( vif )
  vvars <- vvars[ !vvars %in% c( 'diam', 'shade' )]
  
  while( max( vif ) > maxVIF ){
    
    ft <- columnSplit( fnew, ' + ' )
    ft <- unique( ft )
    ft <- .replaceString( ft, ' ', '' )
    ft <- .replaceString( ft, '~', '' )
    ft <- unique( as.vector( ft ) )
    ft <- ft[ nchar( ft ) > 0]
    
    dvar <- names ( which.max( vif[ vvars] ) )
    gas  <- grep( 'slope', dvar )
    if( length( gas ) > 0 ){
      vvars <- vvars[ -grep( 'aspect', vvars, fixed = T )]
      ft    <- ft[ -grep( 'aspect', ft, fixed = T )]
      ft    <- ft[ ft != 'slope']
    }
    gaa  <- grep( 'aspect', dvar )
    if( length( gaa ) > 0 ){
      vvars <- vvars[ -grep( 'aspect', vvars, fixed = T )]
      ft    <- ft[ -grep( 'aspect', ft, fixed = T )]
  #    ft    <- ft[ ft != 'slope']
    }
    if( length( gas ) == 0 & length( gaa ) == 0 ){
      vvars <- vvars[ -grep( dvar, vvars, fixed = T )]
      ft    <- ft[ -grep( dvar, ft, fixed = T )]
    }
    
  #  fnew <- as.character( vars2formula( ft ) )
  #  fnew[ 2] <- .replaceString( fnew[ 2], 'species + species', 'species' )
  #  fnew[ 2] <- .replaceString( fnew[ 2], 'species * species', 'species' )
    fnew <- paste0( ft, collapse = ' + ' )
    fnew <- as.formula( paste( '~', fnew ) )
    
    xtmp <- model.matrix( fnew, tdata )
    vif <- .checkDesign( xtmp )$VIF
  }
  
  dont <-  terms[ !terms %in% ft]
  dont <- dont[ !dont %in% c( '( Intercept )', iterms )]
  inot <- character( 0 )
  if( length( dont ) > 0 ){
    for( k in 1:length( dont ) ){
      dk <- grep( dont[ k], iterms )
      if( length( dk ) > 0 ){
        inot <- c( inot, iterms[ dk] )
      }
      if( length( iterms ) == 0 )stop( )
    }
  }
  dont <- unique( c( dont, inot ) )
  
  itt <- iterms[ !iterms %in% inot]
  
  fnew <- paste0( c( ft, itt ), collapse = ' + ' )
  fnew <- as.formula( paste( '~', fnew ) )
  
  list( form = fnew, dontUse = dont )
}


vars2formula <- function( terms, SPEC = T ){
  
  terms <- unique( terms )
  if( SPEC )terms <- paste( 'species *', terms )
  terms <- .replaceString( terms, 'species * species *', 'species *' )
  terms <- c( 'species', terms )
  terms <- unique( terms )
  v1    <- paste0( terms, collapse = ' + ' )
  as.formula( paste( '~', v1 ) )
}


appendSpeciesPars <- function( xx, spp, fill = NULL ){
  
  # spp - vector of spp names to be included
  # xx must have names ( vector ), colnames, or rownames
  # fill - value to fill new added species; otherwise fill with mean for others
  
 # require( stringr )
  
  TRANS <- MISSING <- F
  
  if( is.data.frame( xx ) )xx <- as.matrix( xx )
  
  if( !is.matrix( xx ) ){
    wsp <- spp[ !spp %in% names( xx )]
    if( length( wsp ) > 0 ){
      fnew <- rep( mean( xx ), length( wsp ) )
      wsp <- paste( names( wsp ), wsp, sep = '__' )
      names( fnew ) <- wsp
      xx <- c( xx, fnew )
    }
    return( xx )
  }
  
  rmat <- grepVec( spp, rownames( xx ) ) 
  cmat <- grepVec( spp, colnames( xx ) )
  
  if( length( cmat ) > 0 ){
    TRANS <- T
    rmat  <- cmat
    xx    <- t( xx )
  }
  
  if( length( rmat ) > 0 )specInName <- grep( 'species', rownames( xx ) )
  
  if( length( rmat ) == 0 & length( cmat ) == 0 ){
    
    b <- stringi::stri_locate_first_regex( spp[ 1], "[ A-Z]" )[ 1]
    gpart <- substr( spp[ 1], 1, b-1 )
    
    rmat <- grepVec( gpart, rownames( xx ) ) 
    cmat <- grepVec( gpart, colnames( xx ) )
    
    if( length( cmat ) > 0 ){
      TRANS <- T
      rmat  <- cmat
      xx    <- t( xx )
    }
    
    # get all names
    specInName <- grep( 'species', rownames( xx ) )

    rnames <- .replaceString( rownames( xx )[ rmat[[ 1]]], 'species', '' )
    inregs <- grep( '__', rnames )
    regs   <- rep( '', length( rnames ) )
    if( length( inregs ) > 0 ){
      tmp  <- columnSplit( rnames[ inregs], '__' )
      regs[ inregs] <- tmp[, 1]
      rnames[ inregs] <- tmp[, 2]
    }
    ncc <- stringr::str_count( rnames, ':' )
    if( sum( ncc ) > 0 ){
      for( i in 1:max( ncc ) ){
        wi <- which( ncc == i )
        rnames[ wi] <- columnSplit( rnames[ wi], ':' )[, 1]
      }
    }
    ncc <- stringr::str_count( rnames, '_' )
    if( sum( ncc ) > 0 ){
      for( i in 1:max( ncc ) ){
        wi <- which( ncc == i )
        rnames[ wi] <- columnSplit( rnames[ wi], '_' )[, 1]
      }
    }
    if( length( specInName ) > 0 )rnames <- paste( 'species', rnames, sep = '' )
    rnames <- unique( paste( regs, rnames, sep = '__' ) )
    rmat <- grepVec( rnames, rownames( xx ) ) 
  }
  
  namesNew <- spp[ which( !spp %in% names( rmat ) &
                                !spp %in% names( cmat ) )]
  regNew <- names( namesNew )
  if( length( specInName ) > 0 )namesNew <- paste( 'species', namesNew, sep = '' )
  namesNew <- paste( regNew, '__', namesNew, sep = '' )
  
  if( length( namesNew ) == 0 ){
    if( TRANS )xx <- t( xx )
    return( xx )
  }
  
  nr <- nrow( xx )
  namesNow <- names( rmat )
  
  RORD <- F
  ns <- 0
  
  # average xx
  xsum <- xx
  for( k in 1:length( rmat ) ){
    if( length( rmat[[ k]] ) > ns )ns <- length( rmat[[ k]] )
    index <- rmat[[ k]]
    newr <- .replaceString( rownames( xsum )[ index], names( rmat )[ k], '' )
    newr[ nchar( newr ) == 0] <- namesNow[ 1]
    rownames( xsum )[ index] <- newr
  }
  
  
  if( is.null( colnames( xsum ) ) ){
    colnames( xsum ) <- c( 1:ncol( xsum ) )
    RORD <- T
  }
  
  xm <- tapply( as.vector( xsum ), list( rep( rownames( xsum ), ncol( xsum ) ), 
                                      rep( colnames( xsum ), each = nrow( xsum ) ) ), 
                mean, na.rm = T )
  newRN <- rep( rownames( xsum )[ 1:ns], length( namesNew ) )
  xm <- xm[ drop = F, newRN, ]
  
  if( !is.null( fill ) )xm[ 1:length( xm )] <- fill
  
  newRN <- rep( rownames( xx )[ 1:ns], length( namesNew ) )
  i <- 1:ns
  for( k in 1:length( namesNew ) ){
    newRN[ i] <-  .replaceString( newRN[ i], namesNow[ 1], namesNew[ k] )
    i <- i + ns
  }
  rownames( xm ) <- newRN
  
  xx <- rbind( xx, xm )
  
  if( TRANS )xx <- t( xx )
  if( RORD ){
    ord <- order( as.numeric( rownames( xx ) ) )
    xx  <- xx[ drop = F, ord, ]
  }
  if( is.vector( xx ) )xx <- xx[ order( names( xx ) )]
  if( is.matrix( xx ) ){
    if( !is.null( rownames( xx ) ) )xx <- xx[ drop = F, order( rownames( xx ) ), ]
    if( !is.null( colnames( xx ) ) )xx <- xx[ drop = F, , order( colnames( xx ) )]
  }
  xx
}



appendSpeciesParsOld <- function( xx, specVec ){
  
  # specVec - vector of spp names to be included
  # xx must have names ( vector ), colnames, or rownames
  
  TRANS <- F
  
  if( length( xx ) == 1 | is.vector( xx ) ){
    wsp <- specVec[ !specVec %in% names( xx )]
    if( length( wsp ) > 0 ){
      fnew <- rep( mean( xx ), length( wsp ) )
      names( fnew ) <- wsp
      xx <- c( xx, fnew )
    }
    return( xx )
  }
  
  # xx is a matrix
  
  rmat <- grepVec( specVec, rownames( xx ) ) 
  cmat <- grepVec( specVec, colnames( xx ) )
  
  namesNew <- specVec[ which( !specVec %in% names( rmat ) &
                                !specVec %in% names( cmat ) )]
  if( length( namesNew ) == 0 )return( xx )
  
  
  if( length( cmat ) > 0 ){
    TRANS <- T
    rmat  <- cmat
    xx    <- t( xx )
  }
  
  
  nr <- nrow( xx )
  namesNow <- names( rmat )
  
  RORD <- F
  
  if( length( namesNow ) == 1 ){          # currently only one species
    
    newRows <- xx[ rep( 1:nr, length( namesNew ) ), ]
    newRN   <- rownames( xx )
    for( k in 1:length( namesNew ) ){
      newRN <- c( newRN, .replaceString( rownames( xx ), namesNow, namesNew[ k] ) )
    }
    xx <- rbind( xx, newRows )
    rownames( xx ) <- newRN
    
  }else{                             # more than one species
    
    ns <- 0
    
    xx <- as.matrix( xx )
    
    # average xx
    xsum <- xx
    for( k in 1:length( rmat ) ){
      if( length( rmat[[ k]] ) > ns )ns <- length( rmat[[ k]] )
      index <- rmat[[ k]]
      newr <- .replaceString( rownames( xsum )[ index], names( rmat )[ k], '' )
      newr[ nchar( newr ) == 0] <- namesNow[ 1]
      rownames( xsum )[ index] <- newr
    }
    
    
    if( is.null( colnames( xsum ) ) ){
      colnames( xsum ) <- c( 1:ncol( xsum ) )
      RORD <- T
    }
    
    xm <- tapply( as.vector( xsum ), list( rep( rownames( xsum ), ncol( xsum ) ), 
                                        rep( colnames( xsum ), each = nrow( xsum ) ) ), 
                  mean, na.rm = T )
    newRN <- rep( rownames( xsum )[ 1:ns], length( namesNew ) )
    xm <- xm[ drop = F, newRN, ]
    
    newRN <- rep( rownames( xx )[ 1:ns], length( namesNew ) )
    i <- 1:ns
    for( k in 1:length( namesNew ) ){
      newRN[ i] <-  .replaceString( newRN[ i], namesNow[ 1], namesNew[ k] )
      i <- i + ns
    }
    rownames( xm ) <- newRN
    
    xx <- rbind( xx, xm )
  }
  if( TRANS )xx <- t( xx )
  if( RORD ){
    ord <- order( as.numeric( rownames( xx ) ) )
    xx  <- xx[ ord, ]
  }
  xx
}


grepVec <- function( c1, c2 ){
  # grep all c1 in c2
  
  out <- character( 0 )
  
  for( k in 1:length( c1 ) ){
    ok  <- grep( c1[ k], c2 )
    if( length( ok ) == 0 )next
    out <- append( out, list( ok ) )
    names( out )[ length( out )] <- c1[ k]
  }
  out
}
 
short2longParName <- function( pnames, species ){ 
  
  
  wi <- grep( '( Intercept )', pnames, fixed = T )
  
  if( length( wi ) > 0 ){                                # only one fitted species
    
    ssm <- paste( 'species', species, sep = '' )
    pnames   <- paste( ssm, ':', pnames, sep = '' )
    pnames   <- .replaceString( pnames, ':( Intercept )', ':intercept' )
    
  }else{                                            # multiple species
    
    gi <- grep( ':', pnames, fixed = T )
    wi <- which( !c( 1:length( pnames ) ) %in% gi  )
    if( length( wi ) > 0 )pnames[ wi] <- paste( pnames[ wi], ':intercept', sep = '' )
  }
  
  pnames
}

aspect2u <- function( slopeDegrees, aspectDegrees ){
  
  # slope, aspect are degrees
  # return radians
  
  slope   <- slopeDegrees/360*2*pi
  a       <- aspectDegrees/360*2*pi
  aspect1 <- sin( slope )*sin( a )
  aspect2 <- sin( slope )*cos( a )
  
  cbind( slope, aspect1, aspect2 )
}


traitGroups <- function( trait ){
  
  # trait - character vector of fruit or dispersal types
  
  FAC <- F
  if( is.factor(trait) ){
    trait <- as.character( trait )
    FAC <- T
  }
  
  # aggregate dispersal types
  trait[ trait == '' ] <- 'other'
  trait[ trait == 'hydrochory' ] <- 'other'
  trait[ trait == 'barochory' ] <- 'zoochory'
  
  # aggregate fruit types
  trait[ trait %in% c( '', 'seed','spore','follicle' ) ] <- 'other'
  trait[ trait %in% c( 'aggregate', 'bacca', 'berry', 'drupe', 'fleshy_fruit', 'pome',
                       'pseudodrupe', 'syncarpium' ) ] <- 'fleshy'
  trait[ trait %in% c( 'achene', 'achenosum', 'samara', 'samaretum', 'samarium','schizocarpic', 
                       'winged_nut' ) ] <- 'winged'
  trait[ trait %in% c( 'legume', 'pod' ) ] <- 'pod'
  
  if( FAC )trait <- as.factor( trait )
  
  trait
}

getTraits <- function( specNames = NULL, traitName, FAMILY = T,
                       path2Traits = "/Users/jimclark/makeMastOnJimClark/traitsByGroup/" ){
  
  # if FAMILY, then search for family-level values where genus-level values are missing
  
  traitTab <- read.csv( paste( path2Traits, 'plantTraits.csv', sep = '' ), 
                              stringsAsFactors = F )
  
  if( is.null( specNames ) ) specNames <- traitTab$code8
  
  mm    <- match( specNames, traitTab$code8 )
  tvals <- traitTab[ mm, traitName]
  names( tvals ) <- specNames
  
  if( traitName == 'section' )return( tvals )
  
  if( is.character( traitTab[, traitName] ) ){  # use modal value
    
    wna  <- which( is.na( tvals ) | nchar( tvals ) == 0 )
    
    if( length(wna) > 0 ){
      section <- traitTab$section[ mm ]
      wf      <- which( !is.na(section) & nchar(section) > 0 )
      
      if( length(wf) > 0 ){
        names( tvals ) <- section
        gg  <- which( traitTab$section %in% section[wf] )
        
        ttab  <- table( traitTab$section[ gg ], traitTab[ gg, traitName] )
        ttab  <- ttab[, nchar( colnames( ttab ) ) > 0, drop = F]
        cc    <- apply( ttab, 1, which.max )
        tt    <- colnames(ttab)[cc]
        names(tt) <- names(cc)
        tvals[wna] <- tt[ names(tvals)[wna] ]
        names( tvals ) <- specNames
        tvals[ is.na(tvals) ] <- ''
      }
    }
    
    wna  <- which( is.na( tvals ) | nchar( tvals ) == 0 )
    
    if( length( wna ) == 0 ) return( tvals )
    if( length( wna ) == length( tvals ) ) return( tvals ) 
    
    gen <- traitTab$genus[ mm ]
    names( tvals ) <- gen
    gg  <- which( traitTab$genus %in% gen )
    
    ttab  <- table( traitTab$genus[ gg ], traitTab[ gg, traitName] )
    ttab  <- ttab[, nchar( colnames( ttab ) ) > 0, drop = F]
    cc    <- apply( ttab, 1, which.max ) 
    tt    <- colnames(ttab)[cc]
    names(tt) <- names(cc)
    tvals[wna] <- tt[ names(tvals)[wna] ]
    names( tvals ) <- specNames
    
    
    wna  <- which( is.na( tvals ) | nchar( tvals ) == 0 )
    
    if( length( wna ) == 0 | !FAMILY ) return( tvals )
    
    
    fam <- traitTab$family[ mm ]
    names( tvals ) <- fam
    gg  <- which( traitTab$genus %in% fam )
    
    ttab  <- table( traitTab$family[ gg ], traitTab[ gg, traitName] )
    ttab  <- ttab[, nchar( colnames( ttab ) ) > 0, drop = F]
    if( length(ttab) > 0 ){
      cc    <- apply( ttab, 1, which.max )
      tt    <- colnames(ttab)[cc]
      names(tt) <- names(cc)
      tvals[wna] <- tt[ names(tvals)[wna] ]
    }
    names( tvals ) <- specNames
    
    return( tvals )
  }
  
  wna   <- which( is.na( tvals ) ) 
  
  if( length( wna ) > 0 ){
    
    section <- traitTab$section[ mm ]
    names( tvals ) <- section
    gg  <- which( traitTab$section %in% section )
    mu  <- tapply( traitTab[ gg, traitName], traitTab$section[ gg], mean, na.rm = T )
    tvals[ wna ] <- mu[ names( tvals )[ wna ]]
    names( tvals ) <- specNames
  }
  
  wna   <- which( is.na( tvals ) )
  
  if( length( wna ) > 0 ){
    
    gen <- traitTab$genus[ mm ]
    names( tvals ) <- gen
    gg  <- which( traitTab$genus %in% gen )
    mu  <- tapply( traitTab[ gg, traitName], traitTab$genus[ gg], mean, na.rm = T )
    tvals[ wna ] <- mu[ names( tvals )[ wna ]]
    names( tvals ) <- specNames
  }
  
  if( FAMILY ){
    
    wna   <- which( is.na( tvals ) )
    
    if( length( wna ) > 0 ){
      fam <- traitTab$family[ mm]
      names( tvals ) <- fam
      gg  <- which( traitTab$family %in% fam )
      mu  <- tapply( traitTab[ gg, traitName], traitTab$family[ gg], mean, na.rm = T )
      tvals[ wna] <- mu[ names( tvals )[ wna]]
      names( tvals ) <- specNames
    }
  }
  
  wna   <- which( is.na( tvals ) )
  
  if( length( wna ) > 0 & traitName %in% c( 'seedsPerFruit' ) ){
    
    tvals[ wna ] <- 1
  }
  
  tvals
}
  
  
  
  
species2code <- function( genus, specEpith, subSpec = NULL, length = 8 ){
  
  gen <- lowerFirstLetter( substr( genus, 1, length ) )
  spe <- upperFirstLetter( substr( specEpith, 1, length ) )
  
  gss <- columnPaste( gen, spe, '' )
  
  if( !is.null( subSpec ) ){
    wss <- which( nchar( subSpec ) > 0 )
    gss[ wss] <- columnPaste( gss[ wss], substr( subSpec[ wss], 1, length ), '.' )
  }
  gss <- .replaceString( gss, 'uNKN', 'UNKN' )
  gss
}

codeSwap <- function( xstring, specsNow, codeNow = 'code8', codeNew = 'code4', 
                     file = '../traitsByGroup/plantTraits.csv' ){
  # replace code names in xstring from codeNow to codeNew
  
  traits <- read.csv( file, stringsAsFactors = F )
  
  if( codeNow == 'code4' )specsNow <- substr( specsNow, 1, 8 )
  
  mm   <- match( specsNow, traits[, codeNow] )
  snew <- traits[ mm, codeNew]
  
  for( j in 1:length( specsNow ) ){
    wj <- grep( specsNow[ j], xstring )
    if( length( wj ) > 0 )xstring[ wj] <- .replaceString( xstring[ wj], specsNow[ j], snew[ j] )
  }
  xstring
}

code2species <- function( codes, ssep = ' subsp. ', 
                         variableSearch = NULL, 
                         file = '../traitsByGroup/plantTraits.csv' ){
  
  # restrict search to variableSearch( region = c( 'east', 'west' ) ):
  #    east  - eastern North America
  #    west  - western North America
  #    south - south and central America
  #    europe
  #    africa
  #    asia
  #    oceania
  # codes ending in 'UNKN' are assigned to genus
  
  traits <- read.csv( file, stringsAsFactors = F )
  
  if( !is.null( variableSearch ) ){
    wkeep <- numeric( 0 )
    for( k in 1:length( variableSearch ) ){
      ncol  <- names( variableSearch )[ k ]
      for( i in 1:length( variableSearch[[ k ]] ) ){
        wkeep <- c( wkeep, grep( variableSearch[[ k ]][ i], traits[, ncol] ) )
      }
    }
    wkeep <- sort( unique( wkeep ) )
    traits <- traits[ wkeep, ]
  }
  
  codeFull <- codes
  codes <- sort( unique( codes ) )
  
  # unknowns have 'UNKN' in last four characters
  l <- nchar( codes )
  u <- which( startsWith( codes, 'UNKN' ) )
  if( length( u ) > 0 ) substr( codes[ u], 1, 4 ) <- 'unkn'
  u <- grep( 'UNKN', substr( codes, l - 3, l ), ignore.case = T )
  
  cnow <- regexpr( "[ A-Z]", codes )
  dnow <- regexpr( ".", codes, fixed = T )
  wss  <- which( dnow > 0 )
  gss  <- substr( codes, cnow*0 + 1, 100 )
  if( length( wss ) > 0 )gss[ wss] <- substr( codes[ wss], wss*0 + 1, dnow[ wss]-1 )
  
  gen <- upperFirstLetter( substr( gss, cnow*0 + 1, cnow-1 ) )
  spe <- lowerFirstLetter( substr( gss, cnow, cnow + 100 ) )
  ssp <- rep( '', length( spe ) )
  if( length( wss ) > 0 )ssp[ wss] <- substring( codes[ wss], dnow[ wss]+1 )
  
  ggg <- outer( traits$genus, gen, startsWith )
  sss <- outer( traits$specEpith, spe, startsWith )
  
  sbs <- traits$subSpec
  sbs[ nchar( sbs ) == 0] <- 'NOT'
  ssp[ nchar( ssp ) == 0] <- 'NOT'
  eee <- outer( sbs, ssp, startsWith )     # subspecies
  
  ii <- which( ggg & sss & eee, arr.ind = T )
  ii <- ii[ order( ii[, 2], ii[, 1] ), drop = F, ]
  kk <- ii[ duplicated( ii[, 2] ), drop = F, ]
  ii <- ii[ !duplicated( ii[, 2] ), drop = F, ]
  
  mm <- which( ggg & sss, arr.ind = T )       # omit subspecies
  mm <- mm[ order( mm[, 2], mm[, 1] ), drop = F, ]
  mm <- mm[ !duplicated( mm[, 2] ), drop = F, ]
  
  noss <- which( !mm[, 1] %in% ii[, 1] )
  
  
  if( length( u ) > 0 ){      # unknowns matched to genus
    
    ugen <- rep( 'UNKN', length( u ) )
    iu <- which( ggg[, u, drop = F], arr.ind = T )
    # if( length( u ) == 1 ){
    #   iu <- cbind( iu, 1 )
    #   colnames( iu ) <- NULL
    # }
    
    if( nrow( iu ) > 0 ){
      utab <- table( iu[, 2], traits$genus[ iu[, 1]] )
      ind  <- as.numeric( rownames( utab ) )
      
      # first choice is genus in other codes
      utab <- table( iu[, 2], traits$genus[ iu[, 1]] )
      umax <- apply( utab, 1, which.max )
      ugen[ ind] <- colnames( utab )[ umax]
      
      # for remaining find most common matching genus
      wu <- which( ugen == '' )
      if( length( wu ) > 0 ){
        fp <- substr( codes[ u[ wu]], 1, nchar( codes[ u[ wu]] ) - 4 )
        for( m in 1:length( fp ) ){
          wk <- which( startsWith( traits$genus, fp[ m] ) )
          if( length( wk ) > 0 ){
            mtab <- table( traits$genus[ wk] )
            fp[ m] <- names( mtab )[ which.max( mtab )]
          }
        }
        ugen[ wu] <- fp
      }
    }
  }
  
  if( length( kk ) > 0 ){
    con <- numeric( 0 )
    for( j in 1:nrow( kk ) ){
      wj <- which( ii[, 2] == kk[ j, 2] )
      dj <- data.frame( code = codes[ kk[ j, 2]], ii[ drop = F, wj, c( 2, 1 )], 
                        stringsAsFactors = F )
      con <- rbind( con, dj )
    }
    conflicts <- columnPaste( traits$genus[ kk[, 1]], traits$specEpith[ kk[, 1]], ' ' )
    ws <- which( nchar( traits$subSpec[ kk[, 1]] ) > 0 )
    if( length( ws ) > 0 ){
      conflicts[ ws] <- columnPaste( conflicts[ ws], traits$subSpec[ kk[ ws, 1]], ssep )
    }
    conflicts <- data.frame( con[, c( 2, 1 )], conflicts, stringsAsFactors = F )
    colnames( conflicts )[ 1] <- 'index'
  }
  
  miss <- which( !c( 1:length( codes ) ) %in% ii[, 2] )
  
  if( length( noss ) > 0 & length( miss ) > 0 ){    # accept species if subspecies absent
    ii <- rbind( ii, mm[ noss, ] )
    ii <- ii[ order( ii[, 1] ), ]
    miss <- miss[ !miss %in% noss]
  }
  
  species <- columnPaste( traits$genus[ ii[, 1]], traits$specEpith[ ii[, 1]], ' ' )
  
  if( length( miss ) > 0 ){
    
    wf  <- which( c( 1:length( codes ) ) %in% ii[, 2] )
    tmp <- rep( '', length( codes ) )
    tmp[ wf] <- species
    tmp[ nchar( tmp ) == 0] <- NA
    if( length( u ) > 0 ){
      tmp[ u] <- paste( ugen, 'UNKN', sep = ' ' )
      miss   <- miss[ !miss %in% u]
    }
    
    species <- tmp
    if( length( miss ) > 0 ){
      miss <- sort( unique( codes[ miss] ) )
      attr( species, 'missing' ) <- miss
    }
  }
  
  # subspecies
  wss <- which( nchar( ssp ) > 0 & ssp != 'NOT' & !is.na( species ) )
  species[ wss] <- columnPaste( species[ wss], 
                              traits$subSpec[ ii[ wss, 1]], sep = ssep )
  
  # conflicts
  
  if( length( kk ) > 0 ){
    
    conflicts$assigned <- species[ conflicts[, 1]]
    conflicts$conflict <- conflicts[, 3]
    
    conflicts <- conflicts[ conflicts$assigned != conflicts$conflict, ]
    
    if( nrow( conflicts ) > 0 ){
      rownames( con ) <- NULL
      attr( species, 'conflicts' ) <- conflicts
      warnings( 'there are species conflicts with trait file' )
    }
  }
  
  species <- species[ match( codeFull, codes )]
  species
}


code2speciesOld <- function( codes, ssep = ' subsp. ', 
                         variableSearch = NULL, 
                         file = '../traitsByGroup/plantTraits.csv' ){
  
  # restrict search to variableSearch( region = c( 'east', 'west' ) ):
  #    east  - eastern North America
  #    west  - western North America
  #    south - south and central America
  #    europe
  #    africa
  #    asia
  #    oceania
  # codes ending in 'UNKN' are assigned to genus
  
  traits <- read.csv( file, stringsAsFactors = F )
  
  if( !is.null( variableSearch ) ){
    wkeep <- numeric( 0 )
    for( k in 1:length( variableSearch ) ){
      ncol  <- names( variableSearch )[ k]
      for( i in 1:length( variableSearch[[ k]] ) ){
        wkeep <- c( wkeep, grep( variableSearch[[ k]][ i], traits[, ncol] ) )
      }
    }
    wkeep <- sort( unique( wkeep ) )
    traits <- traits[ wkeep, ]
  }
  
  # unknowns have 'UNKN' in last four characters
  l <- nchar( codes )
  u <- which( startsWith( codes, 'UNKN' ) )
  if( length( u ) > 0 ) substr( codes[ u], 1, 4 ) <- 'unkn'
  u <- grep( 'UNKN', substr( codes, l - 3, l ), ignore.case = T )
  
  cnow <- regexpr( "[ A-Z]", codes )
  dnow <- regexpr( ".", codes, fixed = T )
  wss  <- which( dnow > 0 )
  gss  <- substr( codes, cnow*0 + 1, 100 )
  if( length( wss ) > 0 )gss[ wss] <- substr( codes[ wss], wss*0 + 1, dnow[ wss]-1 )
  
  gen <- upperFirstLetter( substr( gss, cnow*0 + 1, cnow-1 ) )
  spe <- lowerFirstLetter( substr( gss, cnow, cnow + 100 ) )
  ssp <- rep( '', length( spe ) )
  if( length( wss ) > 0 )ssp[ wss] <- substring( codes[ wss], dnow[ wss]+1 )
  
  
  
  ggg <- outer( traits$genus, gen, startsWith )
  sss <- outer( traits$specEpith, spe, startsWith )
  

  
  sbs <- traits$subSpec
  sbs[ nchar( sbs ) == 0] <- 'NOT'
  ssp[ nchar( ssp ) == 0] <- 'NOT'
  eee <- outer( sbs, ssp, startsWith )
  
  ii <- which( ggg & sss & eee, arr.ind = T )
  ii <- ii[ order( ii[, 2], ii[, 1] ), drop = F, ]
  kk <- ii[ duplicated( ii[, 2] ), drop = F, ]
  ii <- ii[ !duplicated( ii[, 2] ), drop = F, ]
  
  if( length( u ) > 0 ){      # unknowns matched to genus
    
    ugen <- rep( 'UNKN', length( u ) )
    iu <- which( ggg[, u, drop = F], arr.ind = T )
   # if( length( u ) == 1 ){
   #   iu <- cbind( iu, 1 )
   #   colnames( iu ) <- NULL
   # }
    
    if( nrow( iu ) > 0 ){
      utab <- table( iu[, 2], traits$genus[ iu[, 1]] )
      ind  <- as.numeric( rownames( utab ) )
      
      # first choice is genus in other codes
      utab <- table( iu[, 2], traits$genus[ iu[, 1]] )
      umax <- apply( utab, 1, which.max )
      ugen[ ind] <- colnames( utab )[ umax]
      
      # for remaining find most common matching genus
      wu <- which( ugen == '' )
      if( length( wu ) > 0 ){
        fp <- substr( codes[ u[ wu]], 1, nchar( codes[ u[ wu]] ) - 4 )
        for( m in 1:length( fp ) ){
          wk <- which( startsWith( traits$genus, fp[ m] ) )
          if( length( wk ) > 0 ){
            mtab <- table( traits$genus[ wk] )
            fp[ m] <- names( mtab )[ which.max( mtab )]
          }
        }
        ugen[ wu] <- fp
      }
    }
  }
  
  if( length( kk ) > 0 ){
    con <- numeric( 0 )
    for( j in 1:nrow( kk ) ){
      wj <- which( ii[, 2] == kk[ j, 2] )
      dj <- data.frame( code = codes[ kk[ j, 2]], ii[ drop = F, wj, c( 2, 1 )], 
                        stringsAsFactors = F )
      con <- rbind( con, dj )
    }
    conflicts <- columnPaste( traits$genus[ kk[, 1]], traits$specEpith[ kk[, 1]], ' ' )
    ws <- which( nchar( traits$subSpec[ kk[, 1]] ) > 0 )
    if( length( ws ) > 0 ){
      conflicts[ ws] <- columnPaste( conflicts[ ws], traits$subSpec[ kk[ ws, 1]], ssep )
    }
    conflicts <- data.frame( con[, c( 2, 1 )], conflicts, stringsAsFactors = F )
    colnames( conflicts )[ 1] <- 'index'
  }
    
  miss <- which( !c( 1:length( codes ) ) %in% ii[, 2] )
  
  species <- columnPaste( traits$genus[ ii[, 1]], traits$specEpith[ ii[, 1]], ' ' )
  
  if( length( miss ) > 0 ){
    
    wf  <- which( c( 1:length( codes ) ) %in% ii[, 2] )
    tmp <- rep( '', length( codes ) )
    tmp[ wf] <- species
    tmp[ nchar( tmp ) == 0] <- NA
    if( length( u ) > 0 ){
      tmp[ u] <- paste( ugen, 'UNKN', sep = ' ' )
      miss   <- miss[ !miss %in% u]
    }
    
    species <- tmp
    if( length( miss ) > 0 ){
      miss <- sort( unique( codes[ miss] ) )
      attr( species, 'missing' ) <- miss
    }
  }
  
  # subspecies
  wss <- which( nchar( ssp ) > 0 & ssp != 'NOT' & !is.na( species ) )
  species[ wss] <- columnPaste( species[ wss], 
                              traits$subSpec[ ii[ wss, 1]], sep = ssep )
  
  # conflicts
 
  if( length( kk ) > 0 ){
    
    conflicts$assigned <- species[ conflicts[, 1]]
    conflicts$conflict <- conflicts[, 3]
    
    conflicts <- conflicts[ conflicts$assigned != conflicts$conflict, ]
    
    if( nrow( conflicts ) > 0 ){
      rownames( con ) <- NULL
      attr( species, 'conflicts' ) <- conflicts
      warnings( 'there are species conflicts with trait file' )
    }
  }
  species
}



treesNearTraps <- function( tdata, xytree, xytrap, meters = 60 ){
  
  # retain only trees within meters of the closest seed trap
  
  tmp  <- nn2( xytrap[, c( 'x', 'y' )], xytree[, c( 'x', 'y' )], k = 1 )
  wrow <- which( tmp[[ 2]] < meters )
  
  tr <- columnPaste( tdata$plot, tdata$tree )
  xy <- columnPaste( xytree$plot, xytree$tree )[ wrow]
  
  tdata <- tdata[ tr %in% xy, ]
  
  list( treeData = tdata, xytree = xytree[ wrow, ] )
}
  

mastVolatility <- function( treeID, year, fec, minLength = 6, minFrequency = 1/20 ){
  
  # minFrequency should be set low enough to permit comparisons with shortest series
  
  trees   <- sort(unique( treeID ))
  
  mastMatrix <- matrix( 0, length(trees), 6 )
  colnames(mastMatrix) <- c( 'nyr', 'meanLogFec', 'Variance', 'Volatility', 'Period Est', 'Period SD' )
  
  frequency <- density <- matrix( NA, length(trees), 100 )
  rownames(mastMatrix) <- rownames(frequency)  <- rownames(density) <- trees
  
  for(i in 1:length(trees)){
    
    wi <- which( treeID == trees[i] ) # must be mature
    if( length(wi) < minLength )next
    
    o <- order( year[wi] )
    x <- log( fec[ wi[o] ] )
    s <- mastSpectralDensity( x, maxPeriod = 1/minFrequency )
    if( !is.matrix( s$spect ) )next
    
    mastMatrix[i, ] <- c( length(x), mean(x, na.rm = T), s$totVar, s$volatility, 
                          s$periodMu, s$periodSd )
    
    ci <- 1:nrow(s$spect)
    frequency[ i, ci ] <- s$spec[, 'frequency' ]
    density[ i, ci ]   <- s$spec[, 'spectralDensity' ]/length(wi)  # series vary in length
  }
  
  keepRows   <- which(  is.finite(mastMatrix[,'Variance']) & mastMatrix[,'Variance'] != 0 )
  keepCols   <- which( colSums( frequency, na.rm=T ) > 0 )
  
  if( length( keepRows ) == 0 )return()
  
  mastMatrix <- mastMatrix[ drop = F, keepRows, ]
  density    <- density[ drop = F, keepRows, keepCols ]
  frequency  <- frequency[ drop = F, keepRows, keepCols ]
  
  # weighted by fecundity and sample size
  wt  <- log( mastMatrix[,'nyr'] ) + mastMatrix[,'meanLogFec']
  
  pseq <- seq( 1, max( 1/frequency, na.rm = T ), length = 12 )
  pbin <- findInterval( 1/frequency, pseq, all.inside = T )
  
  dvec <- as.vector( density*wt )
  dsum <- tapply( dvec, pbin, sum, na.rm = T )
  wvec <- as.vector( (density*0 + 1)*wt )
  dmu  <- dsum/tapply( wvec, pbin, sum, na.rm = T )
  
  dvec <- as.vector( density^2*wt )
  dsum <- tapply( dvec, pbin, sum, na.rm = T )
  dsd  <- sqrt( dsum/tapply( wvec, pbin, sum, na.rm = T ) - dmu^2 )
  
  pmids <- pseq + diff(pseq)[1]/2
  statsDensity <- rbind( pmids[ as.numeric( names(dmu) ) ], dmu, dsd )
  rownames( statsDensity ) <- c('Period', 'Mean', 'SD')
  colnames( statsDensity ) <- NULL
  
  dlo  <- tapply( dvec, pbin, quantile, .05, na.rm = T )
  dhi  <- tapply( dvec, pbin, quantile, .95, na.rm = T )
  pvec <- pseq[ as.numeric( names(dmu) ) ]
  
  dmu <- colSums(density*wt, na.rm = T)/sum( wt )
  dsd <- sqrt( colSums(density^2*wt, na.rm = T)/sum( wt ) - dmu^2 )
  
  vmu <- sum( mastMatrix[,'Volatility']*wt )/sum( wt )
  vsd <- sqrt( sum( mastMatrix[,'Volatility']^2*wt )/sum( wt ) - vmu^2 )
  
  wt  <- wt - 2*log( mastMatrix[,'Period SD'] )
  pmu <- sum( mastMatrix[,'Period Est']*wt )/sum( wt )
  psd <- sqrt( sum( mastMatrix[,'Period Est']^2*wt )/sum( wt ) - pmu^2 )
  
  stats <- signif( cbind( rbind( c(vmu, vsd), c(pmu, psd) ) ), 4 )
  colnames( stats ) <- c( 'Mean', 'SD' )
  rownames( stats ) <- c( 'Volatility', 'Period' )
  
  list( stats = stats, statsDensity = signif( statsDensity, 4), 
        mastMatrix = mastMatrix, density = density, frequency = frequency )
}

mastSpectralDensity <- function( x, maxPeriod = length(x)/2, PLOT = FALSE, ylim = NULL ){
  
  # volatility has units x^2 ( variance ); standardized by number of years in series 
  # periodMu, periodSd have units yr ( power-weighted period )
  # maxPeriod set to lower values to make long series comparable to shorter ones
  
  if( !is.null( ylim ) )PLOT <- TRUE
  
  mspect <- spectrum( ts( x ), log = "no", spans = c( 2, 2 ), plot = FALSE )
  xspect <- mspect$freq
  pwr    <- mspect$spec/pi
  
  ms <- which( 1/xspect <= maxPeriod )
  
  mscore <- sum( 1/xspect[ ms ]*pwr[ ms ] )  # reward low frequency, high variance
  yscore <- mscore/sum( pwr[ ms ] )          # power-weighted period ( yr )
  y2     <- sum( 1/xspect[ ms ]^2 *pwr[ ms ] )/sum( pwr[ ms ] )  - yscore^2
  ysd    <- sqrt( y2 )
  
  mscore <- mscore/length( ms )            # per year
  totVar <- sum( pwr[ ms ] )/length( ms )  # total spectral variance, per year
  
  ps <- cbind( xspect, 1/xspect, pwr )
  colnames( ps ) <- c( 'frequency', 'period', 'spectralDensity' )
  ps <- ps[ ps[,'period' ] <= maxPeriod, ]
  
  if( PLOT ){
    if( is.null( ylim ) )ylim <- range( ps[,'spectralDensity'] )
    plot( ps[,'period'], ps[,'spectralDensity'], type = 'l', log = 'xy',
          xlab = 'Period = 1/frequency ( yr )', ylab = 'Variance', ylim = ylim )
  }
  
  list( spect = ps, totVar = totVar, volatility = mscore, periodMu = yscore, periodSd = ysd )
}


  
gen4code <- function( xx, nn = 4 ){   # needed for combineds runs
  
  #shorten genus name in genusSpecies string to nn characters
  
  FAC  <- FALSE
  if( is.factor( xx ) )FAC <- TRUE
  xx   <- as.character( xx )
  fc   <- sapply( gregexpr( "[ A-Z]", xx ), '[ ', 1 )
  wf   <- which( fc > 5 )
  if( length( wf ) > 0 ){
    gen <- substr( xx[ wf], 1, 4 )
    spp <- substr( xx[ wf], fc[ wf], 1000 )
    xx[ wf] <- columnPaste( gen, spp, '' )
  }
  if( FAC )xx <- as.factor( xx )
  xx
}

.appendMatrix <- function( m1, m2, fill = NA, SORT = FALSE, asNumbers = FALSE ){  
  
  # matches matrices by column names
  # asNumbers: if column heads are numbers and SORT, then sort numerically
  
  if( length( m1 ) == 0 ){
    if( is.matrix( m2 ) ){
      m3 <- m2
    } else {
      m3 <- matrix( m2, nrow = 1 )
    }
    if( !is.null( names( m2 ) ) )colnames( m3 ) <- names( m2 )
    return( m3 )
  }
  if( length( m2 ) == 0 ){
    if( !is.matrix( m1 ) )m1 <- matrix( m1, nrow = 1 )
    return( m1 )
  }
  if( is.vector( m1 ) | ( length( m1 ) > 0 & !is.matrix( m1 ) ) ){
    nn <- names( m1 )
    if( is.null( nn ) )message( 'cannot append matrix without names' )
    m1 <- matrix( m1, 1 )
    colnames( m1 ) <- nn
  }  
  if( is.vector( m2 ) | ( length( m2 ) > 0 & !is.matrix( m2 ) ) ){
    nn <- names( m2 )
    if( is.null( nn ) )message( 'cannot append matrix without names' )
    m2 <- matrix( m2, 1 )
    colnames( m2 ) <- nn
  }
  
  c1 <- colnames( m1 )
  c2 <- colnames( m2 )
  r1 <- rownames( m1 )
  r2 <- rownames( m2 )
  n1 <- nrow( m1 )
  n2 <- nrow( m2 )
  
  allc <-  unique( c( c1, c2 ) ) 
  if( SORT & !asNumbers )allc <- sort( allc )
  if( SORT & asNumbers ){
    ac <- as.numeric( allc )
    allc <- as.character( sort( ac ) )
  }
  
  allr <- unique( c( r1, r2 ) )
  
  nr <- length( allr )
  nc <- length( allc )
  out <- matrix( 0, nr, nc )
  colnames( out ) <- allc
  rownames( out ) <- allr
  
  out[ rownames( m1 ), colnames( m1 )] <- m1
  out[ rownames( m2 ), colnames( m2 )] <- out[ rownames( m2 ), colnames( m2 )] + m2
  
  out
}


buildSpecByPlot <- function( cnames, mat, plot ){
  
  if( is.matrix( mat ) ){
    wg <- which( !cnames %in% rownames( mat ) )
    if( length( wg ) > 0 ){
      mm <- matrix( 0, length( wg ), ncol( mat ) )
      rownames( mm ) <- cnames[ wg]
      mat <- rbind( mat, mm )
    }
    
    if( !plot %in% colnames( mat ) ){
      mat <- cbind( mat, 0 )
      colnames( mat )[ ncol( mat )] <- plot
    }
    mat[ cnames, plot] <- 1
    
  }else{
    mat <- matrix( 1, length( cnames ), ncol = 1 )
    rownames( mat ) <- cnames
    colnames( mat )  <- plot
  }
  mat
}

dbetaBinom <- function( y, n, p, sd, log = FALSE ){
  
  # sd is sqrt( var ) of beta( p|a, b ), not of betaBinomial
  # not normalized for n
  
  n[ n < y] <- y[ n < y]
  bb <- n*0
  
  ww <- which( sd == 0 )
  if( length( ww ) > 0 )bb[ ww] <- dbinom( y[ ww], n[ ww], p[ ww], log = T )
  
  ww <- which( sd > 0 )
  tiny <- 1e-5
  a    <- p[ ww]^2/sd[ ww]/sd[ ww]*( 1 - p[ ww] ) - p[ ww]
  a[ a < tiny] <- tiny
  b  <- a*( 1/p[ ww] - 1 )
  bb[ ww] <- lchoose( n[ ww], y[ ww] ) + lbeta( y[ ww] + a, n[ ww] - y[ ww] + b ) - lbeta( a, b )
  
  if( log )return( bb )
  
  exp( bb )
}

myrmultinom <- function( size, p, ASVECTOR = FALSE ){  
  
  # n multinomial r.v. for a n by ncol( p ) matrix of probs
  # each row of p is a probability vector
  # size is one integer or a length-n vector of integers
  # if ASVECTOR = TRUE all size == 1, returns a vector of columns, otherwise a matrix
  
 # p <- row2Mat( p )
  
  n     <- nrow( p )
  J     <- ncol( p )
  
  if( length( size ) == 1 )size <- rep( size, n )
  
  jord  <- sample( J, J )    #randomize order
  
  rs <- rowSums( p )
  ws <- which( rs != 1 )
  if( length( ws ) > 0 ){
    p[ ws, ] <- p[ ws, ]/rs[ ws]
  }
  
  p <- p[, jord, drop = FALSE]
  
  sizej <- size
  sumj  <- rep( 0, n )
  dpj   <- rep( 1, n )
  pj    <- p
  wj    <- c( 1:n )
  
  if( ASVECTOR ){        #  only if all size == 1
    
    yy <- size*0
    
    for( j in 1:( J-1 ) ){
      a     <- round( pj[ wj, 1], 10 )
      tmp  <- rbinom( length( wj ), sizej[ wj], a )
      yy[ wj[ tmp == 1]] <- j
      sumj[ wj]  <- sumj[ wj] + tmp
      sizej <- size - sumj                       # no. remaining to choose
      dpj   <- dpj - p[, j]                       # Pr for remainder
      pj    <- matrix( p[, c( ( j+1 ):J )]/dpj, nrow( p ) )
      wj    <- which( sumj < size, arr.ind = TRUE ) 
    }
    
    yy[ yy == 0] <- J
    yy <- jord[ yy]
    
    return( yy )
  }
  
  yy  <- matrix( 0, n, J )
  
  for( j in 1:( J-1 ) ){
    a     <- round( pj[ wj, 1], 10 )
    yy[ wj, j] <- rbinom( length( wj ), sizej[ wj], a )
    sumj  <- sumj + yy[, j]
    sizej <- size - sumj                       # no. remaining to choose
    dpj   <- dpj - p[, j]                       # Pr for remainder
    pj    <- matrix( p[, c( ( j+1 ):J )]/dpj, nrow( p ) )
    wj    <- which( sumj < size, arr.ind = TRUE ) 
  }
  
  if( n == 1 )yy[, J] <- size - sum( yy )
  if( n > 1 ) yy[, J] <- size - rowSums( yy )
  
  yy[, jord] <- yy
  yy
  
}

mastIDmatrix <- function( treeData, seedData, genus, 
                         specNames = NULL, seedNames = NULL, 
                         censMin = NULL, verbose, ngen = 4 ){
  
  # possible seed ID errors: seedNames counted where seedNames of species 
  #    is missing. A '1' in R matrix indicates a 
  # must supply either 'genus' or both 'specNames' and 'seedNames'
  # ngen: no. of characters to match in genus
  
  CENS <- FALSE
  
  specIn <- specNames
  seedIn <- seedNames
  
  plotT <- treeData$plot <- as.character( treeData$plot )
  plotS <- seedData$plot <- as.character( seedData$plot )
  treeData$species <- as.character( treeData$species )
  
  if( is.null( specNames ) ){
    trows  <- which( startsWith( treeData$species, substr( genus, 1, 4 ) ) )
    specNames <- sort( unique( treeData$species[ trows] ) )
  }else{
    trows <- which( treeData$species %in% specNames )
  }
  if( length( trows ) == 0 )stop( '\nspecNames not found in treeData\n' )
  
  if( is.null( seedNames ) ){
    scols  <- which( startsWith( colnames( seedData ), substr( genus, 1, 4 ) ) )
  }else{
    scols <- which( colnames( seedData ) %in% seedNames )
  }
  if( length( scols ) == 0 )stop( '\nseedNames not found in seedData\n' )
  
  snames <- sort( colnames( seedData )[ scols] )
  
  tplots <- plotT[ trows]
  ws     <- which( seedData[, scols, drop = FALSE] > 0, arr.ind = TRUE )
  splots <- plotS[ seedData$plot[ ws[, 1]]]
  
  allPlots <- sort( unique( plotT ) )
  
  tdata <- treeData[ trows, ]
  sdata <- seedData[ plotS %in% allPlots, c( 'plot', 'trap', snames )]
  
  # possible errors where seed type is missing
  spec <- sort( unique( tdata$species ) )
  specBySeed <- matrix( 0, length( spec ), length( snames ) )
  rownames( specBySeed ) <- spec
  colnames( specBySeed ) <- snames
  
  if( !is.null( censMin ) ){
    CENS <- TRUE
    scens <- colnames( censMin )[ colnames( censMin ) %in% seedNames]
    pcens <- columnSplit( rownames( censMin ), '-' )[, 1]
  }
  
  UN <- FALSE
  gu <- grep( 'UNKN', snames )
  if( length( gu ) > 0 )UN <- TRUE
  uncol <- rep( 0, length( spec ) )
  names( uncol ) <- spec
  
  for( j in 1:length( allPlots ) ){
    
    ws <- which( sdata$plot == allPlots[ j] )
    wt <- which( tdata$plot == allPlots[ j] )
    sm <- suppressWarnings( 
      apply( sdata[ ws, snames, drop = FALSE], 2, max, na.rm = TRUE )
    )
    sj <- names( sm[ sm > 0] )
      
    tj  <- names( table( tdata$species[ wt] ) )
    win <- which( !tj %in% sj )                          #species not in seedNames
    if( length( win ) > 0 )specBySeed[ tj[ win], sj] <- 1
    if( CENS ){
      wc <- which( pcens == allPlots[ j] )
      cj <- colSums( censMin[ wc, scens, drop = FALSE], na.rm = TRUE )
      cj <- names( cj[ cj > 0] )
      wic <- which( !tj %in% cj )       
      if( length( wic ) > 0 )specBySeed[ tj[ wic], cj] <- 1
    }
    if( UN )uncol[ tj] <- 1
  }
  
  wj <- match( rownames( specBySeed ), colnames( specBySeed ) )
  wf <- which( is.finite( wj ) )
  specBySeed[ cbind( wf, wj[ wf] )] <- 1
  if( UN )specBySeed[, gu] <- uncol
  
  # missing seedNames
  wc <- colnames( specBySeed )[ colSums( specBySeed ) == 0]
  if( length( wc ) > 0 ){
    wmiss <- colnames( specBySeed )[ wc]
    specBySeed <- specBySeed[, !colnames( specBySeed ) %in% wc, drop = FALSE]
    sdata <- sdata[, !colnames( sdata ) %in% wc, drop = FALSE]
    snames <- colnames( specBySeed )
  }
  
  # missing specNames, seedNames
  wc <- rownames( specBySeed )[ rowSums( specBySeed ) == 0]
  if( length( wc ) > 0 )specBySeed[ wc, ] <- 1 
  
  specNames <- rownames( specBySeed )
  seedNames <- colnames( specBySeed )
  
  wm <- which( !seedIn %in% seedNames )
  if( length( wm ) > 0 ){
    sa <- paste0( seedIn[ wm], collapse = ', ' )
    if( verbose )cat( paste( '\nseedNames could not be used:', sa, '\n' ) )
    seedNames <- seedNames[ !seedNames %in% sa]
  }
  wm <- which( !specIn %in% specNames )
  if( length( wm ) > 0 ){
    sa <- paste0( specIn[ wm], collapse = ', ' )
    if( verbose )cat( paste( '\nspecNames could not be used:', sa, '\n' ) )
    specNames <- specNames[ !specNames %in% sa]
  }
  
  specBySeed <- specBySeed[ drop = FALSE, specNames, seedNames]
  
  list( R = specBySeed, specNames = specNames, 
       seedNames = seedNames, seedData = sdata )
}

mastPriors <- function( file, specNames, code, genus = 'NULL' ){
  
  # if not found in 'code' column can use 'genus', if supplied
  # if only 'genus', then a single vector returned
  # code columns in priorParameters.txt are 'code...'
  
  specNames <- as.character( specNames )
  
  ns <- length( specNames )
  
  if( endsWith( file, '.txt' ) )
     priorVals <- read.table( file, header = TRUE, stringsAsFactors = F )
  if( endsWith( file, '.csv' ) )
    priorVals <- read.csv( file, header = TRUE, stringsAsFactors = F )
  
  ccols <- grep( 'code', colnames( priorVals ) )
  wcol  <- which( colnames( priorVals ) == code )
  mcols <- ccols[ !ccols == wcol]
  if( length( mcols ) > 0 )priorVals <- priorVals[, -mcols]
  
  
  wr <- which( priorVals[, 'genus'] == genus )
 # if( length( wr ) == 0 )wr <- grep( 'UNKN', priorVals[, code] ) 
  
  if( length( wr ) == 0 )wr <- which( priorVals$code8 == 'default' )
  
  genRow <- priorVals[ drop = FALSE, wr, ]
  genRow$genus <- genus
  
  genMu  <- genRow[ 1, , drop = F]
  genNum <- which( sapply( priorVals, is.numeric ) )
  genMu[, genNum] <- round( colMeans( as.matrix( genRow[, genNum] ) ) )
  
  pt <- genMu[ drop = F, rep( 1, ns ), ]
  rownames( pt ) <- specNames
  
  mm <- match( specNames, priorVals[, code] )
  wf <- which( is.finite( mm ) )
  wn <- which( !is.finite( mm ) )
  if( length( wf ) > 0 ){
    pt[ wf, ] <- priorVals[ mm[ wf], ]
  }
  if( length( wn ) > 0 ){
    for( g in genNum )pt[ wn, g] <- genMu[ 1, g]
  }
 # pt <- pt[, !colnames( pt ) == code]
  
  rownames( pt ) <- pt$code8 <- specNames
  pt
}


cropByPlotSpec <- function( treeData, cropCols = c( 'cropCount', 'fecMin', 'cropMin' ) ){
  
  plots   <- sort( unique( treeData$plot ) )
  species <- sort( unique( treeData$species ) )
  cps     <- matrix( 0, length( plots ), length( species ) )
  rownames( cps ) <- plots
  colnames( cps ) <- species
  
  wc <- which( cropCols %in% colnames( treeData ) )
  
  if( length( wc ) == 0 )return( cps )
  
  css <- colSums( treeData[, cropCols[ wc], drop = F], na.rm = T )
  if( sum( css ) == 0 )return( cps )
  
  pl <- rep( treeData$plot, length( css ) )
  si <- rep( treeData$species, length( css ) )
  
  tapply( as.vector( as.matrix( treeData[, cropCols[ wc]] ) ), 
          list( plot = pl, species = si ), 
          sum, na.rm = T )
}


buildSeedByPlot <- function( sdata, snames, specNames, UNKN2TREE = FALSE, SHORTNAMES = FALSE ){
  
 # credit all specNames with 'UNKN'
 # plot  <- as.character( sdata$plot )
 # plots <- sort( unique( plot ) )
  
  tnames <- specNames[ specNames %in% colnames( sdata )]
  snames <- snames[ snames %in% colnames( sdata )]
  ntype  <- length( snames )
  nseed  <- nrow( sdata )
  
  if( ntype == 0 )return( numeric( 0 ) )
  
  seedCount <- as.matrix( sdata[, snames, drop = F] )
  rownames( seedCount ) <- rownames( sdata ) 
  
  if( UNKN2TREE ){
    
    gt <- grep( 'UNKN', snames )
    
    if( length( gt ) > 0 ){                      # credit UNKN to all specNames
      
      gent <- gsub( 'UNKN', '', snames[ gt] )
      tmat <- matrix( seedCount[, snames[ gt]], nseed, length( tnames ) )
      colnames( tmat ) <- tnames
      
      seedCount <- cbind( seedCount, tmat )
      rownames( seedCount ) <- rownames( sdata ) 
      seedCount <- tapply( seedCount, list( rep( rownames( seedCount ), ncol( seedCount ) ), 
                                            rep( colnames( seedCount ), each = nrow( seedCount ) ) ), 
                           sum, na.rm = T )
    }
  }
  
  totalSeed <- tapply( seedCount, list( rep( sdata$plot, ncol( seedCount ) ), 
                                        rep( colnames( seedCount ), each = nrow( seedCount ) ) ), 
                       sum, na.rm = T )

  if( !SHORTNAMES )colnames( totalSeed ) <- paste( 'seeds_', colnames( seedCount ), sep = '' )
  
  totalSeed
}

buildSeedByYear <- function( sdata, snames, specNames, UNKN2TREE = FALSE, SHORTNAMES = FALSE ){
  
  # credit UNKN to specNames
  
  tnames <- specNames[ specNames %in% colnames( sdata )]
  snames <- snames[ snames %in% colnames( sdata )]
  ntype  <- length( snames )
  nseed  <- nrow( sdata )
  
  if( ntype == 0 )return( numeric( 0 ) )
  
  seedCount <- as.matrix( sdata[, snames, drop = F] )
  rownames( seedCount ) <- rownames( sdata ) 
  
  if( UNKN2TREE ){
    gt <- grep( 'UNKN', snames )
    
    if( length( gt ) > 0 ){                      # credit UNKN to all specNames
      
      gent <- gsub( 'UNKN', '', snames[ gt] )
      tmat <- matrix( seedCount[, snames[ gt]], nseed, length( tnames ) )
      colnames( tmat ) <- tnames
      
      seedCount <- cbind( seedCount, tmat )
      seedCount <- tapply( seedCount, list( rep( rownames( seedCount ), ncol( seedCount ) ), 
                                            rep( colnames( seedCount ), each = nrow( seedCount ) ) ), 
                           sum, na.rm = T )
    }
  }

  totalSeed <- tapply( seedCount, list( rep( sdata$year, ncol( seedCount ) ), 
                           rep( colnames( seedCount ), each = nrow( seedCount ) ) ), 
                           sum, na.rm = T )
  if( !SHORTNAMES )colnames( totalSeed ) <- paste( 'seeds_', colnames( seedCount ), sep = '' )
  
  totalSeed
}


rangeBySpec <- function( tdat, tvar = 'shade', minDiam = 1, 
                         minPlots = 1, minYr = 1, minRange = .1, minSd = 1 ){
  
  # find species that do not span sufficient variation in predictor tvar
  # tdat     - treeData
  # tvar     - variable name
  # minDiam  - examine on trees bigger than this
  # minPlots - minimum number of plots
  # minYr    - minimum no. years
  # minRange - minimum range in tvar
  # minSd    - minimum standard deviation in tvar
  
  td   <- tdat[ tdat$diam > minDiam, ]
  ptab <- table( td$plot, td$species )
  if( nrow( ptab ) < minPlots ) return( paste( 'species', colnames( ptab ), ':', tvar, sep = '' ) )
  
  ptab[ which( ptab > 1 )] <- 1
  ptab  <- colSums( ptab )
  wspec <- names( ptab )[ ptab < minPlots]
  if( length( wspec ) > 0 ) td[ td$species %in% wspec , tvar] <- 0
  
  ptab <- table( td$year, td$species )
  ptab[ ptab > 1] <- 1
  ptab <- colSums( ptab )
  wspec <- names( ptab )[ ptab < minYr]
  if( length( wspec ) > 0 ) td[ td$species %in% wspec , tvar] <- 0
  
  
  nf  <- character( 0 )
  
  rbys <- tapply( td[, tvar], td$species, range, na.rm = T )
  rbys <- sapply( rbys, diff )
  wm   <- which( rbys < minRange )
  if( length( wm ) > 0 ){
    qf <- names( wm )
    nf <- paste( 'species', qf, ':', tvar, sep = '' )
  }
  
  sbys <- tapply( td[, tvar], td$species, sd, na.rm = T )
  wm <- which( sbys < minSd )
  if( length( wm ) > 0 ){
    qf <- names( wm )
    nf <- c( nf, paste( 'species', qf, ':', tvar, sep = '' ) )
  }
  unique( nf )
}



climIndex <- function( tmp, months, tyears ){
  
  mi <- yi <- NULL
  ym <- grep( '_', colnames( tmp ) )
  
  if( length( ym ) == 0 ){
    yi <- as.numeric( colnames( tmp ) )
    ym <- which( yi %in% tyears )
    yi <- yi[ ym ]
  }else{
    ti <- columnSplit( colnames( tmp ), '_' )
    yi <- as.numeric( ti[, 1] )
    mi <- as.numeric( ti[, 2] )
    wi <- which( yi %in% tyears & mi %in% months )
    ym <- ym[ wi ]
    yi <- yi[ wi ]
    mi <- mi[ wi ]
  }
  list( ym = ym, yi = yi, mi = mi )
}

tree2climate <- function( treeData, ylag = 0, xkname, 
                          normYr = c( 1990:2020 ), months = 1:12, fun = 'mean', 
                          clfile = "/Users/jimclark/Library/Mobile Documents/com~apple~CloudDocs/Documents/makeMastOnJimClark/makeMast/climateBuild/mastFormat/temp.csv" ){
  
  tmp <- temp <- prec <- def <- ppt <- pet <- data <- NULL
  sumVars <- c( 'prec', 'ppt', 'pet', 'def' )  # variables that are summed
  
  for( i in 1:length( sumVars ) ){
    ii <- grep( sumVars[ i], clfile )
    if( length( ii ) > 0 )fun <- 'sum'
  }
  
  if( endsWith( clfile, '.csv' ) ){
    tmp  <- read.csv( clfile, stringsAsFactors = F, row.names = 1 )
    rownames( tmp ) <- .replaceString( rownames( tmp ), '_', '' )
    colnames( tmp ) <- .replaceString( colnames( tmp ), 'X', '' )
  }else{
    load( clfile, verbose = F )
    assign( 'tmp', get( xkname ) )
    
    if( is.null( tmp ) )assign( 'tmp', data )
  }
  
  rownames( tmp ) <- .replaceString( rownames( tmp ), 'MASTIF-', '' )
  treeData$plot   <- .replaceString( treeData$plot, 'MASTIF-', '' )
  
  ww <- which( !treeData$plot %in% rownames( tmp ) )
  if( length( ww ) > 0 ){
    spl <- sort( unique( treeData$plot[ ww] ) )
    cat( '\nmissing plots in climate file:\n' )
    print( clfile )
    cat( '\nplots missing:\n' )
    print( spl )
    stop( 'not all treeData$plot in climate file' )
  }
  
  tmp <- tmp[ drop = F, rownames( tmp ) %in% treeData$plot, ]
  
  dataForm <- 'year_month'
  if( length( grep( '_', colnames(tmp) ) ) == 0 )dataForm <- 'year'
  
  tyears <- range( treeData$year ) + ylag
  tyears <- tyears[1]:tyears[2]
  
  cli    <- climIndex( tmp, months, tyears )
  ym     <- cli$ym
  yi     <- cli$yi
  climyr <- sort( unique( yi ) )
  wy     <- tyears[ !tyears %in% climyr ]
  
  if( length( wy ) > 0 ){
    
    closeyr <- RANN::nn2( climyr, wy, k = 1 )[[ 1]][, 1]
    moreyr  <- cnow <- tmp[ drop = F, , ym[ match( climyr[ closeyr ], yi ) ] ]
    
    if( dataForm == 'year_month' ){
      cnow <- columnSplit( colnames( moreyr ), '_' )
      substr( colnames( moreyr ), 1, 4 ) <- as.character( wy )
    }else{
      colnames( moreyr ) <- wy
    }
    
    tmp <- cbind( tmp, moreyr )
    cli <- climIndex( tmp, months, tyears )
    ym <- cli$ym
 #   yi <- cli$yi
  }
  
  # norms
  cli <- climIndex( tmp, months, normYr )
  ymnorm <- cli$ym
  yinorm <- cli$yi
  
  if( fun == 'mean' ){
    
    norm <- rowMeans( tmp[ drop = F, , ymnorm], na.rm = T )

  }else{
    
    tnrm <- tmp[ drop = F, , ymnorm]
    
    # sum annually, then average
    norm <- tapply( as.vector( as.matrix( tnrm ) ), 
                    list( plot = rep( rownames( tnrm ), ncol( tnrm ) ), 
                          year = rep( yinorm, each = nrow( tnrm ) ) ), sum, na.rm = T )
    norm <- rowMeans( norm, na.rm = T )
  }
  
  tmp <- tmp[ drop = F, , ym ]
  yi  <- climIndex( tmp, months, tyears )$yi
  
  byyr <- tmp
  if( dataForm == 'year_month' ){
    byyr <- tapply( as.vector( as.matrix( tmp ) ), 
                    list( plot = rep( rownames( tmp ), ncol( tmp ) ), 
                          year = rep( yi, each = nrow( tmp ) ) ), fun, na.rm = T )
  }
  more <- max( treeData$year + ylag, na.rm = T ) - max( yi )
  if( more > 0 ){
    rcol <- ncol( byyr ) - more + 1
    rcol <- rcol:ncol( byyr )
    ttt  <- byyr[ drop = F, , rep( ncol( byyr ), more )]
    colnames( ttt ) <- ( max( yi )+1 ):( max( yi ) + more )
    byyr <- cbind( byyr, ttt )
  }
  
  ycol   <- as.character( treeData$year + ylag )
  norm   <- norm[ treeData$plot]
  bi     <- cbind( treeData$plot, ycol )
  annual <- byyr[ bi ]
  anom   <- annual - norm
  
  signif( cbind( annual, norm, anom ), 4 )
}

mastClimate <- function( file, plots, years, months = 1:12, FUN = 'mean', 
                         vname = '', normYr = c( 1990:2020 ), lastYear = 2021 ){
  
  # return covariate for a vector of plots and years
  # vname variable name; special treatment of 'degDays'
  # plots and years are vectors of the same length
  # months is a vector in ( 1, 12 )
  
  fform <- integer( 0 )
  
  tform <- grep( '.csv', file )
  if( length( tform ) == 0 )ffrom <- grep( '.txt', file )
  
  if( length( fform ) == 0 & length( tform ) == 0 )
    stop( '\nfile must be .csv or .txt format\n' )

  if( length( tform ) > 0 )data <- read.csv( file, header = TRUE, row.names = 1 )
  if( length( fform ) > 0 )data <- read.table( file, header = TRUE, row.names = 1 )
  
  colnames( data ) <- .replaceString( colnames( data ), 'X', '' )
  rownames( data ) <- .fixNames( rownames( data ), all = TRUE, MODE = 'character' )$fixed
  
  # precip must be positive
  PREC <- FALSE
  dmin <- min( data, na.rm = TRUE )
  if( dmin > 0 )PREC <- TRUE
  
  plots <- .fixNames( plots, all = TRUE, MODE = 'character' )$fixed
  
  # small number of plots, but many points
  
  allPlots <- sort( unique( plots ) )
  
  tmp <- columnSplit( colnames( data ), '_' )
  yr  <- as.numeric( tmp[, 1] )
  mo  <- as.numeric( tmp[, 2] )
  yd  <- sort( unique( yr ) )
  
  my <- max( years )
  n.ahead <- my - max( yd )
  nyr     <- length( yd ) + max( c( 0, n.ahead ) )
  
  if( n.ahead > 0 ){
    
    lastyr <- max( yr )
    lastmo <- max( mo )
    yseq   <- ( lastyr + 1 ):( lastyr + n.ahead )
    mseq   <- ( lastmo + 1 ):( lastmo + 12 )
    ymore  <- rep( yseq, each = 12 )
    mmore  <- rep( mseq, n.ahead )
    
    wk <- which( mseq > 12 )             # data do not end in december
    if( length( wk ) > 0 ){
      mseq[ wk] <- mseq[ wk] - 12
      mmore <- rep( mseq, n.ahead )
      ytmp <- ymore*0
      ytmp[ 1] <- ymore[ 1] - 1
      ytmp[ mseq == 1] <- ymore[ mseq == 1] 
      for( j in 2:length( ytmp ) ) if( ytmp[ j] == 0 )ytmp[ j] <- ytmp[ j-1] 
      ymore <- ytmp
    }

    yr <- c( yr, ymore )
    mo <- c( mo, mmore )
    
    dmore <- matrix( NA, nrow( data ), length( ymore ) )
    colnames( dmore ) <- paste( ymore, '_', mmore, sep = '' )
    data <- cbind( data, dmore )
  }
  
  yd <- sort( unique( yr ) )
  xx <- aa <- numeric( 0 )  # hold mean and monthly anomaly
  wy <- match( yr, yd )
  wm <- match( mo, 1:12 )
  
  # years to use for climate norm
  wyNorm <- match( yr, normYr )
  wfNorm <- which( is.finite( wyNorm ) )
  
  missing <- character( 0 )
  
  for( j in 1:length( allPlots ) ){
    
    wj <- which( rownames( data ) == allPlots[ j] )
    
    if( length( wj ) == 0 ){
      xx <- cbind( xx, rep( NA, nyr ) )
      missing <- c( missing, allPlots[ j] )
      stop( paste( 'plot', allPlots[ j], 'is missing from', file ) )
      next
    }
    
    dj   <- data[ wj, ] 
    if( is.list( dj ) )dj <- unlist( dj )
    
    wf     <- which( is.finite( dj ) )
    nahead <- length( dj ) - max( wf )
    dj     <- dj[ 1:max( wf )]
    
    if( nahead > 0 ){  # predict forward
      fitAR <-  arima( dj, order = c( 2, 0, 0 ), 
                      seasonal = list( order = c( 1, 0, 0 ), period = 12 ) )
      ptmp  <- predict( fitAR, n.ahead = nahead )
      ptmp  <- ptmp$pred + rnorm( nahead, 0, ptmp$se ) 
      dj    <- c( dj, signif( ptmp, 3 ) )
    }
    
    
    mmat <- matrix( NA, nyr, 12 )
    mmat[ cbind( wy, wm )] <- dj
    
    nmat <- matrix( NA, length( normYr ), 12 )
    nmat[ cbind( wyNorm[ wfNorm], wm[ wfNorm] )] <- dj[ wfNorm]
    
    # mean of monthly anomalies is the same as this:
    # avec <- rowMeans( mmat, na.rm = T ) - mean( mmat, na.rm = T )
    
    monthMu   <- colMeans( nmat, na.rm = T )  # monthly means over all years
    monthAnom <- t( t( mmat ) - monthMu )
    
    if( vname == 'degDays' ){
      mvec <- mmat
      mvec[ mvec < 0] <- 0
      mvec <- 30*rowSums( mvec, na.rm = T )
      avec <- mvec*0
    }else{
      mvec <- suppressWarnings( 
        apply( mmat[, months, drop = FALSE], 1, FUN, na.rm = TRUE )
      )
      avec <- suppressWarnings( 
        apply( monthAnom[, months, drop = FALSE], 1, FUN, na.rm = TRUE )
      )
    }
    xx   <- cbind( xx, mvec )
    aa   <- cbind( aa, avec )
  }
  
  
  if( length( missing ) > 0 ){
    pmiss <- paste0( missing, collapse = ', ' )
    warning( paste( '\nMissing plots in covariate file:\n', pmiss ) )
  }
  
  colnames( xx ) <- colnames( aa ) <- allPlots
  xx[ !is.finite( xx )] <- NA
  aa[ !is.finite( aa )] <- NA
  
  if( PREC )xx[ xx < 0] <- 0
  
  iy <- match( years, yd )
  ip <- match( plots, colnames( xx ) )
  
  yy   <- xx[ cbind( iy, ip )]
  anom <- aa[ cbind( iy, ip )]
  
  site <- signif( apply( xx, 2, mean, na.rm = T )[ ip], 4 )
  tc   <- paste0( num2Month( months ), collapse = '' )
  
  xm <- signif( cbind( yy, site, anom ), 4 )
  colnames( xm ) <- paste( vname, tc, c( '', 'SiteMean', 'Anom' ), sep = '' )
  
  xm[, 3] <- xm[, 1] - xm[, 2]
  
  if( length( missing ) > 0 ){
  #  miss <- unique( columnPaste( plots[ -wfy], years[ -wfy], '_' ) )
  #  pmiss <- paste0( miss, collapse = ', ' )
    warning( paste( '\nMissing plot_years in covariate file:\n', pmiss ) )
  }

  list( x = xm, missingPlots = missing )
}

num2Month <- function( monthNum ){
  
  mNames   <- c( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 
                'Sep', 'Oct', 'Nov', 'Dec' )
  mNames[ monthNum]
}

month2Num <- function( monthName ){
  
  match( monthName, num2Month( 1:12 ) )
}

lowerFirstLetter <- function( xx ){
  
  f <- tolower( substring( xx, 1, 1 ) )
  l <- substring( xx, 2 )
  columnPaste( f, l, '' )
}

upperFirstLetter <- function( xx ){
  
  # FIRSTONLY - only first letter of first word when a string has multiple words
  
  f <- toupper( substring( xx, 1, 1 ) )
  l <- substring( xx, 2 )
  columnPaste( f, l, '' )
}

getSigFig <- function( x ){
  length( gregexpr( "[[ :digit:]]", as.character( x ) )[[ 1]] )
}

combineSpecies <- function( specVec, specNames, combineSpecs ){
  
  if( is.null( combineSpecs ) )
    return( list( specNames = specNames, species = specVec ) )
  
  if( !is.character( specVec ) )specVec <- as.character( specVec )
  
  if( !is.null( combineSpecs ) ){
    wf <- which( combineSpecs[, 'from'] %in% as.character( specVec ) )
    if( length( wf ) > 0 ){
      specs <- as.character( specVec )
      for( m in wf ){
        ws <- which( specs == combineSpecs[ m, 'from'] )
        specs[ ws] <- combineSpecs[ m, 'to']
      }
  #    specVec <- as.factor( specs )
      specVec <- specs
    }
    specNames <- sort( unique( as.character( specVec ) ) )
  }
  list( specNames = specNames, species = specVec )
}

combineSeedNames <- function( sdata, snames, cseed = NULL ){
  
  if( is.null( cseed ) )
    return( list( seedNames = snames, seedData = sdata ) )
  
  from <- cseed[, 1]
  to   <- cseed[, 2]
  
  c1 <- matrix( paste( from, '_min', sep = '' ), ncol = 1 )
  c2 <- matrix( paste( from, '_max', sep = '' ), ncol = 1 )
  
  cnew <- rbind( cbind( c1, to ), cbind( c2, to ) )
  
  cmb <- rbind( cbind( from, to ) , cnew )
  
  wmm <- grep( '_min_min', cmb[, 1] )
  if( length( wmm ) > 0 ){
    cmb[ wmm, 1] <- .replaceString( cmb[ wmm, 1], '_min_min', '_min' )
  }
  wmm <- grep( '_min_max', cmb[, 1] )
  if( length( wmm ) > 0 ){
    cmb[ wmm, 1] <- .replaceString( cmb[ wmm, 1], '_min_max', '_min' )
  }
  cmb <- cmb[ !duplicated( cmb[, 1] ), ]
  cmb <- cmb[ order( cmb[, 1] ), ]
  
  smb1 <- paste( snames, '_min', sep = '' )
  smb2 <- paste( snames, '_max', sep = '' )
  smb  <- c( snames, smb1, smb2 )
  
  wmm <- grep( '_min_min', smb )
  if( length( wmm ) > 0 ){
    smb[ wmm] <- .replaceString( smb[ wmm], '_min_min', '_min' )
  }
  wmm <- grep( '_min_max', smb )
  if( length( wmm ) > 0 ){
    smb[ wmm] <- .replaceString( smb[ wmm], '_min_max', '_min' )
  }
  smb <- smb[ !duplicated( smb )]
  
  ww <- which( smb %in% cmb[, 'from'] )
  if( length( ww ) == 0 | is.null( cmb ) )
    return( list( seedNames = snames, seedData = sdata ) )
  
  mm <- match( smb[ ww], cmb[, 'from'] )
  
 # sall <- smb[ -mm]
  
  for( k in 1:length( mm ) ){
    fromk <- cmb[ mm[ k], 'from']
    tok   <- cmb[ mm[ k], 'to']
    smb[ ww[ k]] <- tok
    if( !tok %in% colnames( sdata ) & fromk %in% colnames( sdata ) ){
      colnames( sdata )[ colnames( sdata ) == fromk] <- tok
      next
    }
    if( tok %in% colnames( sdata ) & fromk %in% colnames( sdata ) ){
      sdata[, tok] <- sdata[, tok] +
        sdata[, fromk]
    }else{
      colnames( sdata )[ colnames( sdata ) == fromk] <- tok
    }
  }
  
  wm <- which( colnames( sdata ) %in% cmb[, 'from'] )
  if( length( wm ) > 0 )sdata <- sdata[, -wm]
 
  seedNames <- snames[ !duplicated( snames )]
  seedNames <- seedNames[ seedNames %in% colnames( sdata )]

  list( seedNames = seedNames, seedData = sdata )
}

trimCharVec <- function( cvec, string = NULL, good = NULL, bad = NULL ){
  
  #delete elements from character vector cvec:
  #    containing string
  #    in bad
  #    not in good
  
  if( !is.null( string ) ){
    wm <- grep( string, cvec )
    if( length( wm ) > 0 )cvec <- cvec[ -wm]
  }
  if( !is.null( good ) ){
    wm <- which( !cvec %in% good )
    if( length( wm ) > 0 )cvec <- cvec[ -wm]
  }
  if( !is.null( bad ) ){
    wm <- which( cvec %in% bad )
    if( length( wm ) > 0 )cvec <- cvec[ -wm]
  }
  
  cvec
}

.trimRows <- function( xmat1, xmat2, xcol, STOP = FALSE ){
  
  # xmat1 will have rows trimmed to include xmat2, no row matching
  
  kword <- character( 0 )
  
  x1 <- xmat1[, xcol]
  x2 <- xmat2[, xcol]
  if( is.factor( x1 ) | is.factor( x2 ) ){
    x1 <- as.character( x1 )
    x2 <- as.character( x2 )
  }
  
  wm <- match( x1, x2 )
  wf <- which( is.finite( wm ) )
  if( length( wf ) < length( wm ) ){
    if( STOP ){
      stop( paste( '\nduplicates in', xcol ) )
    }else{
      kword <- paste( 'Values have been trimmed in ', xcol, '.', sep = '' )
      xmat1 <- xmat1[ wf, ]
    }
  }
  list( mat1 = xmat1, words = kword )
}

cleanSeedData <- function( sdata, xytrap, seedNames, verbose ){
  
  words <- character( 0 )
  sdata$plot <- as.character( sdata$plot )
  sdata$trap <- as.character( sdata$trap )
  
  if( is.factor( sdata$year ) )sdata$year <- factor2integer( sdata$year )
  
  sdata$trapID <- columnPaste( sdata$plot, sdata$trap )
  xytrap$trapID <- columnPaste( xytrap$plot, xytrap$trap )
  
  if( !'area' %in% colnames( sdata ) ){
    sdata$area <- 1
    kword <- 'area is missing from seedData.'
    warning( kword )
    words <- paste( words, kword )
  }
  if( is.character( sdata$area ) ){
    kword <- 'seedData$area was coerced to numeric.'
    warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
    sdata$area <- as.numeric( sdata$area )
  }
  if( !'active' %in% colnames( sdata ) ){
    kword <- 'An $active column was added to seedData.'
    if( verbose )cat( paste( "\nNote: ", kword, sep = "" ) )
    sdata$active <- 1
  }
  if( is.character( sdata$active ) ){
    kword <- 'seedData$active coerced to numeric.'
    warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
    sdata$active <- as.numeric( sdata$active )
  }
  if( max( sdata$active, na.rm = TRUE ) > 1 | min( sdata$active, na.rm = TRUE ) < 0 ){
    kword <- 'Some seedData$active are outside ( 0, 1 ).'
    warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
  }
  
  wm <- match( colnames( sdata ), seedNames )
  wf <- which( is.finite( wm ) )
  colnames( sdata )[ wf] <- .fixNames( colnames( sdata )[ wf], all = TRUE, MODE = 'character', 
                                   NODASH = F )$fixed
  seedNames <- .fixNames( seedNames, all = TRUE, MODE = 'character', 
                         NODASH = F )$fixed
  #censored columns
  seedNamesAll <- seedNames
  m1 <- grep( '_min', colnames( sdata ) )
  if( length( m1 ) > 0 )seedNamesAll <- c( seedNamesAll, colnames( sdata )[ m1] )
  m2 <- grep( '_max', colnames( sdata ) )
  if( length( m2 ) > 0 )seedNamesAll <- c( seedNamesAll, colnames( sdata )[ m2] )
  
  nseed <- length( seedNamesAll )
  
  #fill missing with zero count, zero active
  sdata  <- sdata[ order( sdata$plot, sdata$trap, sdata$year ), ]
  trapID <- columnPaste( sdata$plot, sdata$trap )
  id     <- sort( unique( trapID ) )
  snew   <- numeric( 0 )
  
  for( k in 1:length( id ) ){
    
    wk <- which( trapID == id[ k] )
    pk <- sdata$plot[ wk[ 1]]
    ak <- range( sdata$year[ sdata$plot == pk] )
    ak <- ak[ 1]:max( ak )
    yk <- sdata$year[ wk]
    if( ( max( ak ) - min( ak ) + 1 ) == length( yk ) ){
      smat <- sdata[ wk, c( 'plot', 'trap', 'year', 'area', 'active', seedNamesAll )]
    }else{
  
      sk <- min( ak ):max( ak )
      nk <- length( sk )
      
      kmat <- data.frame( plot = rep( sdata$plot[ wk[ 1]], nk ), 
                         trap = rep( sdata$trap[ wk[ 1]], nk ), 
                         year = sk, area = rep( sdata$area[ wk[ 1]], nk ) )
      cmat <- matrix( 0, nk, 1+nseed )
      colnames( cmat ) <- c( 'active', seedNamesAll )
      smat <- as.matrix( sdata[ drop = F, wk, c( 'active', seedNamesAll )] )
      rownames( smat ) <- rownames( sdata )[ wk]
      cmat[ match( yk, sk ), ] <- smat
      smat <- cbind( kmat, cmat )
    }
    snew <- rbind( snew, smat )
  }
  sid <- columnPaste( snew$plot, snew$trap )
  sid <- columnPaste( sid, snew$year, '_' )
  rownames( snew ) <- sid
  
  sdata <- snew
  
  ccols <- c( 'plot', 'trap', 'year', 'area', 'active', seedNamesAll )
  wm <- which( !ccols %in% colnames( sdata ) )
  if( length( wm ) > 0 )
    stop( paste0( '\nNMissing columns from seedData:\n', ccols[ wm], collapse = ', ' ) )
  
  ccols <- c( 'plot', 'trap', 'x', 'y' )
  wm <- which( !ccols %in% colnames( xytrap ) )
  if( length( wm ) > 0 )
    stop( paste0( '\nMissing columns from xytrap:\n', ccols[ wm], collapse = ', ' ) )
  
  wna <- which( is.na( sdata$active ) )
  if( length( wna ) > 0 ){
    kword <- 'Some values are undefined in seedData$active.'
    if( verbose )cat( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
    sdata$active[ wna] <- 0
  }
  wna <- which( is.na( sdata$area ) )
  if( length( wna ) > 0 )
    stop( '\nSome values undefined or zero in seedData$area\n' )
  
  sdata  <- .fixNamesVector( c( 'plot', 'trap' ), sdata, MODE = 'character' )
  xytrap <- .fixNamesVector( c( 'plot', 'trap' ), xytrap, MODE = 'character' )
  if( is.character( sdata$year ) )sdata$year <- as.numeric( sdata$year )
  sdata$trapID  <- columnPaste( sdata$plot, sdata$trap )
  sdata$plotYr  <- columnPaste( sdata$plot, sdata$year, '_' )
  xytrap$trapID <- columnPaste( xytrap$plot, xytrap$trap )
  
  ww <- which( !sdata$trapID %in% xytrap$trapID )
  
  if( length( ww ) > 0 ){
    wp <- paste0( sort( unique( sdata$trapID[ ww] ) ), collapse = ', ' )
    if( verbose )cat( paste( '\nRemoved seedData missing from xytrap: ', wp, '\n', sep = '' ) )
    sdata <- sdata[ -ww, ]
  }
   
  sdata <- sdata[, c( 'plot', 'trap', 'trapID', 'year', 'plotYr', 
                    'area', 'active', seedNamesAll )]
  
  xytrap <- .cleanRows( xytrap, 'trapID' )
  xytrap <- xytrap[ xytrap$trapID %in% sdata$trapID, ]
  
  list( sdata = sdata, xytrap = xytrap, words = words )
}

cleanTreeData <- function( tdata, xytree, specNames ){
  
  words <- character( 0 )
  
  ccols <- c( 'plot', 'tree', 'species', 'year', 'diam' )
  wm <- which( !ccols %in% colnames( tdata ) )
  if( length( wm ) > 0 )
    stop( paste0( '\nMissing columns from treeData:\n', ccols[ wm], collapse = ', ' ) )
  
  tdata$plot <- .fixNames( tdata$plot, all = TRUE, MODE = 'character' )$fixed
  tdata$tree <- .fixNames( tdata$tree, all = TRUE, MODE = 'character' )$fixed
  tdata$species <- .fixNames( tdata$species, all = TRUE, MODE = 'character', 
                              NODASH = F )$fixed
  if( is.character( tdata$year ) )tdata$year <- as.numeric( tdata$year )
  
  xytree$tree <- as.character( xytree$tree )
  xytree$plot <- as.character( xytree$plot )
  
  if( is.null( xytree ) ){       # bogus tree locations if missing
    kword <- ' xytree is missing from inputs.'
    warning( kword )
    words <- paste( words, kword )
    
    tid <- columnPaste( tdata$plot, tdata$tree )
    tid <- sort( unique( tid ) )
    pt  <- columnSplit( tid, '-' )
    xytree <- data.frame( plot = pt[, 1], tree = pt[, 2], x = 0, y = 0, 
                         stringsAsFactors = F )
  }
  xytree$plot <- .fixNames( xytree$plot, all = TRUE, MODE = 'character' )$fixed
  xytree$tree <- .fixNames( xytree$tree, all = TRUE, MODE = 'character' )$fixed
  
  tdata <- tdata[ as.character( tdata$species ) %in% specNames, ]
  tdata$treeID  <- columnPaste( tdata$plot, tdata$tree )
  xytree$treeID <- columnPaste( xytree$plot, xytree$tree )
  xytree <- xytree[ as.character( xytree$treeID ) %in% as.character( tdata$treeID ), ]
  
  mm <- match( as.character( xytree$treeID ), as.character( tdata$treeID ) )
  xytree$species <- tdata$species[ mm]
  
  ccols <- c( 'plot', 'tree', 'x', 'y' )
  wm <- which( !ccols %in% colnames( xytree ) )
  if( length( wm ) > 0 )
    stop( paste0( '\nMissing columns from xytree:\n', ccols[ wm], collapse = ', ' ) )
  
  tdata$plotYr  <- columnPaste( tdata$plot, tdata$year, '_' )
  
  tmp <- .trimRows( xytree, tdata, 'treeID' )
  xytree <-  tmp$mat1
  words <- paste( words, tmp$words )
  
  if( !'species' %in% colnames( xytree ) ){
    wm <- match( xytree$treeID, tdata$treeID )
    xytree$species <- tdata$species[ wm]
  }
  
  if( is.character( tdata$diam ) ){
    kword <- ' treeData$diam coerced to numeric.'
    warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
    tdata$diam <- as.numeric( tdata$diam )
  }
  
  if( is.factor( tdata$year ) )tdata$year <- factor2integer( tdata$year )
  
  xytree <- .cleanRows( xytree, 'treeID' )
  xytree <- .trimRows( xytree, tdata, 'treeID' )[[ 1]]
 # tdata  <- .trimRows( tdata, xytree, 'treeID' )[[ 1]]
  
  list( tdata = tdata, xytree = xytree, specNames = specNames, 
       words = words )
}

cleanInputs <- function( inputs, beforeFirst = 20, 
                        afterLast = 10, p = 0, verbose = FALSE ){
  
  xytree <- xytrap <- sdata <- NULL
  
  SEEDDATA <- TRUE
  if( !'seedData' %in% names( inputs ) )SEEDDATA <- FALSE
  
  SEEDCENSOR <- TREESONLY <- FALSE   # censored counts with 'seedNames_min', 'seedNames_max'
  censMin <- censMax <- NULL
  #minDiam <- 0
  words <- character( 0 )
  cropCols <- c( 'cropCount', 'cropMin', 'cropMax' )
  
  inputs$treeData$species <- as.character( inputs$treeData$species )
  
  tdata        <- inputs$treeData
  specNames    <- inputs$specNames
  nspec        <- length( specNames )
  
  if( is.null( specNames ) )stop( "'specNames' missing from inputs list, e.g., 'acerRubr'" )
  combineSpecs <- inputs$combineSpecs
  tdata$plot   <- .fixNames( tdata$plot, all = TRUE, MODE = 'character' )$fixed
  tdata$year   <- factor2integer( tdata$year )
  tdata        <- tdata[ as.character( tdata$species ) %in% specNames, ]
  tdata$tree   <- .fixNames( tdata$tree, all = TRUE, MODE = 'character' )$fixed
  tdata$treeID <- columnPaste( tdata$plot, tdata$tree )
  priorTable   <- inputs$priorTable
  
  if( !is.null( priorTable ) ){
    minDiam <- priorTable[ tdata$species, 'minDiam']
    maxDiam <- priorTable[ tdata$species, 'maxDiam']
    maxFec  <- priorTable[ tdata$species, 'maxFec']
  }else{
    if( verbose ){
      cat( '\nNote: missing priorTable, used defaults for minDiam, maxDiam, maxFec' )
    }
    minDiam <- rep( 10, nrow( tdata ) )
    maxDiam <- rep( 40, nrow( tdata ) )
    maxFec  <- rep( 1e+8, nrow( tdata ) )
  }
  
  ww <- which( is.na( tdata$year ) )
  if( length( ww ) > 0 )
    stop( 'treeData$year has NAs' )
  if( min( tdata$year ) < 1700 )
    stop( 'treeData$year < 1700' )
  
  tdata  <- tdata[ order( tdata$plot, tdata$tree, tdata$year ), ]
  
  plotInput <- sort( unique( tdata$plot ) )
  
  if( SEEDDATA ){
    
    xytree        <- inputs$xytree
    xytree$plot   <- .fixNames( xytree$plot, all = TRUE, MODE = 'character' )$fixed
    xytree        <- xytree[ order( xytree$plot, xytree$tree ), ]
    xytree$treeID <- columnPaste( xytree$plot, xytree$tree )
    
    sdata  <- inputs$seedData
    xytrap <- inputs$xytrap
    combineSeeds <- inputs$combineSeeds
    seedNames    <- inputs$seedNames
    censMin      <- inputs$censMin
    censMax      <- inputs$censMax
    sdata$year   <- as.numeric( sdata$year )
    sdata$year   <- factor2integer( sdata$year )
    plotInput    <- sort( unique( c( tdata$plot, sdata$plot ) ) )
    xytrap$plot  <- .fixNames( xytrap$plot, all = TRUE, MODE = 'character' )$fixed
    sdata$plot   <- .fixNames( sdata$plot, all = TRUE, MODE = 'character' )$fixed
    xytrap$trap  <- .fixNames( xytrap$trap, all = TRUE, MODE = 'character' )$fixed
    sdata$trap   <- .fixNames( sdata$trap, all = TRUE, MODE = 'character' )$fixed
    
    ww <- which( is.na( xytree$x ) | is.na( xytree$y ) )
    if( length( ww ) > 0 )xytree <- xytree[ -ww, ]
    
    ww <- which( is.na( xytrap$x ) | is.na( xytrap$y ) )
    if( length( ww ) > 0 )xytrap <- xytrap[ -ww, ]
    
    ww <- which( !xytrap$plot %in% sdata$plot )
    if( length( ww ) > 0 ){
      nop   <- unique( xytrap$plot[ ww] )
      sdata <- sdata[ !sdata$plot %in% nop, ]
    }
  }
  
  pname <- .fixNames( plotInput, all = TRUE, MODE = 'character' )$fixed
  names( plotInput ) <- pname
  
  specNames <- .fixNames( inputs$specNames, all = TRUE, MODE = 'character', 
                         NODASH = F )$fixed
  
  if( length( which( duplicated( c( specNames ) ) ) ) > 0 )stop( 'duplicate specNames' )
  
  tmp <- combineSpecies( tdata$species, specNames, combineSpecs )
  tdata$species <- tmp$species
  specNames     <- tmp$specNames
  
  
  # must have traps or crop count
  ll <- !tdata$treeID %in% xytree$treeID       # missing from xytree
  ww <- which( ll )
  
  if( length( ww ) > 0 ){                       # trees not on trapped plots must have cropCounts
    
    wc <- tdata$treeID %in% xytree$treeID     # in a seedData plot
    
    if( 'cropCount' %in% colnames( tdata ) ){
      wc <- wc | is.finite( tdata$cropCount ) 
   }
    if( 'cropMin' %in% colnames( tdata ) ){
      wc <- wc | is.finite( tdata$cropMin )
    }
    
    wk <- which( !wc )        # neither seed data nor cropCount data
    
    if( length( wk ) == nrow( tdata ) & !SEEDDATA )stop( 'must have crop counts or seedData' )
  
    if( length( wk ) > 0 ){
      tdata <- tdata[ -wk, ]
    }
    wk <- which( !tdata$treeID %in% xytree$treeID )
    if( length( wk ) > 0 ){
      tdata <- rbind( tdata[ -wk, ], tdata[ wk, ] )   # TREESONLY moved to end
    }
  }
  
  if( SEEDDATA ){
    
    sdata$year  <- as.numeric( sdata$year )
    sdata$plot  <- .fixNames( sdata$plot, all = TRUE, MODE = 'character' )$fixed
    xytrap$plot <- .fixNames( xytrap$plot, all = TRUE, MODE = 'character' )$fixed
    
    sdata  <- sdata[ order( sdata$plot, sdata$trap, sdata$year ), ]
    xytrap <- xytrap[ order( xytrap$plot, xytrap$trap ), ]
    
    # columns in seedNames or seedNames_min/max
    scols     <- c( "plot", "trap", "year", "area", "active" )
    countCols <- colnames( sdata )[ !colnames( sdata ) %in% scols]
    
    ck <- numeric( 0 )
    for( k in 1:length( seedNames ) ){
      wk <- grep( seedNames[ k], countCols )
      ck <- c( ck, wk )
    }
    countCols <- countCols[ sort( unique( ck ) )]
    
    smin <- paste( seedNames, '_min', sep = '' )
    smax <- paste( seedNames, '_max', sep = '' )
    
    countCols <- countCols[ countCols %in% c( seedNames, smin, smax )]
    
    tmp <- combineSeedNames( sdata, countCols, combineSeeds )
    sdata     <- tmp$seedData
    seedNames <- tmp$seedNames
    nseed     <- length( seedNames )
    
    sdata <- sdata[, c( scols, seedNames ), drop = F]
    
    seedPlots <- sort( unique( sdata$plot ) )
    treePlots <- sort( unique( tdata$plot ) )
    
    sdata$trapID <- columnPaste( sdata$plot, sdata$trap )
    rownames( sdata ) <- NULL
    
    plotTrapYr <- columnPaste( sdata$trapID, sdata$year, '_' )
    
    rnames <- columnPaste( sdata$trapID, sdata$year, '_' )
    
    rownames( sdata ) <- rnames
    
    if( is.null( censMin ) ){   # if censMin not built yet
      sall <- c( seedNames, paste( seedNames, '_min', sep = '' ), 
                paste( seedNames, '_max', sep = '' ) )
      countCols <- countCols[ countCols %in% sall] 
      sdata <- sdata[, c( scols, countCols )]
    }
    
    xytrap$plot   <- as.character( xytrap$plot )
    sdata$plot    <- as.character( sdata$plot )
    sdata$trapID  <- columnPaste( sdata$plot, sdata$trap )
    xytrap$trapID <- columnPaste( xytrap$plot, xytrap$trap )
    
    #only seedData on plots with trees
    psave     <- intersect( seedPlots, treePlots )
    if( length( psave ) == 0 )stop( 'tree and seed data not from same plots' )
    sdata     <- sdata[ sdata$plot %in% psave, ]
    xytrap    <- xytrap[ xytrap$plot %in% psave, ]
    
    # treesOnly
    ww <- which( !tdata$plot %in% sdata$plot )    # not on a seed trap plot
    
    if( length( ww ) > 0 ){
      
      # if no crop counts, retain only trapped plots
      
      wcrop <- which( cropCols %in% colnames( tdata ) )
      
      if( length( wcrop ) == 0 ){
        tdata     <- tdata[ tdata$plot %in% psave, ]
      }else{                                  # there are crop counts
        
        # not on trapped plots, but finite crop counts: keep but move to bottom
        w1 <- !tdata$plot %in% sdata$plot
        w2 <- rep( FALSE, length( w1 ) )
        for( m in wcrop ){
          w2[ is.finite( tdata[, cropCols[ m]] )] <- TRUE
        }
        wk <- which( w1 & w2 )
        if( length( wk ) > 0 )tdata <- rbind( tdata[ -wk, ], tdata[ wk, ] )
        TREESONLY <- TRUE
      }
    }
    
    seedPlots <- sort( unique( sdata$plot ) )
    treePlots <- sort( unique( tdata$plot ) )
    
    #tdata cannot start more than p yr before or after sdata
    
    pb <- p + beforeFirst
    pl <- p + afterLast
    
    womit <- numeric( 0 )
    for( k in 1:length( seedPlots ) ){
      kp <- range( sdata$year[ sdata$plot == seedPlots[ k]] )
      wt <- which( tdata$plot == seedPlots[ k] )
      wk <- which( tdata$year[ wt] < ( kp[ 1] - pb ) )
      if( length( wk ) > 0 )womit <- c( womit, wt[ wk] )
      wk <- which( tdata$year[ wt] > ( kp[ 2] + pl ) )
      if( length( wk ) > 0 )womit <- c( womit, wt[ wk] )
    }
    
    # trees with cropCounts
    if( TREESONLY ){
      wf <- which( is.finite( tdata$cropCount ) )
      womit <- womit[ !womit %in% wf]
    }
    
    if( length( womit ) > 0 )tdata <- tdata[ -womit, ]
    
    # censor inactive traps
    seedNames <- .fixNames( inputs$seedNames, all = TRUE, MODE = 'character', NODASH = F )$fixed
    
    ww <- which( !seedNames %in% colnames( sdata ) )
    if( length( ww ) > 0 )seedNames <- seedNames[ -ww]
    
    #fix seed names in censored columns
    ntype <- length( seedNames )
    scens <- .multivarChainNames( c( 'min', 'max' ), seedNames )
    wcens <- which( scens %in% colnames( sdata ) )   # data input as censored
    mcols <- integer( 0 )
    
    if( length( wcens ) > 0 ){  # repair names, but leave '_min', '_max'
      m1cols <- grep( '_min', colnames( sdata ) )
      ncc <- .replaceString( colnames( sdata )[ m1cols], '_min', '' )
      mc <- .fixNames( ncc, all = TRUE, MODE = 'character', NODASH = F )$fixed
      colnames( sdata )[ m1cols] <- paste( mc, '_min', sep = '' )
      
      m2cols <- grep( '_max', colnames( sdata ) )
      ncc <- .replaceString( colnames( sdata )[ m2cols], '_max', '' )
      mc <- .fixNames( ncc, all = TRUE, MODE = 'character', NODASH = F )$fixed
      colnames( sdata )[ m2cols] <- paste( mc, '_max', sep = '' )
      mcols <- c( m1cols, m2cols )
      
      seedNames <- .fixNames( seedNames, all = TRUE, MODE = 'character', NODASH = F )$fixed
    }
    
    wcc <- c( 1:ncol( sdata ) )
    if( length( mcols ) > 0 )wcc <- wcc[ -mcols]
    colnames( sdata )[ wcc] <- .fixNames( colnames( sdata )[ wcc], all = TRUE, 
                                      MODE = 'character', NODASH = F )$fixed
    
    tmp <- cleanSeedData( sdata, xytrap, seedNames, verbose )
    sdata  <- tmp$sdata
    xytrap <- tmp$xytrap
    words  <- paste( words, tmp$words )
    
    scols <- c( "plot", "trap", "trapID", "year", "plotYr", "area", "active" )
    countCols <- colnames( sdata )[ !colnames( sdata ) %in% scols]
    
    sdata <- sdata[, c( scols, countCols )]
    
    if( length( wcens ) > 0 ){  # only if censMin/censMax not built yet
      
      # move _min, _max columns out of sdata to censMin, censMax, 
      # only for rows
      
      SEEDCENSOR <- TRUE
      
      scens <- paste( seedNames, '_min', sep = '' )
      tcens <- paste( seedNames, '_max', sep = '' )
      wcens <- which( scens %in% colnames( sdata ) )   # data input as censored
      scens <- scens[ wcens]
      wcens <- which( tcens %in% colnames( sdata ) )   # data input as censored
      tcens <- tcens[ wcens]
      
      stypes <- columnSplit( scens, '_min' )
      ttypes <- columnSplit( tcens, '_max' )
      stypes <- sort( unique( c( stypes, ttypes, seedNames ) ) ) #seedNames from censored columns
      
      slo <- matrix( 0, nrow( sdata ), length( stypes ) )  
      colnames( slo ) <- stypes
      snew <- shi <- slo 
      
      # censored rows:
      ms <- match( stypes, seedNames )
      wf <- which( is.finite( ms ) )
      
      snew[, stypes[ ms[ wf]]] <- as.matrix( sdata[, stypes[ ms[ wf]]] )
      rownames( snew ) <- rownames( sdata )
      
      # uncensored rows
      scensName <- .replaceString( scens, '_min', '' )
      slo[, scensName] <- as.matrix( sdata[, scens] )
      shi[, scensName] <- as.matrix( sdata[, tcens] )
      rownames( slo ) <- rownames( shi ) <- rownames( sdata )
      
      wnot  <- sort( unique( which( is.na( slo ), arr.ind = TRUE )[, 1] ) )
      wcens <- sort( unique( which( is.na( snew ), arr.ind = TRUE )[, 1] ) )
      
      sinit <- round( ( slo[ wcens, ] + shi[ wcens, ] )/2 )
      sinit[ !is.finite( sinit )] <- slo[ wcens][ !is.finite( sinit )]
      sinit[ !is.finite( sinit )] <- 0
      
      snew[ wcens, ] <- sinit
      
      snew[ is.na( snew )] <- 0
      
      censMin <- cbind( wcens, slo[ wcens, ] )
      censMax <- cbind( wcens, shi[ wcens, ] )
      colnames( censMin )[ 1] <- colnames( censMax )[ 1] <- 'srow'
      censMin[ is.na( censMin )] <- 0
      censMax[ is.na( censMax )] <- censMin[ is.na( censMax )]
      
      colnames( censMin ) <- colnames( censMax ) <- 
        .fixNames( colnames( censMin ), all = TRUE, MODE = 'character', NODASH = F )$fixed
      
      sdata <- cbind( sdata[, scols], snew )
      
      sdata$plot <- .fixNames( sdata$plot, all = TRUE, MODE = 'character' )$fixed
      srr <- columnPaste( sdata$plot, sdata$trap )
      srr <- columnPaste( srr, sdata$year )
      rownames( sdata ) <- srr
      rownames( censMin ) <- rownames( censMax ) <- rownames( sdata )[ wcens]
    }
    
    srow <- which( sdata$active < 1 )
    rrow <- which( is.na( sdata[, seedNames] ), arr.ind = TRUE )
    if( is.matrix( rrow ) )rrow <- rrow[, 1]
    
    srow <- sort( unique( c( srow, rrow ) ) )
    
    if( length( censMin ) > 0 ){
      mm   <- match( rownames( censMin ), rownames( sdata ) )
      srow <- srow[ !srow %in% mm]
    }
    
    nseed <- length( seedNames )
    
    if( length( srow ) > 0 ) { # only if not already in censMin/censMax
      
      # seedNames identified in plotYr
      
      cmin <- sdata[ srow, seedNames, drop = FALSE]
      cmin[ is.na( cmin )] <- 0
      
      sdata[ srow, seedNames] <- cmin
      
      if( length( censMin ) == 0 ){
        censMin <- cmin
        censMax <- cmin*0 + Inf
      }else{
        wnew <- which( !colnames( cmin ) %in% colnames( censMin ) )
        if( length( wnew ) > 0 ){
          newmat <- matrix( 0, nrow( censMin ), length( wnew ) )
          colnames( newmat ) <- colnames( cmin )[ wnew]
          censMin <- cbind( censMin, newmat )
          newmat <- newmat + Inf
          censMax <- cbind( censMax, newmat )
        }
        wnew <- which( !colnames( censMin ) %in% colnames( cmin ) )  
        snn <- seedNames[ seedNames %in% colnames( censMin )]
        cmax <- cmin
        cmax <- cmax + Inf
        
        censMin <- rbind( censMin[, snn, drop = FALSE], cmin[, snn, drop = FALSE] )
        censMax <- rbind( censMax[, snn], drop = FALSE, cmax[, snn, drop = FALSE] )
      }
    }
    sdata$trapID <- columnPaste( sdata$plot, sdata$trap )
  }
  
  plots     <- sort( unique( tdata$plot ) )
  
  if( SEEDDATA ){
    
    tmp <- cleanTreeData( tdata, xytree, specNames )
    tdata     <- tmp$tdata
    xytree    <- tmp$xytree
    specNames <- tmp$specNames
    words     <- paste( words, tmp$words )
    plots     <- sort( unique( tdata$plot ) )
    
    wseed <- which( sdata$plot %in% plots )
    sdata  <- sdata[ wseed, ]
    xytrap <- xytrap[ xytrap$plot %in% plots, ]
    if( !is.null( censMin ) ){
      tmp <- trimCens( sdata, censMin, censMax )
      censMin <- tmp$censMin
      censMax <- tmp$censMax
    }
    
    # check coordinates
    ntt    <- table( xytree$plot )
    utt    <- tapply( xytree$x, xytree$plot, range )
    tplots <- .fixNames( names( utt ) )$fixed
    metersX <- matrix( round( unlist( utt ) ), ncol = 2, byrow = TRUE )
    colnames( metersX ) <- c( 'minX', 'maxX' )
    dx <- apply( metersX, 1, diff )
    
    metersY <- matrix( round( unlist( tapply( xytree$y, xytree$plot, range ) ) ), ncol = 2, 
                       byrow = TRUE )
    colnames( metersY ) <- c( 'minY', 'maxY' )
    dy <- apply( metersY, 1, diff )
    
    ha <- round( apply( metersX, 1, diff )*apply( metersY, 1, diff )/10000, 2 )
    metersX <- cbind( metersX, dx )
    metersY <- cbind( metersY, dy )
    
    
    mmm <- cbind( metersX, metersY )
    rownames( mmm ) <- tplots
    mmm <- cbind( ntt[ tplots], mmm )
    colnames( mmm )[ 1] <- 'trees'
    
    if( verbose ){
      if( max( ha ) > 100 )cat( '\nNote: plot area from xytree > 100 ha? See below:' )
      cat( '\n\nSpatial range for trees on trapped plots ( dx, dy ): \n' )
      print( cbind( mmm ) )
    }
    
  }else{
    
    tdata$plotYr  <- columnPaste( tdata$plot, tdata$year, '_' )
  }
  
  if( TREESONLY ){
    
    wp <- which( !plots %in% rownames( mmm ) )
    
    if( length( wp ) > 0 ){
      
      plt <- plots[ wp]
      ww  <- grep( '.', plt, fixed = T )
      if( length( ww ) > 0 )plt[ ww] <- columnSplit( plt[ ww], '.' )[, 1]
      plt <- unique( plt )
      pw <- paste0( plt, collapse = ', ' )
      pw <- paste( 'Plots without seed traps: ', pw, '.', sep = '' )
      words <- paste( words, pw )
      if( verbose )cat( paste( '\n', pw, '\n', sep = '' ) )
    }
  }
  
  if( SEEDDATA ){
    
    ntt     <- table( xytrap$plot )
    splots  <- names( ntt )
    metersX <- matrix( round( unlist( tapply( xytrap$x, xytrap$plot, range ) ) ), ncol = 2, 
                       byrow = TRUE )
    colnames( metersX ) <- c( 'minX', 'maxX' )
    dx <- apply( metersX, 1, diff )
    
    metersY <- matrix( round( unlist( tapply( xytrap$y, xytrap$plot, range ) ) ), ncol = 2, 
                       byrow = TRUE )
    colnames( metersY ) <- c( 'minY', 'maxY' )
    dy <- apply( metersY, 1, diff )
    
    ha <- round( apply( metersX, 1, diff )*apply( metersY, 1, diff )/10000, 2 )
    metersX <- cbind( metersX, dx )
    metersY <- cbind( metersY, dy )
    
    mmm <- cbind( metersX, metersY )
    
    rownames( mmm ) <- splots
    mmm <- cbind( ntt[ splots], mmm )
    colnames( mmm )[ 1] <- 'traps'
    
    if( verbose ){
      if( max( ha ) > 100 )cat( '\nNote: plot area from xytrap > 100 ha? See below:' )
      cat( '\n\nSpatial range for traps in meters: \n' )
      print( mmm )
      
      if( !is.null( censMin ) ){
        stab <- table( sdata$plot )
        ttab <- matrix( 0, 3, length( stab ) )
        colnames( ttab ) <- names( stab )
        ttab[ 2, ] <- stab
        mm   <- match( rownames( censMin ), rownames( sdata ) )
        ctab <- table( sdata$plot[ mm] )
        ttab[ 1, names( ctab )] <- ctab
        ttab[ 3, ] <- round( ttab[ 1, ]/ttab[ 2, ], 3 )
        rownames( ttab ) <- c( 'censored', 'total', 'fraction' )
        cat( '\n\nCensored seed collections: \n' )
        print( t( ttab ) )
      }
    }
  }
  
  # diameter
  rdiam <- range( tdata$diam, na.rm = TRUE )
  if( rdiam[ 1] <= 0 ){
    ww <- which( tdata$diam <= 0 )
    if( length( ww ) > 0 )tdata <- tdata[ -ww, ]
    kword <- ' Removed diameters <= 0.'
    if( verbose )cat( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
  }
  if( rdiam[ 2] > 800 & verbose )cat( '\nNote: some diameters > 8 m' )
  
  wna <- which( is.na( tdata$diam ) )
  if( length( wna ) > 0 ){
    mm <- paste0( unique( tdata$treeID[ wna] ), collapse = ', ' )
    tdata <- tdata[ -wna, ]
    kword <- paste( ' Removed treeData with missing diam:\n ', mm, sep = '' )
    if( verbose )cat( '\nNote: ', kword, '\n' )
    words <- paste( words, kword )
  }
  
  minDiam <- priorTable[ tdata$species, 'minDiam']
  maxDiam <- priorTable[ tdata$species, 'maxDiam']
  maxFec  <- priorTable[ tdata$species, 'maxFec']
  
  if( is.null( minDiam ) )minDiam <- 5
  if( is.null( maxDiam ) )maxDiam <- 50
  if( is.null( maxFec ) )maxFec <- 1e+6
  
  
  wna <- which( tdata$diam > minDiam )
  if( length( wna ) == 0 ){
    
    mdd <- quantile( tdata$diam, .8, na.rm = T )
    minDiam[ minDiam > mdd] <- mdd
    
   # stop( paste( '\nno trees > minDiam:\n ', minDiam, sep = '' ) )
  }
  
  if( SEEDDATA )xytree <- .trimRows( xytree, tdata, 'treeID' )[[ 1]]
  
  if( 'repr' %in% names( tdata ) ){
    rr <- suppressWarnings( range( tdata$repr, na.rm = TRUE ) )
    
    if( rr[ 1] == 1 & sum( rr, na.rm = TRUE ) == nrow( tdata ) ){
      kword <- ' All trees declared to be reproductive in treeData$repr.'
      warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
      words <- paste( words, kword )
    }
    if( rr[ 2] == 0 & sum( rr, na.rm = TRUE ) == nrow( tdata ) ){
      kword <- ' All trees declared to be immature in treeData$repr.'
      warning( paste( '\nNote: ', kword, '\n', sep = '' ) )
      words <- paste( words, kword )
      tdata$repr[ tdata$diam < minDiam] <- NA
    }
  }
  
  plots <- sort( unique( as.character( tdata$plot ) ) )
  
  EXTEND <- FALSE
  if( EXTEND ){
    for( j in 1:length( plots ) ){
      
      ts <- unique( tdata$year[ as.character( tdata$plot ) == plots[ j]] )
      rs <- ts
      if( SEEDDATA ){
        ss <- unique( sdata$year[ as.character( sdata$plot ) == plots[ j]] )
        rs <- ss
      }
      
      rs <- rs[ rs <= ( max( ts ) + afterLast )]
      rs <- rs[ rs >= ( min( ts ) - beforeFirst )]
      ts <- ts[ ts %in% rs]     # change for tree obs outside seed obs yrs
      
      pyr <- ( min( rs )-p ):( max( rs )+p )
      
      if( SEEDDATA ){
        wj <- which( as.character( sdata$plot ) == plots[ j] & 
                      !sdata$year %in% pyr )
        if( length( wj ) > 0 )sdata <- sdata[ -wj, ]
      }
      wi <- which( as.character( tdata$plot ) == plots[ j] )
      wj <- which( as.character( tdata$plot ) == plots[ j] & !tdata$year %in% pyr )
      
      if( length( wj ) > 0 ){
        if( length( wi ) == length( wj ) ){   #census does not fall in seed trap interval
          yi <- sort( unique( tdata$year[ wj] ) )
          dd <- outer( X = yi, Y = pyr, function( X, Y ) ( X - Y )^2 ) #closest trap yr
          dy <- pyr[ apply( dd, 1, which.min )]
          di <- match( tdata$year[ wj], yi )
          tdata$year[ wj] <- dy[ di]
          wj <- which( as.character( tdata$plot ) == plots[ j] & !tdata$year %in% pyr )
        }
        if( TREESONLY ){
          wc <- which( is.finite( tdata$cropFraction ) )
          wj <- wj[ !wj %in% wc]
        }
        if( length( wj ) > 0 )tdata <- tdata[ -wj, ]
      }
    }
  }
  
  specNames <- sort( unique( tdata$species ) )
  plots     <- sort( unique( as.character( tdata$plot ) ) )
  
  # duplicated tree years
  ty <- with( tdata, table( treeID, year ) )
  treeYr <- columnPaste( tdata$treeID, tdata$year, '_' )
  
  if( max( ty ) > 1 ){
    wm <- which( ty > 1, arr.ind = TRUE )
    cw <- unique( rownames( wm ) )
    cy <- paste0( cw , collapse = ', ' )
    
    wn <- which( !duplicated( treeYr ) )
    tdata <- tdata[ wn, ]
    
    kword <- paste( ' Removed treeData$tree with duplicate years:', cy )
    if( verbose )cat( paste( '\nNote: ', kword, '\n', sep = '' ) )
    words <- paste( words, kword )
    words <- paste( words, kword )
 #   tdata <- tdata[ !as.character( tdata$treeID ) %in% cw, ]
  }
  
  
  # after tdata$year extended by p, beforeFirst, afterLast, 
  # remove traps beyond range( tdata$year ) by plot
  # don't remove tree years between range( tdata$year ), they will be interpolated
  # sdata <- trimPlotYr( tdata, sdata, beforeFirst, afterLast, p )
  
  years <- range( tdata$year ) 
  if( SEEDDATA ){
    tmp <- .trimRows( xytree, tdata, 'treeID' )
    xytree <- tmp$mat1
    words  <- paste( words, tmp$words )
    years <- range( c( years, sdata$year ) )
  }
  years <- min( years ):max( years )
  
  # too rare
  tid     <- tdata[ !duplicated( tdata$treeID ), ]
  specTab <- table( tid$species )
  wna     <- which( specTab < 5 )
  
  if( length( wna ) == length( specNames ) )
    stop( paste( 'All species too rare: ', paste0( names( wna ), collapse = ', ' ), sep = '' ) )
  
  if( length( wna ) > 0 ){               # species too rare
    
    bad   <- names( specTab )[ wna]
    ww    <- which( !tdata$species %in% bad )
    tdata <- tdata[ ww, ]
    
    tmp <- .trimRows( xytree, tdata, 'treeID' )
    xytree <- tmp[[ 1]]
    words  <- paste( words, tmp[[ 2]] )
    
    rn     <- paste0( names( specTab )[ wna], collapse = ', ' )
    specNames <- specNames[ !specNames %in% names( specTab )[ wna]]
    nspec  <- length( specNames )
    
    if( nchar( rn ) > 1 & verbose ){
      cat( '\nNote: too rare, removed:\n' )
      print( rn )
    }
    
    if( SEEDDATA ){
      
      wukn <- grep( 'UNKN', bad )   # do not remove UNKN type
      if( length( wukn ) > 0 )bad <- bad[ -wukn]
      
      badFruit <- which( colnames( sdata ) %in% paste( bad, 'fruit', sep = '' ) )
      badCones <- which( colnames( sdata ) %in% paste( bad, 'cones', sep = '' ) )
      
      bad <- c( bad, colnames( sdata )[ c( badFruit, badCones )] )
      
      wz <- which( bad %in% colnames( sdata ) )
      if( length( wz ) > 0 ){
        for( b in wz ){
          wb <- which( colnames( sdata ) == bad[ b] )
          sdata <- sdata[, -wb]
          if( SEEDCENSOR ){
            wb <- which( colnames( censMin ) == bad[ b] )
            censMin <- censMin[, -wb, drop = FALSE]
            censMax <- censMax[, -wb, drop = FALSE]
          }
        }
        seedNames <- seedNames[ !seedNames %in% bad]
      }
    }
    
    ptab <- table( tdata$plot )
    w0   <- which( ptab == 0 )
    
    if( length( w0 ) > 0 ){
      pmiss <- names( ptab )[ w0]
      wm <- which( as.character( xytree$plot ) %in% pmiss )
      if( length( wm ) > 0 )xytree <- xytree[ -wm, ]
      
      if( SEEDDATA ){
        wm <- which( as.character( sdata$plot ) %in% pmiss )
        if( length( wm ) > 0 )sdata <- sdata[ -wm, ]
        
        wm <- which( as.character( xytrap$plot ) %in% pmiss )
        if( length( wm ) > 0 )xytrap <- xytrap[ -wm, ]
      }
      plots  <- plots[ !plots %in% pmiss]
    }
  }
  
  # remove plots where there are no trees
  plotRm <- character( 0 )
  
  for( j in plots ){
    t2 <- which( as.character( tdata$plot ) == j )
    if( length( t2 ) == 0 ){
      plotRm <- c( plotRm, j )
      next
    }
  }
  
  if( length( plotRm ) > 0 ){
    plots  <- plots[ !plots %in% plotRm]
    wr     <- which( tdata$plot %in% plotRm )
    if( length( wr ) > 0 )tdata  <- tdata[ -wr, ]
    wr     <- which( xytree$plot %in% plotRm )
    if( length( wr ) > 0 )xytree  <- xytree[ -wr, ]
    if( SEEDDATA ){
      wr     <- which( sdata$plot %in% plotRm )
      if( length( wr ) > 0 )sdata  <- sdata[ -wr, ]
      wr     <- which( xytrap$plot %in% plotRm )
      if( length( wr ) > 0 )xytrap <- xytrap[ -wr, ]
    }
  }
  
  # retain trees in plot-years that have seed traps
  
  plotYears <- sort( unique( as.character( tdata$plotYr ) ) )
  
  if( SEEDDATA ){
    sdata        <- sdata[ sdata$plot %in% plots, ]
    sdata$plotYr <- columnPaste( sdata$plot, sdata$year, '_' )
    xytrap       <- xytrap[ xytrap$plot %in% plots, ]
    plotYears <- sort( unique( c( as.character( sdata$plotYr ), 
                               as.character( tdata$plotYr ) ) ) )
    sdata$plotyr <- match( sdata$plotYr, plotYears )
    
    if( !is.null( censMin ) ){
      tmp <- trimCens( sdata, censMin, censMax )
      censMin <- tmp$censMin
      censMax <- tmp$censMax
    }
  }
  
  
  tdata$plotyr <- match( tdata$plotYr, plotYears )
  specNames    <- sort( unique( as.character( tdata$species ) ) )
  plots        <- sort( unique( as.character( tdata$plot ) ) )
  
  # seedNames, specNames
  
  if( SEEDDATA ){
    
    xytree    <- xytree[ xytree$treeID %in% tdata$treeID, ]
    
    gg <- grep( 'UNKN', seedNames )
    
    if( length( gg ) > 0 ){
      kword <- paste0( 'The unknown seed type is ', seedNames[ gg], '.', sep = ' ' )
      if( verbose )cat( paste( '\nNote: ', kword, '\n', sep = '' ) )
      words <- paste( words, kword )
    }
    if( length( gg ) > 1 )
      stop( 'Only one seedName can have "UNKN" in name' )
    
    ww <- which( !specNames %in% seedNames )
    if( length( ww ) > 0 ){
      if( length( gg ) == 0 ){
        kword <- ' There is no "UNKN" in seedNames'
        if( verbose )cat( '\nNote: ', kword, '\n' )
        words <- paste( words, kword )
      }
    }
    
    ww <- which( !seedNames %in% specNames ) ##########################################
    
    if( length( ww ) > 0 ){
      
      wg <- which( !ww %in% gg )
      
      if( length( wg ) > 0 ){
        
        missName <- seedNames[ ww[ wg]]
        mname    <- paste0( missName, collapse = ', ' )
        kword <- paste( ' seedNames that are not in specNames and not "UNKN":\n', mname )
        
        if( verbose )cat( paste( '\n', kword, '\n', sep = '' ) )
        words <- paste( words, kword, '.', sep = '' )
        
        # appended specName
        ispec <- character( 0 )
        for( i in 1:length( specNames ) ){
          iss <- grep( specNames[ i], missName )
          if( length( iss ) > 0 )ispec <- c( ispec, specNames[ i] )
        }
        
        # if not, add to UNKN class
        mcol <- grep( missName[ 1], colnames( sdata ) )
        
        if( length( gg ) > 0 ){   # there is an UNKN type
          if( length( mcol ) > 0 & length( ispec ) == 0 ){
            if( length( missName ) > 1 ){
              for( k in 1:length( missName ) ){
                mcol <- c( mcol, grep( missName[ k], colnames( sdata ) ) )
              }
            }
            mcol <- unique( mcol )
            
            smc <- sdata[, mcol]
            if( length( mcol ) > 1 )smc <- rowSums( smc, na.rm = TRUE )
            
            sdata[, seedNames[ gg]] <- sdata[, seedNames[ gg]] + smc
            sdata <- sdata[, -mcol]
            missName <- paste0( missName, collapse = ", " )
            kword <- paste( ' Moved ', missName, ' to "UNKN" class.', 
                            sep = '' )
            if( verbose )cat( paste( '\n', kword, '\n', sep = '', fixed = T ) )
            words <- paste( words, kword )
          }
        }else{
          sdata <- sdata[, -mcol]  #there is no UNKN type
          #     seedNames <- seedNames[ !seedNames %in% missName]
        }
        
        if( length( ispec ) == 0 )seedNames <- seedNames[ -ww[ wg]]
      }
    }
    sdata  <- sdata[ order( sdata$plot, sdata$trap, sdata$year ), ]
    xytrap <- xytrap[ order( xytrap$plot, xytrap$trap ), ]
    
    if( SEEDCENSOR | length( censMin ) > 0 ){
      
      tmp <- trimCens( sdata, censMin, censMax )
      censMin <- tmp$censMin
      censMax <- tmp$censMax
      
      wc <- which( colnames( censMin ) %in% colnames( sdata ) )
      censMin <- censMin[, wc, drop = FALSE]
      censMax <- censMax[, wc, drop = FALSE]
    }
  }
  
  if( is.null( tdata$obs ) )tdata$obs <- 1
  

  inputs$treeData  <- tdata
  inputs$specNames <- specNames
  inputs$plotInput <- plotInput
  inputs$inwords   <- words
  inputs$TREESONLY <- TREESONLY
  
  if( SEEDDATA ){
    inputs$xytrap    <- xytrap
    inputs$seedNames <- seedNames
    inputs$seedData  <- sdata
    inputs$xytree    <- xytree
    inputs$censMin <- censMin
    inputs$censMax <- censMax
  }

  inputs
}

trimCens <- function( sdata, censMin, censMax ){
  
  mm <- match( rownames( censMin ), rownames( sdata ) )
  wf <- which( is.finite( mm ) )
  censMin <- censMin[ drop = FALSE, wf, ]
  censMax <- censMax[ drop = FALSE, wf, ]
  list( censMin = censMin, censMax = censMax )
}

trimPlotYr <- function( tdata, sdata, beforeFirst, afterLast, p ){
  
  tmp  <- table( tdata$plot, tdata$year )
  
  tmp[ tmp > 1] <- 1
  tmat <- tmp*matrix( as.numeric( colnames( tmp ) ), nrow( tmp ), ncol( tmp ), byrow = TRUE )
  tmat[ tmat == 0] <- NA
  mm   <- apply( tmp*tmat, 1, range, na.rm = TRUE )
  
  mm[ 1, ] <- mm[ 1, ] - max( c( beforeFirst, p ) )
  mm[ 2, ] <- mm[ 2, ] + max( c( afterLast, p ) )
  ty   <- character( 0 )
  for( j in 1:ncol( mm ) ){
    jy <- paste( colnames( mm )[ j], mm[ 1, j]:mm[ 2, j], sep = '_' )
    ty <- c( ty, jy )
  }
  ww <- which( !sdata$plotYr %in% ty )
  if( length( ww ) > 0 ){
    sdata <- sdata[ -ww, ]
  }
  sdata
}


addObsTrap <- function( tdata, sdata ){
  
  plots <- sort( unique( tdata$plot ) )
  nplot <- length( plots )
  obsTrap <- rep( 0, nrow( tdata ) )
  
  for( j in 1:nplot ){
    wj  <- which( as.character( sdata$plot ) == plots[ j] )
    if( length( wj ) == 0 )next
    sjj <- sdata[ wj, ]
    pyr <- min( sjj$year ):max( sjj$year )
    wtt <- which( as.character( tdata$plot ) == plots[ j] & 
                   tdata$year %in% pyr )
    obsTrap[ wtt] <- 1
  }
  obsTrap
}

mastFillCensus <- function( inputs, beforeFirst = 15, 
                           afterLast = 15, p = 0, verbose = FALSE ){
  
  # fill census with seed trap years, interpolated diameter
  # beforeFirst - assumed present for no. of years before tree first observed
  # afterLast   - no. yr after last observed
  # p       - if AR( p > 0 ) model, fills p yr before and after tree observed
  
  words <- character( 0 )
  SEEDCENSOR <- TREESONLY <- FILLED <- FALSE
  SEEDDATA   <- TRUE
  if( !'seedData' %in% names( inputs ) )SEEDDATA <- FALSE
  priorTable <- NULL
  cropCols <- c( 'cropCount', 'fecMin', 'fecMax', 'cropMin', 'cropMax' )
  
  if( 'FILLED' %in% names( inputs ) )return( inputs )
  
  AR <- FALSE
  if( p > 0 ){
    AR <- TRUE
    kword <- paste( ' This is an AR( ', p, ' ) model. ', sep = '' )
    words <- paste( words, kword )
    if( verbose )cat( '\n', kword, '\n' )
  }
  
  inputs$treeData$year <- factor2integer( inputs$treeData$year )
  inputs$treeData$plot <- .fixNames( inputs$treeData$plot, all = TRUE, 'character' )$fixed
  
  ss <- tapply( inputs$treeData$year, 
               list( plot = inputs$treeData$plot ), range, na.rm = TRUE )
  sn <- names( ss )
  censusYr <- matrix( unlist( ss ), ncol = 2, byrow = TRUE )
  rownames( censusYr ) <- sn
  
  if( SEEDDATA ){
    inputs$seedData$year <- factor2integer( inputs$seedData$year )
    inputs$seedData$plot <- .fixNames( inputs$seedData$plot, all = TRUE, 'character' )$fixed
    ss <- tapply( inputs$seedData$year, 
                 list( plot = inputs$seedData$plot ), range )
    sn <- names( ss )
    trapYr <- matrix( unlist( ss ), ncol = 2, byrow = TRUE )
    rownames( trapYr ) <- sn
  }
  
  inputs    <- cleanInputs( inputs, beforeFirst, afterLast, p, verbose = verbose )
  specNames <- inputs$specNames
  seedNames <- inputs$seedNames  
  tdata     <- inputs$treeData   
  sdata     <- inputs$seedData  
  xytree    <- inputs$xytree     
  xytrap    <- inputs$xytrap
  censMin   <- inputs$censMin
  censMax   <- inputs$censMax
  words     <- c( words, inputs$inwords )
  TREESONLY <- inputs$TREESONLY
  rownames( tdata ) <- columnPaste( tdata$treeID, tdata$year, '_' )
  
  # rare species removed in cleanInputs, 
  #    now determine if there are still cropCounts/cropMin
  if( 'cropCount' %in% colnames( tdata ) ){
    rc <- suppressWarnings( max( tdata$cropCount, na.rm = T ) )
    if( rc < 0 ){
      CONES <- FALSE
      tdata <- tdata[, !colnames( tdata ) %in% 
                       c( 'cropCount', 'cropFraction', 'cropFractionSd' )]
    }
    rc <- suppressWarnings( max( tdata$cropMin, na.rm = T ) )
    if( rc < 0 ){
      CONES <- FALSE
      tdata <- tdata[, !colnames( tdata ) %in% 
                       c( 'cropMin', 'cropMax' )]
    }
  }
  
  if( !is.null( censMin ) )SEEDCENSOR <- TRUE
  
  years   <- range( tdata$year[ tdata$obs == 1] )  
  plots   <- sort( unique( as.character( tdata$plot ) ) )
  nplot   <- length( plots )
  nyr     <- length( years )
  
  if( SEEDDATA ){
    # traps without tree data
    kk    <- which( sdata$plot %in% tdata$plot )
    sdata <- sdata[ kk, ]
    wxy   <- which( xytrap$plot %in% sdata$plot )
    
    if( length( wxy ) < nrow( xytrap ) ){
      mxy <- paste0( unique( xytrap$plot[ -wxy] ), collapse = ', ' )
      cat( '\nMissing xytrap for these plots:\n' )
      print( mxy )
    }
      
    xytrap <- xytrap[ xytrap$plot %in% sdata$plot, ]
    
    sdata$obs     <- 1
    tdata$obsTrap <- addObsTrap( tdata, sdata )
    years   <- range( c( years, sdata$year ) )
    trapIDs <- sort( unique( as.character( sdata$trapID ) ) )
  }
  
  
  years <- years[ 1]:years[ 2]
  allYears <- ( min( years ) - p ):( max( years ) + p )
  
  rownames( tdata ) <- columnPaste( tdata$treeID, tdata$year, sep = '_' )
  
  vtypes <- getVarType( colnames( tdata ), tdata, i = tdata$treeID, j = tdata$year )
  
  if( 'repr' %in% names( tdata ) )vtypes$repr = 'ij'
  if( 'repMu' %in% names( tdata ) )vtypes$repMu = 'ij'
  if( 'repSd' %in% names( tdata ) )vtypes$repSd = 'ij'
  if( 'province' %in% names( tdata ) )vtypes$province = 'i'
  
  
  fecMin <- fecMax <- cropMin <- cropMax <- NULL
  
  
  if( 'cropMin' %in% names( tdata ) ){ # if censored classes, then fecMin, fecMax already provided
    vtypes$cropMin = 'ij'
    cropMin <- tdata$cropMin
    names( cropMin ) <- rownames( tdata )
    
    wcrop <- which( is.finite( cropMin ) )
    if( !'fecMin' %in% colnames( tdata ) ){
      tdata$fecMin <- NA
    }
    mcrop <- which( !is.finite( tdata$fecMin[ wcrop] ) )
    
    if( 'seedTraits' %in% names( inputs ) & length( mcrop ) > 0 ){  
      fecMin <- tdata$cropMin[ wcrop]*inputs$seedTraits[ tdata$species[ wcrop], 'seedsPerFruit']
      tdata$fecMin[ wcrop[ mcrop]] <- fecMin[ mcrop]
      names( fecMin ) <- rownames( tdata )
      if( verbose )cat( paste( '\nNote: cropMin values without fecMin--used seedsPerFruit\n' ) )
    }
  }
  if( 'cropMax' %in% names( tdata ) ){
    vtypes$cropMax = 'ij'
    cropMax <- tdata$cropMax
    names( cropMax ) <- rownames( tdata )
    
    wcrop <- which( is.finite( cropMax ) )
    if( !'fecMax' %in% colnames( tdata ) ){
      tdata$fecMax <- NA
    }
    mcrop <- which( !is.finite( tdata$fecMax[ wcrop] ) )
    
    if( 'seedTraits' %in% names( inputs ) & length( mcrop ) > 0 ){
      fecMax <- tdata$cropMax*inputs$seedTraits[ tdata$species, 'seedsPerFruit']
      fecMax[ fecMax < 1] <- 1
      tdata$fecMax[ wcrop[ mcrop]] <- fecMax[ mcrop]
      tdata$fecMax <- fecMax
      names( fecMax ) <- rownames( tdata )
      if( verbose )cat( paste( '\nNote: cropMax values without fecMax--used seedsPerFruit\n' ) )
    }
  }
  
  if( 'priorTable' %in% names( inputs ) ){
    if( 'fecMax' %in% colnames( priorTable ) ){
      mf <- inputs$priorTable[ tdata$species, 'maxFec']
      tdata$fecMax[ tdata$fecMax > mf] <- mf[ tdata$fecMax > mf]
    }
  }
  if( 'fecMax' %in% colnames( tdata ) ){
    vtypes$fecMax = 'ij'
    fecMax <- tdata$fecMax
    names( fecMax ) <- rownames( tdata )
  }
  
  wnull <- which( is.null( vtypes ) )
  if( length( wnull ) > 0 ){
    for( k in 1:length( wnull ) ) vtypes[[ k]] <- 'ij'
  }
  
  
  
  ############## year range by tree
  
  treeID  <- columnPaste( tdata$plot, tdata$tree )
  treeIDs <- unique( treeID )
  
  # tree census range
  yminD <- tapply( tdata$year, treeID, min )[ treeIDs]
  ymaxD <- tapply( tdata$year, treeID, max )[ treeIDs]
  
  if( 'firstYr' %in% colnames( tdata ) ){
    mm <- match( names( yminD ), treeID )
    fy <- tdata$firstYr[ mm]
    yminD[ is.finite( fy )] <- fy[ is.finite( fy )]
  }
  if( 'lastYr' %in% colnames( tdata ) ){
    mm <- match( names( ymaxD ), treeID )
    fy <- tdata$lastYr[ mm]
    ymaxD[ is.finite( fy )] <- fy[ is.finite( fy )]
  }
  
  yplot <- tdata$plot[ match( names( yminD ), treeID )] # plot for each row of yminD
  
  # plot range by tree
  yminP <- tapply( tdata$year, tdata$plot, min )[ yplot]
  ymaxP <- tapply( tdata$year, tdata$plot, max )[ yplot]
  
  # death during inventory: 
#  deathYr <- ymaxD[ ymaxD < ymaxP]

  
  
  # years extended to crop counts
  yminC <- yminD + Inf
  ymaxC <- ymaxD - Inf
  tcrop <- as.matrix( tdata[, colnames( tdata ) %in% cropCols, drop = F] )
  if( length( tcrop ) > 0 ){
    tcrop[ is.finite( tcrop )] <- 1
    wc <- rowSums( tcrop, na.rm = T )
    wc <- which( wc > 0 )
    if( length( wc ) > 0 ){
      yminC <- tapply( tdata$year[ wc], treeID[ wc], min )[ treeIDs]
      ymaxC <- tapply( tdata$year[ wc], treeID[ wc], max )[ treeIDs]
    }
    names( yminC ) <- names( ymaxC ) <- treeIDs
  }
  
  # seed traps extend years
  yminS <- yminD + Inf
  ymaxS <- ymaxD - Inf
  
  if( SEEDDATA ){
    yminS  <- tapply( sdata$year, sdata$plot, min )[ yplot]
    ymaxS  <- tapply( sdata$year, sdata$plot, max )[ yplot]
    names( yminS ) <- names( ymaxS ) <- treeIDs
    
    yminS[ is.na( yminS )] <- Inf
    ymaxS[ is.na( ymaxS )] <- -Inf
  }
  
  # beyond seed traps for crop counts
  yrMin <- apply( cbind( yminS, yminC ), 1, min, na.rm = T ) - p   # first crop or trap
  yrMax <- apply( cbind( ymaxS, ymaxC ), 1, max, na.rm = T ) + p   # last crop or trap
  
  #died before end
  wd <- which( ( ymaxP - ymaxD ) > 10 )
  yrMax[ wd] <- ymaxD[ wd] + 1
  
  # ingrowth
  wd <- which( ( yminD - yminP ) > 8 )
  yrMin[ wd] <- yminD[ wd] - 1
  
  
 # yrMax[ names( deathYr )] <- deathYr
  
  yrSeq <- min( yrMin ):max( yrMax )
  nyr   <- length( yrSeq )
  ntree <- length( treeIDs )
  
  mhi <- matrix( 0 , ntree, nyr )
  rownames( mhi ) <- treeIDs
  colnames( mhi ) <- yrSeq
  mlo <- mhi
  tindex <- match( treeID, treeIDs )
  yindex <- match( yrMin, yrSeq )
  mlo[ cbind( 1:ntree, yindex )] <- 1
  mlo <- t( apply( t( mlo ), 2, cumsum ) )
  
  yindex <- match( yrMax, yrSeq )
  mhi[ cbind( 1:ntree, yindex )] <- 1
  mhi <- t( apply( t( mhi[, nyr:1] ), 2, cumsum ) )
  mhi <- mhi[, colnames( mlo )]*mlo
  
  allYears <- yrSeq
  
  ijIndex <- which( mhi == 1, arr.ind = T )
  
  tdata$treeID <- treeID
  
  
  ijFull <- which( mhi > 0, arr.ind = T )
  
  tdata$times <- match( tdata$year, allYears )
  if( SEEDDATA )sdata$times <- match( sdata$year, allYears )
  
  vtypes    <- getVarType( colnames( tdata ), tdata, i = tdata$treeID, j = tdata$year ) 
  vtypes$obs   <- 'ij'
  #  vtypes$times <- 'j'
  vtypes$diam  <- 'ij'
  vtypes$repr  <- 'ij'
  vtypes$obs   <- 'ij'
  vtypes$year  <- 'time'
  vtypes$species <- 'i'
  if( 'cropCount' %in% colnames( data ) )vtypes$cropCount <- 'none'
  if( 'cropFraction' %in% colnames( data ) )vtypes$cropFraction <- 'none'
  if( 'cropFractionSd' %in% colnames( data ) )vtypes$cropFractionSd <- 'none'
  if( 'fecMin' %in% colnames( data ) )vtypes$fecMin <- 'none'
  if( 'fecMax' %in% colnames( data ) )vtypes$fecMax <- 'none'
  
  # jtimes <- 1:nyr
  
  tmp <- fillMissing( variables = vtypes, data = tdata, icol = 'treeID', jcol = 'year', 
                     jtimes = allYears, ijFull = ijFull )
  data <- tmp$data
  
  # data$year <- allYears[ data$times]
  data$plot      <- as.character( data$plot )
  data$tree      <- as.character( data$tree )
  rnames         <- columnPaste( data$treeID, data$year, '_' )
  rownames( data ) <- rnames
  data$diam      <- round( data$diam, 1 )
  
  if( 'province' %in% colnames( data ) ){
    ptab <- table( data$province, data$plot )
    wtab <- which( ptab > 0, arr.ind = TRUE )
    wtab <- cbind( rownames( ptab )[ wtab[, 1]], colnames( ptab )[ wtab[, 2]] )
    mm   <- match( data$plot, wtab[, 2] )
    data$province <- wtab[ mm, 1]
  }
  
  data$treeID <- as.character( data$treeID )
  rownames( data ) <- columnPaste( data$treeID, data$year, '_' )
  
  
  wm <- match( rownames( data ), rownames( tdata ) )
  wf <- which( is.finite( wm ) )
  
  data$repr <- NA
  if( 'repr' %in% colnames( tdata ) )data$repr[ wf] <- tdata$repr[ wm[ wf]]
  
  tid <- unique( data$treeID )
  yrs <- range( data$year )
  yrs <- yrs[ 1]:yrs[ 2]
  
  rmat <- matrix( 0, length( tid ), length( yrs ) )
  rmat[ cbind( match( data$treeID, tid ), match( data$year, yrs ) )] <- data$repr
  rmat[ is.na( rmat )] <- 0
  cmat <- t( apply( rmat, 1, cumsum ) )  # observed mature
  
  rmat <- matrix( NA, length( tid ), length( yrs ) )
  rmat[ cbind( match( data$treeID, tid ), match( data$year, yrs ) )] <- 1 - data$repr
  rmat[ rmat == 1] <- 100
  rmat[ rmat == 0] <- -1
  rmat[ is.na( rmat )] <- -1
  imat <- t( apply( rmat, 1, cumsum ) )
  imat[ imat[, ncol( imat )] == -ncol( imat ), ] <- NA
  imat[ imat > 0] <- 0
  imat[ imat < 0] <- 1
  
  cmat[ cmat == 0 & is.na( imat )] <- NA
  cmat[ cmat == 0 & imat == 0] <- NA
  cmat[ imat == 1] <- 0
  
  data$repr <- cmat[ cbind( match( data$treeID, tid ), match( data$year, yrs ) )]
  data$repMu <- data$repr
  data$repMu[ is.na( data$repr )] <- .5
  data$repSd <- .5
  data$repSd[ data$repr %in% c( 0, 1 )] <- .01
  
  
  
  if( 'cropCount' %in% colnames( data ) ){
    
    data$cropCount <- data$cropFraction <- data$cropFractionSd <- NA
    
    data$cropCount[ wf]    <- ceiling( tdata$cropCount[ wm[ wf]] )
    if( 'cropFraction' %in% colnames( tdata ) )data$cropFraction[ wf] <- tdata$cropFraction[ wm[ wf]]
    
    if( !'cropFractionSd' %in% colnames( data ) )data$cropFractionSd <- NA
    
    if( 'cropFractionSd' %in% colnames( tdata ) ){
      data$cropFractionSd[ wf] <- tdata$cropFractionSd[ wm[ wf]]
    }
    wmm <- which( is.na( data$cropFractionSd ) & !is.na( data$cropFraction ) )
    if( length( wmm ) > 0 ){
      data$cropFractionSd[ wmm] <- .2*dbeta( data$cropFraction[ wmm], .1, 2 ) + 1e-3
    }
    data$repr[ data$cropCount > 0] <- 1
  }
  
  tdata        <- data
  tdata$obs    <- as.numeric( as.character( tdata$obs ) )
  tdata$obs[ is.na( tdata$obs )] <- 0
  tdata$plotYr <- columnPaste( tdata$plot, tdata$year, '_' ) 
  tdata$treeID <- as.character( tdata$treeID )
  
  if( SEEDDATA ){
    xytree <- .trimRows( xytree, tdata, 'treeID' )[[ 1]]   # trees having too few years
    
    ss <- tapply( sdata$year, list( plot = sdata$plot ), range )    
    sn <- names( ss )
    trapYr <- matrix( unlist( ss ), ncol = 2, byrow = TRUE )
    rownames( trapYr ) <- sn
    
    tdata$obsTrap <- tdata$obs <- 0
    for( j in 1:nplot ){
      kj <- as.character( tdata$plot ) == plots[ j]
      wj <- which( kj )
      if( !plots[ j] %in% rownames( trapYr ) )next
      yr <- ( trapYr[ plots[ j], 1] ):( trapYr[ plots[ j], 2] )
      tdata$obsTrap[ wj] <- 0
      tdata$obsTrap[ kj & ( tdata$year %in% yr )] <- 1
      tdata$obs[ kj & ( tdata$year %in% yr )] <- 1
    }
    sdata <- trimPlotYr( tdata, sdata, beforeFirst, afterLast, p )
  }
  
  tdata$obs[ is.finite( tdata$cropFraction )] <- 1
  tdata$obs[ is.finite( tdata$cropMin )] <- 1
  
  if( SEEDCENSOR ){
    tmp <- trimCens( sdata, censMin, censMax )
    censMin <- tmp$censMin
    censMax <- tmp$censMax
  }
  
  
  # keep treeYr in trap years or with cropCounts#########################################
  #  wkeep <- rep( TRUE, nrow( tdata ) )
  #  if( SEEDDATA )wkeep <- tdata$plotYr %in% sdata$plotYr
  #  if( 'cropCount' %in% colnames( tdata ) | 'cropMin' %in% colnames( tdata ) ){
  #    fkeep <- is.finite( tdata$cropCount ) 
  #    wkeep <- wkeep | fkeep
  #  }
  #  wkeep <- which( wkeep )
  #  tdata <- tdata[ wkeep, ]
  
  plots <- sort( unique( tdata$plot ) )
  tdata <- tdata[ order( tdata$treeID, tdata$year ), ]
  
  
  plotYears <- sort( unique( c( as.character( tdata$plotYr ), 
                             as.character( sdata$plotYr ) ) ) )
  tdata$plotyr <- match( as.character( tdata$plotYr ), plotYears )
  if( SEEDDATA )sdata$plotyr <- match( as.character( sdata$plotYr ), plotYears )
  
  rownames( tdata ) <- columnPaste( tdata$treeID, tdata$year, '_' )
  
  if( !'repr' %in% colnames( tdata ) )tdata$repr <- NA
  
  if( 'fecMin' %in% names( tdata ) & !is.null( fecMin ) ){
    wm <- match( names( fecMin ), rownames( tdata ) )
    wf <- which( is.finite( wm ) )
    tdata$fecMin <- NA
    tdata$fecMin[ wm[ wf]] <- fecMin[ wf]
  }
  if( 'fecMax' %in% names( tdata ) & !is.null( fecMax ) ){
    wm <- match( names( fecMax ), rownames( tdata ) )
    wf <- which( is.finite( wm ) )
    tdata$fecMax <- NA
    tdata$fecMax[ wm[ wf]] <- fecMax[ wf]
  }
  if( 'cropMin' %in% names( tdata ) ){
    wm <- match( names( cropMin ), rownames( tdata ) )
    wf <- which( is.finite( wm ) )
    tdata$cropMin <- NA
    tdata$cropMin[ wm[ wf]] <- cropMin[ wf]
    tdata$repr[ tdata$cropMin > 0] <- 1
  }
  if( 'cropMax' %in% names( tdata ) ){
    wm <- match( names( cropMax ), rownames( tdata ) )
    wf <- which( is.finite( wm ) )
    tdata$cropMax <- NA
    tdata$cropMax[ wm[ wf]] <- cropMax[ wf]
    tdata$repr[ tdata$cropMax > 0] <- 1
  }

allYears <- sort( unique( tdata$year ) )

tdata$times <- match( tdata$year, allYears )
sdata$times <- match( sdata$year, allYears )

if( TREESONLY & SEEDDATA ){
  ww <- which( !tdata$plot %in% sdata$plot )
  if( length( ww ) > 0 ){
    tdata <- rbind( tdata[ -ww, ], tdata[ ww, ] )
  }
}

attr( tdata, 'plag' ) <- p

inputs$treeData  <- tdata
inputs$xytree    <- xytree
inputs$specNames <- specNames
inputs$inwords   <- words
inputs$TREESONLY <- TREESONLY

if( SEEDDATA ){
  inputs$seedData  <- sdata
  inputs$xytrap    <- xytrap
  inputs$seedNames <- seedNames
  inputs$censMin   <- censMin
  inputs$censMax   <- censMax
}

inputs$FILLED <- T

inputs
}

vec2mat <- function( xx, ROW = FALSE ){
  
  #if( ROW ) make row vector
  
  if( is.matrix( xx ) )return( xx )
  
  cc <- names( xx )
  xx <- matrix( xx )
  rownames( xx ) <- cc
  if( !ROW )xx <- t( xx )
  xx
}

.cleanRows <- function( xmat, xcol, STOP = FALSE, verbose = FALSE ){
  
  ww <- which( duplicated( xmat[, xcol] ) )
  if( length( ww ) == 0 )return( xmat )
  
  if( STOP )stop( paste( 'duplicates in', xcol ) )
  
  tvec <- xmat[ ww, xcol]
  if( length( ww ) > 1 )tvec <- paste0( tvec, collapse = ', ' )
  
  if( verbose )cat( paste( '\nNote: removed duplicates in', xcol, ':\n', tvec ) )
  
  xmat[ -ww, ]
}

HMC <- function ( ff, fMin, fMax, ep, L, tree, sdat, ug, 
                 mu, sg, zz, R, SAMPR, distance, 
                 obsTrapRows, obsYr, seedNames, USPEC ){
  
  #Hamiltonian Markov chain update
  
  getU <- function( q, U = TRUE ){   # yq = log( fec )
    
    # for Hamiltonian
    nseed <- ncol( R )
    fq <- exp( q )
    
    ww <- which( fq > fMax )
    vv <- which( fq < fMin )
    
    fq[ ww] <- fMax[ ww]
    fq[ vv] <- fMin[ vv]
    
    
    if( SAMPR | nseed > 1 ){
      fq <- matrix( fq, length( fq ), ncol = ncol( R ) )*R[ drop = FALSE, tree$specPlot, ]
    }else{
      fq <- matrix( fq, ncol = 1 )
    }
    
    uvec <- ug[ 1]
    
    if( USPEC ){
      uvec <- matrix( ug[ attr( distance, 'species' )], nrow( distance ), ncol( distance ) )
    }
    
    dmat <- uvec/pi/( uvec + distance^2 )^2
    dmat[ dmat < 1e-8] <- 0
    dmat[ is.na( dmat )] <- 0
    
    
    plotyrs <- unique( sdat$plotyr )
    
    lambda <- kernYrRcpp( dmat, fq*zz, seedrow = sdat$drow, 
                         treecol = tree$dcol, plotyrs, 
                         treeplotYr = tree[, 'plotyr'], seedplotYr = sdat[, 'plotyr'] )
    ss <- as.matrix( sdat[, seedNames] )
    lambda[ lambda < 1e-6] <- 1e-6
    
    if( U ){
      mmat  <- matrix( 0, max( sdat$plotyr ), 1 )
      sprob <- -ss*log( lambda ) + activeArea*lambda
      ii    <- rep( sdat$plotyr, nseed )
      tmp   <- .myBy( as.vector( sprob ), ii, ii*0+1, summat = mmat, fun = 'sum' )
      tprob <- 1/sg*( q - mu )^2 + tmp[ tree$plotyr]
      
      return( tprob ) 
    }
    
    kmat <- dmat[ sdat$drow, tree$dcol]
    smat <- -ss/lambda + activeArea
    
    if( nseed == 1 ){
      svec <- ff*colSums( kmat*as.vector( smat ) )
    }else{
      svec <- rep( 0, length( q ) )
      for( m in 1:nseed ){
        sv <-  colSums( kmat*as.vector( smat[, m] ) )*fq[, m]
        svec <- svec + sv
      }
    }
    svec + ( q - mu )/sg
  }
  
  q <- log( ff )
  p <- currentP <- rnorm( length( q ) ) 
  
  activeArea <- sdat$area
  
  # half step for momentum 
  
  p <- p - ep*getU( q, U = FALSE )/2
  
  
  # Alternate full steps for position and momentum
  wall <- 1:length( q )
  
  for ( i in 1:L ){
    
    q[ wall] <- q[ wall] + ep[ wall]*p[ wall]  
    
    if( i < L )p[ wall] <- p[ wall] - ep[ wall]*getU( q, U = FALSE )[ wall] 
    wall <- which( q < log( fMax ) )
  }
  
  # half step for momentum end
  p <- p - ep*getU( q, U = FALSE )/2
  
  # Negate momentum at end of trajectory to make proposal symmetric
  p <- -p
  
  # Evaluate potential and kinetic energies at start and end of trajectory
  currentU  <- getU( log( ff ), U = TRUE ) 
  proposedU <- getU( q, U = TRUE )
  currentK  <- currentP^2/2 
  proposedK <- p^2/2
  
  # Accept or reject the state at end of trajectory, returning either 
  # the position at the end of the trajectory or the initial position
  sp <- currentU - proposedU + currentK - proposedK
  ii <- tree$plotyr
  
  pnow <- .myBy( sp*zz, ii, ii*0 + 1, fun = 'sum' )
  
  a <- exp( pnow )
  wa <- which( runif( length( a ) ) < a )
  
  if( length( wa ) > 0 ){
    wt <- which( tree$plotyr %in% wa & zz == 1 )
    ff[ wt] <- exp( q[ wt] )
    ep[ wt] <- ep[ wt]*1.1
    ep[ -wt] <- ep[ -wt]*.9
  }else{
    ep <- ep*.9
  }
  
  list( fg = ff, epsilon = ep, accept = length( wa ) )
}

msarLagTemplate <- function( plag, data, icol, jcol, gcol, ocol, yeGr, verbose = FALSE ){
  
  # index for sampling betaYr
  # data - data.frame created by msarSetup
  # icol - individual column ( integer or name )
  # jcol - time column ( integer )
  # gcol - group column ( integer or name )
  # ocol - indicator for observed ( 1 ) or interpolated ( 0 )
  
  ifac  <- gfac <- FALSE
  idata <- data[, icol]
  jdata <- data[, jcol]
  gdata <- data[, gcol]
  odata <- data[, ocol]
  
  jindex   <- sort( unique( jdata ) )
  groups   <- yeGr
  times    <- sort( unique( jdata ) )
  ngroup   <- length( groups )
  nyr      <- length( times )
  lagGroup <- vector( 'list', ngroup )
  names( lagGroup ) <- groups
  
  lagMatrix <-  numeric( 0 )
  lagGroup  <- numeric( 0 )
  
  nall <- 0
  
  for( m in 1:ngroup ){
    
    wm   <- which( gdata == m & odata == 1 ) 
    lagm <- numeric( 0 )
    
    im <- idata[ wm]
    tall <- unique( im )
    
    jm <- jdata[ wm]
    
    orm <- order( im, jdata[ wm] )
    
    imk <- match( im, tall )
    jmk <- match( jm, jindex )
    tmat <- matrix( NA, length( tall ), nyr )
    tmat[ cbind( imk, jmk )] <- wm
    rownames( tmat ) <- tall
    colnames( tmat ) <- jindex
    
    for( j in ( plag+1 ):nyr ){
      
      jname <- paste( tall, times[ j], sep = '-' )
      tj    <- tmat[, j:( j-plag ), drop = FALSE]
      rownames( tj ) <- jname
      lagm <- rbind( lagm, tj )
    }
    wm <- unique( which( is.na( lagm ), arr.ind = TRUE )[, 1] )
    if( length( wm ) > 0 )lagm <- lagm[ drop = FALSE, -wm, ]
    
    if( nrow( lagm ) == 0 )next
  
    nall <- nall + nrow( lagm )
    
    colnames( lagm ) <- paste( 'lag', c( 0:plag ), sep = '-' )
    
    ttt <- columnSplit( rownames( lagm ), '-' )
    ord <- order( ttt[, 1], ttt[, 2], ttt[, 3] )
    
    lagm <- lagm[ drop = FALSE, ord, ]
    lagMatrix <- rbind( lagMatrix, lagm )
    
    lagGroup  <- c( lagGroup, rep( m, nrow( lagm ) ) )
  }
  
  if( verbose ){
    cat( paste( '\nNumber of full observations with AR( ', plag, ' ) model\ is: ', sep = '' ) )
    print( nall ) 
    if( nall < 10 )stop( 'not enough observations for AR( p ), try reducing p' )
  }
  
  list( matrix = lagMatrix, group = lagGroup )
}

getVarType <- function( vnames, data, i, j ){
  
  # 'i'  - individual variable
  # 'j'  - time variable
  # 'ij' - individual/time
  
  if( is.factor( i ) )i <- as.character( i )
  
  id <- sort( unique( i ) )
  ni <- length( id )
  yr <- sort( unique( j ) )
  ny <- length( yr )
  i <- match( i, id )
  j <- match( j, yr )
  
  ij <- cbind( i, j )
  
  
  vnew <- vector( 'list', length( vnames ) )
  names( vnew ) <- vnames
  
  for( k in 1:length( vnames ) ){
    
    cj <- data[, vnames[ k]]
    if( is.factor( cj ) )cj <- as.character( cj )
    mj <- matrix( NA, ni, ny )
    mj[ ij] <- cj
    
    rr <- suppressWarnings( apply( mj, 1, range, na.rm = TRUE ) )
    rc <- suppressWarnings( apply( mj, 2, range, na.rm = TRUE ) )
    rowSame <- all( rr[ 1, ] == rr[ 2, ] )
    colSame <- all( rc[ 1, ] == rc[ 2, ] )
    if( is.na( rowSame ) )rowSame <- FALSE
    if( is.na( colSame ) )colSame <- FALSE
    if( !rowSame & !colSame )vnew[[ k]] <- 'ij'
    if( rowSame &  colSame )vnew[[ k]] <- 'i'
    if( !rowSame &  colSame )vnew[[ k]] <- 'j'
    if( rowSame & !colSame )vnew[[ k]] <- 'i'
  }
  vnew
}

msarSetup <- function( data, plag, icol, jcol, gcol = NULL, yeGr, 
                      minGroup = 10, verbose = FALSE ){
  
  # icol - column names in data for individual index; integer or factor
  # jcol - column name in data for time index; integer
  # gcol - column name for group index; integer or factor
  # pcol - column name for group names ( character )
  # gmat - matrix of individual columns to retain in output
  # plag - AR lag 
  # minGroup - minimum group size
  
  if( !is.data.frame( data ) )stop( 'data must be a data.frame' )
  
  huge <- 1e+10
  
 # data$obs <- 1
  
  if( is.factor( data[, icol] ) )data[, icol] <- droplevels( data[, icol] )
  if( is.factor( data[, jcol] ) )data[, jcol] <- droplevels( data[, jcol] )
  if( is.null( gcol ) ){
    gcol <- 'group'
    data$group <- rep( 1, nrow( data ) )
  }else{
    if( is.factor( data[, gcol] ) )data[, gcol] <- droplevels( data[, gcol] )
  }
  
  i <- as.character( data[, icol] )
  j <- data[, jcol]
  g <- data[, gcol]
  if( is.factor( g ) )g <- as.character( g )
  
  iall <- unique( as.character( i ) )                  # preserve order
  
  jobs <- range( data[ data$obsTrap == 1 | data$obs == 1, jcol] )     
  jall <- range( range( j ) )
  if( jall[ 1] < ( jobs[ 1] - plag ) )jall[ 1] <- jall[ 1] - plag
  if( jall[ 2] > ( jobs[ 2] + plag ) )jall[ 2] <- jall[ 2] + plag
  
  jall <- allYears <- c( jall[ 1]:jall[ 2] )
  
  if( !is.null( yeGr ) ){
    groups <- yeGr
  }else{
    groups <- unique( g )
  }
  
  ii <- match( i, iall )
  jj <- match( j, jall )  # original times
  ni <- length( iall )
  nj <- length( jall )
  
  io <- i[ data$obsTrap == 1 | data$obs == 1]
  jo <- j[ data$obsTrap == 1 | data$obs == 1]
  ijIndex <- cbind( match( io, iall ), match( jo, jall ) )
  ijFull  <- cbind( ii, jj )
  
  
 # baseMat <- matrix( 0, length( iall ), length( jall ) )
 # baseMat[ cbind( ii, jj )] <- 1
 # rownames( baseMat ) <- iall
 # colnames( baseMat ) <- jall
 # base <- baseMat
 # base[ base == 0] <- NA
  
  #groups with sufficient times
  tmp <- table( g, ii )
  tmp[ tmp < plag] <- 0
  tmp[ tmp > 1] <- 1
  tsum <- rowSums( tmp )
  
  if( verbose ){
    cat( '\nNote: no. trees with > plag years, by group:\n' )
    print( tsum )
  }
  
  wlow <- which( tsum < minGroup )
  if( length( wlow ) > 0 ){
    pll <- paste0( names( tsum )[ wlow], collapse = ', ' )
    if( verbose )cat( paste( '\nsmall group( s ): ', pll, '\n', sep = '' ) )
  }
  
  vtypes    <- getVarType( colnames( data ), data, ii, jj ) 
  vtypes$obs <- 'ij'
  if( 'cropCount' %in% colnames( data ) )vtypes$cropCount <- 'none'
  if( 'cropFraction' %in% colnames( data ) )vtypes$cropFraction <- 'none'
  if( 'cropFractionSd' %in% colnames( data ) )vtypes$cropFractionSd <- 'none'
  if( 'fecMin' %in% colnames( data ) )vtypes$fecMin <- 'none'
  if( 'fecMax' %in% colnames( data ) )vtypes$fecMax <- 'none'
  
  tpy <- as.character( columnPaste( data$treeID, data$year ) )
  
  tmp <- fillMissing( vtypes, data, icol, jcol, jtimes = allYears, ijFull )
  data   <- tmp$data
  naVars <- tmp$naVars
  tpn    <- as.character( columnPaste( data$treeID, data$year ) )
  data$obs[ which( !tpn %in% tpy )] <- 0
  rm( tpy, tpn )
  
  inew <- numeric( 0 )
  
  for( i in 1:length( iall ) ){           # speed up needed
    wi <- which( data[, icol] == iall[ i] )
    inew <- c( inew, wi )
  }
    
  data <- data[ inew, ]
  
  
  i <- match( data[, icol], iall )
  g <- match( as.character( data[, gcol] ), as.character( groups ) )
  
  wideGroup <- apply( table( i, g ), 1, which.max ) 
  
  ngroup <- length( groups )
  betaYr <- round( matrix( rnorm( ngroup*plag, 0, .1 ), ngroup, plag ), 3 )
  rownames( betaYr ) <- groups
  colnames( betaYr ) <- paste( 'lag', c( 1:plag ), sep = '_' )
  
  list( xdata = data, times = jall, yeGr = groups, 
       groupByInd = wideGroup, betaYr = betaYr, plag = plag )
}

fillMissing <- function( variables, data, icol, jcol, jtimes, 
                        ijFull = NULL ){
  
  # ijFull is location in i by j matrix that includes added obs
  
  if( !is.data.frame( data ) )data <- as.data.frame( data, stringsAsFactors = F )
  
  if( !'obs' %in% colnames( data ) )data$obs <- 1
  
  id  <- data[, icol]
  it  <- data[, jcol]
  ids <- unique( id )
  
  # adjust ijFull to include additional years in data
  rt <- range( c( jtimes, it ) )
  atimes <- rt[ 1]:rt[ 2]
  
  ijIndex <- cbind( match( id, ids ), match( it, atimes ) )
  ijIndex <- ijIndex[ order( ijIndex[, 1], ijIndex[, 2] ), ]
  
  ijtmp <- ijFull
  ijtmp[, 2] <- match( jtimes[ ijFull[, 2]], atimes )
  ijFull <- ijtmp
  
  if( is.null( ijFull ) )ijFull <- ijIndex
#  ijFull <- ijFull[ order( ijFull[, 1], ijFull[, 2] ), ]
  
  ny <- length( atimes )
  ni <- length( ids )

  newData <- vector( 'list', ncol( data ) )
  names( newData ) <- names( data )
  ffact <- which( sapply( data, is.factor ) )
  naVars <- character( 0 )
  
  for( k in 1:ncol( data ) ){           #expand to pre- and post-data
    
    jmat  <- matrix( NA, ni, ny )
    rownames( jmat ) <- ids
    colnames( jmat ) <- atimes
    
    vtype <- variables[ names( data )[ k]]
    tinySlope <- .00001
    
    kvar <- data[, k]
    sigFig <- getSigFig( kvar[ 1] )
    
    if( k %in% ffact )kvar <- as.character( kvar )
    
    
    jmat[ ijIndex]  <- kvar
 
    w0 <- which( is.na( jmat ), arr.ind = TRUE )
    w1 <- which( !is.na( jmat ), arr.ind = TRUE )
    
    if( vtype == 'time' ){
      jmat <- matrix( atimes, ni, ny, byrow = TRUE )
    }
    
    if( vtype == 'i' ){
      w1 <- w1[ !duplicated( w1[, 1] ), ]
      w2 <- w0
      w2[, 2] <- w1[ match( w2[, 1], w1[, 1] ), 2]
      jmat[ w0] <- jmat[ w2]
    }
    if( vtype == 'j' ){
      if( colnames( data )[ k] == jcol ){
        jmat <- matrix( atimes, ni, ny, byrow = TRUE )
      }else{
        w1 <- w1[ !duplicated( w1[, 2] ), ]
        w2 <- w0
        w2[, 1] <- w1[ match( w2[, 2], w1[, 2] ), 1]
        jmat[ w0] <- jmat[ w2]
      }
    }
    if( vtype == 'ij' ){            # use trend
      if( is.numeric( kvar ) & !all( is.na( kvar ) ) ){
        minVal <- suppressWarnings( apply( jmat, 1, min, na.rm = T ) )
        maxVal <- suppressWarnings( apply( jmat, 1, max, na.rm = T ) )
        
        INCREASING <- FALSE
        
        if( colnames( data )[ k] == 'diam' ){
          
          tinySlope <- .005
          minVal[ minVal < .25] <- .25
          
          zz <- which( minVal >= maxVal )
          if( length( zz ) > 0 ){
            minVal[ zz] <- minVal[ zz] - .1*ny
            maxVal[ zz] <- maxVal[ zz] + .1*ny
          }
          minVal[ minVal < .1] <- .1
            
          INCREASING <- TRUE
        }
        if( colnames( data )[ k] == 'repMu' ){
          INCREASING <- TRUE
          minVal <- 0
          maxVal <- 1
        }
        jmat <- .interpRows( jmat, INCREASING = INCREASING, minVal = minVal, maxVal = maxVal, 
                            defaultValue = NULL, tinySlope = tinySlope ) 
      }else{
        naVars <- c( naVars, colnames( data )[ k] )
      }
    }
    
    ktmp <- jmat[ ijFull]
    if( k %in% ffact ) ktmp <- as.factor( ktmp )

    newData[[ k]] <- ktmp
  }
  
  xdata <- data.frame( newData, stringsAsFactors = F )
  rownames( xdata ) <- NULL
  xdata <- xdata[ order( xdata[, icol], xdata[, jcol] ), ]
  xdata <- xdata[ xdata[, jcol] %in% jtimes, ]
  
  list( data = xdata, naVars = naVars )
}

.propZ <- function( znow, last0first1, matYr ){
  
  # repr - known repr from tdata
  # random walk proposal
  
  new <- matYr + sample( c( -1:1 ), nrow( znow ), replace = TRUE )
  
  ww  <- which( new < last0first1[, 'last0'] )
  new[ ww] <- last0first1[ ww, 'last0']
  
  ww  <- which( new > last0first1[, 'first1'] )
  new[ ww] <- last0first1[ ww, 'first1']
  
  new[ last0first1[, 'all0'] == 1] <- ncol( znow ) + 1
  new[ last0first1[, 'all1'] == 1] <- 1
  
  down <- which( new < matYr & new > 0 )
  znow[ cbind( down, new[ down] )] <- 1   # advance 1 year
  
  up <- which( new > matYr & new < ncol( znow ) )
  znow[ cbind( up, matYr[ up] )] <- 0     # delay 1 year
  
  znow[ last0first1[, 'all0'] == 1, ] <- 0
  znow[ last0first1[, 'all1'] == 1, ] <- 1
  
  wna <- which( is.na( znow ) )
  if( length( wna ) > 0 ){
    znow[ wna] <- 0
    znow <- t( apply( znow, 1, cumsum ) )
    znow[ znow > 1] <- 1
  }
  
  list( zmat = znow, matYr = new )
}

.boxCoeffsLabs <- function( boxPars, labels, colLabs = NULL, cex = 1, 
                            xadj = 0 ){
  
  ncols <- length( labels )
  if( is.null( colLabs ) )colLabs <- rep( 'black', ncols )
  
  at <- boxPars$xtick
  if( is.matrix( at ) )at <- colMeans( at )
  
  yfig <- par( 'usr' )[ 3:4]
  dy   <- diff( yfig )
  yloc <- boxPars$stats[ 1, ]
  pos  <- 2
  
  if( length( at ) > 1 ){
    yends <- boxPars$stats[ c( 1, nrow( boxPars$stats ) ), ]
    dends <- rbind( yfig[ 1] - yends[ 1, ], yfig[ 2] - yends[ 2, ] )
    sides <- apply( abs( dends ), 2, which.max )
    wt  <- which( sides == 1 )
    yloc <- yends[ 1, ]
    pos  <- 2
  }
  
  text( at, yloc - dy/20, labels, 
        offset = -.1, 
        col = colLabs, pos = pos, srt = 90, cex = cex )
  
  
  #if( length( wt ) > 0 )text( at[ wt], yends[ 1, wt] - dy/20, labels[ wt], 
  #                       offset = -.1, 
  #                       col = colLabs[ wt], pos = 2, srt = 90, cex = cex )
 # wt  <- which( sides == 2 )
 # if( length( wt ) > 0 )text( at[ wt], yends[ 2, wt] + dy/20, labels[ wt], 
 #                        offset = -.1, 
 #                        col = colLabs[ wt], pos = 4, srt = 90, cex = cex )
}

getBins <- function( xx, nbin = 15, pow = 1 ){
  
  xrange <- range( xx, na.rm = TRUE )
  bins <- unique( quantile( as.vector( xx[ xx > 0] ), seq( 0, 1, length = nbin )^pow ) )
  bins <- c( 0, bins )
  dbin <- diff( bins )
  
  bins[ -1] <- bins[ -1] - diff( bins )/2
  bins <- c( bins, max( bins )+1 )
  db   <- diff( bins )
  w0   <- which( db < 1 )
  
  if( length( w0 ) > 0 )bins <- bins[ -( w0+1 )]
  sort( unique( bins ) )
}

plotCoeffs <- function( beta, bchain, burnin, ng, specNames, specCol, cex = .8, 
                       xlab = '' ){
  
  fnames  <- .coeffNames( rownames( beta ) )
  nspec   <- length( specNames )
  
  nint <- grep( ':', colnames( bchain ) )
  intt <- c( 1:ncol( bchain ) )
  intt <- c( 1:ncol( bchain ) )
  if( length( nint ) > 0 )intt <- intt[ -nint]
  
  bc <- bchain[ burnin:ng, intt, drop = FALSE]
  colnames( bc ) <- .replaceString( colnames( bc ), 'species', '' )
  
  ylim <- quantile( bc, c( .1, .99 ) )
  ylim[ 1] <- ylim[ 1] - .7*diff( ylim )
  ylim[ 2] <- ylim[ 2] + .7*diff( ylim )
  
  boxPars <- .boxCoeffs( chain = bc, snames = specNames, xaxt = 'n', 
                        xlab = xlab, ylab = '', ylim = ylim, 
                        cols = specCol[ specNames], addSpec = '' )
  
  .boxCoeffsLabs( boxPars, specNames, specCol[ specNames], cex = cex, xadj = 1/nspec/2 )
  .plotLabel( 'intercept', 'bottomleft', cex = cex )
  
  bnint <- numeric( 0 )
  
  if( length( nint ) > 0 ){
    
    bc <- bchain[ burnin:ng, nint, drop = FALSE]
    colnames( bc ) <- .replaceString( colnames( bc ), 'species', '' )
    scol <- rep( character( 0 ), ncol( bc ) )
    
    ylim <- quantile( bc, c( .1, .99 ) )
    ylim[ 1] <- ylim[ 1] - .5*diff( ylim )
    ylim[ 2] <- ylim[ 2] + .5*diff( ylim )
    
    bcc <- .boxCoeffsMultiSpec( bc, specNames, xlab = '', xaxt = 'n', ylim = ylim, 
                               ylab = ' ', cols = specCol[ specNames], addSpec = '' )
    bnint <- append( bnint, list( bcc ) )
  }
  invisible( list( intercept = boxPars, slopes = bnint ) )
}


.mastPlot2File <- function( output, plotPars ){
  
  parfile <- 'plotPars'
  if( is.null( plotPars ) )plotPars <- list( )
  
  RMD <- plotPars$RMD
  if( RMD == 'pdf' ){
    RMD <- 'pandoc'
    plotPars$MAPS <- FALSE
  }
  
  if( !RMD %in% c( 'html', 'pandoc', 'pdf' ) )plotPars$RMD  <- 'html'
  
  rfile   <- 'tmp.r'
  file.create( rfile )
  fileConn <- file( rfile )
  rtext <- '.mastPlot( output, plotPars )'
  
  writeLines( rtext, con = fileConn )
  close( fileConn )
  
  knitr::spin( rfile )
  file.remove( rfile )
  
  ttab <- table( output$inputs$treeData$plot )
  t2   <- names( ttab )[ which.max( ttab )]
  t1   <- output$inputs$specNames[ 1]
  
  fname <- paste( t1, t2, 'report.Rmd', sep = '_' )
  
  tmp <- readLines( 'tmp.md' )
  rmdOut <- file( fname, "w" )
  
  tmp <- .replaceString( tmp, ".mastPlot( output, plotPars )", "" )
  
  capline <- grep( '## ', tmp, fixed = T )
  newCaps <- .replaceString( tmp[ capline], '## ', '' )

  caption <- grep( 'plot of chunk', tmp )
  cwords  <- tmp[ caption - 3]
  cwords  <- .replaceString( cwords, ' ', '' )
  
  fnum <- c( 1:length( caption ) )
  
  for( m in 1:length( caption ) ){
    tmp[ caption[ m]]  <- .replaceString( tmp[ caption[ m]], 'plot of chunk unnamed-chunk-1', 
                                       newCaps[ m] )
  }
  comment <- grep( '##', tmp )
  if( length( comment ) > 0 )tmp <- tmp[ -comment]
  tick <- grep( '`', tmp )
  if( length( tick ) > 0 )tmp <- tmp[ -tick]
  
  day <- paste( 'date: ', date( ), '\n', sep = '' )
  
  doc <- "output: 'html_document'\n"
  if( RMD == 'pandoc' )doc <- "output: pdf_document\n"
  
  ptab <- paste( "\n   print( knitr::kable( tj, knitr.kable.NA = '', caption = caps[ wj, 2], format = '", 
                RMD, "' ) )\n", sep = '' )
  
  top <- paste( "title: '", t1, " at ", t2, "'\n", sep = '' )
  
  #new lines to rmdOut file
  cat( "---\n", file = rmdOut )
  cat( top, file = rmdOut )
  cat( day, file = rmdOut )
  cat( doc, file = rmdOut )
  cat( "---\n", file = rmdOut )
  
  cat( "\nFor more background on this summary see http://rpubs.com/jimclark/281413\n", 
      file = rmdOut )
  
  cat( "\n```{r, results = 'asis', echo = F}\n", file = rmdOut )
  cat( "\ntfiles <- list.files( 'tables', full.names = TRUE )", file = rmdOut )
  cat( "\ntfiles <- tfiles[ !tfiles %in% c( 'tables/words.txt', 'tables/captions.txt' )]", 
      file = rmdOut )
  cat( "\ncaps  <- read.table( 'tables/captions.txt', as.is = TRUE, header = FALSE )", 
      file = rmdOut )
  
  cat( "\nwords <- read.table( 'tables/words.txt', header = FALSE )", file = rmdOut )
  cat( "\ncolnames( words ) <- NULL", file = rmdOut )
  cat( "\ncat( paste0( unlist( words ), collapse = ' ' ) )\n", file = rmdOut )
  cat( "\nfor( j in 1:length( tfiles ) ){\n", file = rmdOut )
  cat( "\n   wj <- which( caps[, 1] == tfiles[ j] )", file = rmdOut )
  cat( "\n   tj <- read.table( tfiles[ j], header = TRUE )", file = rmdOut )
  cat( ptab, file = rmdOut )
  cat( "\n}\n", file = rmdOut )
  cat( "```\n", file = rmdOut )
  
  #all lines from rmdOut file
  for( i in 1:length( tmp ) ){
    cat( tmp[ i], "\n", file = rmdOut, sep = "\t" )
  }
  close( rmdOut )
}

plotAspectEffect <- function( betaSlope, slopeRange = c( .1, .3 ), specCol, 
                              aspect = seq( -pi, pi, length = 100 ), minEffect = 0, maxNumber = 20, 
                              ylim = NULL, textSize = 1, xlab = 'Aspect', ylab = 'Effect' ){
  
  # slopeRange - two values giving envelop to plot
  # betaSlope  - species by 3 u coefficients
  # min2Plot   - plot only those having at least this aspect effect
  
  tmp    <- predictSlopeAspect( betaSlope, slopeValue = slopeRange[ 2], aspect = aspect )
  ub     <- tmp$ubeta
  aspect <- tmp$aspect
  tmp    <- predictSlopeAspect( betaSlope, slopeValue = slopeRange[ 1], aspect = aspect )
  uc     <- tmp$ubeta
  
  mm  <- apply( ub, 2, max )
  
  if( minEffect > 0 ){
    wm  <- which( mm > minEffect )
    mm  <- mm[ wm]
    ub  <- ub[, wm]
    uc  <- uc[, wm]
  }
  if( ncol( ub ) > maxNumber ){
    o <- order( mm, decreasing = T )
    wm <- o[ 1:maxNumber]
    ub <- ub[, wm]
    uc <- uc[, wm]
  }
  
  bname <- colnames( ub )
  if( is.null( bname ) )bname <- paste( 'S', wm, sep = '_' )
  
  if( is.null( ylim ) )ylim <- c( 0, max( ub )*2 )
  
  nr <- ncol( ub )
  
  par( bty = 'n' )
  
  for( s in 1:nr ){
    if( s == 1 ){
      plot( aspect, ub[, s], type = 'l', ylim = ylim, xaxt = 'n', xlab = xlab, ylab = ylab )
      axis( 1, at = c( -pi, -pi/2, 0, pi/2, pi ), labels = c( 'S', 'W', 'N', 'E', 'S' ) )
    }
    polygon( c( aspect, rev( aspect ) ), c( ub[, s], rev( uc[, s] ) ), col = specCol[ s], border = specCol[ s] )
  }
  for( s in 1:nr ){
    lines( aspect, ub[, s], lwd = 2, col = specCol[ s] )
    lines( aspect, uc[, s], lwd = 2, col = specCol[ s] )
  }
  for( s in 1:nr ){
    wx <- which.max( ub[, s] )
    text( aspect[ wx], ub[ wx, s], bname[ s], srt = 70, pos = 4, cex = textSize, 
         col = 'black' )
  }
}

u2slopeAspect <- function( umat ){
  
  # umat - slope, sin( slope )sin( aspect ), sin( slope )cos( aspect )
  
  ww <- sort( unique( which( is.na( umat ), arr.ind = T )[, 1] ) )
  aspect <- slope <- rep( NA, nrow( umat ) )
  ww <- c( 1:nrow( umat ) )[ -ww]

  umat <- umat[ ww, ]
  umat[ umat[, 1] > .999, 1] <- .999
  
  aspect[ ww] <- atan2( umat[, 2], umat[, 3] )*180/pi
  slope[ ww]  <- asin( umat[, 1] )*180/pi
  
  cbind( slope, aspect )
}

predictSlopeAspect <- function( betaSlope, slopeValue, aspect = seq( -pi, pi, length = 100 ) ){
  
  # betaSlope - matrix of coefficients for u1, u2, u3
  
  nas     <- length( aspect )
  
  ub <- getSlopeAspect( slopeValue, aspect )
  
  if( ncol( betaSlope ) == 3 ) betaSlope <- t( betaSlope )
  S       <- ncol( betaSlope )
  
  ub <- ub%*%betaSlope
  rb <- apply( ub, 2, range )
  ub <- ub - matrix( rb[ 1, ], nas, S, byrow = T )
  
  list( ubeta = ub, aspect = aspect )
}

getSlopeAspect <- function( slope, aspect, CLOCKWISE = F ){
  #slope   - one value in radians
  #aspect  - vector of values
  #assumes aspect is counterclockwise from North
  
  if( CLOCKWISE )aspect <- 2*pi - aspect
  
  u1 <- sin( slope )
  u2 <- sin( slope )*sin( aspect )
  u3 <- sin( slope )*cos( aspect )
  
  cbind( u1, u2, u3 )
}

mastPlot <- function( output, plotPars = NULL ){
  
  # RMD - generate Rmarkdown
  
  verbose <- FALSE
  
  if( !is.null( plotPars ) ){
    if( 'RMD' %in% names( plotPars ) ){
      .mastPlot2File( output, plotPars )
      return( )
    }
  }
  .mastPlot( output, plotPars, verbose )
}
  
.mastPlot <- function( output, plotPars, verbose ){
    
  CONES <- POINTS <- SAVEPLOTS <- SEEDCENSOR <- RMAT  <- FALSE
  YR <- AR <- RANDOM <- TV <- SAMPR <- PREDICT <- SPACETIME <- FALSE
  CONSOLE <- SEEDDATA <- TRUE
  
  RMD <- NULL

  caption <- character( 0 )
  
  data <- treeData <- priorUgibbs <- fecPred <- plotDims <- seedTraits <-
    plotHaByYr <- plotArea <- keepIter <- aUgibbs <- alphaMu <- NULL
  seedNames <- specNames <- R <- formulaFec <- formulaRep <- xfec <- xrep <-
    tdata <- seedData <- xytree <- xytrap <- distall <- ng <- burnin <- nplot <-
    ntree <- ntrap <- nyr <- maxFec <- bfec <- brep <- upar <- rgibbs <- 
    betaFec <- betaRep <- rMu <- rSe <- usigma <- fecMu <- fecSe <- matrMu <- 
    seedPred <- inputs <- chains <- parameters <- predictions <- 
    upars <- dpars <- trueValues <- betaYrMu <- betaYrSe <-  
    sgibbs <- ugibbs <- omegaE <- predPlots <- betaYrRand <- priorTable <-
    betaYrRandSE <- prediction <- eigenMu <- facLevels <- specPlots <- NULL
  randGroups <- formulaRan <- rnGroups <- reIndex <- xrandCols <- NULL  
  specGroups <- plotGroups <- yrIndex <- randomEffect <- yearEffect <- NULL
  pacfMat <- pacfSe <- acsMat <- acsSe <- obsRows <- NULL
  modelYears <- seedPredGrid <- treePredGrid <- acfMat <- NULL
  notFit <- character( 0 )
  censMin <- censMax <- NULL
  
  ugibbs <- matrix( 0 )
  
  outFolder <- 'mastPlots'
  yeGr <- NULL
  plotsPerPage <- 4
  MAPS <- FALSE
  
  for( k in 1:length( output ) )assign( names( output )[ k], output[[ k]] )
  for( k in 1:length( inputs ) )assign( names( inputs )[ k], inputs[[ k]] )
  for( k in 1:length( chains ) )assign( names( chains )[ k], chains[[ k]] )
  for( k in 1:length( parameters ) )assign( names( parameters )[ k], parameters[[ k]] )
  for( k in 1:length( prediction ) )assign( names( prediction )[ k], prediction[[ k]] )
  if( 'arList' %in% names( data ) ){
    for( k in 1:length( data$arList ) )
      assign( names( data$arList )[ k], data$arList[[ k]] )
    AR <- TRUE
    plag <- ncol( data$arList$betaYr )
  }
  
  if( !'seedData' %in% names( inputs ) ){
    SEEDDATA <- FALSE
  }else{
    if( length( seedData ) == 0 )SEEDDATA <- FALSE
  }
  
  if( !is.null( plotPars ) ){
    for( k in 1:length( plotPars ) )assign( names( plotPars )[ k], plotPars[[ k]] )
    if( 'trueValues' %in% names( plotPars )  ){
      TV <- TRUE
    }
  }
  if( 'trueValues' %in% names( inputs ) ){
    TV <- TRUE
    for( k in 1:length( inputs$trueValues ) )
      assign( names( inputs$trueValues )[ k], inputs$trueValues[[ k]] )
  }
  if( 'cropCount' %in% colnames( treeData ) )CONES <- TRUE
  notFit    <- output$data$setupData$notFit
  maxFec    <- output$inputs$maxFec
  specNames <- output$inputs$specNames
  seedNames <- output$inputs$seedNames
  if( 'rgibbs' %in% names( output$chains ) )SAMPR <- TRUE
  
  if( 'randomEffect' %in% names( output$inputs ) ){
    RANDOM <- TRUE
    for( k in 1:length( randomEffect ) )assign( names( randomEffect )[ k], randomEffect[[ k]] )
    agibbs <- .orderChain( agibbs, specNames )
  }
  if( 'yearEffect' %in% names( output$inputs ) ){
    YR <- TRUE
    yrIndex <- output$data$setupYear$yrIndex
    if( is.null( yrIndex ) )yrIndex <- output$inputs$yrIndex
    if( 'p' %in% names( output$inputs$yearEffect ) ){
      if( output$inputs$yearEffect$p > 0 ){
        AR <- TRUE
        YR <- FALSE
      }
    }
    yeGr <- as.character( output$data$setupYear$yeGr )
    if( is.null( yeGr ) )yeGr <- output$data$setupData$yeGr
    #   yeGr <- .replaceString( yeGr, ' ', '' )
    bygibbsR <- .orderChain( bygibbsR, yeGr )
    if( ncol( ugibbs ) > 1 )ugibbs <- .orderChain( ugibbs, specNames )
  }
  if( !YR )yeGr <- as.character( output$data$setupData$yeGr )
  ngroup <- length( yeGr )
  
  ngLab   <- ng
  burnLab <- burnin
  if( 'keepIter' %in% names( inputs ) ){
    burnin <- ceiling( burnin*keepIter/ng )
    ng <- keepIter
  }
  nspec <- length( specNames )
  
  if( !is.null( RMD ) )SAVEPLOTS <- CONSOLE <- FALSE
  if( SAVEPLOTS )CONSOLE <- FALSE
  
  if( SAVEPLOTS & verbose ){
    tt <- paste( '\nPlots saved to ', outFolder, '/\n', sep = '' )
    cat( tt )
  }
  
  if( AR )YR <- FALSE
  if( !is.null( censMin ) & !is.null( censMax ) )SEEDCENSOR <- TRUE
  
  xmean <- output$data$setupData$xmean  # to unstandardize xfec, xrep
  xsd   <- output$data$setupData$xsd
  
  tdata <- output$inputs$treeData
  sdata <- output$inputs$seedData
  
  xfecu2s <- output$data$setupData$xfecu2s
  xrepu2s <- output$data$setupData$xrepu2s
  
  xfecs2u <- output$data$setupData$xfecs2u
  xreps2u <- output$data$setupData$xreps2u
  
  fnames  <- .coeffNames( rownames( betaFec ) )
  rnames  <- .coeffNames( rownames( betaRep ) )
  
  xfec <- output$data$setupData$xfec
  xrep <- output$data$setupData$xrepUn
  Qf   <- ncol( xfec )/nspec
  Qr   <- ncol( xrep )/nspec
  
  if( !is.matrix( pacfMat ) )pacfMat <- t( as.matrix( pacfMat ) )
  if( !is.matrix( pacfSe ) )pacfSe <- t( as.matrix( pacfSe ) )
  
  
  
  ###############
  rm( treeData )
  ##############
  
  outTables <- 'tables/table_'
  if( file.exists( 'tables' ) ){
    fi <- list.files( 'tables', full.names = TRUE )
    for( j in 1:length( fi ) )file.remove( fi[ j] )
  }else{
    dir.create( 'tables' )
  }
  
  captions <- character( 0 )        # captions for tables
  
  sumOut <- summary.mastif( output, verbose = FALSE )
  
  if( !is.null( RMD ) ){
    ww <- which( !names( sumOut ) == 'words' )
    for( k in ww ){
      xk <- sumOut[[ k]]
      ok <- paste( outTables, names( sumOut )[ k], '.txt', sep = '' )
      
      cap <- attr( xk, 'caption' )
      if( is.null( cap ) )cap <- 'tcap'
      write.table( xk, quote = FALSE, file = ok, row.names = TRUE ) 
      
      captions <- rbind( captions, cbind( ok, cap ) )
    }
  }
  words <- paste0( sumOut$words, collapse = '. ' )
  
  
  words <- .replaceString( words, '\n', '' )
  
  if( !is.null( RMD ) ){
    write.table( captions, file = 'tables/captions.txt', row.names = FALSE, col.names = FALSE )
    write.table( sumOut$words, file = 'tables/words.txt', row.names = FALSE, col.names = FALSE )
  }
  
  if( is.null( yeGr ) )yeGr <- 'all'
  
  nspec  <- length( specNames )
  years  <- sort( unique( tdata$year ) )
  nyr    <- length( years )
  ngroup <- length( yeGr )
  plots  <- sort( unique( as.character( tdata$plot ) ) )
  nplot  <- length( plots )
  
  tmp1 <- as.character( tdata$plot )
  tmp2 <- tdata$year
  
  if( SEEDDATA ){
    ntype  <- length( seedNames )
    if( !is.null( seedPredGrid ) ){
      PREDICT <- TRUE
      tmp1 <- c( tmp1, as.character( seedPredGrid$plot ) )
      tmp2 <- c( tmp2, seedPredGrid$year )
    }
  }
  
  plotYrTable <- table( plot = tmp1, year = tmp2 )
  rm( tmp1 )
  rm( tmp2 )
  
  cfun <- colorRampPalette( c( '#66c2a5', '#fc8d62', '#8da0cb' ) )
  specCol <- cfun( nspec )
  names( specCol ) <- specNames
  cols <- specCol
  
  gfun <- colorRampPalette( c( "#8DD3C7", "#BEBADA", "#FB8072", 
                              "#80B1D3", "#FDB462" ) )
  groupCol <- gfun( ngroup )
  names( groupCol ) <- yeGr
  
  gfun <- colorRampPalette( c( "forestgreen", "#8DD3C7", "#BEBADA", "#FB8072", 
                              "#80B1D3", "#FDB462", "brown" ) )
  plotCol <- gfun( nplot )
  names( plotCol ) <- plots
  
  if( SAVEPLOTS ){
    ff <- file.exists( outFolder )
    if( !ff )dir.create( outFolder, recursive = TRUE )
  }
  
  
  ########### MCMC chains
  
  if( is.null( RMD ) ) graphics.off( )
  
  refVals <- NULL
  
  words <- .chainPlot( chains$brep, burnin, 'maturation', ngLab, burnLab, 
                      refVals = refVals, CONSOLE, RMD, SAVEPLOTS, outFolder )
  bfecFit <- chains$bfec[, !colnames( chains$bfec ) %in% notFit, drop = FALSE]
  words   <- .chainPlot( bfecFit, burnin, 'fecundity', ngLab, burnLab, 
                      refVals = refVals, CONSOLE, RMD, SAVEPLOTS, outFolder )
  
  # species with estimated seed dispersal
  trapSpec <- tapply( tdata$fit, tdata$species, sum )
  trapSpec <- names( trapSpec )[ trapSpec > 10]
  trapSpec <- trapSpec[ trapSpec %in% colnames( ugibbs )]
  if( length( trapSpec ) == 0 )trapSpec <- colnames( ugibbs )
  
  if( SEEDDATA ){
    
    USPEC <- TRUE
    if( ncol( ugibbs ) == 1 )USPEC <- FALSE
    
    ALLONE <- FALSE
    if( USPEC )ALLONE <- TRUE
    
    sord <- order( colMeans( ugibbs ), decreasing = TRUE ) 
    sord <- colnames( ugibbs )[ sord]
    ugibbs <- ugibbs[, sord, drop = FALSE]
    
    if( TV ){
      refVals <- inputs$trueValues$upar[ sord]
      if( is.na( refVals ) )refVals <- inputs$trueValues$upar
    }
    
    intval <- priorTable[ drop = FALSE, sord, c( 'priorU', 'priorVU', 'minU', 'maxU' )]
    colnames( intval ) <- c( 'mean', 'var', 'min', 'max' )
    ylim <- range( ugibbs )
    
    ql <- min( qnorm( .05, intval[, 'mean'], sqrt( intval[, 'var'] ) ) )
    qh <- max( qnorm( .95, intval[, 'mean'], sqrt( intval[, 'var'] ) ) )
    if( ql < 0 )ql <- 0
    
    if( ylim[ 1] > ql )ylim[ 1] <- ql
    if( ylim[ 2] < qh )ylim[ 2] <- qh
    
    words <- .chainPlot( ugibbs, burnin, 
                        label = 'dispersal parameter u ( with prior )', 
                        ngLab = ngLab, burnLab = burnLab, refVals = refVals, CONSOLE, 
                        RMD, SAVEPLOTS, outFolder, ALLONE = TRUE, cols = specCol, 
                        ylim = ylim, intval = intval )
    if( USPEC ){
      words <- .chainPlot( chains$priorUgibbs, burnin, 'dispersal mean and variance', 
                          ngLab, burnLab, 
                          refVals = NULL, CONSOLE, RMD, SAVEPLOTS, outFolder )
    }
    
    words <- .chainPlot( chains$sgibbs, 
                        burnin, 'variance sigma', ngLab, burnLab, 
                        refVals = NULL, CONSOLE, RMD, 
                        SAVEPLOTS, outFolder )
  }else{
    words <- .chainPlot( chains$sgibbs[, 1, drop = FALSE], 
                        burnin, 'variance sigma', ngLab, burnLab, 
                        refVals = NULL, CONSOLE, RMD, 
                        SAVEPLOTS, outFolder )
  }
  if( ncol( ugibbs ) > 1 ){
    sord   <- order( colMeans( ugibbs ), decreasing = FALSE ) 
    sord   <- colnames( ugibbs )[ sord]
    ugibbs <- ugibbs[, sord, drop = FALSE]
  }

############ R matrix
  
  if( SAMPR & RMAT ){
    
    mg   <- chains$rgibbs
    posR <- attr( rMu, 'posR' )
    rff  <- NULL
    
    tmp <- columnSplit( colnames( mg ), '_' )
    seedCols <- tmp[, 1]
    plotCols <- tmp[, 2]
    np <- length( plots )
    
    if( ncol( tmp ) == 3 ){
      plotCols <- tmp[, 3]
      specCols <- tmp[, 1]
    }else{
      wdash <- grep( '-', tmp[ 1, 2] )
      if( length( wdash ) > 0 ){
        tmp  <- columnSplit( tmp[, 2], '-' )
        specCols <- tmp[, 1]
        plotCols <- tmp[, 2]
        
      }else{
        specCols <- tmp[, 2]
        plotCols <- NULL
        np <- 1
      }
    }
    
    for( j in 1:np ){
      if( !is.null( plotCols ) ){
        wj <- which( plotCols == plots[ j] )
        if( length( wj ) == 0 )next
        rj <- range( mg[, wj] )
        if( rj[ 1] == 1 | rj[ 2] == 0 )next
      }else{
        wj <- 1:ncol( mg )
      }
      
      label <- paste( 'M matrix', plots[ j] )
      
      if( TV ){
        tt <- columnSplit( colnames( mg )[ wj] )
        rff <- inputs$trueValues$R[ cbind( tt[, 2], tt[, 1] )]
      }
      
      words <- .chainPlot( mg[, wj, drop = FALSE], burnin, label, 
                          ngLab, burnLab, ylim = c( 0, 1 ), 
                 refVals = rff, CONSOLE, RMD, SAVEPLOTS, outFolder )
    }
    
    if( is.null( RMD ) ) graphics.off( )
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'Mpars.pdf' ) )
    
    espec <- sort( unique( specCols ) )
    
    if( RMAT ){
      
      par( mfrow = c( length( espec ), 1 ), bty = 'n', mar = c( .5, 4, .5, 3 ), oma = c( 4, 3, 2, 4 ) )
      tlab <- ''
      
      plotColors <- plotCol[ plotCols]
      plpt <- character( 0 )
      
      for( j in 1:nspec ){
        
        cj <- which( specCols == specNames[ j] )
        if( length( cj ) == 0 )next
        
        unkn <- grep( 'UNKN', colnames( mg )[ cj] )
        if( length( unkn ) > 0 ){
          cj <- c( cj[ -unkn], cj[ unkn] )
        }
        
        cols <- plotColors[ cj]
        plpt <- c( plpt, unique( names( cols ) ) )
        
        boxPars <- .boxCoeffs( mg[ burnin:ng, cj, drop = FALSE], specNames[ j], xlab = tlab, 
                              ylab = '', 
      #                        ylab = specNames[ j], 
                              addSpec = '', ylim = c( 0, 1 ), 
                              cols = cols, yaxt = 'n' )
        st <- boxPars$stats
        s2 <- columnSplit( colnames( st ), '_' )[, 2]
        wc <- which( !s2 == specNames[ j] )           # seed types != this one
        
        par( xpd = NA )
        if( length( wc ) > 0 )text( wc, 1.1, s2[ wc], cex = .8, col = cols[ wc] )
        
        wt <- c( match( seedCols[ cj], seedNames ), 1000 )
        wt[ length( wt )] <- wt[ length( wt )] + 1
        wt <- which( diff( wt ) != 0 )
        
     #   text( .1, 1.3, seedCols[ cj[ wt]], cex = .8, pos = 4 )
        legend( 'topleft', seedCols[ cj[ wt]], bty = 'n' )
        
   #     text( wt-.1, .2, seedCols[ cj[ wt]], cex = .8, pos = 2 )
        par( xpd = FALSE )
        
        abline( h = 1, col = 'grey', lwd = 1 )
        axis( 2, at = c( 0, 1 ), las = 2 )
        tlab <- ''
      }
      
      mtext( 'Fraction from these species...', side = 2, line = .4, outer = TRUE, cex = 1.2 )
      mtext( '...counted as these seed types', side = 3, line = .4, outer = TRUE, cex = 1.2 )
      
      ncol <- round( length( plpt )/4 ) + 1
      
      plpt <- unique( plpt )
      
      cornerLegend( 'bottomright', plpt, text.col = plotCol[ plpt], 
                   cex = .9, bty = 'n', ncol = ncol )
      
      if( CONSOLE )
        readline( 'species -> seed type -- return to continue ' )
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      
      
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- paste( 'Contribution of each species to seedNames' )
        message( words )
        caption <- c( caption, words )
      }
    }
    
  ########################
  
    #inverse probability species h| seedtype m
    
    fec <- output$prediction$fecPred
    
    nsim <- 50
    ksim <- sample( c( burnin:ng ), nsim, replace = TRUE )
    
    npairs <- columnSplit( colnames( rgibbs ), '_' )[, c( 2, 1 )]
    
    rmat <- sprob <- sprob2 <- parameters$rMu*0
    
    for( m in 1:length( plots ) ){
      
      wj <- grep( paste( '-', plots[ m], sep = '' ), colnames( rgibbs ) )
      
      if( length( wj ) <= 1 )next
      mm <- rgibbs[, wj, drop = FALSE]
      mp <- npairs[ wj, ]
      
      wm <- which( fec$plot == plots[ m] )
      ff <- fec$fecEstMu[ wm]
      ss <- fec$fecEstSe[ wm] + .00001
      mt <- fec$matrEst[ wm]
      
      rrow <- grep( plots[ m], rownames( rmat ) )
      
      for( k in 1:nsim ){
        
        rmat <- rmat*0
        rmat[ npairs[ wj, ]] <- mm[ ksim[ k], ]
        rmm  <- rmat[ drop = FALSE, rrow, ]
        
        fk <- .tnorm( length( ff ), 0, maxFec, ff, ss )*mt
        tf <- tapply( ff, list( species = fec$species[ wm] ), FUN = sum )
        tf <- tf/sum( tf )
        names( tf ) <- paste( names( tf ), plots[ m], sep = '-' )
        tmat <- rmm*0
        tmat[ names( tf ), ] <- rep( tf, ncol( tmat ) )
        
        sf <- rmm*tmat/matrix( colSums( rmm*tmat ), nrow( rmm ), ncol( rmm ), byrow = TRUE )
        sf[ is.na( sf )] <- 0
        sprob[ rrow, ] <- sprob[ rrow, ] + sf
        sprob2[ rrow, ] <- sprob2[ rrow, ] + sf^2
      }
    }
    seed2SpecMu <- sprob/nsim
    sse <- sprob2/nsim - seed2SpecMu^2
    sse[ sse < 1e-30] <- 0
    seed2SpecSe <- sqrt( sse )
    
    if( max( seed2SpecSe, na.rm = TRUE ) > 1e-20 ){
      
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'undiffSeed.pdf' ) )
      
      kplots <- character( 0 )
      
      for( m in 1:length( plots ) ){
        rrow <- grep( plots[ m], rownames( seed2SpecMu ) )
        smm  <- seed2SpecMu[ rrow, ]
        wk   <-  which( smm > 1e-20 & smm < 1, arr.ind = TRUE )
        if( length( wk ) == 0 )next
        kplots <- c( kplots, plots[ m] )
      }
      
      tt <- .getPlotLayout( length( kplots ) )
      par( mfrow = tt$mfrow, bty = 'n', mar = c( 3, 3, 1, 1 ), oma = c( 3, 3, 3, 4 ) )
      aspec <- character( 0 )
      
      ucol <- grep( 'UNKN', colnames( seed2SpecMu ) )
      
      ISPLOT <- FALSE
      
      for( m in 1:length( kplots ) ){
        
        rrow <- grep( kplots[ m], rownames( seed2SpecMu ) )
        smm  <- seed2SpecMu[ rrow, ]
        emm  <- seed2SpecSe[ rrow, ]
        wk   <-  which( smm > 1e-20 & smm < 1, arr.ind = TRUE )
        if( length( wk ) == 0 )next
        
        wk <- wk[ wk[, 2] == ucol, ]
        if( length( wk ) == 0 )next
        
        ISPLOT <- TRUE
        
        cspec <- columnSplit( rownames( wk ), '-' )[, 1]
        aspec <- c( aspec, cspec )
        colm <- specCol[ cspec]
        tmp  <- barplot( smm[ wk], beside = TRUE, col = .getColor( colm, .5 ), 
                        border = colm, ylim = c( 0, 1 ), yaxt = 'n', lwd = 2 )
        labels <- FALSE
        if( m %in% tt$left )labels = c( 0, 1 )
        axis( 2, c( 0, 1 ), labels = labels )
        segments( tmp, smm[ wk], tmp, smm[ wk] + 1.96*emm[ wk], lwd = 1.5, col = colm )
        segments( tmp-.1, smm[ wk] + 1.96*emm[ wk], tmp+.1, smm[ wk] + 1.96*emm[ wk], 
                 lwd = 1.5, col = colm )
        .plotLabel( kplots[ m], 'topright', above = TRUE )
      }
      
      if( ISPLOT ){
        mtext( '...from these species', side = 1, line = .4, outer = TRUE, cex = 1.2 )
        mtext( 'Fraction of unknown seed type...', side = 2, line = .4, outer = TRUE, cex = 1.2 )
        
        aspec <- sort( unique( aspec ) )
        
        cornerLegend( 'bottomright', aspec, text.col = specCol[ aspec], 
                     cex = 1.1, bty = 'n', ncol = 1 )
        
        if( CONSOLE )
          readline( 'Species to undiff seed -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- paste( 'Contribution of each species to undifferentiated type' )
          message( words )
          caption <- c( caption, words )
        }
      }else{
        while (!is.null(dev.list())) dev.off()
      }
    }
  }
  
  ##############################
  
  if( RANDOM ){
    
    aMu <- parameters$aMu
    
    att <- aMu*0
    wc <- 1
    if( length( aMu ) > 1 ){
      diag( att ) <- 1
      wc <- which( att == 1 )
    }
    
    vaa <- agibbs[, wc, drop = FALSE]
    vrr <- apply( vaa, 2, sd )
    
    if( max( vrr ) > 1e-5 ){
      
      words <- .chainPlot( aUgibbs[, wc, drop = FALSE], burnin, 
                          'random effects covariance', 
                          ngLab, burnLab, 
                 refVals = NULL, CONSOLE, RMD, SAVEPLOTS, outFolder )
      caption <- c( caption, words )
    }
    if( is.null( RMD ) ) graphics.off( )
  }
  
  
  ########### coefficients
  
  if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'fecundityCoeffs.pdf' ) )

  fitCols <- colnames( xfecu2s )
  
  # standardized betas
  bfecStnd <- bfec*0
 # bfecStnd[, fitCols] <- bfec[, fitCols]%*%t( xfecu2s )
  
  bfecStnd <- bfec[, fitCols]%*%t( xfecu2s )
  
 # brepStnd <- brep%*%t( xrepu2s )
 # colnames( brepStnd ) <- colnames( brep )
  
  wss <- grep( 'species', colnames( bfecStnd ) )
  wff <- grep( 'species', rownames( betaFec ) )
  
  if( length( wss ) > 0 & length( wff ) == 0 )
    rownames( betaFec ) <- colnames( bfecStnd )
  
  if( nspec == 1 ){
              
    par( mfrow = c( 1, 2 ), mar = c( 5, 4, 2, 1 ), bty = 'n' )
    tmp <- .boxplotQuant( brep[ drop = FALSE, burnin:ng, ], add = F, xaxt = 'n', 
                          xlim = NULL, ylab = 'Standard deviations', 
                          outline = FALSE, col = .getColor( 'black', .2 ), 
                          border = 'black', lty = 1, boxfill = NULL )
    
    axis( 1, at = c( 1:nrow( betaRep ) ), labels = rnames, las = 2 )
    abline( h = 0, col = 'grey', lwd = 2, cex.axis = .6 )
    title( 'a ) Maturation' )
    if( TV )abline( h = inputs$trueValues$betaRep, lwd = 2, lty = 2, col = 'grey' )
    
    tmp <- .boxplotQuant( bfecStnd[ drop = FALSE, burnin:ng, !colnames( bfecStnd ) %in% notFit], 
                          add = F, xaxt = 'n', 
                          xlim = NULL, ylab = '', 
                          outline = FALSE, col = .getColor( 'black', .2 ), 
                          border = 'black', lty = 1, boxfill = NULL )
    axis( 1, at = c( 1:nrow( betaFec ) ), labels = fnames, las = 2 )
    abline( h = 0, col = 'grey', lty = 2 )
    title( 'b ) Fecundity' )
    if( TV ){
      abline( h = inputs$trueValues$betaFec, lwd = 2, lty = 2, col = 'grey' )
      text( 2, inputs$trueValues$betaFec[ 1] + 2, 'true values' )
    }
    
  }else{
    
    par( mfrow = c( 2, 2 ), mar = c( 1, 3, 1, .2 ), bty = 'n', oma = c( 2, 2, 1, 1 ) )
    
    rr <- rownames( betaFec )
    if( length( notFit ) > 0 )rr <- rr[ !rr %in% notFit]

    plotCoeffs( beta = brep, bchain = brep, burnin, ng, 
               specNames, specCol, cex = .85, 
               xlab = 'Maturation' )
    
    plotCoeffs( betaFec[ rr, ], bfecStnd[, rr], burnin, ng, specNames, specCol, cex = .85, 
               xlab = 'Fecundity' )
    mtext( 'Standardardized estimates', side = 2, outer = TRUE )
  }
  
  if( CONSOLE )readline( 'fecundity ( standardized ), maturation ( unstandardized ) -- return to continue ' )
  if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
  
  if( is.null( RMD ) ){
    graphics.off( )
  }else{
    words <- paste( 'Posterior estimates for maturation and fecundity parameters' )
    message( words )
    caption <- c( caption, words )
  }
  
  
  ############ aspect
  
  asp   <- grep( 'aspect', colnames( bfec ) )
  
  if( length( asp ) > 0 ){
    
    ssp   <- grep( 'slope', colnames( bfec ) )
    abeta <- colMeans( bfec[, unique( c( ssp, asp ) )] )
    betaSlope <- matrix( abeta, nspec, 3 )
    rownames( betaSlope ) <- specNames
    betaSlope <- betaSlope[ drop = F, betaSlope[, 1] != 0, ]
    
    if( nrow( betaSlope ) > 0 ){
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'slopeAspect.pdf' ) )
      
      plotAspectEffect( betaSlope, slopeRange = c( .1, .3 ), specCol = .getColor( specCol, .4 ), 
                        aspect = seq( -pi, pi, length = 100 ), minEffect = 0, maxNumber = 20, 
                        ylim = NULL, textSize = .8, xlab = 'Aspect', ylab = 'Effect' )

      sa <- u2slopeAspect( inputs$treeData[, c( 'slope', 'aspect1', 'aspect2' )] )
      
      ww <- which( !is.na( sa[, 1] ) )
      xa <- sa[ ww, 'aspect']/180*pi 
      cx <- sa[ ww, 'slope']/45  # percent slope
      cl <- specCol[ inputs$treeData$species[ ww]]
      
      points( jitter( xa, 100 ), runif( length( xa ), 0, .5 ), cex = cx, 
              pch = 15, col = .getColor( cl, cx/2 ) )
      
      
      if( CONSOLE )readline( 'slope, aspect -- return to continue ' )
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      if( is.null( RMD ) )graphics.off( )
    }
  }
  
  
  ############ maturation, fecundity
  
  obsRows  <- which( tdata$obs == 1 )
  
  nsim <- 500
  lseq <- seq( 0, 1, length = 1000 )
  lseq <- cumsum( lseq*( 1 - lseq ) )
  lseq <- lseq/max( lseq )
  lseq <- lseq[ !duplicated( lseq )]
  
  fss   <- rep( specNames[ 1], length( obsRows ) )
  
  if( nspec > 1 ){
    scols <- paste( 'species', specNames, sep = '' )
    xftmp <- xfec[, scols]
    xrtmp <- xrep[, scols]
    fss   <- specNames[ apply( xftmp[ obsRows, ], 1, which.max )]
  }
  
  # simulate first to evaluate scale
  
  mrList <- vector( 'list', nspec )
  names( mrList ) <- specNames
  drList <- srList <- arList <- mrList

  xmax <- ymax <- 0
  
  for( j in 1:nspec ){
    
    fspec  <- fecPred[ obsRows, ]
    wrow   <- which( fss == specNames[ j] )
    fspec  <- fspec[ wrow, ]
    pspec  <- fspec$plot
    mspec  <- fspec$matrEst
    dspec  <- fspec$diam
    
    # plot up to last 5 trees
    qd <- 5/length( dspec )
    dtops <- quantile( dspec, 1 - qd )
    
    xrspec <- xrep[ rownames( fspec ), ]
    xfspec <- xfec[ rownames( fspec ), ]
    
    pspec <- as.character( pspec )
    pall  <- sort( unique( pspec ) )
    
    dq   <- round( quantile( dspec, lseq ), 1 )
    dq   <- unique( dq )
    
    ttt  <- nn2( dspec, dq, k = 1 )[[ 1]]
    www  <- which( duplicated( ttt ) )
    if( length( www ) > 0 )ttt <- ttt[ -www]
    
    ntt  <- length( ttt )                          # tree yr
    ksamp <- sample( burnin:ng, nsim, replace = TRUE )   # MCMC row
    bcols <- colnames( brep )
    fcols <- colnames( bfec )
    if( nspec > 1 ){
      bcols <- bcols[ grep( specNames[ j], bcols )]
      fcols <- fcols[ grep( specNames[ j], fcols )]
    }
    
    ddcol <- grep( 'diam', bcols )
    fdcol <- grep( 'diam', fcols )
    
    xtt <- xrspec[ ttt, bcols]            # standardized
    ftt <- xfspec[ ttt, fcols]
    dtt <- dspec[ ttt]
    
    fcol <- c( 1, grep( 'diam', colnames( ftt ) ) )  # isolate diameter effect
    rcol <- c( 1, grep( 'diam', colnames( xtt ) ) )
    
    fcols <- fcols[ fcol]
    bcols <- bcols[ rcol]
    
    grf <- grep( ':diam:', fcols )
    if( length( grf ) > 0 )fcols <- fcols[ -grf]
    grf <- grep( 'diam:', fcols )
    if( length( grf ) > 0 )fcols <- fcols[ -grf]
    
    grb <- grep( ':diam:', bcols )
    if( length( grf ) > 0 )bcols <- bcols[ -grf]
    grf <- grep( 'diam:', bcols )
    if( length( grf ) > 0 )bcols <- bcols[ -grf]
    
    xtmu <- matrix( colMeans( ftt ), nrow( ftt ), ncol( ftt ), byrow = TRUE )
    gcol <- grep( 'diam', colnames( ftt ) )
    
    rk <- mk <- ak <- sk   <- matrix( NA, ntt, nsim )
    
    for( k in 1:nsim ){  # predict maturation, fecundity
      
      ss <- sqrt( sgibbs[ ksamp[ k], 1] )
      kcols <- fcols[ fcols %in% colnames( bfecStnd )]
      bf <- bfecStnd[ ksamp[ k], kcols, drop = FALSE] 
      bint <- 0
      
      if( RANDOM ){                             # check standardized
        bfr <- rmvnormRcpp( 1, aMu[ 1, ]*0, aMu )
        names( bfr ) <- colnames( aMu )
        bfr <- bfr[ colnames( aMu ) %in% kcols]
        bf[, names( bfr )] <- bf[, names( bfr )] + bfr
      }
      
      mk[, k] <- pnorm( xtt[, bcols]%*%t( brep[ ksamp[ k], bcols, drop = FALSE] ) )
      muk <- ftt[, kcols]%*%t( bf )
      #   sk[, k] <- exp( muk + rnorm( ntt, 0, ss ) )*mk[, k]
      
      sk[, k] <- exp( muk )*mk[, k]
      ak[, k] <- exp( muk + rnorm( ntt, 0, ss ) )*mk[, k]
    }
    
    wd <- which( dtt <= dtops )
    
    mrList[[ j]] <- apply( mk[ wd, ], 1, quantile, c( .5, .05, .95 ) )  # 90% credible interval for maturation
    srList[[ j]] <- apply( sk[ wd, ], 1, quantile, c( .5, .05, .95 ) )  # for 90% credible interval on fecundity
    arList[[ j]] <- apply( ak[ wd, ], 1, quantile, c( .5, .05, .95 ) )  # for 90% predictive interval
    drList[[ j]] <- dtt[ wd]
    ymax <- max( c( ymax, srList[[ j]][ 1, ] ) )
    xmax <- max( c( xmax, dtops ) )
    
    colnames( srList[[ j]] ) <- dtt[ wd]
    
  }
  diamFec <- srList
  
  if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'maturation.pdf' ) )
  
  mfrow <- c( nspec, 2 )
  par( mfrow = mfrow, bty = 'n', mar = c( 1, 3, .5, 3 ), oma = c( 3, 2, 1.2, 2 ) )
  
  ym   <- max( c( 1.1*sqrt( ymax ), 20 ) )  # sets vertical scale
  tt   <- sqrtSeq( ym )
  at   <- tt$at
  labs <- tt$labs
  xlim <- c( 0, max( tdata$diam, na.rm = TRUE ) )
  npat <- 5
  if( nspec > 4 )npat <- 4
  if( nspec > 7 )npat <- 3
  
  diamSeq <- seq( xlim[ 1], xlim[ 2], length = 500 )
  
  bprior <- inputs$brepPriorBoundsUnst
  blims  <- inputs$priorTable[, c( 'minDiam', 'maxDiam' )]
  
  # sqrt scale
  for( j in 1:nspec ){
    
    fspec  <- fecPred[ obsRows, ]
    wrow   <- which( fss == specNames[ j] )
    fspec  <- fspec[ wrow, ]
    pspec  <- fspec$plot
    mspec  <- fspec$matrEst
    dspec  <- fspec$diam
    
    mr <- mrList[[ j]]
    sr <- sqrt( srList[[ j]] )
    ar <- sqrt( arList[[ j]] ) # plot on sqrt scale
    dtt <- drList[[ j]]
    
    xaxt <- 'n'
    if( j == nspec )xaxt <- 's'
    
    plot( NULL, xlim = xlim, ylim = c( 0, 1 ), xlab = '', 
         ylab = '', xaxt = xaxt )
    if( j < nspec )axis( 1, labels = FALSE )
    wp <- match( as.character( pspec ), plots )
    
    
    bdiam <- unlist( blims[ specNames[ j], ] )
    wdd <- which( diamSeq >= bdiam[ 1] & diamSeq <= bdiam[ 2] )
    if( length( wdd ) < 3 ){
      bdiam[ 2] <- bdiam[ 2] + 3
      wdd <- which( diamSeq >= bdiam[ 1] & diamSeq <= bdiam[ 2] )
    }
    
    if( !is.null( bprior ) ){
      bpr <- bprior[ c( j, j+nspec ), ]
      dss <- diamSeq[ wdd]
      plo <- pnorm( bpr[ 1, 1] + bpr[ 2, 1]*dss )
      phi <- pnorm( bpr[ 1, 2] + bpr[ 2, 2]*dss )
      .shadeInterval( dss, cbind( plo, phi ) , col = .getColor( 'orange', .1 ) )
      
      lines( diamSeq, pnorm( bpr[ 1, 1] + bpr[ 2, 1]*diamSeq ), col = .getColor( 'black', .4 ), 
            lty = 2, lwd = 1 )
      lines( diamSeq, pnorm( bpr[ 1, 2] + bpr[ 2, 2]*diamSeq ), col = .getColor( 'black', .4 ), 
            lty = 2, lwd = 1 )
      
      pd1 <- pnorm( bpr[ 1, 1] + bpr[ 2, 1]*bdiam )
      
      segments( bdiam, c( 0, 0 ), bdiam, pd1, col = .getColor( 'black', .4 ), 
                lty = 2, lwd = 1 )
    }
    
    fj <- mspec
    wj <- which( fj < .001 | fj > .999 )
    fj[ wj] <- jitter( fj[ wj], .15 )
    if( POINTS )points( dspec, fj, pch = 16, col = .getColor( plotCol[ pspec], .3 ), cex = .3 )
    .shadeInterval( dtt, t( mr[ 2:3, ] ) , col = .getColor( '#e34a33', .2 ) )
    lines( dtt, mr[ 1, ], col = 'white', lwd = 5 )
    lines( dtt, mr[ 1, ], lwd = 2 )
    
    if( j == 1 )title( 'Maturation' )
    
    fpp <- fspec$fecEstMu*fspec$matrEst
    
    xaxt <- 'n'
    if( j == nspec )xaxt <- 's'
    
    # histogram of diameter polygon getpoly
    
    plot( NULL, xlim = xlim, ylim = range( at ), xlab = '', ylab = '', 
         xaxt = xaxt, yaxt = 'n' )
    if( j < nspec )axis( 1, labels = FALSE )
    axis( 2, at = at, labels = labs )
    
    
    tov  <- hist( fspec$diam, nclass = 20, plot = FALSE )
    ovec <- tov$count
    
    tmp <- .getPoly( tov$breaks[ -1], ovec )
    cnt <- tmp[ 2, ]
    cnt <- log10( cnt )
    cnt[ cnt < 0] <- 0
    
    pmax   <- .4
    pscale <- pmax*max( at )/( 1 + max( cnt ) )
    polygon( tmp[ 1, ], pscale*cnt, col = .getColor( specCol[ specNames[ j]], .3 ), lwd = 2, 
             border = specCol[ specNames[ j]] )
    
    pat <- max( cnt/pmax ) + 1
    mpat <- floor( pat )
    
    pat <- seq( 0, mpat, length = npat )
    lpat <- round( 10^pat, -2 )
    if( lpat[ 2] == 0 )lpat <- round( 10^pat, -1 )
    if( lpat[ 2] == 0 )lpat <- round( 10^pat, 0 )
    apat <- pat*max( at )/mpat
    axis( side = 4, at = apat, labels = lpat )
    abline( h = apat, col = .getColor( specCol[ specNames[ j]], .3 ), lty = 2, 
           lwd = 2 )
    
    if( POINTS )points( dspec, sqrt( fpp ), pch = 16, col = .getColor( plotCol[ pspec], .3 ), 
                     cex = .5 )
    
    .shadeInterval( dtt, t( ar[ 2:3, ] ) , col = 
                      .getColor( '#fdcc8a', .1 ) )
    .shadeInterval( dtt, t( sr[ 2:3, ] ) , col = 
                      .getColor( '#e34a33', .01 ) )
    
    lines( dtt, sr[ 1, ], col = 'white', lwd = 6 )
    lines( dtt, sr[ 1, ], lwd = 2 )
    
    if( nspec > 1 ).plotLabel( specNames[ j] )
    if( j == 1 )title( 'Fecundity' )
  }
  mtext( 'Diameter ( cm )', side = 1, line = 1, outer = TRUE )
  mtext( 'Probability', side = 2, line = 0, outer = TRUE )
  mtext( 'log trees', side = 4, line = 0, outer = TRUE )
  
  if( CONSOLE )
    readline( 'maturation, fecundity by diameter -- return to continue ' )
  if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
  
  if( is.null( RMD ) ){
    graphics.off( )
  }else{
    words <- paste( 'Predictive distribution for maturation, fecundity from posterior ( brown shaded ) and prior interval for maturation at left ' )
    message( words )
    caption <- c( caption, words )
  }
  
  ########### random coefficients
  
  if( RANDOM ){
    
    xrandCols  <- output$data$setupRandom$xrandCols
    formulaRan <- output$data$setupRandom$formulaRan
    
    betaFec <- output$parameters$betaFec[, 1, drop = FALSE]
    names( xrandCols ) <- rownames( output$parameters$betaFec )[ xrandCols]
    alphaUMu <- parameters$alphaUMu
    intercept <- paste( 'species', specNames, sep = '' )
    if( nspec == 1 )intercept <- '(Intercept)'
    slopes    <- names( xrandCols )[ !names( xrandCols ) %in% intercept]
    
    rlim <- range( alphaUMu )
    
    
    if( rlim[ 2 ] > 0 ){
      
      npp <- length( slopes )/length( intercept )
      
      npp <- 1
      
      mfrow <- c( 1, 1 )
      if( npp > 1 )mfrow <- c( 2, 2 )
      
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'randomCoeffs.pdf' ) )
      par( mfrow = mfrow, bty = 'n', mar = c( 4, 4, 1, 1 ), cex = 1.2 )
      
      icol <- match( intercept, colnames( alphaMu ) )
      icol <- icol[ is.finite( icol )]
      xlim <- range( betaFec[ icol, ] + alphaMu[, icol] )
      intercept <- intercept[ is.finite( icol )]
      
      if( length( slopes ) == 0 ){
        
        breaks <- seq( rlim[ 1]-.1, rlim[ 2]+.1, length = 20 )
        hvals <- xvals <- numeric( 0 )
        for( s in 1:length( specNames ) ){
          ra <- alphaUMu[, icol[ s]]
          ra <- ra[ ra != 0]
          tmp <- hist( ra, plot = FALSE, breaks = breaks )
          hvals <- cbind( hvals, tmp$density )
          xvals <- cbind( xvals, tmp$mids )
        }
        ylim <- range( hvals, na.rm = TRUE )
        xl   <- range( betaFec[ colnames( alphaUMu ), 1], na.rm = TRUE ) + range( rlim, na.rm = TRUE )
        xl[ 1] <- xl[ 1] - 1
        xl[ 2] <- xl[ 2] + 1
        
        plot( NA, xlim = xl, ylim = ylim, xlab = 'log fecundity ( fixed plus random )', ylab = 'frequency' )
        for( s in 1:length( specNames ) ){
          
          hp <- which( hvals[, s] > 0 )
          if( length( hp ) == 0 )next
          
          ws <- suppressWarnings( range( hp ) )
          
          
          
          ss <- ws[ 1]:ws[ 2]
          xs <- betaFec[ icol[ s], 1] + xvals[ ss, 1]
          xs <- c( xs[ 1], xs, xs[ length( xs )] )
          ys <- c( 0, hvals[ ss, s], 0 )
          lines( xs, ys, type = 's', col = specCol[ s], lwd = 2 )
          lines( xs, xs*0, col = specCol[ s], lwd = 2 )
        }
      }else{
        
        ww <- grep( ':', slopes )
        
        if( length( ww ) > 0 ){
          slopeLab <- columnSplit( slopes, ':' )[, 2]
        }else{
          slopeLab <- slopes
        }
        jcol <- match( slopes, colnames( alphaMu ) )
        ylim <- range( betaFec[ jcol, 1] + alphaMu[, jcol] )
        
        if( length( icol ) == 1 )jcol <- jcol[ 1]
        
        slab <- unique( slopeLab )
        jcol <- jcol[ slopeLab == slab[ 1]]
        
        plot( betaFec[ icol, 1], betaFec[ jcol, 1], col = .getColor( specCol, .7 ), 
             xlim = xlim, ylim = ylim, cex = .8, xlab = 'Intercept', ylab = slopeLab[ 1] )
        abline( h = 0, lwd = 2, lty = 2, col = 'grey' )
        abline( v = 0, lwd = 2, lty = 2, col = 'grey' )
        
        for( s in 1:length( specNames ) ){
          points( betaFec[ icol[ s], 1] + alphaMu[, icol[ s]], 
                 betaFec[ jcol[ s], 1] + alphaMu[, jcol[ s]], 
                 col = .getColor( specCol[ s], .3 ), pch = 16, cex = 1 )
        }
      }
      legend( 'topright', specNames, text.col = specCol, bty = 'n' )
      
      if( CONSOLE )
        readline( 'fixed plus random effects -- return to continue ' )
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- 'Posterior estimates of fixed plus random effects'
        message( words )
        caption <- c( caption, words )
      }
    }
  }
  
  ############ dispersal
  
  if( SEEDDATA ){
    
    cols  <- specCol[ colnames( ugibbs )]
    upars <- parameters$upars[ drop = FALSE, colnames( ugibbs ), ]
    
    if( ncol( ugibbs ) > 1 ){
      
      if( is.null( rownames( upars ) ) )rownames( upars ) <- 'mean'
      
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'dispersalCoeffs.pdf' ) )
      
      ncc <- ncol( ugibbs )
      sideMar <- min( c( 3, 3 + 10/ncc ) )
      
      par( mfrow = c( 1, 1 ), mar = c( 3, 5, 5, 4 ), bty = 'n', oma = c( 2, sideMar, 1, sideMar ) )
      
      ylim <- range( ugibbs )
      ylim[ 1] <- .75*ylim[ 1]
      ylim[ 2] <- 1.25*ylim[ 2]
      
      ylab1 <- expression( paste( hat( u ), ' ( ', plain( m )^2, ' )' ) )
      ylab2 <- expression( paste( 'Kernel mean ', bar( d ), ' ( m )' ) )
      
      # uord <- order( colMeans( ugibbs, na.rm = T ) )
      # colu <- cols[ uord]
      
      atvals <- c( 1:ncc )/( ncc + 1 )
      atvals <- atvals - mean( atvals )
      
      tmp <- .boxplotQuant( ugibbs, xaxt = 'n', add = F, xlim = NULL, 
                            ylab = ylab1, ylim = ylim, boxwex = .1, 
                            at = atvals, 
                            outline = FALSE, col = .getColor( cols, .3 ), 
                            border = cols, lty = 1, boxfill = NULL )
      tmp$xtick <- atvals
      .boxCoeffsLabs( boxPars = tmp, labels = names( cols ), 
                      colLabs = cols, cex = .8 )
      
      rr <- range( pi*sqrt( ugibbs )/2 )
      rm <- -1
      by <- 10
      if( diff( rr ) < 20 ){
        by <- 5
        rm <- 0
      }
      if( diff( rr ) < 10 ){
        by <- 2
        rr[ 1] <- rr[ 1] - 1
        rr[ 2] <- rr[ 2] + 1
      }
      
      rr <- round( rr, rm )
      rr <- seq( rr[ 1], rr[ 2], by = by )
      
      axis( 4, at = ( 2*rr/pi )^2, labels = rr )
      mtext( ylab2, 4, line = 0, outer = TRUE )
      abline( v = par( 'usr' )[ 1:2], lwd = 2 )
      
      if( CONSOLE )
        readline( 'dispersal by group -- return to continue ' )
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- paste( 'Posterior estimates for dispersal parameters' )
        message( words )
        caption <- c( caption, words )
      }
    }
    
    if( is.null( RMD ) ) graphics.off( )
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'seedShadow.pdf' ) )
    
    par( mfrow = c( 1, 1 ), bty = 'n' )
    
    xfec  <- data$setupData$xfec
    
    qd     <- .75
    dcol  <- grep( ':diam', colnames( xfec ) )
    dtcol <- grep( 'diam', colnames( tdata ) )
    lab60 <- tdata[, dtcol]
    lab60 <- lab60[ lab60 != 0]
    lab60 <- quantile( lab60, qd )
    lab60 <- signif( lab60, 1 )
    if( lab60 < 10 )lab60 <- 10
    ord <- order( tdata[, dtcol] )
    sdd <- tdata[ ord, dtcol]
    dd <- findInterval( lab60, sdd )
    lab60 <- sdd[ dd]
    diam60 <- xfec[ ord[ dd], dcol]
    diam60 <- diam60[ diam60 != 0]
    
    # each group at mean for other predictors
    xbar   <- numeric( 0 )
    rnames <- character( 0 )
    ucol   <- numeric( 0 )
    
    snames <- colnames( ugibbs )
    
    for( j in 1:ncol( ugibbs ) ){
      
      wj   <- which( tdata$species == snames[ j] )
      xmu  <- colMeans( xfec[ drop = FALSE, wj, ] )
      
      w0 <- which( xmu != 0 )       #insert diameter value
      w0 <- intersect( w0, dcol )
      xmu[ w0] <- diam60
      
      xbar <- rbind( xbar, xmu )
      rnames <- c( rnames, snames[ j] )
    }
    
    rownames( xbar ) <- rnames
    if( !USPEC )xbar <- xbar[ drop = FALSE, 1, ]
    
    nsim   <- 2000
    ns     <- 100
    buffer <- 15
    
    dpars <- parameters$dpars[ drop = FALSE, colnames( ugibbs ), ]
    
    mm <- 6*max( dpars )
    if( USPEC )mm <- 6*max( dpars[, 'estimate'] )
    
    dseq <- 10^seq( 0, log10( mm ), length = ns ) - 1
    dseq <- matrix( dseq, ns, nsim )
    
    ij <- sample( 1:nrow( ugibbs ), nsim, replace = TRUE )
    
    ssList <- numeric( 0 )
    maxy   <- 0
    
    xbar <- xbar[, colnames( xbar ) %in% colnames( bfecStnd ), drop = F]
    
    bf <- bfecStnd[ ij, colnames( xbar )]
    
    if( RANDOM ){
      br <- rmvnormRcpp( nrow( bf ), aMu[ 1, ]*0, aMu )
      colnames( br ) <- colnames( aMu )
      bf[, colnames( br )] <- bf[, colnames( br )] + br
    }
    ff <-  bf%*%t( xbar )
    ff <- ff[, colnames( ugibbs ), drop = FALSE]
    xbar <- xbar[ drop = F, colnames( ugibbs ), ]
    
    maxy <- numeric( 0 )
    
    kss <- 1:( ns-buffer )
    keepSeq <- c( rev( kss ), kss ) 
    dss  <- c( -rev( dseq[ kss, 1] ), dseq[ kss, 1] )
    
    for( k in 1:ncol( ugibbs ) ){
      
      uj <- ugibbs[ ij, k]
      sj <- sgibbs[ ij, 'sigma']
      
      kj <- uj/pi/( uj + dseq^2 )^2
      kj <- kj*matrix( exp( ff[, k] + sj/2 ), ns, nsim, byrow = TRUE )
      kj[ !is.finite( kj )] <- NA
      qj <- t( apply( kj, 1, quantile, c( .5, .05, .95 ), na.rm = TRUE ) )
      
      for( m in 1:3 )qj[, m] <- runmed( qj[, m], k = buffer, endrule = 'constant' )
      maxy <- c( maxy, max( qj[, 1] ) )
      
      ssList <- append( ssList, list( qj[ keepSeq, ] ) )
    }
    
    maxy[ maxy > 1e+10] <- 1e+10
    maxy[ maxy < 1e-10] <- 1e-10
    names( ssList ) <- rownames( xbar )
    
    par( bty = 'n', mar = c( 5, 5, 1, 1 ) )
    
    labSeeds <- expression( paste( 'Seeds ( ', plain( m )^-2, ' )' ) )
    
    if( USPEC ){
      rmax <- diff( range( log10( maxy ) ) )
    }else{
      rmax <- log10( maxy )
    }
    SQRT <- FALSE
    if( rmax > 3 ){
      SQRT <- TRUE
      smax <- sqrt( max( maxy ) )
      plot( NULL, xlim = range( dss ), ylim = c( 0, smax ), 
           xlab = 'Distance ( m )', ylab = labSeeds, yaxt = 'n' )
      tt   <- sqrtSeq( 1.2*smax )
      at   <- tt$at
      labs <- tt$labs
      axis( 2, at = at, labels = labs )
      
    }else{
      plot( NULL, xlim = range( dss ), ylim = c( 0, 1.2*max( maxy ) ), 
           xlab = 'Distance ( m )', ylab = labSeeds )
    }
    
    for( k in 1:length( ssList ) ){
      if( maxy[ k] <= 1e-10 | maxy[ k] >= 1e+10 )next
      ss <- ssList[[ k]][, 2:3]
      
      if( SQRT )ss <- sqrt( ss )
      .shadeInterval( dss, ss , col = 
                        .getColor( cols[ names( cols )[ k]], .2 ) )
    }
    mc <- numeric( 0 )
    for( k in 1:length( ssList ) ){
      ss <- ssList[[ k]][, 1]
      if( max( ss, na.rm = TRUE ) >= 1e+10 )next
      if( SQRT )ss <- sqrt( ss )
      lines( dss, ss, col = 'white', lwd = 6 )
      lines( dss, ss, col = cols[ names( cols )[ k]], lwd = 2 )
      mc <- c( mc, max( ssList[[ k]][, 1] ) )
    }
    
    if( USPEC ){
      ord <- order( mc, decreasing = TRUE )
      legend( 'topright', names( cols )[ ord], 
             text.col = cols[ names( cols )[ ord]], bty = 'n' )
    }
    legend( 'topleft', paste( round( lab60 ), ' cm diameter tree', sep = '' ), bty = 'n' )
    
    if( CONSOLE )
      readline( 'seed shadow -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- paste( 'Seed shadow predictions for a ', round( lab60 ), ' cm diameter tree', sep = '' )
      message( words )
      caption <- c( caption, words )
    }
    
    
    ########### predicted seed counts, true fecundity
    
    xs <- rowSums( sdata[ sdata$obs == 1, seedNames, drop = FALSE] )
    pcols <- grep( 'predMean', colnames( seedPred ) )      # by seed trap
    ecols <- grep( 'estMean', colnames( seedPred ) )
    
    ys <- seedPred[, pcols]
    zs <- seedPred[, ecols]
    
    ww <- which( is.finite( xs ) & xs > 0 )
    
    if( length( ww ) > 10 ){
      
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'seedPrediction.pdf' ) )
      
      xs <- xs[ ww]
      ys <- ys[ ww]
      zs <- zs[ ww]
      
      ylim <- quantile( c( ys, zs ), c( 0, .99 ), na.rm = TRUE )
      ylim[ 2] <- ylim[ 2]*1.5
      xlim <- range( xs, na.rm = TRUE ) + 1
      
      mfrow <- c( 1, 2 )
      title <- 'a ) From posterior distribution'
      
      if( TV )mfrow <- c( 2, 2 )
      if( SEEDCENSOR )mfrow <- c( 2, 2 )
      
      par( mfrow = mfrow, mar = c( 4, 4, 2, 1 ), bty = 'l' )
      
      bins <- getBins( xs, nbin = 10, pow = .4 )
      nbin <- length( bins )
      
      opt <- list( log = FALSE, xlabel = 'Observed', bins = bins, 
                  nbin = nbin, ylabel = 'Predicted', col = 'forestgreen', 
                  ylimit = ylim, xlimit = xlim, SQRT = TRUE )
      tmp <- .plotObsPred( xs, ys, opt = opt )
      .plotLabel( title, above = TRUE, cex = 1 )
      abline( 0, 1, lwd = 2, col = 'white' )
      abline( 0, 1, lty = 2 )
      abline( h = mean( ys, na.rm = T ), lty = 2 )
      if( SEEDCENSOR ){
        cs <- sqrt( seedPred[ rownames( censMin ), pcols] )
        xl <- rowSums( censMin[, -1, drop = FALSE] )
        xh <- rowSums( censMax[, -1, drop = FALSE] )
        xh[ xh > xlim[ 2]] <- xlim[ 2]
        opt <- list( log = FALSE, xlabel = 'Censored interval', bins = bins, 
                    nbin = nbin, ylabel = ' ', col = 'white', ptcol = 'white', 
                    ylimit = ylim, xlimit = xlim, SQRT = TRUE )
        tmp <- .plotObsPred( xs, ys, opt = opt )
        segments( xl, cs, xh, cs, col = .getColor( 'black', .1 ) )
        abline( 0, 1, lwd = 2, col = 'white' )
        abline( 0, 1, lty = 2 )
        .plotLabel( 'b ) Censored observations', above = TRUE, cex = 1 )
      }
      
      lab <- 'b ) From fecundity estimate'
      if( SEEDCENSOR )lab <- 'c ) From fecundity estimate'
      
      opt <- list( log = FALSE, xlabel = 'Observed', bins = bins, atx = tmp$atx, labx = tmp$labx, 
                  aty = tmp$aty, laby = tmp$laby, 
                  ylabel = '', col = 'forestgreen', #ylimit = ylim, xlimit = xlim, 
                  nbin = nbin, SQRT = TRUE )
      tmp <- .plotObsPred( xs, zs, opt = opt )
      .plotLabel( lab, above = TRUE, cex = .8 )
      abline( 0, 1, lwd = 2, col = 'white' )
      abline( 0, 1, lty = 2 )
      abline( h = mean( zs, na.rm = T ), lty = 2 )
      
      cwords <- 'prediction'
      
      if( SEEDCENSOR ){
        cs <- sqrt( seedPred[ rownames( censMin ), ecols] )
        xl <- rowSums( censMin[, -1, drop = FALSE] )
        xh <- rowSums( censMax[, -1, drop = FALSE] )
        xh[ xh > xlim[ 2]] <- xlim[ 2]
        opt <- list( log = FALSE, xlabel = 'Censored interval', bins = bins, 
                    nbin = nbin, ylabel = ' ', col = 'white', ptcol = 'white', 
                    ylimit = ylim, xlimit = xlim, SQRT = TRUE )
        tmp <- .plotObsPred( xs, ys, opt = opt )
        segments( xl, cs, xh, cs, col = .getColor( 'black', .1 ) )
        .plotLabel( 'd ) Censored from fecundity estimate', above = TRUE, cex = .9 )
        abline( 0, 1, lwd = 2, col = 'white' )
        abline( 0, 1, lty = 2 )
      }
      
      if( TV ){
        
        xs <- inputs$trueValues$fec
        ys <- prediction$fecPred$fecEstMu
        names( ys ) <- rownames( prediction$fecPred )
        
        anames <- intersect( names( xs ), names( ys ) )
        anames <- anames[ anames %in% names( xs ) & anames %in% names( ys )]
        ys <- ys[ anames]
        xs <- xs[ anames]
        
        ylim <- quantile( ys[ ys > 1], c( .02, .99 ) )
        ylim[ 1] <- max( c( ylim[ 1], 1 ) )
        
        ws <- which( xs > 0 & ys > 0 )
        xlim <- quantile( xs[ ws], c( .02, .99 ) )
        
        bins <- getBins( xs, pow = .2 )
        nbin <- length( bins )
        
        opt <- list( xlimit = xlim, ylimit = ylim, bins = bins, 
                    nbin = nbin, log = FALSE, xlabel = 'True values', 
                    ylabel = 'Estimates', col = 'darkgreen', SQRT = TRUE )
        .plotObsPred( xs, ys, opt = opt )
        .plotLabel( 'c ) Fecundity prediction', above = TRUE, cex = .8 )
        abline( 0, 1, lwd = 2, col = 'white' )
        abline( 0, 1, lty = 2 )
        
        xs <- inputs$trueValues$repr
        ys <- prediction$fecPred$matrEst
        names( ys ) <- rownames( prediction$fecPred )
        
        anames <- intersect( names( xs ), names( ys ) )
        anames <- anames[ anames %in% names( xs ) & anames %in% names( ys )]
        ys <- ys[ anames]
        xs <- xs[ anames]
        
        tmp <- boxplot( ys ~ xs, plot = FALSE )
        
        ss  <- apply( prediction$fecPred[, c( 'matrEst', 'matrPred' )], 2, quantile, 
                      pnorm( c( -1.96, -1, 0, 1, 1.96 ) ), na.rm = TRUE ) 
        ss  <- ss[ names( xs )]
        
        ps <- c( .025, .05, .1, .157 )
        ps <- c( ps, .5, 1 - ps )
        qs <- unlist( by( ys, INDICES = xs, FUN = quantile, ps ) )
        
        
        tmp$stats <- matrix( qs, length( ps ), 2 )
        bxp( tmp, add = F, yaxt = 'n', varwidth = TRUE, xlab = 'True values', 
            ylim = c( 0, 1 ), ylab = '', boxwex = .5, 
            outline = FALSE, col = .getColor( 'black', .2 ), 
            border = 'black', lty = 1, boxfill = NULL )
        axis( 2, at = c( 0, 1 ) )
        .plotLabel( 'd ) Maturation prediction', above = TRUE, cex = .8 )
      }
      
      if( SEEDDATA | TV ){
        
        if( CONSOLE )
          readline( paste( cwords, '-- return to continue' ) )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- 'Prediction from the posterior distribition'
          message( words )
          caption <- c( caption, words )
        }
      }
    } 
  }###################### end plot obs/pred seedData
  
  
  wc    <- which( is.finite( tdata$cropCount ) )
  if( length( wc ) == 0 )CONES <- FALSE
  
  if( CONES | 'cropMin' %in% colnames( tdata ) ){
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'cropTrees.pdf' ) )
    
    par( mfrow = c( 1, 1 ), bty = 'n', mar = c( 4, 4, 2, 1 ), omi = c( .8, .2, 0, .5 ) )
    
    cobs  <- seedTraits[ tdata$species, 'seedsPerFruit']*tdata$cropCount/tdata$cropFraction
    
    if( 'cropMin' %in% colnames( tdata ) ){
      wcrop <- which( is.finite( tdata$cropMin ) )
      cobs[ wcrop] <- ( tdata$fecMin[ wcrop] + tdata$fecMax[ wcrop] )/2 #  mean
      cobs[ wcrop][ !is.finite( cobs[ wcrop] )] <- tdata$fecMin[ wcrop][ !is.finite( cobs[ wcrop] )]
    }
    
    wc    <- which( is.finite( cobs ) )
    cobs  <- sqrt( cobs[ wc] )                    #sqrt scale
    cest  <- prediction$fecPred$fecEstMu[ wc]
    cese  <- prediction$fecPred$fecEstSe[ wc]
    cpre  <- prediction$fecPred$fecPredMu[ wc]
    cpse  <- prediction$fecPred$fecPredSe[ wc]
    
    cplo <- cpre - cpse
    cplo[ cplo < 0] <- 0
    cplo <- sqrt( cplo )
    cphi <- sqrt( cpre + cpse )
    
    celo <- cest - cese 
    celo[ celo < 0] <- 0
    celo <- sqrt( celo )
    cehi <- sqrt( cest + cese )
    
    xlim <- c( 0, max( cobs ) )      # sqrt scale
    ylim <- sqrt( c( 0, max( cpre + cpse ) ) )
    if( ylim[ 2] < max( cobs ) )ylim[ 2] <- max( cobs )
    
    ccens <- rep( 0, nrow( tdata ) )
    ws    <- numeric( 0 )
    
    ccenlo <- ccenhi <- NA
    if( 'cropMin' %in% colnames( inputs$treeData ) ){
      ws <- which( is.finite( tdata$cropMin ) )
      ccenlo <- tdata$fecMin[ ws]
      ccens[ ws]  <- ccenlo
      sest  <- prediction$fecPred$fecEstMu[ ws]
      sese  <- prediction$fecPred$fecEstSe[ ws]
      selo  <- sest - sese
      selo[ selo < 0] <- 0
      selo  <- sqrt( selo )
      selo  <- sqrt( selo )
    }
    if( 'cropMax' %in% colnames( inputs$treeData ) ){
      ws <- which( is.finite( tdata$cropMax ) )
      ccenhi <- tdata$fecMax[ ws]
      ccens[ ws]  <- ( ccens[ ws] + ccenhi )/2
      sehi  <- sqrt( sest + sese )
    }
    if( 'cropMin' %in% colnames( inputs$treeData ) |
       'cropMax' %in% colnames( inputs$treeData ) ){
      sobs  <- sqrt( ccens )
      slo   <- sqrt( ccenlo )
      shi   <- sqrt( ccenhi )
      shi[ shi > max( sehi )] <- max( sehi )
    }
    
    xlab <- expression( frac( 'count', 'crop fraction' ) %*% 'seeds per cone' )
      
  #    expression( paste( 'Kernel mean ', bar( d ), ' ( m )' ) )
    tt   <- sqrtSeq( 1.2*xlim[ 2] )
    atx   <- tt$at
    labsx <- tt$labs
    
    tt   <- sqrtSeq( 1.2*ylim[ 2] )
    aty   <- tt$at
    labsy <- tt$labs
 
    plot( cobs, sqrt( cpre ), xlim = xlim, ylim = ylim, xaxt = 'n', yaxt = 'n', 
         pch = 3, xlab = '', ylab = 'Seeds per tree', col = 'thistle4' )
    axis( 1, at = atx, labels = labsx )
    axis( 2, at = aty, labels = labsy )
    
    suppressWarnings( 
      arrows( cobs, cplo, cobs, cphi, lwd = 1, 
              angle = 90, length = .05, col = 'thistle4', code = 3 )
    )
    
    if( length( ws ) > 0 ){
      suppressWarnings( 
      arrows( sobs, selo, sobs, sehi, lwd = 1, 
              angle = 90, length = .05, col = .getColor( 'mediumaquamarine', .8 ), code = 3 ) )
     suppressWarnings( 
      arrows( slo, sqrt( sest ), shi, sqrt( sest ), lwd = 1, 
              angle = 90, length = .05, col = .getColor( 'mediumaquamarine', .8 ), code = 3 ) )
    }
    
    points( cobs, sqrt( cest ), pch = 3 )

    suppressWarnings( 
      arrows( cobs, celo, cobs, sqrt( cest + cese ) + .1, lwd = 1, 
              angle = 90, length = .05, col = 1, code = 3 )
    )
    abline( 0, 1, lwd = 2, col = 'grey', lty = 2 )
    leg <- c( 'Estimated', 'Predicted' )
    text.col <- c( 'black', 'grey' )
    if( length( ws ) > 0 ){
      leg <- c( 'Estimated censored counts', 'Estimated crop counts', 'Predicted' )
      text.col <- c( .getColor( 'mediumaquamarine', .8 ), 'black', 'thistle4' )
    }
    legend( 'topleft', legend = leg, text.col = text.col, 
           box.col = 'grey' )
    mtext( xlab, side = 1, outer = TRUE, line = 0 )
    
    if( CONSOLE )
      readline( 'Fecundity for cropCount trees -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Estimated/predicted fecundity for trees with cone counts'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  # true parameter values
  
  if( TV ){
    
    brepTrue <- inputs$trueValues$betaRep
    bfecTrue <- inputs$trueValues$betaFec
    
    betaFec <- as.matrix( output$parameters$betaFec[, 1:4] )
    betaRep <- as.matrix( output$parameters$betaRep[, 1:4] )
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, 'trueParameters.pdf' ) )
    
    par( mfrow = c( 1, 2 ), bty = 'n', mar = c( 3, 3, 3, 4 ), oma = c( 2, 2, 1, 1 ) )

    sc  <- grep( 'diam', rownames( betaRep ) )
    col <- rep( 'black', nrow( betaRep ) )
    col[ -sc] <- 'gray'
    slp <- c( mean( inputs$trueValues$betaRep[ sc, 1] ), mean( betaRep[ sc, 1] ) )
    
    xlim <- range( c( brepTrue, betaRep[, 3:4] ) )
    
    plot( brepTrue, betaRep[, 1], xlim = xlim, ylim = xlim, xlab = '', 
          ylab = ' ', pch = 3, col = col )
    abline( 0, 1, lwd = 2, lty = 2, col = .getColor( 'black', .4 ) )
    suppressWarnings( 
      arrows( inputs$trueValues$betaRep, betaRep[, 3], 
              inputs$trueValues$betaRep, betaRep[, 4], lwd = 2, 
              angle = 90, length = .05, col = col, code = 3 )
    )
    text( slp[ 1], slp[ 2], 'Slopes', pos = 2 )
    .plotLabel( 'a ) Maturation parameters', above = TRUE, cex = 1 )
    
    sc  <- grep( 'diam', rownames( betaFec ) )
    col <- rep( 'black', length( betaFec ) )
    col[ -sc] <- 'gray'
    slp <- c( mean( inputs$trueValues$betaFec[ sc, 1] ), mean( betaFec[ sc, 1] ) )
    
    bt <- bfecTrue
    bf <- betaFec
    
    ylim <- range( c( bt, bf[, -2] ) )
    
    plot( bt, bf[, 1], ylim = ylim, 
          xlab = '', ylab = '', pch = 3, col = col )
    abline( 0, 1, lwd = 2, lty = 2, col = .getColor( 'black', .4 ) )
    suppressWarnings( 
      arrows( bt, bf[, 3], 
              bt, bf[, 4], lwd = 2, 
              angle = 90, length = .05, code = 3, col = col )
    )
    text( slp[ 1], slp[ 2], 'Slopes', pos = 2 )
    .plotLabel( 'b ) Fecundity parameters', above = TRUE, cex = 1 )
    mtext( 'True values', side = 1, line = 0, outer = TRUE )
    mtext( 'Estimates', side = 2, line = 0, outer = TRUE )
    
    if( CONSOLE )
      readline( 'parameter recovery -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Posterior estimates compared with true values'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  ################# year effects
  
  YE <- 'betaYr' %in% names( parameters )
  
  if( is.null( parameters$betaYr ) )YE <- YR <- FALSE
  
 # if( YE )YE <- nrow( parameters$betaYr ) > 1 
  if( YE ){
    YEE <- 'betaYrRand' %in% names( parameters )
    if( YEE ){
      if( sum( parameters$betaYrRand ) == 0 )YE <- YR <- FALSE
    }
  }
  
  if( YE ){
    
    if( is.null( RMD ) ) graphics.off( )
    
    file <- paste( 'yearEffect.pdf', sep = '' )
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
    
    if( 'lagGroup' %in% names( inputs ) )AR <- TRUE
    
 #   betaYrMu <- parameters$betaYrRand[, 1, drop = FALSE]
 #   betaYrSe <- parameters$betaYrRandSE[, 2, drop = FALSE]
    
  #  if( ncol( betaYrMu ) == 1 ){
  #    betaYrMu <- t( betaYrMu )
  #    betaYrSe <- t( betaYrSe )
  #  }
    
    RANDYR <- FALSE
    
    if( 'betaYrRand' %in% names( parameters ) ){  #combine fixed and random
      
      betaYrRand   <- parameters$betaYrRand
      
      by <- betaYrRand
      by[ by != 0] <- 1
      wy <- which( rowSums( by, na.rm = T ) > 1 )
      betaYrRand <- betaYrRand[ drop = F, wy, ]
      betaYrRandSE <- parameters$betaYrRandSE[ drop = F, wy, ]
      betaYrRandSE[ is.na( betaYrRandSE )] <- 0
      bmu <- bsd <- betaYrRand*0
      RANDYR <- TRUE
      
      if( !AR ){
        ttab <- table( tdata$groupName, tdata$year )
      }else{
        ttab <- betaYrRand
      }
      ttab[ ttab != 0] <- 1
      ttab <- ttab[ drop = F, rownames( betaYrRand ), ]
      ctab <- betaYrRand*0
      ctab[, colnames( ttab )] <- ttab
      
      for( k in 1:nrow( betaYrRand ) ){
        
        bmu[ k, ] <- betaYrRand[ k, ]
        bsd[ k, ] <- betaYrRandSE[ k, ]
        bmu[ k, ] <- bmu[ k, ]*ctab[ rownames( betaYrRand )[ k], ]
        bsd[ k, ] <- bsd[ k, ]*ctab[ rownames( betaYrRand )[ k], ]
      }
      
      betaYrMu <- bmu
      betaYrSe <- bsd
      betaYrSe[ is.na( betaYrSe )] <- 0
    }
    
    if( AR ){
      par( mfrow = c( 1, 2 ), bty = 'n', mar = c( 5, 4, 2, 1 ) )
      xlab <- 'lag ( yr )'
      yr <- c( 1:plag )
      mr <- .5
    }
    
    xtt <- seq( 1900, 2100, by = 5 )                #reference xtick
    
    par( mfrow = c( 1, 1 ), bty = 'n', mar = c( 4, 4, 2, 5 ), mai = c( 1, 1, 1, 1.1 ) )
    if( AR ){
      yr <- xtick <- 1:plag
      xlab <- 'lag ( yr )'
    }
    if( YR & !AR ){
      yr <- which( colSums( betaYrMu ) != 0 ) 
      betaYrMu <- betaYrMu[drop = F, , yr]
      betaYrSe <- betaYrSe[drop = F,, yr]
      names( yr ) <- .replaceString( names( yr ), 'yr-', '' )
      yr <- as.numeric( names( yr ) )
      xtick <- min( yr ):max( yr )
      xlab <- ''
      if( length( yr ) > 15 )xtick <- xtick[ xtick %in% xtt]
    }
    mr  <- max( betaYrMu + betaYrSe, na.rm = TRUE )
    mm  <- max( betaYrMu - betaYrSe, na.rm = TRUE )
    mr  <- max( c( abs( mr ), abs( mm ) ) )
    
    ylim = mr*c( -1.5, 1.5 )
    
    plot( NULL, xlim = range( yr ), ylim = ylim, xlab = xlab, 
         ylab = 'log fecundity', xaxt = 'n' )
    axis( 1, xtick )
    abline( h = 0, lty = 2, col = 'grey', lwd = 2 )
    leg <- character( 0 ); col <- numeric( 0 )
    
    if( ( YR & !RANDYR ) | ( !AR & !YR ) ){  # there is one group
      loHi <- cbind( betaYrMu - 1.96*betaYrSe, 
                     betaYrMu + 1.96*betaYrSe )
      .shadeInterval( yr, loHi, col = 'black', PLOT = TRUE, add = TRUE, trans = .3 )
      lines( yr, betaYrMu, col = .getColor( 'white', .7 ), lwd = 5 )
      lines( yr, betaYrMu, col = 'grey', lwd = 2 )
    }
    
    col    <- numeric( 0 )
    ngroup <- nrow( betaYrMu )
    
    if( ngroup == 1 ){
      wj <- which( is.finite( betaYrMu ) & betaYrMu != 0 ) 
      loHi <- cbind( betaYrMu[ wj] - 1.96*betaYrSe[ wj], 
                     betaYrMu[ wj] + 1.96*betaYrSe[ wj] )
      .shadeInterval( yr[ wj], loHi, col = groupCol[ 1], PLOT = TRUE, add = TRUE, trans = .3 )
      lines( yr[ wj], betaYrMu[ wj], col = .getColor( 'white', .7 ), lwd = 5 )
      lines( yr[ wj], betaYrMu[ wj], col = groupCol[ 1], lwd = 2 )
    }else{
      
      for( j in 1:ngroup ){
        
        nj <- j
        wj <- which( is.finite( betaYrMu[ nj, ] ) & betaYrMu[ nj, ] != 0 ) 
        if( length( wj ) < 2 )next
        kj <- wj[ which( diff( wj ) == 1 )]
        if( length( kj ) == 0 )next
        dj <- c( 1, which( diff( wj ) > 1 ) ) #, max( wj ) )
        sj <- kj[ dj]
        ej <- c( wj[ dj-1], max( wj ) )
        ej <- ej[ is.finite( sj )]
        sj <- sj[ is.finite( sj )]
        
        sj <- sj[ is.finite( ej )]
        
        for( m in 1:length( sj ) ){
          mm   <- sj[ m]:ej[ m]
          if( length( mm ) < 2 )next
          loHi <- cbind( betaYrMu[ nj, mm] - 1.96*betaYrSe[ nj, mm], 
                         betaYrMu[ nj, mm] + 1.96*betaYrSe[ nj, mm] )
          .shadeInterval( yr[ mm], loHi, col = groupCol[ nj], PLOT = TRUE, add = TRUE, trans = .3 )
        }
      }
      
      legj <- numeric( 0 )
      
      for( j in 1:ngroup ){
        
        nj <- j
        wj <- which( is.finite( betaYrMu[ nj, ] ) & betaYrMu[ nj, ] != 0 ) 
        if( length( wj ) < 2 )next
        kj <- wj[ which( diff( wj ) == 1 )]
        if( length( kj ) == 0 )next
        dj <- c( 1, which( diff( wj ) > 1 ) ) #, max( wj ) )
        sj <- kj[ dj]
        ej <- c( wj[ dj-1], max( wj ) )
        ej <- ej[ is.finite( sj )]
        sj <- sj[ is.finite( sj )]
        sj <- sj[ is.finite( ej )]
        
        legj <- c( legj, j )
        
        for( m in 1:length( sj ) ){
          mm   <- sj[ m]:ej[ m]
          lines( yr[ mm], betaYrMu[ nj, mm], col = .getColor( 'white', .7 ), lwd = 5 )
          lines( yr[ mm], betaYrMu[ nj, mm], col = groupCol[ nj], lwd = 2 )
        }
      }
      if( length( legj ) < 10 ){
        cornerLegend( 'topright', yeGr[ legj], text.col = groupCol[ yeGr[ legj]], 
                     cex = .8, bty = 'n' )
      }
    }
  }
  
  if( YE & AR ){
    title( 'AR coefficients', adj = 0, font.main = 1, font.lab = 1, 
          cex.main = .9 )
    
    if( CONSOLE )
      readline( 'lag effect groups -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Posterior estimates of lag effects, by random group'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  if( YR & !AR ){
    title( 'Year effects, +/- 1 se', adj = 0, font.main = 1, font.lab = 1, 
          cex.main = .9 )
    if( CONSOLE )
      readline( 'year effect all groups -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Posterior estimate of year effects, by random group'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  if( ( AR ) & 'groups' %in% names( yearEffect ) ){  # by region
    
    if( is.null( RMD ) ) graphics.off( )
    
    file <- 'yearEffectByGroup.pdf'
    if( AR )file <- 'lagEffectByGroup.pdf'
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
                 
    
 #   yeGr <- output$data$setupYear$yeGr
 #   if( is.null( yeGr ) )yeGr <- as.character( output$data$setupData$yeGr )
 #   region <- yearEffect$plotGroups
 #   spec   <- yearEffect$specGroups
    
    
    rgg <- grep( '_', rownames(betaYrRand) )
    
    if( length(rgg) == 1 ){
      
      groupSpec <- columnSplit( rownames( betaYrRand ), '_' )
      
      if( specNames[ 1] %in% groupSpec[, 1] ){
        spec   <- groupSpec[, 1]
        region <- groupSpec[, 2]
      }else{
        spec   <- groupSpec[, 2]
        region <- groupSpec[, 1]
      }
      
      regs <- unique( region )
      npp  <- nreg <- length( regs )
      
    }else{
      spec   <- rownames(betaYrRand)
      regs <- region <- NULL
      nreg   <- length(spec)
      npp  <- 1
    }
    
    if( nreg > 0 & any( betaYrRand != 0) & !AR ){
      
   #   nr <- ceiling( nreg/2 )
      
      par( mfrow = c( npp, 1 ), bty = 'n', mar = c( 2, 2, .1, 2 ), oma = c( 2, 3, 1, 1 ) )  
      
      if( YR )yval <- 4
      if( AR )yval <- 1
      
      for( k in 1:npp ){
        
        wk <- which( region == regs[ k ] )
        if( length(wk) == 0 )wk <- 1:length(spec)
        
        plot( NULL, xlim = range( yr ), ylim = c( -yval, yval ), xlab = xlab, 
             ylab = '', xaxt = 'n', yaxt = 'n' )
        if( k == nreg )axis( 1, xtick )
        axis( 2, c( -yval, 0, yval ) )
        abline( h = 0, lty = 2, col = 'grey', lwd = 2 )
        
        wll <- numeric( 0 )
        
        for( j in wk ){
          
          nj <- j
          wj <- which( is.finite( betaYrMu[ nj, ] ) & betaYrMu[ nj, ] != 0 ) 
          if( length( wj ) < 2 )next
          wll  <- c( wll, j )
          wj <- which( is.finite( betaYrMu[ nj, ] ) & betaYrMu[ nj, ] != 0 ) 
          kj <- wj[ which( diff( wj ) == 1 )]
          dj <- c( 1, which( diff( wj ) > 1 ) ) #, max( wj ) )
          sj <- kj[ dj]
          ej <- c( wj[ dj-1], max( wj ) )
          ej <- ej[ is.finite( sj )]
          sj <- sj[ is.finite( sj ) & is.finite( ej )]
          
          if( length( sj ) == 0 )next
          
          for( m in 1:length( sj ) ){
            
            mm   <- sj[ m]:ej[ m]
            if( length( mm ) < 2 )next
            loHi <- cbind( betaYrMu[ nj, mm] - 1.96*betaYrSe[ nj, mm], 
                           betaYrMu[ nj, mm] + 1.96*betaYrSe[ nj, mm] )
            .shadeInterval( yr[ mm], loHi, col = groupCol[ nj], PLOT = TRUE, add = TRUE, trans = .3 )
          }
        }
        
        for( j in wk ){
          
          nj <- j
          
          ww <- which( is.na( betaYrMu[ nj, ] ) | betaYrMu[ nj, ] == 0 )
          yj <- yr
          bj <- betaYrMu[ nj, ]
          bj[ ww] <- NA
          yj[ ww] <- NA
          
          lines( yj, bj, col = .getColor( 'white', .7 ), lwd = 5 )
          lines( yj, bj, col = groupCol[ nj], lwd = 2 )
          
        }
        
        if( length( wll ) == 0 ){
          par( new = TRUE )
          next
        }
        
        legend( 'bottomleft', rownames( betaYrMu )[ wll], text.col = groupCol[ wll], 
               cex = 1., bty = 'n' )
      #  .plotLabel( region[ j], 'topleft' )
        
        par( new = F )
      }
      
      if( AR ){
        mtext( 'Lag', side = 1, line = 1, outer = TRUE )
      }else{
        mtext( 'Year', side = 1, line = 1, outer = TRUE )
      }
      mtext( 'log fecundity', side = 2, line = 1, outer = TRUE )
    }
    
    if( AR ){ 
      
      
      par( mfrow = c( 1, 1 ), bty = 'n', mar = c( 4, 2, .1, 2 ), oma = c( 2, 3, 1, 1 ) )  
      
      betaAr <- output$parameters$betaYr[,1:2]
      ayr    <- 1:nrow(betaAr)
      ylim   <- range( betaAr[,c(1,1)] + c(-2,2)*betaAr[,c(2,2)] )
      if( ylim[1] > -.01 )ylim[1] <- -.01
      
      plot( NULL, xlim = range( ayr ), ylim = ylim, xlab = 'lag (yr)', 
            ylab = '' )
      abline( h = 0, lty = 2, col = 'grey', lwd = 2 )
      lines( ayr, betaAr[,1], lwd = 2, col = groupCol[ 1] )
      
      
      loHi <- cbind( betaAr[ , 1] - 1.96*betaAr[ , 2], 
                     betaAr[ , 1] + 1.96*betaAr[ , 2] )
      .shadeInterval( ayr, loHi, col = groupCol[ 1 ], PLOT = TRUE, add = TRUE, trans = .3 )
    }
    
    
    if( CONSOLE )
      readline( 'year effect by group -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Posterior estimate of year effects, by group'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  ############# acf, pacf
  
  nyy <- ceiling( nyr*.6 )
  if( nyy > 10 )nyy <- 10
  
  if( nyr > 3 & sum( acfMat, na.rm = TRUE ) != 0 ){
    
    acm <- output$parameters$acfMat
    acs <- output$parameters$acfSe
    anote <- 'ACF'
    
    nyy <- max( which( colSums( acm )[ -1] != 0 ) ) 
    
    for( aa in 1:2 ){
      
      if( aa == 2 ){
        acm <- output$parameters$acfMat
        acs <- output$parameters$acfSe
      }
      
      if( is.null( RMD ) ) graphics.off( )
      
      file <- paste( 'acf.pdf', sep = '' )
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
      
      par( mfrow = c( 1, 2 ), bty = 'n', mar = c( 3, 2, 1, .5 ), oma = c( 2, 3, 1, 1 ) )
      
      mr  <- .9
      ylim <- range( acm[, -1, drop = F], na.rm = TRUE )
      if( SEEDDATA )ylim <- range( c( ylim, acsMat[ -1] ), na.rm = TRUE )
      
      plot( NULL, xlim = c( 1, nyy ), ylim = ylim, xaxt = 'n', 
           xlab = '', ylab = '' )
      axis( 1, at = c( 1:nyy ) )
      abline( h = 0, lty = 2, col = 'grey', lwd = 2 )
      leg <- character( 0 ); col <- numeric( 0 )
      lag <- c( 0:( nyr-1 ) )
      
      if( yeGr[ 1] %in% specNames & specNames[ 1] %in% rownames( acm ) ){
        acm <- acm[ drop = FALSE, specNames, ]
        cols <- specCol[ specNames]
        leg  <- specNames
      }else{
        cols <- groupCol
        leg <- rownames( acm )
      }
      
      pacCol <- gfun( nrow( acm ) )
      names( pacCol ) <- rownames( acm )
      
      for( j in 1:nrow( acm ) ){
        
        wj <- which( is.finite( acm[ j, ] ) )
        wj <- wj[ -1]                   # omit lag zero
        nj <- length( wj )
        if( nj < 2 )next
        
        ac <- acm[ j, wj]
        
        lines( lag[ wj], ac, col = pacCol[ j], lwd = 2 )
        loHi <- cbind( ac - 1.96*acs[ j, wj], 
                       ac + 1.96*acs[ j, wj] )
        .shadeInterval( lag[ wj], loHi, col = pacCol[ j], PLOT = TRUE, add = TRUE, 
                       trans = .2 )
        
        up <- which( loHi[, 1] > 0 )
        up <- up[ up > 1]
        points( lag[ wj[ up]], ac[ up], cex = 1.3, pch = 16, col = .getColor( pacCol[ j], .5 ) )
        
        up <- up[ up < 10]
        up <- paste0( up[ up > 2], collapse = ', ' )
        ll <- rownames( acm )[ j]
        leg <- c( leg, ll )
        col <- c( col, j )
      }
      if( length( leg ) > 1 )legend( 'topright', leg, text.col = pacCol, 
                                bty = 'n', cex = .6 )
      .plotLabel( 'a ) log Fecundity', location = 'topleft', above = TRUE, cex = .9 )
      
      if( SEEDDATA ){
        
        lags <- colnames( acsMat )
        if( is.null( lags ) )lags <- names( acsMat )
        nys <- max( as.numeric( columnSplit( lags, '-' )[, 2] ) )
        
        xlim <-  c( 1, nys )
        plot( NULL, xlim = xlim, ylim = ylim, xaxt = 'n', yaxt = 'n', 
             xlab = '', ylab = '' )
        axis( 1, at = c( 1:nys ) )
        axis( 2, labels = FALSE )
        abline( h = 0, lty = 2, lwd = 2, col = 'grey' )
        leg <- character( 0 ); col <- numeric( 0 )
        lag <- c( 0:nys )
        
        wj <- which( acsMat != 0 )
        wj <- wj[ wj != 1]
        nj <- length( wj )
        
        if( nj > 2 ){
          
          ac <- acsMat[ wj]
          lines( lag[ wj], ac, col = 1, lwd = 2 )
          segments( lag[ wj], ac*0, lag[ wj], ac )
        }
        .plotLabel( 'b ) Seed counts', location = 'topleft', above = TRUE, cex = .9 )
        mtext( 'Lag ( yr )', side = 1, outer = TRUE )
        mtext( 'PACF', side = 2, outer = TRUE, line = 1 )
      }
      
      if( CONSOLE ){
        cc <- paste( 'z', 'return to continue ' )
        readline( cc )
      }
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- anote
        message( words )
        caption <- c( caption, words )
      }
    }
    
    if( 'groups' %in% names( yearEffect ) & sum( acm, na.rm = TRUE ) != 0 ){
      
      file <- paste( 'pacfByGroup.pdf', sep = '' )
      
      if( is.null( RMD ) ) graphics.off( )
      
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
      
      mfrow <- .getPlotLayout( nspec )
      par( mfrow = mfrow$mfrow, bty = 'n', mar = c( 1, 1, 1, 1 ), oma = c( 3, 3, 1, 3 ) )  
      
      preg <- columnSplit( rownames( acm ), '-' )
      if( ncol( preg ) == 1 )preg <- columnSplit( rownames( acm ), '_' )
      
      
      for( k in 1:nspec ){
        
        wk <- which( preg[, 1] == specNames[ k] )
        
        ylab <- xlab <- FALSE
        if( k %in% mfrow$left )ylab = TRUE
        if( k %in% mfrow$bottom )xlab = TRUE
        
        plot( NULL, xlim = c( 1, nyy ), ylim = ylim, xaxt = 'n', yaxt = 'n', 
             xlab = '', ylab = '' )
        axis( 1, at = c( 1:nyy ), labels = xlab )
        axis( 2, labels = ylab )
        abline( h = 0, lty = 2, col = 'grey', lwd = 2 )
        leg <- character( 0 ); col <- numeric( 0 )
        lag <- c( 0:( nyr-1 ) )
        
        for( j in wk ){
          wj <- which( is.finite( acm[ j, ] ) )
          wj <- wj[ -1]                   # omit lag zero
          nj <- length( wj )
          if( nj < 2 )next
          
          ac <- acm[ j, wj]
          
          lines( lag[ wj], ac, col = plotCol[ preg[ j, 2]], lwd = 2 )
          loHi <- cbind( ac - 1.96*acs[ j, wj], 
                         ac + 1.96*acs[ j, wj] )
          .shadeInterval( lag[ wj], loHi, col = plotCol[ preg[ j, 2]], PLOT = TRUE, add = TRUE, 
                         trans = .4 )
          
          up <- which( loHi[, 1] > 0 )
          up <- up[ up > 1]
          points( lag[ wj[ up]], ac[ up], cex = 1.3, pch = 16, 
                 col = .getColor( plotCol[ preg[ j, 2]], .5 ) )
          
          up <- up[ up < 10]
          up <- paste0( up[ up > 2], collapse = ', ' )
          ll <- rownames( acm )[ j]
          #    leg <- c( leg, ll )
          #    col <- c( col, j )
        }
        .plotLabel( specNames[ k], 'topright' ) 
      }
      if( nspec == prod( mfrow$mfrow ) ){
        if( length( plots ) < 20 ){
          cornerLegend( 'bottomright', plots, bty = 'n', text.col = plotCol[ plots], cex = .9 )
        }
      }else{
        plot( NULL, xlim = xlim, ylim = ylim, xlab = '', ylab = '', axes = FALSE )
        legend( 'topleft', plots, bty = 'n', text.col = plotCol[ plots], cex = 1.2 )
      }
      mtext( 'Lag ( yr )', side = 1, line = 1, outer = TRUE )
      mtext( 'PACF', side = 2, line = 1, outer = TRUE )
      
      if( CONSOLE ){
        cc <- paste( anote, 'return to continue ' )
        readline( cc )
      }
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- anote
        message( words )
        caption <- c( caption, words )
      }
    }
  }
  
  ############# eigenvalues AR
  
  if( AR ){
    
    if( is.null( RMD ) ) graphics.off( )
    
    file <- paste( 'eigenAR.pdf', sep = '' )
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
    
    par( bty = 'n', mai = c( 1, 1, 1, 1 ), mar = c( 5, 5, 1, 1 ), mfrow = c( 1, 1 ) )
    
    ename <-rownames( eigenMu )
    ename <- rep( ename, each = ncol( eigenMu ) )
    if( nrow( eigenMu ) == 1 )ename <- '+'
    text.col <- rep( groupCol[ yeGr], each = ncol( eigenMu ) )
    
    xlab <- expression( paste( plain( Re ), ' ', lambda ) )
    ylab <- expression( paste( plain( Im ), ' ', lambda ) )
    
    xseq <- seq( -1, 1, length = 100 )
    yseq <- sqrt( 1 - xseq^2 )
    plot( eigenMu, xlim = c( -1.2, 1.2 ), ylim = c( -1.1, 1.1 ), 
         cex = .1, xlab = xlab, ylab = ylab )
    lines( xseq, yseq, lwd = 2, col = 'grey', lt = 2 )
    lines( xseq, -yseq, lwd = 2, col = 'grey', lt = 2 )
    lines( c( 0, 0 ), c( -1, 1 ), col = 'grey', lt = 2 )
    lines( c( -1, 1 ), c( 0, 0 ), col = 'grey', lt = 2 )
    text( Re( eigenMu ) , Im( eigenMu ), ename, cex = 1.1, col = text.col )
    
    if( CONSOLE )
      readline( 'ACF eigenvalues -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'ACF eigenvalues'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  ############# fecundity and seed prediction
  
  if( SEEDDATA ){
    
    tyears <- years  <- sort( unique( sdata$year ) )
    tplots <- pplots <- sort( unique( as.character( sdata$plot ) ) )
    if( AR )tyears <- sort( unique( tdata$year ) )
    
    if( PREDICT & length( inputs$predList$years ) > 1 ){
      
      file <- paste( 'prediction.pdf', sep = '' )
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
      
      pyears <- sort( unique( c( fecPred$year, seedPredGrid$year ) ) )
      pplots <- sort( unique( as.character( seedPredGrid$plot ) ) )
      tyears <- sort( unique( c( years, pyears, tyears ) ) )
      tplots <- sort( unique( c( plots, pplots ) ) )
      
      # prediction grid closest to traps
      
      pcol <- grep( 'meanM2', colnames( seedPredGrid ) )
      scol <- grep( 'seM2', colnames( seedPredGrid ) )
      
      kcol <- c( "trapID", "plot", "year", "trap", "plotYr", "plotyr", 
                "drow", "area", "active" )
      spred <- numeric( 0 )
      
      for( j in 1:length( pplots ) ){
        
        xyt <- xytrap[ xytrap$plot == pplots[ j], ]
        
        sp <- seedPredGrid[ seedPredGrid$plot == pplots[ j], ]
        so <- sdata[ sdata$plot == pplots[ j], ]
        if( nrow( so ) == 0 )next
        sxy <- xyt[ match( so$trapID, xyt$trapID ), c( 'x', 'y' )]
        
        spi <- as.character( columnPaste( sp$trapID, sp$year ) )
        soo <- as.character( columnPaste( so$trapID, so$year ) )
        spi <- match( soo, spi )
        wf  <- which( is.finite( spi ) )
        
        spp <- sp[ spi[ wf], pcol, drop = FALSE]
        countPerM2 <- rowSums( so[ wf, seedNames, drop = FALSE] )/so$area[ wf]
        predPerM2  <- rowSums( spp )
        
        sall  <- cbind( so[ wf, ], spp, countPerM2, predPerM2 )
        spred <- rbind( spred, sall )
      }
      
      #error by year
      rmse <- sqrt( ( spred$countPerM2 - spred$predPerM2 )^2 )
      aerr <- spred$countPerM2 - spred$predPerM2
      
      xlim <- range( spred$year, na.rm = TRUE )
      
      maxMod <- NULL
      if( !is.null( modelYears ) )maxMod <- max( modelYears )
      
      pplots <- as.character( sort( unique( spred$plot ) ) )
      
      mfrow <- .getPlotLayout( length( pplots ) )$mfrow
      opt   <- list( log = FALSE, xlabel = 'Year', POINTS = FALSE, 
                    ylabel = 'Residual', col = 'brown', add = TRUE )
      
      par( mfrow = mfrow, bty = 'n', mar = c( 3, 3, 1, 1 ), oma = c( 2, 2, 0, 2 ) )
      
      xseq <- c( 0, 2^c( 0:15 ) )[ -2]
      
      ylabel <- expression( paste( 'Count ( ', plain( m )^-2, ' )' ) )
      zlabel <- expression( bar( y ) %+-% plain( sd ) )
      
      npl <- 0
      
      for( j in 1:length( pplots ) ){
        
        wj    <- which( spred$plot == pplots[ j] )
        obs   <- spred$year[ wj]
        yMean <- spred$predPerM2[ wj]
        yObs  <- spred$countPerM2[ wj]
        
        if( max( yMean, na.rm = TRUE ) == 0 | length( yMean ) < 3 )next
        
        tj <- by( yMean, obs, quantile, probs = pnorm( c( 0, -1, 1 ) ), na.rm = TRUE )
        cj <- names( tj )
        tj <- matrix( unlist( tj ), ncol = 3, byrow = TRUE )
        rownames( tj ) <- cj
        tj <- sqrt( tj )     
        ww <- which( is.finite( tj[, 1] ) )
        
        if( length( ww ) < 2 )next
        
        yj <- as.numeric( rownames( tj ) )
        
        omu <- by( yObs, obs, quantile, probs = pnorm( c( 0, -1, 1 ) ), na.rm = TRUE )
        cj <- names( omu )
        oj <- matrix( unlist( omu ), ncol = 3, byrow = TRUE )
        rownames( oj ) <- cj
        oj <- sqrt( oj )     # not for residuals
        
        smax <- max( c( tj, oj, 5 ) )
        tt   <- sqrtSeq( smax )
        at   <- tt$at
        labs <- tt$labs
        
        #  xlim <- range( obs, na.rm = TRUE )
        ylim <- range( at )
        
        plot( NULL, xlim = xlim, ylim = ylim, ylab = '', xlab = '', yaxt = 'n' )
        axis( 2, at = at, labels = labs )
        
        if( !is.null( maxMod ) ){
          rect( maxMod+.5, ylim[ 1], xlim[ 2]+.5, ylim[ 2], col = 'wheat', border = 'wheat' )
        }
        
        .shadeInterval( yj, loHi = tj[ drop = FALSE, ww, 2:3], col = .getColor( 'grey', .8 ) )
        abline( h = 0, lty = 2, lwd = 4, col = 'white' )
        
        .shadeInterval( yj, loHi = oj[ drop = FALSE, ww, 2:3], col = .getColor( 'green', .3 ) )
        
        lines( yj, tj[ ww, 1], col = 'white', lwd = 8 )
        lines( yj, tj[ ww, 1], lwd = 3 )
        lines( yj, oj[ ww, 1], col = .getColor( 'white', .5 ), lwd = 8 )
        lines( yj, oj[ ww, 1], col = .getColor( 'forestgreen', .7 ), lwd = 3 )
        
        points( jitter( obs ), sqrt( yObs ), pch = 16, col = .getColor( 'forestgreen', .2 ) )
        
        .plotLabel( pplots[ j], 'topleft' )
        
        npl <- npl + 1
      }
      
      if( npl > 0 ){
        mtext( 'Year', side = 1, line = 0, outer = TRUE, cex = 1.4 )
        mtext( ylabel, side = 2, line = 0, outer = TRUE, cex = 1.4 )
        mtext( zlabel, side = 4, line = 0, outer = TRUE, cex = 1.4 )
        
        if( CONSOLE )
          readline( 'observed ( green ), predicted ( black ), shaded forecast ( if modelYears ) -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- 'Observed ( green ), predicted ( black ), shaded forecast ( if modelYears )'
          message( words )
          caption <- c( caption, words )
        }
      }else{
        while (!is.null(dev.list())) dev.off()
      }
    }
    
    yfun    <- colorRampPalette( c( 'tan', 'brown', 'turquoise', 'steelblue' ) )
    yearCol <- yfun( nyr )
    names( yearCol ) <- tyears
  }
  
  ########## tree correlations over years
  
  if( length( years ) > 3 ){
    
    if( is.null( RMD ) ) graphics.off( )
    
    file <- paste( 'treeCor.pdf', sep = '' )
    
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
    
    breaks <- seq( -1.1, 1.1, by = .1 )
    ylim <- c( 0, 5 )
    nplot <- length( plots )
    
    ppt <- character( 0 )
    
    for( j in 1:nplot ){
      
      wjk <- tdata$tnum[ tdata$plot == plots[ j] & 
                           prediction$fecPred$matrPred > .5]
      njk <- length( unique( wjk ) )
      if( njk < 2 )next
      
      if( njk > 1000 ){
        wjk <- njk[ sample( 1000 )]
        njk <- length( wjk )
      }
      ojk <- omegaE[ wjk, wjk]
      ojk[ is.na( ojk )] <- 0
      if( max( ojk ) == 0 )next
      
      ppt <- c( ppt, plots[ j] )
    }
    
    npp <- length( ppt )
    
    mfrow <- .getPlotLayout( npp )
    par( mfrow = mfrow$mfrow, mar = c( 1, 1, 1, 2 ), oma = c( 3, 3, 1, 1 ), bty = 'n' )
    
    for( j in 1:npp ){
      
      jk <- 0
      sk <- character( 0 )
      ek <- numeric( 0 )
      
      for( k in 1:nspec ){
        
        wjk <- tdata$tnum[ tdata$species == specNames[ k] &
                             tdata$plot == ppt[ j]]
        njk <- length( unique( wjk ) )
        if( njk < 2 )next
        
        wjk <- sort( unique( wjk ) )
        ojk <- omegaE[ wjk, wjk]
        
        ojk[ is.na( ojk )] <- 0
        oj <- ojk
        diag( oj ) <- 0
        rs <- which( rowSums( oj ) == 0 )
        diag( oj ) <- diag( ojk )
        if( length( rs ) > 0 )oj <- oj[ -rs, -rs]
        
        if( length( oj ) < 2 )next
        
        oj[ oj > .95] <- .95
        oj[ oj < -.95] <- -.95
        
        diag( oj ) <- 1
        
        jk <- jk + 1
        sk <- c( sk, specNames[ k] )
        
        oj <- oj[ lower.tri( ojk )]
        ovec <- hist( oj, breaks = breaks, plot = FALSE )$density
        
        tmp <- .getPoly( breaks[ -1], ovec )
        if( jk == 1 ){
          plot( tmp[ 1, ], tmp[ 2, ], type = 's', lwd = 2, 
               col = .getColor( specCol[ specNames[ k]], .3 ), 
               xlab = '', ylab = '', ylim = ylim, xaxt = 'n', yaxt = 'n' )
          axis( 1, at = c( -1, 0, 1 ), labels = c( -1, 0, 1 ) )
          axis( 2, labels = TRUE )
        }
        
        tmp <- .getPoly( breaks[ -1], ovec )
        polygon( tmp[ 1, ], tmp[ 2, ], col = .getColor( specCol[ specNames[ k]], .3 ), lwd = 2, 
                 border = specCol[ specNames[ k]] )
      }
      if( length( sk ) == 0 )next
      .plotLabel( ppt[ j], 'topleft' )
      legend( 'topright', sk, text.col = specCol[ sk], bty = 'n' )
    }
    
    if( jk > 0 ){
      mtext( 'Correlation', side = 1, outer = TRUE, line = 1 )
      mtext( 'Density', side = 2, outer = TRUE, line = 1 )
    }
    
    if( CONSOLE )
      readline( 'tree correlation in time -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Correlations between trees, over time'
      message( words )
      caption <- c( caption, words )
    }
  }
  
  ############# predicted maps
  
  if( !SEEDDATA )return( invisible( caption ) )
  
  if( MAPS & is.null( RMD ) ){
    
    treeSymbol <- sqrt( output$prediction$fecPred$fecEstMu )
    treeSymbol[ treeSymbol < 0] <- 0
    if( is.null( treeSymbol ) )treeSymbol <- treeData$diam
    
    
    seedMax <- as.matrix( sdata[, seedNames] )
    if( is.matrix( seedMax ) ){
      if( nrow( seedMax ) == 0 ){
        seedMax <- rbind( seedMax, 0 )
      }
      seedMax <- rowSums( seedMax, na.rm = TRUE )
    }
    
    seedMax <- max( seedMax, na.rm = TRUE ) + 1
    fecMax  <- max( treeSymbol )
    
    
    if( is.null( RMD ) ) graphics.off( )
    
    mpp <- 1:length( plots )
    
    plotDims <- as.matrix( plotDims )
    plotDims <- plotDims[ !is.na( plotDims[, 1] ), ]
    
    for( m in 1:nrow( plotDims ) ){
      
      plot <- rownames( plotDims )[ m]
      
      xlim <- plotDims[ m, c( 'xmin', 'xmax' )]
      if( is.na( xlim[ 1] ) )next
      
      ylim <- plotDims[ m, c( 'ymin', 'ymax' )]
      
      dx <- diff( xlim )
      dy <- diff( ylim )
      ratio <- dx/dy
      
      pyr <- plotYrTable[ plot, ]
      pyr <- as.numeric( colnames( plotYrTable )[ pyr > 0] )
      
      mfrow <- c( 2, 2 )
      if( max( c( dx, dy ) ) > 100 ){
        if( ratio > 2 ) mfrow <- c( 2, 1 )
        if( ratio < .5 )mfrow <- c( 1, 2 )
      }
      
      if( !is.null( RMD ) )mfrow <- c( 1, 1 )
      
      nperPage <- prod( mfrow )
      
      yrm <- years[ years %in% pyr]
      ny  <- length( yrm )
      
      k   <- 0
      add <- FALSE
      o   <- 1:nperPage
      o   <- o[ o <= nyr]
      
      while( max( o ) <= nyr & length( o ) > 0 ){
        
        if( length( o ) < 5 & is.null( RMD ) )mfrow <- c( 2, 2 )
        
        yr <- yrm[ o]
        yr <- yr[ is.finite( yr )]
        if( length( yr ) == 0 )break
        
        if( is.null( RMD ) ) graphics.off( )
        
        file <- paste( 'map_', plot, '_', yr[ 1], '.pdf', sep = '' )
        
        if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
        
        mapList <- output
        mapList$treeSymbol <- treeSymbol
        mapList$mapPlot    <- plot
        mapList$xlim      <- xlim
        mapList$ylim <- ylim
        mapList$PREDICT <- TRUE
        mapList$mapYears <- yr
        mapList$treeScale <- .9#*sqrt( dx )
        mapList$trapScale <- 1.5
        mapList$mfrow <- mfrow
        mapList$seedMax <- seedMax
        mapList$fecMax  <- fecMax
        mapList$plotScale <- 1
        mapList$COLORSCALE <- FALSE
        mapList$LEGEND <- TRUE
        mapList$RMD <- RMD
        
        ############
        mapList$specNames <- output$inputs$specNames
        mapList$treeData  <- output$inputs$treeData
        mapList$xytree    <- output$inputs$xytree
        mapList$seedData  <- output$inputs$seedData
        mapList$seedNames <- output$inputs$seedNames
        mapList$xytrap    <- output$inputs$xytrap
        
        add <- mastMap( mapList )
        
        if( add )scaleBar( 'm', value = 20, yadj = .07 )
        
        if( CONSOLE )
          readline( 'predicted fecundity, seed data maps -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- paste( 'Prediction map for plot', plots[ m], 
                         'in year', yr )
          message( words )
          caption <- c( caption, words )
        }
        
        o <- o + nperPage
        o <- o[ o <= nyr]
        
        if( length( o ) == 0 ){
          break
        }
        
        if( !add )next
      }  
    }
  }
  
  ################# spatio-temporal correlation
  
  if( SPACETIME ){
    
    # trees/sites ordered by similarity at zero lag
    
    mvs <- suppressWarnings( 
      meanVarianceScore( output, Q = pnorm( c( 0, -1, 1 ) ), nsim = 30, LAGMAT = TRUE, 
                        cyr = 8, ktree = 20, maxArea = 30^2, CLOSE = TRUE )
    )
    
    treeCov <- mvs$lagCanopy
    trapCov <- mvs$lagGround
    nkk <- length( treeCov )
    plotk <- names( treeCov )
    gridArea <- mvs$gridArea
    
    if( is.null( RMD ) ) graphics.off( )
    
    if( nkk > 0 ){
      
      col2 <- colorRampPalette( c( "#67001F", "#67001F", "#B2182B", "#D6604D", "#F4A582", 
                                 "#FDDBC7", "#FFFFFF", "#D1E5F0", "#92C5DE", 
                                 "#4393C3", "#2166AC", "#053061", "#053061" ) )
      for( k in 1:nkk ){
        
        wpt <- which( names( treeCov ) == plotk[ k] )
        wpc <- which( names( trapCov ) == plotk[ k] )
        
        if( length( wpt ) == 0 | length( wpc ) == 0 )next
        
        tvar <- treeCov[[ wpt]]
        cvar <- trapCov[[ wpc]]
        
        if( length( tvar ) < 2 | length( cvar ) < 2 ) next
        
        tmp  <- columnSplit( colnames( tvar ), '_' )
        
        klag <- as.numeric( tmp[, ncol( tmp )] )
       
        if( nrow( tvar ) < 2 )next
        
        km <- max( klag )
        if( km > 5 )km <- 5
        
        file <- paste( 'spaceTime', plotk[ k], '.pdf', sep = '' )
        if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
        
        par( mfrow = c( 2, km+1 ), mar = c( 2, 1, 1, 1 ), oma = c( 2, 1, 2, 1 ), bty = 'n', xpd = TRUE )
        
        order  <- 'hclust'
        
        for( i in 0:km ){
          
          wl <- which( klag == i )
          stree <- tvar[, wl]
          rnames <- rownames( stree )
          
          if( i > 0 ){
            order <- 'original'
            colnames( stree ) <- rownames( stree )
            stree <- stree[ rnames, rnames]
          }
          
          tmp <- corrplot( stree, is.corr = TRUE, method = 'color', col = rev( col2( 200 ) ), 
                          tl.pos = 'n', cl.length = 3, cl.lim = c( -1, 1 ), type = 'lower', 
                          order = order, cl.pos = 'n' )
          rnames <- rownames( tmp )
          tlab <- paste( 'lag', i )
          title( main = list( tlab, cex = 1.5, 
                            font = 1 ), line = -2, adj = 1 )
          if( i == 0 )title( main = list( "Canopy", cex = 1.5, 
                                      font = 3 ) )
        }
        
        tmp  <- columnSplit( colnames( cvar ), '_' )
        klag <- as.numeric( tmp[, ncol( tmp )] )
        cvar[ cvar < -1] <- 0
        cvar[ cvar > 1] <- 0
        
        order  <- 'hclust'
        
        for( i in 0:km ){
          wl <- which( klag == i )
          if( length( wl ) == 0 )next
          stree <- cvar[, wl]
          
          if( ncol( stree ) < nrow( stree ) ){
            sc <- columnSplit( colnames( stree ), '_' )[, 1]
            w0 <- which( !rownames( stree ) %in% sc )
            c1 <- c( 1:( w0-1 ) )
            c2 <- c( ( w0+1 ):ncol( stree ) )
            c1 <- c1[ c1 > 0]
            c2 <- c2[ c2 < nrow( stree ) & c2 > w0]
            stree <- cbind( stree[, c1], 0, stree[, c2] )
            colnames( stree )[ w0] <- paste( rownames( stree )[ w0], i, sep = '_' )
          }
          
          if( i > 0 ){
            order <- 'original'
            colnames( stree ) <- rownames( stree )
            stree <- stree[ rnames, rnames]
          }
          
          tmp <- corrplot( stree, is.corr = TRUE, method = 'color', col = rev( col2( 200 ) ), 
                          tl.pos = 'n', cl.length = 3, cl.lim = c( -1, 1 ), type = 'lower', 
                          cl.pos = 'n' )
          rnames <- rownames( tmp )
          if( i == 0 )title( main = list( "Forest floor", cex = 1.5, 
                                      font = 3 ) )
        }
        mtext( plotk[ k], 1, outer = TRUE, line = 0 )
        
        
        if( CONSOLE )
          readline( 'tree-time ( above ), space-time ( below ) -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- 'Tree-time ( above ), space-time ( below )'
          message( words )
          caption <- c( caption, words )
        }
      }
    }
    
    ############## score by scale
    
   # darea <- 100
    
    mvs <- suppressWarnings( 
      meanVarianceScore( output, Q = pnorm( c( 0, -1, 1 ) ), ktree = 20, 
                        nsim = 20, LAGMAT = TRUE, CLOSE = TRUE )
    )
    gridArea <- mvs$gridArea
    
    if( is.null( RMD ) ) graphics.off( )
    
    scoreT <- scoreS <- scoreTse <- scoreSse <- numeric( 0 )
    pname  <- character( 0 )
    
    for( k in 1:length( plots ) ){
      
      wt <- which( names( mvs$scoreTree ) == plots[ k] )
      ws <- which( names( mvs$scoreSeed ) == plots[ k] )
      
      if( length( wt ) == 0 | length( ws ) == 0 )next
      
      dtree <- mvs$scoreTree[[ wt]]
      dseed <- mvs$scoreSeed[[ ws]]
      dtreeSE <- mvs$scoreTreeSe[[ wt]]
      dseedSE <- mvs$scoreSeedSe[[ ws]]
      
      if( length( dtree ) > 2 & length( dseed ) > 2 ){
        scoreT <- append( scoreT, list( dtree ) )
        scoreS <- append( scoreS, list( dseed ) )
        scoreTse <- append( scoreTse, list( dtree ) )
        scoreSse <- append( scoreSse, list( dseed ) )
        
        pname  <- c( pname, plots[ k] )
      }
    }
    
    names( scoreT ) <- names( scoreS ) <- names( scoreTse ) <- 
      names( scoreSse ) <- pname
  
    
    pk <- names( scoreT )[ k]
    dss <- scoreT
    ylab  <- 'Number of hosts'
    title <- 'Canopy'
    file  <- 'resourceScoreCanopy.pdf'
    carea <- 1
    q <- seq( 0, 1, length = 15 )^1
    cols <- .getColor( 'black', q )
    
    npp <- length( scoreT )
    
    if( npp > 0 ){
      
      for( j in 1:2 ){
        
        if( j == 2 ){
          dss <- scoreS
          file <- 'resourceScoreGround.pdf'
          yy <- as.numeric( rownames( dk ) )
          ylab <- 'Distance ( m )'
          title <- 'Forest floor'
        }
        
        zscale <- range( sapply( dss, range, na.rm = TRUE ) )
        cseq   <- seq( zscale[ 1], zscale[ 2], length = 30 )
        
        xscale <- max( sapply( dss, ncol ) )
        yscale <- max( sapply( dss, nrow ) )
        if( yscale < 100 )yscale <- 100
        if( j == 2 & yscale < 20 )yscale <- 20
        
        xlim <- log( 1 + c( 0, xscale ) )
        ylim <- log( 1 + c( 0, yscale+10 ) )
        
        if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
        
        mff <- .getPlotLayout( length( dss ) )
        
        par( mfrow = mff$mfrow, bty = 'l', mar = c( 1, 1, .1, .1 ), oma = c( 3, 3, 1, 1 ) )
        
        for( k in 1:npp ){
          
          dk <- dss[[ k]]
          xx <- columnSplit( colnames( dk ), '_' )[, 2]
          xx <- as.numeric( xx )
          yy <- c( 1:nrow( dk ) )
          
          if( j == 2 ){
            aa <- as.numeric( rownames( dk ) )
            yy <- ( pi*aa^2 )/10000
          }
          
          levels <- quantile( dk, q )
          levels <- sort( unique( levels ) )
          
          ytick <- c( 1, 5, c( 1:5 )*10 )
          lx <- log( xx + 1 )
          ly <- log( yy + 1 )
          ltick <- log( ytick + 1 ) 
          
          if( j == 1 )ylim[ 1] <- ly[ 1]/2
          if( j == 2 )ylim[ 1] <- diff( ly[ 1:2] )/2
          
          plot( NA, axes = F, xlim = xlim, ylim = ylim, xlab = '', ylab = '' )
          contour( lx, ly, t( dk ), levels = levels, col = cols, labels = '', add = TRUE, 
                  axes = FALSE )
          .filled.contour( lx, ly, t( dk ), levels = levels, col = cols )
          
          if( length( yy ) > 10 ){
            #     yy <- c( 0, yy )
            #     ly <- c( 0, ly )
            bb <- ceiling( length( yy )/10 )
            ss <- seq( 1, length( yy ), by = bb )
            ytick <- ytick[ ss]
            ltick <- ltick[ ss]
          }
          
          xlabs <- ylabs <- FALSE
          
          if( k %in% mff$bottom )xlabs <- xx
          
          if( j == 2 ){
            ytick <- c( 100, 1000, 10000, 50000, 100000 )/10000
            ltick <- log( ytick + 1 )
          }
          
          if( k %in% mff$left ){
            ylabs <- ytick
            if( j == 2 )ylabs <- c( '100 m2', '1000 m2', '1 ha', '5 ha', '10 ha' )
          }
          
          axis( 1, at = lx, labels = xlabs )
          axis( 2, at = ltick, labels = ylabs )
          
          .plotLabel( names( dss )[ k], 'topright' )
        }
        mtext( 'Years', 1, outer = TRUE, line = 1 )
        mtext( ylab, 2, outer = TRUE, line = 1 )
        
        endLabs <- signif( range( dk ), 1 )
        
        clist <- list( kplot = 1, ytick = NULL, text.col = 'black', 
                       cols = cols, labside = 'right', text.col = col, 
                       bg = 'grey', endLabels = endLabs ) 
        cornerScale( clist )
        
        if( CONSOLE )
          readline( 'score by scale -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- 'Score by scale'
          message( words )
          caption <- c( caption, words )
        }
      }
      
      # plot comparison
      
      nhost <- 5
      nhy   <- 2
      tmat  <- matrix( NA, npp, 3 )
      colnames( tmat ) <- c( 'mu', 'lo', 'hi' )
      rownames( tmat ) <- names( scoreT )
      smat <- tmat
      
      for( k in 1:npp ){
        
        nn  <- nhost
        dkk <- scoreT[[ k]]
        if( nn > nrow( dkk ) )nn <- nrow( dkk )
        skk <- scoreTse[[ k]]
        mu  <- dkk[ nn, nhy-1]
        ss  <- skk[ nn, nhy-1]
        tmat[ k, ] <- c( mu, mu + ss*c( -1, 1 ) )
        
        nn  <- nhost
        dkk <- scoreS[[ k]]
        if( nn > nrow( dkk ) )nn <- nrow( dkk )
        skk <- scoreSse[[ k]]
        mu  <- dkk[ nn, nhy-1]
        ss  <- skk[ nn, nhy-1]
        smat[ k, ] <- c( mu, mu + ss*c( -1, 1 ) )
      }
      
      file <- 'scoreByPlot.pdf'
      if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
      
      par( mfrow = c( 1, 1 ), mar = c( 4, 4, 2, 2 ), bty = 'n', xpd = FALSE )
      xlim <- range( tmat ) + c( -.1, .2 )
      ylim <- range( smat ) + c( -.1, .2 )
      
      ylab <- paste( 'Forest floor, ', nhost*gridArea, 'm2' )
      xlab <- paste( 'Canopy score, ', nhost, 'host trees' )
      
      plot( NA, xlim = xlim, ylim = ylim, xlab = xlab, 
           ylab = ylab )
      points( tmat[, 1], smat[, 1] )
      segments( tmat[, 1], smat[, 2], tmat[, 1], smat[, 3] )
      segments( tmat[, 2], smat[, 1], tmat[, 3], smat[, 1] )
      text( tmat[, 1]+.1, smat[, 1]+.1, names( mvs$scoreTree ), pos = 4 )
      abline( 0, 1, col = 'grey', lwd = 2, lty = 2 )
      .plotLabel( paste( nhy, ' yr' ), 'bottomright' )
      
      if( CONSOLE )
        readline( 'score by plot -- return to continue ' )
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
      if( is.null( RMD ) ){
        graphics.off( )
      }else{
        words <- 'Score by plot'
        message( words )
        caption <- c( caption, words )
      }
    }
    
    if( is.null( RMD ) ) graphics.off( )
    
    file <- 'scoreComponents.pdf'
    if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
    
    score4plot <- function( totalScore, cname ){
      
      mcol <- paste( cname, '_mu', sep = '' )
      vcol <- paste( cname, '_stdDev', sep = '' )
      scol <- paste( cname, '_score', sep = '' )
      
      mrow <- grep( '_mu', rownames( totalScore ) )
      cmu <- totalScore[ mrow, mcol]
      chi <- sqrt( cmu + totalScore[ mrow+1, mcol] )
      clo <- sqrt( cmu - totalScore[ mrow+1, mcol] )
      
      cse <- totalScore[ mrow+1, mcol]
      cse[ !is.finite( cse )] <- cmu[ !is.finite( cse )]
      cup <- cmu + cse
      
      vmu <- totalScore[ mrow, vcol]
      vse <- totalScore[ mrow, vcol]
      vse[ !is.finite( vse )] <- vmu[ !is.finite( vse )]
      vup <- vmu + vse
      
      scoreMu <- totalScore[ mrow, scol]
      scoreSe <- totalScore[ mrow+1, scol]
      
      vmat <- rbind( cmu, vmu )
      ylim <- range( c( cmu, vmu, cup, vup ) )
      list( vmat = vmat, mup = cup, vup = vup, ylim = ylim, 
           score = cbind( scoreMu, scoreSe ) )
    }
    
    par( mfcol = c( 2, 2 ), mar = c( 1, 2, 1, 4 ), oma = c( 1, 2, 1, 1 ) ) # canopy mean vs variance
    cols <- c( "darkgreen", "brown" )
    
    totalScore <- mvs$totalScore
    
    ##################
    
    splot      <- columnSplit( rownames( totalScore ) )[, 1]
    spp        <- splot[ !duplicated( splot )]
    
    ttt  <- score4plot( totalScore, 'canopy' )
    vmat <- ttt$vmat
    
    ylim[ 2] <- ( ttt$ylim[ 2] - ttt$ylim[ 1] )*10
    ylim[ 1] <- ttt$ylim[ 1]*.5
    
    xl <- barplot( vmat, width = .5, beside = TRUE, ylim = ylim, 
                   col = cols, xaxt = 'n', log = 'y' )
    smu <- as.vector( vmat )
    upm <- rbind( ttt$mup, ttt$vup )
    sup <- as.vector( upm )
    stt <- apply( upm, 2, max, na.rm = TRUE )
    
    segments( xl, smu, xl, sup )
    segments( xl-.2, sup, xl+.2, sup )
    mtext( 'n host trees', 2, line = 3 ) 
    text( colMeans( xl )-.5, 1.3*stt, spp, srt = 90, pos = 4, cex = .85 )
      
    title( 'Canopy' )
    
    score <- ttt$score
    sup   <- score[, 1] + score[, 2]
    sdn   <- score[, 1] - score[, 2]
    
    ylim <- range( c( sdn, sup ) )
    
    wn <- which( score[, 1] < 0 )
    cc <- rep( cols[ 1], length( sup ) )
    cc[ wn] <- cols[ 2]
    
    xl <- barplot( score[, 1], width = .5, beside = TRUE, ylim = ylim, 
                   col = cc, xaxt = 'n' )
    mtext( 'Score', 2, line = 3 ) 
    sb <- sup
    sb[ wn] <- sdn[ wn]

    segments( xl, score[, 1], xl, sb )
    segments( xl-.1, sb, xl+.1, sb )
    
    ttt  <- score4plot( totalScore, 'ground' )
    vmat <- ttt$vmat
    
    ylim[ 2] <- ( ttt$ylim[ 2] - ttt$ylim[ 1] )*10
    ylim[ 1] <- ttt$ylim[ 1]*.5
    
    xl <- barplot( vmat, width = .5, beside = TRUE, ylim = ylim, 
                   col = cols, xaxt = 'n', log = 'y' )
    mtext( 'area', 2, line = 3 ) 
    smu <- as.vector( vmat )
    sup <- as.vector( rbind( ttt$mup, ttt$vup ) )
    segments( xl, smu, xl, sup )
    segments( xl-.2, sup, xl+.2, sup )
    
    title( 'Forest floor' )
    
    legend( 'topright', legend = c( 'mean benefit', 'variance cost' ), 
           text.col = cols, bty = 'n' )
    
    score <- ttt$score
    sup   <- score[, 1] + score[, 2]
    sdn   <- score[, 1] - score[, 2]
    
    ylim <- range( c( sdn, sup ) )
    
    wn <- which( score[, 1] < 0 )
    cc <- rep( cols[ 1], length( sup ) )
    cc[ wn] <- cols[ 2]
    
    xl <- barplot( score[, 1], width = .5, beside = TRUE, ylim = ylim, 
                   col = cc, xaxt = 'n' )
    sb <- sup
    sb[ wn] <- sdn[ wn]
    
    segments( xl, score[, 1], xl, sb )
    segments( xl-.2, sb, xl+.2, sb )
    
    if( CONSOLE )
      readline( 'score components -- return to continue ' )
    if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    if( is.null( RMD ) ){
      graphics.off( )
    }else{
      words <- 'Score by plot'
      message( words )
      caption <- c( caption, words )
    }
    
    ################ entropy
    
    entropy <- mvs$entropy
    
    if( !is.null( entropy ) ){
      
      if( nrow( entropy ) > 4 ){
        
        if( is.null( RMD ) ) graphics.off( )
        
        file <- 'entropy.pdf'
        if( SAVEPLOTS )pdf( file = .outFile( outFolder, file ) )
        
        par( mfrow = c( 1, 2 ), mar = c( 4, 4, 1, .5 ), oma = c( 1, 1, 1, 1 ), bty = 'n', xpd = FALSE )
        
        entropy[ !is.finite( entropy )] <- NA
        
        xl <- range( entropy[, 1], na.rm = TRUE )
        dx <- .3*diff( xl )
        xl[ 2] <- xl[ 2] + dx
        yl <- range( entropy[, 1] )
        
        we <- grep( 'tree-tree', rownames( entropy ) )
        wr <- grep( 'site-site', rownames( entropy ) )
        rnames <- unlist( strsplit( rownames( entropy )[ we], '_tree-tree' ) )
        
        xl <- range( entropy[ we, 1], na.rm = TRUE ) + c( -1, 1 )
        dx <- .3*diff( xl )
        xl[ 2] <- xl[ 2] + dx
        yl <- range( entropy[ wr, 1], na.rm = TRUE ) + c( -1, 1 )
         
        plot( entropy[ we, 1], entropy[ wr, 1], xlim = xl, ylim = yl, xlab = '', 
             ylab = 'Forest floor entropy', cex = .01, yaxt = 'n' )
        axis( 2, line = 1 )
        abline( 0, 1, lty = 2 )
        
        par( new = FALSE, xpd = TRUE )
        text( entropy[ we, 1], entropy[ wr, 1], rnames )
        mtext( 'Canopy entropy', 1, outer = TRUE, line = -1 )
        .plotLabel( 'a ) Spatial', above = TRUE )
        
        we <- grep( 'tree-lag', rownames( entropy ) )
        wr <- grep( 'site-lag', rownames( entropy ) )
        rnames <- unlist( strsplit( rownames( entropy )[ we], '_tree-lag' ) )
        
        xl <- range( entropy[ we, 1], na.rm = TRUE ) + c( -1, 1 )
        dx <- .3*diff( xl )
        xl[ 2] <- xl[ 2] + dx
        yl <- range( entropy[ wr, 1], na.rm = TRUE ) + c( -1, 1 )
        
        plot( entropy[ we, 1], entropy[ wr, 1], xlim = xl, ylim = yl, xlab = '', ylab = '', 
             cex = .01, yaxt = 'n' )
        axis( 2, line = 1 )
        # abline( 0, 1, lty = 2 )
        
        par( new = FALSE, xpd = TRUE )
        text( entropy[ we, 1], entropy[ wr, 1], rnames )
        .plotLabel( 'b ) Temporal', above = TRUE )
        
        par( new = TRUE, xpd = FALSE )
        
        if( CONSOLE )
          readline( 'entropy -- return to continue ' )
        if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
        if( is.null( RMD ) ){
          graphics.off( )
        }else{
          words <- 'Entropy'
          message( words )
          caption <- c( caption, words )
        }
      }
    }
  }
   
  invisible( list( caption = caption, diam90 = diamFec ) )
}
  
.getPoly <- function( x, y ){
  
  dx <- diff( x )
  xx <- c( x[ 1] - dx[ 1]/2, x[ -1] - dx/2 )
  xx <- rep( xx, each = 2 )
  yy <- rep( y, each = 2 )
  yy <- c( 0, yy, 0 )
  xx <- c( xx, xx[ length( xx )], xx[ length( xx )] )
  rbind( xx, yy )
}

.chainPlot <- function( mat, burnin, label, ngLab = NULL, burnLab = NULL, 
                       refVals = NULL, CONSOLE, RMD, 
                       SAVEPLOTS = FALSE, outFolder = '', ALLONE = F, 
                       cols = NULL, ylim = NULL, intval = NULL ){
  
  words <- character( 0 )
  
  if( is.null( ngLab ) )ngLab <- ng
  if( is.null( burnLab ) )burnLab <- burnin
  
  if( !is.null( refVals ) ){
    if( length( refVals ) == 1 & ncol( mat ) > 1 )refVals <- rep( refVals, ncol( mat ) )
  }
  
  cseq <- 1:nrow( mat )
  if( length( cseq ) > 2000 )cseq <- round( seq( 1, length( cseq ), length = 1000 ) )
  
  if( SAVEPLOTS ){
    fileName <- .replaceString( label, ', ', '' )
    fileName <- .replaceString( label, ' ', '' )
    fileName <- paste( fileName, '.pdf', sep = '' )
    pdf( file = .outFile( outFolder, fileName ) )
  }
  
  cnames <- .coeffNames( colnames( mat ) )
  colnames( mat ) <- cnames
  
  npp <- length( cnames )
  if( npp > 36 )npp <- 36
  
  if( ALLONE )npp <- 1
  
  mfrow <- .getPlotLayout( npp )
  par( mfrow = mfrow$mfrow, bty = 'n', mar = c( 2, 2, 1, 1 ), oma = c( 2, 3, 1, 1 ) ) 
  
  cex <- 1/( 1 + mfrow$mfrow[ 2] )^.1
  
  ng <- nrow( mat )
  
  cseq <- 1:ng
  burnline <- burnin
  ss   <- burnin:ng
  if( nrow( mat ) > 1000 ){
    cseq <- seq( 1, ng, length = 1000 )
    burnline <- burnin/ng*1000
    ss <- cseq[ cseq > burnin]
  }
  
  if( is.null( ylim ) & ALLONE )ylim <- range( mat )
  
  NEWY <- FALSE
  if( is.null( ylim ) )NEWY <- TRUE
  
  naa <- 0
  
  if( is.null( cols ) )cols <- rep( 'black', ncol( mat ) )
  
  xmax <- max( cseq )
  
  for( j in 1:ncol( mat ) ){
    
    if( j %in% c( 36, 72 ) ){
      naa <- naa + 1
      if( CONSOLE ){
        lab <- paste( label, ' -- return to continue' )
        readline( lab )
      }
      if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
    
      if( !is.null( RMD ) ){
        words <- paste( 'MCMC chains for', label, 'with 95% coverage' )
        message( words )
      }
      if( SAVEPLOTS ){
        fileName <- .replaceString( label, ', ', '' )
        fileName <- .replaceString( label, ' ', '' )
        fileName <- paste( fileName, '_', letters[ naa], '.pdf', sep = '' )
        pdf( file = .outFile( outFolder, fileName ) )
      }
      npp <- ncol( mat ) - j
      if( npp > 36 )npp <- 36
      mfrow <- .getPlotLayout( npp )
      par( mfrow = mfrow$mfrow, bty = 'n', mar = c( 2, 2, 2, 2 ), oma = c( 2, 3, 1, 1 ) ) 
    }
    
    xlabels <- FALSE
    
    if( j %in% mfrow$bottom )xlabels <- TRUE
    
    mj <- mat[, j]
    
    if( NEWY ){
      ylim <- range( mj )
      if( !is.null( refVals ) & NEWY ){
        ylim <- range( c( refVals[ j], mj ) )
        expd <- diff( ylim )
        ylim <- ylim + c( -1, 1 )*.5*expd
      }
    }
    if( cnames[ j] %in% c( 'sigma', 'mspe' ) )ylim <- c( 0, 1.2*ylim[ 2] )
      
    
    if( j == 1 | !ALLONE ){
      plot( mj[ cseq], type = 'l', ylim = ylim, xaxt = 'n', xlab = '', ylab = '', 
           col = cols[ j], lwd = 1.5 )
      if( xlabels ){
        axis( 1, at = c( 0, burnline, 1000 ), labels = c( 0, burnLab, ngLab ) )
      }else{
        axis( 1, at = c( 0, burnline, 1000 ), labels = F )
      }
    }else{
      lines( mj[ cseq], col = cols[ j] )
    }
    if( !is.null( intval ) ){
      int <- intval[ colnames( mat )[ j], ]
      yl  <- ylim
      if( length( int ) > 0 ){
        if( 'min' %in% colnames( intval ) ){
          lines( c( 0, 0 ), intval[ j, c( 'min', 'max' )], col = cols[ j] )
          yl <- unlist( intval[ j, c( 'min', 'max' )] )
          if( yl[ 2] > ylim[ 2] )yl[ 2] <- ylim[ 2]
        }
        if( 'mean' %in% colnames( intval ) &
            'var' %in% colnames( intval ) ){
          dseq <- seq( yl[ 1], yl[ 2], length = 500 )
          pline <- dnorm( dseq, intval[ j, 'mean'], sqrt( intval[ j, 'var'] ) )
          wide <- .05/max( pline )*xmax
          xx <- c( wide*pline, dseq*0 )
          yy <- c( dseq, rev( dseq ) )
          polygon( xx, yy, col = .getColor( cols[ j], .2 ) )
          lines( xx, yy, col = cols[ j] )
        }
      }
    }
    
    q <- quantile( mj[ ss], c( .025, .5, .975 ) )
    for( k in 1:3 ){
      segments( burnline, q[ k], 1000, q[ k], col = 'white', lwd = 1 )
      segments( burnline, q[ k], 1000, q[ k], col = cols[ j], lty = 2 )
    }
    segments( burnline, q[ 1], burnline, q[ 3], col = 'white', lwd = 1 )
    segments( burnline, q[ 1], burnline, q[ 3], col = cols[ j], lty = 2 )
    if( !is.null( refVals ) )abline( h = refVals[ j], col = 'blue' )
    if( !ALLONE ){
      .plotLabel( cnames[ j], above = TRUE, cex = cex )
    }
  }
  mtext( 'Iteration', outer = TRUE, side = 1, line = 1 )
  mtext( 'Parameter value', outer = TRUE, side = 2, line = 1 )
  if( ALLONE ){
    legend( 'topright', colnames( mat ), text.col = cols, bty = 'n' )
  }
 
  if( CONSOLE ){
    lab <- paste( label, ' -- return to continue' )
    readline( lab )
  }
  if( SAVEPLOTS )while (!is.null(dev.list())) dev.off()
  
  if( !is.null( RMD ) ){
    words <- paste( 'MCMC chains for', label, 'with 95% coverage' )
    message( words )
  }
  invisible( words )
}
 
.outFile <- function( outFolder = character( 0 ), file ){
  paste( outFolder, file, sep = '/' )
}

.plotLabel <- function( label, location = 'topleft', cex = 1.3, font = 1, 
                       above = FALSE, below = FALSE, bg = NULL, wrap = 1000 ){
  
  # wrap - no. of characters to wrap label to two lines
  
  if( above ){
    adj <- 0
    if( location == 'topright' )adj = 1
    title( label, adj = adj, font.main = font, font.lab = font, cex.main = cex )
    return( )
  }
  if( below ){
    adj <- 0
    if( location == 'bottomright' )adj = 1
    mtext( label, side = 1, adj = adj, outer = FALSE, font.main = font, font.lab = font, cex = cex )
    return( )
  }
  
  if( is.null( bg ) ){
    tmp <- legend( location, legend = ' ', bty = 'n' )
  } else {
    tmp <- legend( location, legend = label, bg = bg, border = bg, text.col = bg, bty = 'o' )
  }
  
  xt <- tmp$rect$left # + tmp$rect$w
  yt <- tmp$text$y
  
  pos <- 4
  tmp <- grep( 'right', location )
  if( length( tmp ) > 0 )pos <- 2
  
  XX <- par( )$xlog
  YY <- par( )$ylog
  
  if( XX )xt <- 10^xt
  if( YY )yt <- 10^yt
  
  if( wrap > nchar( label ) ){
    text( xt, yt, label, cex = cex, font = font, pos = pos )
    return( )
  }
  
  # split at spaces
  words <- unlist( strsplit( label, ' ' ) )
  if( length( words ) == 1 ){
    text( xt, yt, label, cex = cex, font = font, pos = pos )
    return( )
  }
  
  nw <- cumsum( nchar( words ) + 1 )
  br <- which( nw <= wrap )
  if( length( br ) == 0 ){
    br <- 1
    wrap <- nchar( words[ 1] ) + 1
  }
  n2 <- which( nw > wrap )
  lab1 <- words[ br]
  lab2 <- words[ n2]
  if( length( br ) > 1 ) lab1 <- paste0( words[ br], collapse = ' ' )
  if( length( n2 ) > 1 ) lab2 <- paste0( words[ n2], collapse = ' ' )
  
  yaxp <- par( 'yaxp' )
  da <- diff( yaxp[ 1:2] )
  yz <- yt + .2*c( -da, da )
  if( YY ){
    da <- diff( log( yaxp[ 1:2] ) )
    yz <- exp( log( yt ) + .15*c( -da, 0 ) )
  }
  
  text( xt, yz[ 2], lab1, cex = cex, font = font, pos = pos )
  text( xt, yz[ 1], lab2, cex = cex, font = font, pos = pos )

}

commas4numbers <- function( x ){
  
  x  <- as.character( round( x ) )
  lx <- l1 <- nchar( x )
  nr <- floor( lx/3 ) + 1
  
  l0 <- lx - 2
  xn <- character( 0 )
  for( k in 1:nr ){
    xk <- substr( x, l0, l1 )
    xn <- paste( ', ', xk, xn, sep = '' )
    l0 <- l0 - 3
    l1 <- l1 - 3
    if( l0 < 1 )l0 <- 1
  }
  if( startsWith( xn, ', ' ) ) xn <- substr( xn, 2, 1000 )
  if( startsWith( xn, ', ' ) ) xn <- substr( xn, 2, 1000 )
  if( startsWith( xn, ', ' ) ) xn <- substr( xn, 2, 1000 )
  
  xn
}
.boxCoeffs <- function( chain, snames, xlab = "", ylab = 'Coefficient', 
                       addSpec = 'species', ylim = NULL, cols = NULL, 
                       xaxt = 's', yaxt = 's' ){
  
  nspec  <- length( snames )
  cnames <- colnames( chain )
  xn     <- character( 0 )
  vnames <- numeric( 0 )
  iname  <- character( 0 )
  gnames <- paste( addSpec, snames, sep = '' )

  for( j in 1:nspec ){
    ij     <- which( cnames == gnames[ j] )
    if( length( ij ) > 0 )iname <- 'intercept'
    wj     <- grep( gnames[ j], cnames )
    if( length( wj ) > 0 )vnames <- rbind( vnames, wj )
    wk <- grep( ':', cnames[ wj] )
    if( length( wk ) > 0 ){
      xn <- matrix( unlist( strsplit( cnames[ wj[ wk]], ':' ) ), 
                    ncol = 2, byrow = TRUE )[, 2]
    }
  }
    
  rownames( vnames ) <- snames[ vnames[, 1]]
  colnames( vnames ) <- c( iname, xn )
  nv <- ncol( vnames )
  
  nss <- nrow( vnames )
  
  atvals <- c( 1:nss )/( nss + 1 )
  atvals <- atvals - mean( atvals )
  sseq   <- c( 1:nv )
  xlim   <- c( .5, nv +.5 )
  
  if( is.null( ylim ) ){
    ylim <- range( chain )
    ylim[ 1] <- ylim[ 1] - diff( ylim )*.25
  }
  
  add <- FALSE
  if( is.null( cols ) )cols <- seq( 1:nss )
  
  xlabel <- ''
  
  stats <- xtick <- numeric( 0 )
  
  for( j in 1:nv ){
    
    jcol <- vnames[, j]
    if( j > 1 )add <- TRUE
    chainj <- chain[, jcol, drop = FALSE]
    mj     <- mean( chainj )
    sj     <- sd( chainj )
    chainj <- chainj #/sj
    
    if( j == nv )xlabel <- xlab
    
    colj <- cols[ j]
    
    if( any( colnames( chainj ) %in% snames ) )colj <- cols[ colnames( chainj )]
    
    wi <- grep( ':', colnames( chainj ) )
    if( length( wi ) > 0 ){
      tt <- columnSplit( colnames( chainj )[ wi], ':' )
      tk <- tt[, 1]
      colj <- cols[ tk]
      colnames( chainj ) <- tt[, 2]
    }
    
    boxPars <- .boxplotQuant( chainj, xaxt = xaxt, add = add, 
                          at = atvals + j, xlim = xlim, 
                          outline = FALSE, ylim = ylim, 
                          col = .getColor( colj, .5 ), 
                          border = colj, lty = 1, 
                          ylab = ylab, yaxt = yaxt )
    stats <- cbind( stats, boxPars$stats )
    xtick <- rbind( xtick, atvals+j )
    
  }
  .plotLabel( xlab, 'topleft', above = TRUE )
 # legend( 'topright', snames, text.col = 1:nspec, bty = 'n' )
  abline( h = c( 0 ), lwd = 1, col = .getColor( 'grey', .6 ) )
  boxPars$stats <- stats
  boxPars$xtick <- xtick
  
  
  invisible( boxPars )
}

.boxCoeffsMultiSpec <- function( chain, snames, xlab = "", ylab = 'Coefficient', 
                       addSpec = 'species', ylim = NULL, cols = NULL, 
                       xaxt = 's', yaxt = 's', cex = .85 ){
  
  nspec  <- length( snames )
  cnames <- colnames( chain )
  
  snn <- xnn <- cnames
  
  for( k in 1:length( snames ) ){
    sk <- paste( snames[ k], ':', sep = '' )
    wk <- grep( sk, cnames )
    if( length( wk ) == 0 )next
    xnn[ wk] <- .replaceString( xnn[ wk], sk, '' )
    snn[ wk] <- snames[ k]
  }
  
  xnames   <- unique( xnn )
  allnames <- cbind( snn, xnn )
  
  if( is.null( ylim ) ){
    ylim <- range( chain )
    ylim[ 1] <- ylim[ 1] - diff( ylim )*.25
  }
  
  nv <- length( xnames )
  
  atvals <- c( 1:nspec )/( nspec + 1 )
  atvals <- atvals - mean( atvals )
  sseq   <- c( 1:nv )
  xlim   <- c( .5, nv +.5 )
  stats <- numeric( 0 )
  add   <- FALSE
  
  for( j in 1:nv ){
    
    jcol <- which( allnames[, 2] == xnames[ j] )
    scol <- which( snames %in% allnames[ jcol, 1] )
    colj <- cols[ scol]
    
    if( j > 1 )add <- TRUE
    chainj <- chain[, jcol, drop = FALSE]
    at <- atvals + j
    
    boxPars <- .boxplotQuant( chainj, xaxt = xaxt, add = add, 
                              at = at[ scol], xlim = xlim, 
                              outline = FALSE, ylim = ylim, 
                              col = .getColor( colj, .5 ), 
                              border = colj, lty = 1, 
                              ylab = ylab, yaxt = yaxt )
    if( j == 1 )abline( h = 0, col = 'grey' )
    
    if( nv == 1 ){
      .plotLabel( xnames[ j], 'bottomleft', cex = cex )
      next
    }
    bstat <- boxPars$stats
    brange <- range( bstat )
    if( brange[ 1] > 0 )brange[ 1] <- 0
    if( brange[ 2] < 0 )brange[ 2] <- 0
    wside  <- which.max( abs( ylim - brange ) )
    pos <- 2
    if( wside == 2 )pos <- 4
    text( mean( at ), brange[ wside], xnames[ j], pos = pos, srt = 90, 
         cex = cex )
    if( j < nv )abline( v = ( max( at ) + diff( at[ 1:2] ) ), lty = 2, col = 'grey' )
  }
  at
}

.coeffNames <- function( cvec ){
  
  # clean names  for coefficients
  
  fnames  <- .replaceString( cvec, '( Intercept )', 'intercept' )
  fnames  <- .replaceString( fnames, 'I( ', '' )
  fnames  <- .replaceString( fnames, ' ) )', ' )' )
  fnames  <- .replaceString( fnames, 'species', '' )
  fnames  <- .replaceString( fnames, '^2 )', '^2' )
  fnames
}

.fixNamesVector <- function( vnames, data, MODE = 'keep' ){
  
  wgg <- match( vnames, names( data ) )
  
  for( k in wgg ){
    data[[ k]] <- .fixNames( data[[ k]], all = TRUE, MODE )$fixed
  }
  data
}

.fixNames <- function( cvec, all = FALSE, MODE = 'keep', NODASH = T ){
  
  # MODE == 'character', 'factor', or 'keep' ( return same mode )
  
  cdup <- numeric( 0 )
  
  FACT <- FALSE
  if( is.factor( cvec ) ){
    FACT <- TRUE
    cvec <- as.character( cvec )
  }
  if( is.numeric( cvec ) ){
    cvec <- as.character( cvec )
    wdot <- grep( '.', cvec )
    if( length( wdot ) > 0 )cvec <- .replaceString( cvec, '.', 'dot' )
  }
  if( all ) cvec <- .replaceString( cvec, '_', '' )
  if( NODASH )cvec <- .replaceString( cvec, '-', '' )
  cvec <- .replaceString( cvec, ' ', '' )
  cvec <- .replaceString( cvec, "'", "" )
 # cvec <- .replaceString( cvec, ".", "dot" )
  cvec <- .replaceString( cvec, '"', '' )
  if( ( FACT | MODE == 'factor' ) & MODE != 'character' ){
    cvec <- as.factor( cvec )
    droplevels( cvec )
  }
  
  cvec <- .replaceString( cvec, 'acerPenn', 'acerPens' )
  
  wd <- which( duplicated( cvec ) )
  if( length( wd ) > 0 )cdup <- wd
    
  list( fixed = cvec, dups = cdup )
}

.setupR <- function( sdata, tdata, seedNames, specNames, verbose, unknown = 'UNKN' ){
  
  SAMPR <- TRUE
  UCOLS <- FALSE
  
  wun <- grep( 'UNKN', seedNames )
  if( length( wun ) > 1 ){
    stop( "\ncan only have one seedNames with 'UNKN' class\n" )
  }
  if( length( wun ) == 1 )UCOLS <- TRUE
    
  if( !'specPlot' %in% colnames( tdata ) )
    tdata$specPlot <- columnPaste( tdata$species, tdata$plot, '-' )
  
  if( length( seedNames ) == 1 )SAMPR <- FALSE
  
  plots  <- sort( unique( as.character( tdata$plot ) ) )
  priorR <- numeric( 0 )
  
  for( j in 1:length( plots ) ){
    
    wj   <- which( tdata$plot == plots[ j] )
    jtab <- table( tdata$species[ wj] )
    jtab <- jtab[ jtab > 0]
    
    ws   <- which( sdata$plot == plots[ j] )
    stab <- colSums( sdata[ drop = FALSE, ws, seedNames], na.rm = TRUE )
    sname <- names( stab )
    unkn <- grep( 'UNKN', sname )
    UNKN <- sname[ unkn]
    
    jvec <- matrix( jtab )
    JJ   <- crossprod( t( jvec ) ) + diag( .01, length( jvec ) )
    rr   <- crossprod( matrix( stab, nrow = 1 ), t( jvec ) )%*%solve( JJ )
    rownames( rr ) <- names( stab )
    colnames( rr ) <- names( jtab )
    rr <- t( rr )
    
    if( length( rr ) == 1 ){
      rr[ 1] <- 1
      rownames( rr ) <- paste( names( jtab ), plots[ j], sep = '-' )
      priorR <- rbind( priorR, rr )
    }else{
      
      for( m in 1:nrow( rr ) ){
        
        # no seeds counted
        if( sum( rr[ m, ] ) == 0 ){ 
          if( length( UNKN ) > 0 ){
            rr[ m, UNKN] <- 1
          }
          next
        }
        
        # counted as a different species
        OTHER <- FALSE
        wm <- which( rr[ m, ] > 0 )
        wk <- which( !names( wm ) %in% c( rownames( rr ), UNKN ) )
        keep <- character( 0 )
        if( length( wk ) > 0 ){
          keep  <- names( wm[ wk] )
          OTHER <- TRUE
        }
        
        # to unknown class
        if( UCOLS ){
          wm <- which( !colnames( rr ) %in% c( rownames( rr )[ m], UNKN, keep ) )
          if( length( wm ) > 0 )rr[ m, wm] <- 0
        }
        
        # to same class
        wm <- which( colnames( rr ) == rownames( rr )[ m] )
        if( length( wm ) > 0 ){
          if( OTHER )rr[ m, wm] <- rr[ m, wm]*10
          if( UCOLS & OTHER )rr[ m, unkn] <- rr[ m, unkn]*10
          if( !UCOLS ){
            rr[ m, wm] <- 1
            rr[ m, -wm] <- 0
          }
        }
      }
   #   rownames( rr ) <- paste( names( jtab ), plots[ j], sep = '-' )
      rownames( rr ) <- paste( names( jtab ), plots[ j], sep = '_' )
      rr <- sweep( rr, 1, rowSums( rr ), '/' )
      priorR <- rbind( priorR, rr )
    }
  }
  
  priorR[ !is.finite( priorR )] <- 0
  
  seedCount <- as.matrix( sdata[, seedNames, drop = FALSE] )
  rownames( seedCount ) <- rownames( sdata )

  rownames( priorR ) <- .replaceString( rownames( priorR ), '_', '-' )
  tt <- columnSplit( rownames( priorR ), '-' )
  
  attr( priorR, 'species' ) <- tt[, 1]
  attr( priorR, 'plot' )    <- tt[, 2]
  
  ws <- which( rowSums( priorR ) == 0 )
  if( length( ws ) > 0 ){
    rr <- mastIDmatrix( tdata, sdata, 
                       specNames = specNames, seedNames = seedNames, 
                       verbose = verbose )$R
    if( ncol( rr ) > 1 )rr <- sweep( rr, 1, rowSums( rr ), '/' )
    priorR[ ws, colnames( rr )] <- rr[ attr( priorR, 'species' )[ ws], ]
  }
  
  priorRwt <- priorR*10
  
  posR <- which( !priorR %in% c( 0, 1 ) )
  
  if( all( priorR %in% c( 0, 1 ) ) )SAMPR <- FALSE
  
  return( list( SAMPR = SAMPR, R = priorR, priorR = priorR, priorRwt = priorRwt, 
               seedCount = seedCount, posR = posR, tdata = tdata ) )
}

setupZ <- function( tdata, xytree, specNames, years, minD, maxD, maxFec, CONES, 
                   seedTraits = NULL, verbose ){
  
  SEEDDATA <- TRUE
  if( is.null( xytree ) )SEEDDATA <- FALSE
  
  years <- min( tdata$year, na.rm = TRUE ):max( tdata$year, na.rm = TRUE )
  maxF  <- specPriorVector( maxFec, tdata )
  nspec <- length( specNames )
  
  tdata$treeID <- columnPaste( tdata$plot, tdata$tree )
  
 # tid  <- columnPaste( tdata$plot, tdata$tree )
  tids <- unique( tdata$treeID )
  dcol <- match( tdata$treeID, tids ) #do again after reorder
  ntree <- length( tids )
  
  nyr <- length( years )
  
  # initialize repro
  if( !'repr' %in% colnames( tdata ) ){
    tdata$repr <- NA
  }else{
    tdata$repr[ tdata$repr < .5] <- 0
    tdata$repr[ tdata$repr >= .5] <- 1
  }
  
  if( 'cropMax' %in% colnames( tdata ) ){
    tdata$repr[ tdata$cropMax > 0]  <- 1
 #   tdata$repr[ tdata$cropMax == 0] <- 0
  }
  if( 'cropMin' %in% colnames( tdata ) ){
    tdata$repr[ tdata$cropMin > 0] <- 1
  }
  
  if( !'fecMin' %in% colnames( tdata ) ){
    tdata$fecMin <- 1e-4
  }else{
    wm <- which( is.na( tdata$fecMin ) )
    if( length( wm ) > 0 ){
      tdata$fecMin[ wm] <- 1e-4
    }
  }
  if( !'fecMax' %in% colnames( tdata ) ){
    tdata$fecMax <- maxF
  }else{
    wm <- which( is.na( tdata$fecMax ) | tdata$fecMax == 0 )
    if( length( wm ) > 0 ){
      tdata$fecMax[ wm] <- maxF[ wm]
    }
  }
  tdata$fecMin[ tdata$fecMin < 1e-4] <- 1e-4
  
  fstart <- rep( NA, nrow( tdata ) )
  if( 'lastFec' %in% names( tdata ) )fstart <- tdata$lastFec
  
  if( CONES ){
    
    tdata$repr[ tdata$cropCount > 0] <- 1
    
    if( is.null( seedTraits ) ){
      warning( 'cannot use treeData$cropCount without inputs$seedTraits, 
              assumed = 1' )
      seedTraits <- matrix( 1, nspec, 1 )
      rownames( seedTraits ) <- .fixNames( specNames, MODE = 'character' )$fixed
      colnames( seedTraits ) <- 'seedsPerFruit'
    }
    seedTraits[, 'seedsPerFruit'] <- ceiling( seedTraits[, 'seedsPerFruit'] )
    
    if( !'cropFraction' %in% colnames( tdata ) ){
      kwords <- "\nNote: missing column _cropFraction_, assumed = 1\n"
      words <- c( words, kwords )
      tdata$cropFraction <- .95
    }
    tdata$cropFraction[ tdata$cropFraction > .99] <- .99
    tdata$cropCount <- ceiling( tdata$cropCount )
    
    if( !'cropFractionSd' %in% colnames( tdata ) ){
      tdata$cropFractionSd <- NA
    }
    
    wm <- which( is.finite( tdata$cropFraction ) & 
                   !is.finite( tdata$cropFractionSd ) )
    if( length( wm ) > 0 ){
      fs <- .1*dbeta( tdata$cropFraction[ wm], .1, 2 ) + 1e-3
      tdata$cropFractionSd[ wm] <- signif( fs, 3 )
    }
    
    ww <- which( tdata$cropCount == 0 & tdata$cropFraction == 0 )
    if( length( ww ) > 0 ){
      if( verbose ){
        cat( '\nNote: deleted finite cropCount with cropFraction = 0:\n' )
        print( tdata$treeID[ ww] )
        tdata$cropFraction[ ww] <- tdata$cropCount[ ww] <- NA
      }
    }
      
    ww <- which( is.finite( tdata$cropCount ) & tdata$cropFraction == 0 )
    if( length( ww ) > 0 ){
      if( verbose )cat( '\nNote: deleted finite cropCount with cropFraction = 0:\n' )
      print( tdata$treeID[ ww] )
      tdata$cropFraction[ ww] <- tdata$cropCount[ ww] <- NA
    }               
  }
  

  if( 'serotinous' %in% colnames( tdata ) ){
    
    ww <- which( tdata$serotinous == 1 )
    if( length( ww ) > 0 ){
      snames <- unique( tdata$treeID[ ww] )
      tdata$repr[ tdata$treeID %in% snames] <- 1
    }
  }
  
  iy  <- match( tdata$year, years )
  nyr <- length( years )
  
  zknown <- matrix( NA, ntree, nyr )
  rownames( zknown ) <- tids
  colnames( zknown ) <- years
  
  dmat <- dminMat <- dmaxMat <- zknown
  zknown[ cbind( dcol, iy )]  <- tdata$repr 
  dmat[ cbind( dcol, iy )]    <- tdata$diam
  dminMat[ cbind( dcol, iy )] <- minD
  dmaxMat[ cbind( dcol, iy )] <- maxD
  
  mdc <- apply( dminMat, 1, max, na.rm = TRUE )
  dminMat[, 1:nyr] <- mdc
  mdc <- apply( dmaxMat, 1, max, na.rm = TRUE )
  dmaxMat[, 1:nyr] <- mdc
  
  mmin <- apply( dmat, 1, min, na.rm = TRUE )
  mmax <- apply( dmat, 1, max, na.rm = TRUE )
  
  mtmp <- ntmp <- dminMat*0   
  mtmp[, 1:nyr] <- mmin - 1.5  # could be replaced with growth trend
  ntmp[, 1:nyr] <- mmax + 1.5
  
  dtmp <- dmat
  dtmp[ is.na( dtmp )] <- 0
  mcum <- t( apply( dtmp, 1, cumsum ) )
  dmat[ mcum == 0] <- mtmp[ mcum == 0]
  dmat[ is.na( dmat )] <- ntmp[ is.na( dmat )]
  
  #after first observed mature
  zyr <- zknown
  zyr[ is.na( zyr )] <- 0
  zyr <- t( apply( zyr, 1, cumsum ) )
  zyr[ zyr > 1] <- 1
  zknown[ zyr == 1] <- 1
  
  last0 <- rep( 0, nrow( zknown ) )
  names( last0 ) <- tids
  first1 <- last0 + ncol( dmat ) + 1
  
  znew <- zknown
  
  for( k in 1:nyr ){   # obs repr
    zk <- zknown[, k]
    ww <- which( zk == 0 )

    last0[ ww] <- k
    ww <- which( zk == 1 & first1 > k )
    first1[ ww] <- k                 # known mature
    w0 <- which( dmat[, k] < dminMat[, k] & first1 > k ) # small and not yet obs mature
    if( length( w0 ) > 0 )last0[ w0] <- k
    
    zk[ w0] <- 0
    znew[, k] <- zk
  }
  
  for( k in nyr:1 ){                                                # note reverse
    w1 <- which( dmat[, k] > dmaxMat[, k] & last0 < k & first1 > k )  # large and after last obs immature
    if( length( w1 ) > 0 )first1[ w1] <- k
    znew[ w1, k] <- 1
  }
  
  zknown <- znew
  
  all0 <- all1 <- last0*0
  all0[ last0 >= nyr] <- 1
  all1[ first1 == 1] <- 1
  
  # mature first yr in data?
  fyr <- tapply( tdata$year, tdata$treeID, min )  # 1st yr in data
  fyr <- fyr[ names( last0 )]
  f1  <- first1
#  f1[ f1 > length( years )] <- length( years ) - 1
  zyr <- years[ f1]                          # 1st yr mature
  
  ww <- which( fyr == zyr )                   # always mature
  if( length( ww ) > 0 )all1[ ww] <- 1
  
  # is last yr in data a zero?
  lyr <- tapply( tdata$year, tdata$treeID, max )  # last yr in data
  lyr <- lyr[ names( last0 )]
  l0  <- last0
  l0[ l0 == 0] <- 1
  zyr <- years[ l0]
  
  ww <- which( lyr == zyr )   
  if( length( ww ) > 0 )all0[ ww] <- 1
  
  last0[ all0 == 1] <-  ncol( zknown )
  
  last0first1 <- cbind( last0, first1, all0, all1 )
  
  #initial values
  zmat <- zknown
  zmat[ all0 == 1, ] <- 0
  zmat[ all1 == 1, ] <- 1
  
  matYr <- round( ( last0 + first1 )/2 )
  matYr[ matYr == 0] <- 1
  matYr[ all0 == 1] <- ncol( zmat ) + 1
  
  for( k in 1:length( years ) ){
    zk <- zknown[, k]
    zk[ which( k <= last0 )] <- 0
    zk[ which( k >= first1 )] <- 1
    zknown[, k] <- zk
    
    zk <- zmat[, k]
    wna <- which( is.na( zk ) )
    zk[ k < matYr] <- 0
    zk[ k >= matYr] <- 1
    zmat[, k] <- zk
  }
  
  tids <- unique( tdata$treeID )
  dcol <- match( tdata$treeID, tids )
     
  tyindex <- cbind( dcol, iy )  #tree-yr index
  z    <- zmat[ tyindex]
  
  zknownVec <- zknown[ tyindex]
  
  tdata$repr <- zknownVec
  tdata$fecMin[ is.na( zknownVec )] <- 1e-4
  tdata$fecMax[ is.na( zknownVec )] <- maxF[ is.na( zknownVec )]
  ww <- which( zknownVec == 1 )
  if( length( ww ) > 0 )tdata$fecMax[ ww] <- maxF[ ww]
  tdata$fecMin[ zknownVec == 0] <- 1e-4
  
  ww <- which( tdata$fecMin < 1 & tdata$repr == 1 )
  if( length( ww ) > 0 )tdata$fecMin[ ww] <- 1
  
  ww <- which( is.na( tdata$fecMin ) & tdata$repr == 1 )
  if( length( ww ) > 0 )tdata$fecMin[ ww] <- 1
  
  tdata$fecMax[ tdata$fecMax < 1] <- 1
  tdata$fecMin[ tdata$fecMin < 1e-4] <- 1e-4
  
  last   <- which( last0first1[, 'all0'] == 1 )
  snames <- rownames( last0first1 )[ last]  # always immature
  
  scc <- numeric( 0 )
  fstart[ is.na( fstart ) & tdata$repr == 0] <- .01
  
  
  if( CONES ){
    
    ww <- which( is.finite( tdata$cropCount ) &
                  !is.finite( tdata$cropFraction ) )
    if( length( ww ) > 0 )tdata$cropFraction[ ww] <- .95
    
    ww <- which( !is.finite( tdata$cropCount ) &
                  is.finite( tdata$cropFraction ) )
    if( length( ww ) > 0 )tdata$cropFraction[ ww] <- NA
    
    ww <- which( !is.finite( tdata$cropFractionSd ) &
                  is.finite( tdata$cropFraction ) )
    if( length( ww ) > 0 )tdata$cropFractionSd[ ww] <- 0
    
    ww <- which( is.finite( tdata$cropFraction ) )
     
    cll <- seedTraits[ tdata$species[ ww], 'seedsPerFruit']*tdata$cropCount[ ww] # min is those counted
    scc <- round( cll/tdata$cropFraction[ ww] )                               # mean no. seeds
    
  #  chi <- scc*2
  #  clo <- scc*.5
  #  clo[ clo < cll] <- cll[ clo < cll]
  #  clo[ clo < 1 & cll >= 1] <- 1
  #  chi[ chi < 10] <- 10
    
    clo <- qbinom( tdata$cropFraction[ ww], scc, .1 )
    chi <- qbinom( tdata$cropFraction[ ww], scc*2, .9 )
    
    chi[ chi < 5] <- 5
    chi[ chi == clo] <- chi[ chi == clo] + 1
    
    tdata$fecMin[ ww] <- clo
    tdata$fecMax[ ww] <- chi
    
    ww <- which( tdata$fecMax <= tdata$fecMin )
    if( length( ww ) > 0 ){
      print( 'fecMax < fecMin' )
      print( tdata[ ww[ 1:10], ] )
      stop( )
    }
    
    fstart[ ww] <- ( clo + 2*scc + chi )/4
    
    # non-zero cones cannot be always immature
    specMatr <- unique( tdata$treeID[ which( tdata$cropCount > 0 )] )
    wm <- which( last0first1[, 'all0'] == 1 &
                  rownames( last0first1 ) %in% specMatr )
    if( length( wm ) > 0 )last0first1[ wm, 'all0'] <- 0
  }
  
  
  if( 'cropMin' %in% colnames( tdata ) ){
    ww <- which( is.finite( tdata$cropMin ) )
    fs <- ( tdata$fecMin[ ww] +  tdata$fecMax[ ww] )/2
    fs[ !is.finite( fs )] <- tdata$fecMin[ ww][ !is.finite( fs )]
    fs[ fs < 1e-4] <- 1e-4
    fstart[ ww] <- fs
  }
 
  ww <- which( !is.finite( fstart ) )
  if( length( ww ) > 0 ){
      zw <- z[ ww]
      fw <- zw
      tl <- tdata$fecMin[ ww] + zw
      tl[ zw == 0] <- .01
      th <- tdata$fecMax[ ww] + zw
      tl[ zw == 1 & tl < 1] <- 1
      th[ zw == 0] <- .99
      fm <- sqrt( tl * th )
      fw <- .tnorm( length( zw ), tl, th, fm, 10 )
      fstart[ ww] <- fw
  }
  
  fstart[ fstart < 1e-4] <- 1e-4
  ww <- which( fstart > tdata$fecMax | fstart < tdata$fecMin )
  if( length( ww ) > 0 ){
    fstart[ ww] <- .tnorm( length( ww ), tdata$fecMin[ ww], tdata$fecMax[ ww], fstart[ ww], 10 )
  }
  
  # fit means inclusion in distall: excludes known immature, serotinous, 
  #                                 trees not in xytree ( cropCount only )
  
  if( SEEDDATA ){
    snames <- c( snames, tdata$treeID[ !tdata$treeID %in% xytree$treeID] ) # no location
  }else{
    snames <- rownames( last0first1 )  # none
  }
  ww <- which( tdata$serotinous == 1 )
  if( length( ww ) > 0 )snames <- c( snames, tdata$treeID[ ww] )
  snames <- unique( snames )
  
  fit <- rep( 0, nrow( last0first1 ) )
  
  last  <- which( rownames( last0first1 ) %in% snames )
  first <- which( !rownames( last0first1 ) %in% snames )
  fit[ first] <- 1
  last0first1 <- cbind( last0first1, fit )
  
  wnew   <- c( first, last )
  zmat   <- zmat[ wnew, ]
  zknown <- zknown[ wnew, ]
  matYr  <- matYr[ wnew]
  last0first1 <- last0first1[ wnew, ]
  
  tdata$fit <- 1
    
  if( length( snames ) > 0 ){  # there are some known immature, put immature at end
    mf <- which( !tdata$treeID %in% snames )
    ml <- which( tdata$treeID %in% snames )
    tdata$fit[ ml] <- 0
    mm <- c( mf, ml )
    tdata <- tdata[ mm, ]
    fstart <- fstart[ mm]
    z <- z[ mm]
  }
  
  tdata$tnum <- match( tdata$treeID, rownames( last0first1 ) )
  fstart[ fstart < 1e-4] <- 1e-4
  fecMaxCurrent <- tdata$fecMax
  fecMinCurrent <- tdata$fecMin
  
  list( z = z, zmat = zmat, zknown = zknown, matYr = matYr, seedTraits = seedTraits, 
       last0first1 = last0first1, tdata = tdata, fstart = fstart, 
       fecMinCurrent = fecMinCurrent, fecMaxCurrent = fecMaxCurrent )
}
  
getPredGrid <- function( predList, tdat, sdata, xytree, xytrap, group, 
                        specNames, plotDims, verbose = FALSE ){
  
  mapMeters  <- predList$mapMeters
  mapPlot    <- predList$plots
  mapYear    <- predList$years
  
  if( is.null( mapMeters ) ){
    mapMeters <- 5
    if( verbose )cat( '\nMissing mapMeters for prediction grid set to 5 m\n' )
  }
  
  ww <- which( tdat$plot %in% sdata$plot )
  tdat <- tdat[ ww, ]
  
  plotYrComb <- table( tdat$plot, tdat$year )
  plotYrComb <- plotYrComb[ drop = FALSE, rownames( plotYrComb ) %in% mapPlot, ]
  plotYrComb <- plotYrComb[, colnames( plotYrComb ) %in% mapYear, drop = FALSE]
  
  predList$years <- colnames( plotYrComb )[ colSums( plotYrComb ) > 0]
  
  npred      <- nrow( plotYrComb )
  predList$plots <- predList$plots[ predList$plots %in% rownames( plotYrComb )]
  
  if( sum( plotYrComb ) == 0 ){
    if( verbose ){
      cat( '\n\nPlot-years in predList missing from data:\n' )
      print( paste( predList$plot, ': ', predList$year, sep = '' ) )
      cat( '\n\n' )
    }
    return( list( seedPred = NULL, distPred = NULL ) )
  }
  
  if( length( mapMeters ) == 1 & npred > 1 )mapMeters <- rep( mapMeters, npred )
  
  seedPred <- numeric( 0 )
  drowj <- drowTot <- 0
  
  distPred <- grp <- spp <- numeric( 0 )
  treeid   <- trapid <- numeric( 0 )
  
  gridSize <- rep( 0, npred )
  names( gridSize ) <- rownames( plotYrComb )
  
  for( j in 1:npred ){
    
    wj <- which( plotYrComb[ j, ] > 0 )
    pj <- rownames( plotYrComb )[ j]
    wy <- as.numeric( colnames( plotYrComb )[ wj] )
  
    jplot <- as.matrix( plotDims[ rownames( plotDims ) == pj, ] )
    
    jx <- c( jplot[ 'xmin', 1] - mapMeters[ j]/2, 
            jplot[ 'xmax', 1] + mapMeters[ j]/2 )
    jy <- c( jplot[ 'ymin', 1] - mapMeters[ j]/2, 
            jplot[ 'ymax', 1] + mapMeters[ j]/2 )
    
    sx <- seq( jx[ 1], jx[ 2], by = mapMeters[ j] )
    sy <- seq( jy[ 1], jy[ 2], by = mapMeters[ j] )
    
    jgrid <- expand.grid( x = sx, y = sy )
    gridSize[ j] <- nrow( jgrid )
    
    yrj   <- rep( wy, nrow( jgrid ) )
    
    jseq  <- rep( 1:nrow( jgrid ), each = length( wy ) )
    jgrid <- jgrid[ jseq , ]
    
    dgrid   <- drowTot + jseq
    drowTot <- max( dgrid )
    trapID  <- paste( pj, '-g', dgrid, sep = '' )
    
    dj  <- data.frame( trapID = trapID, year = yrj, jgrid, drow = 0, dgrid = dgrid )
    dj$plot  <- pj
    
    #includes trap years from data
    wmatch <- which( sdata$plot %in% pj )
    id     <- as.character( unique( sdata$trapID[ wmatch] ) )
    sdd    <- sdata[ match( id, sdata$trapID ), ]
    
    xy  <- xytrap[ match( sdd$trapID, xytrap$trapID ), c( 'x', 'y' )]
    jj  <- rep( c( 1:nrow( sdd ) ), each = length( wy ) )
    yrj <- rep( wy, nrow( sdd ) )
    drAll  <- sort( unique( sdd$drow ) )
    dgrid  <- drowTot + c( 1:length( drAll ) )
    dgrid  <- dgrid[ match( sdd$drow[ jj], drAll )]
    drowTot <- max( dgrid )
    
    tj <- data.frame( trapID = sdd$trapID[ jj], year = yrj, 
                     x = xy[ jj, 'x'], y = xy[ jj, 'y'], 
                     drow = sdd$drow[ jj], dgrid = dgrid, plot = sdd$plot[ jj] )
    dj <- rbind( dj, tj )
    
    seedPred <- rbind( seedPred, dj )
  }
  
  tdat <- tdat[ tdat$plot %in% predList$plots &
                  tdat$year %in% predList$years, ]
  
  xyt <- xytree[ xytree$plot %in% predList$plots, ]
  
  tmp <- setupDistMat( tdat, seedPred, xyt, seedPred, verbose )
  distPred <- tmp$distall
  seedPred <- tmp$sdata
  treePred <- tmp$tdata
  
  
  plotYrComb <- cbind( plotYrComb, mapMeters, gridSize )
  seedPred$active  <- seedPred$area <- 1 # note for 1 m2
  
 # distPred[ distPred == 0] <- 100000
  distPred <- round( distPred, 1 )
  
  seedPred$drow <- match( as.character( seedPred$trapID ), rownames( distPred ) )
  
  rownames( seedPred ) <- NULL
  
  if( verbose ){
    cat( "\nPrediction grid size: " )
    cat( "If too large, increase predList$mapMeters:\n" )
    print( plotYrComb[, c( 'mapMeters', 'gridSize' )] )
  }
  
  list( seedPred = seedPred, distPred = distPred, 
       treePred = treePred, predList = predList )
}

cleanFactors <- function( x ){
  
  #fix factor levels
  
  scode <- names( x[ which( sapply( x, is.factor ) )] )
  if( length( scode ) > 0 ){
    for( j in 1:length( scode ) ) {
      x[, scode[ j]] <- droplevels( x[, scode[ j]] )
    }
  }
  x
}
  
.setupRandom <- function( randomEffect, tdata, xfec, xFecNames, specNames ){
  
  tdata$species <- as.factor( tdata$species )
  
  nspec      <- length( specNames )
  formulaRan <- randomEffect$formulaRan
  if( nspec > 1 )formulaRan <- .specFormula( randomEffect$formulaRan )
  xx        <- .getDesign( formulaRan, tdata )$x
  if( nspec > 1 )xx <- xx[, grep( 'species', colnames( xx ) ), drop = FALSE]  # CHECK for 1 spp
  
  xrandCols  <- match( colnames( xx ), colnames( xfec ) )
  
  if( !is.finite( min( xrandCols ) ) )
    stop( '\nthere are variables in formulaRan that are missing from formulaFec\n' )
  
  Qrand      <- length( xrandCols )
  reI        <- as.character( tdata[, randomEffect$randGroups] )
  rnGroups   <- unique( reI )
  reIndex    <- match( reI, rnGroups )
  names( reIndex ) <- rnGroups[ reIndex]
  reGroups   <- unique( reIndex )
  names( reGroups ) <- names( reIndex )[ match( reGroups, reIndex )]

  nRand      <- length( reGroups )
  Arand      <- priorVA <- diag( 1, Qrand )
  dfA        <- ceiling( Qrand + 1  + nRand/2 )
  alphaRand  <- matrix( 0, nRand, Qrand )
  colnames( alphaRand ) <- xFecNames[ xrandCols]
  rownames( alphaRand ) <- rnGroups
  
  XX <- crossprod( xx )
  diag( XX ) <- diag( XX ) + .00000001
  xrands2u <- solve( XX )%*%crossprod( xx, xfec[, xrandCols] ) 
  xrands2u[ abs( xrands2u ) < 1e-8] <- 0
  
  list( formulaRan = formulaRan, xrandCols = xrandCols, Qrand = Qrand, 
       rnGroups = rnGroups, reIndex = reIndex, reGroups = reGroups, 
       Arand = Arand, dfA = dfA, alphaRand = alphaRand, priorVA = priorVA, 
       xrands2u = xrands2u )
}

getPlotDims <- function( xytree, xytrap ){
  
  plots <- sort( unique( as.character( xytree$plot ) ) )
  npp   <- length( plots )
  
  pdims <- numeric( 0 )
  
  for( j in 1:npp ){
    
    wt <- which( xytree$plot == plots[ j] )
    ws <- which( xytrap$plot == plots[ j] )
    
    jx <- range( c( xytree$x[ wt], xytrap$x[ ws] ) )
    jy <- range( c( xytree$y[ wt], xytrap$y[ ws] ) )
    jx[ 1] <- floor( jx[ 1] - 1 )
    jx[ 2] <- ceiling( jx[ 2] + 1 )
    jy[ 1] <- floor( jy[ 1] - 1 )
    jy[ 2] <- ceiling( jy[ 2] + 1 )
    
    area <- diff( jx )*diff( jy )/10000
    
    if( area > 200 ){
      cat( paste( '\nPlot area > 200 ha:', plots[ j], 'is', area, 'ha\n' ) )
      stop( 'check coordinates for xytree, xytrap' )
    }
    
    pdims <- rbind( pdims, c( jx, jy, area ) )
  }
  colnames( pdims ) <- c( 'xmin', 'xmax', 'ymin', 'ymax', 'area' )
  rownames( pdims ) <- plots
  pdims
}
  
.orderChain <- function( xchain, snames ){
  
  if( !snames[ 1] %in% colnames( xchain ) )return( xchain )
  
  ns <- length( snames )
  
  mnames <- .coeffNames( colnames( xchain ) )
  first  <- mnames[ 1:ns]
  tmp    <- grep( '_', first )
  
  if( length( tmp ) > 0 ){
    first <- matrix( unlist( strsplit( first, '_' ) ), ncol = 2, byrow = TRUE )[, 2]
  }
  
  orr    <- match( snames, first )
  if( is.na( orr[ 1] ) )return( xchain )
  
  newChain <- xchain*0
  
  k <- orr
  m <- 1:ns
  while( max( k ) <= ncol( xchain ) ){
    
    newChain[, m] <- xchain[, k]
    colnames( newChain )[ m] <- colnames( xchain )[ k]
    
    m <- m + ns
    k <- k + ns
  }
  newChain
}

factor2integer <- function( fvec ){
  as.numeric( as.character( fvec ) )
}

formit <- function( form, nspec ){
  
  ff   <- as.character( form )
  ff   <- .replaceString( ff, ':', '*' )
  
  form <- as.formula( paste( ff, collapse = ' ' ) )
  
  if( nspec > 1 ){
    fc   <- .replaceString( as.character( form ), 'species *', '' )
    fc   <- as.formula( paste( fc, collapse = ' ' ) )
    form <- .specFormula( fc )
  }
  .fixFormula( form )
}

.fixFormula <- function( form ){
  
  # remove I( log( ) ) from formula
  
  fchar <- as.character( form )[ 2]
  tmp   <- gregexpr( 'I( log( ', fchar, fixed = TRUE )[[ 1]]
  
  if( tmp[ 1] < 0 )return( form )
  
  if( length( tmp ) > 0 ){
    
    while( tmp[ 1] > 0 ){
      tmp   <- gregexpr( 'I( log( ', fchar, fixed = TRUE )[[ 1]]
      end <- gregexpr( ' )', fchar, fixed = TRUE )[[ 1]]
      we <- end[ min( which( end > tmp[ 1] ) )]
      substr( fchar, we, we ) <- " "
      substr( fchar, tmp[ 1], ( tmp[ 1] + attr( tmp, 'match.length' )[ 1] ) ) <- "  log( "
      fchar <- .replaceString( fchar, '  ', ' ' )
      fchar <- .replaceString( fchar, ' )', ' )' )
      tmp   <- gregexpr( 'I( log( ', fchar, fixed = TRUE )[[ 1]]
    }
  }
  as.formula( paste( '~ ', fchar, collapse = ' ' ) )
}


setupPriors <- function( specNames, nn, priorTable, priorList = NULL, 
                        priorDist = NULL, priorVDist = NULL, maxDist = NULL, minDist = NULL, 
                        minDiam = NULL, maxDiam = NULL, sigmaMu = NULL, maxF = NULL, maxFec = NULL, 
                        ug = NULL, priorTauWt = NULL, priorVU = NULL, ARSETUP = F, USPEC = F ){
  
  # nn - nrow( treeData )
  
  if( !is.null( priorList ) ){
    
    if( length( priorList ) > 1 ){ #priors by species
      for( k in 1:length( priorList ) ){
        wk <- which( names( priorList[[ k]] ) == 'priorDist' )
        if( length( wk ) == 1 )priorDist <- unlist( priorList[[ k]][ wk] ) 
        wk <- which( names( priorList[[ k]] ) == 'priorVDist' )
        if( length( wk ) == 1 )priorVDist <- unlist( priorList[[ k]][ wk] )
        wk <- which( names( priorList[[ k]] ) == 'minDist' )
        if( length( wk ) == 1 )minDist <- unlist( priorList[[ k]][ wk] )
        wk <- which( names( priorList[[ k]] ) == 'maxDist' )
        if( length( wk ) == 1 )maxDist <- unlist( priorList[[ k]][ wk] )
        wk <- which( names( priorList[[ k]] ) == 'minDiam' )
        if( length( wk ) == 1 )minDiam <- unlist( priorList[[ k]][ wk] )
        wk <- which( names( priorList[[ k]] ) == 'maxDiam' )
        if( length( wk ) == 1 )maxDiam <- unlist( priorList[[ k]][ wk] )
        wk <- which( names( priorList[[ k]] ) == 'maxF' )
        if( length( wk ) == 1 )maxFec <- unlist( priorList[[ k]][ wk] )
      }
    }
  }else{
    priorList <- list( priorDist = priorDist, priorVDist = priorVDist, 
                      maxDist = maxDist, minDist = minDist, 
                      minDiam = minDiam, maxDiam = maxDiam, 
                      sigmaMu = sigmaMu, maxF = maxF )
  }
  
  pcols <- c( "priorDist", "priorVDist", "minDist", "maxDist", "minDiam", 
             "maxDiam", "maxFec" )
  
  nspec <- length( specNames )
  
  if( is.null( priorTable ) ){
    priorTable <- matrix( NA, nspec, length( pcols ) )
    colnames( priorTable ) <- pcols
    rownames( priorTable ) <- specNames
    for( k in 1:length( pcols ) ){
      priorTable[, pcols[ k]] <- get( pcols[ k][ 1] )
    }
  }else{
    if( nrow( priorTable ) > 1 & !ARSETUP ){
      if( var( priorTable[, 'priorDist'] ) > 0 )USPEC <- TRUE
    }
    pm <- which( !pcols %in% colnames( priorTable ) )
    if( length( pm ) > 0 ){
      for( k in pm ){
        priorTable <- cbind( priorTable, get( pcols[ k][ 1] ) )
        colnames( priorTable )[ k] <- pcols[ k]
      }
    }
  }
  
  priorTable <- priorTable[ drop = FALSE, specNames, ]
  
  
  if( nrow( priorTable ) > 1 ){
    w1 <- w2 <- w3 <- TRUE
    if( !is.null( priorTable[, 'priorDist'] ) )
      w1 <- var( priorTable[, 'priorDist'], na.rm = TRUE ) == 0 
    if( !is.null( priorTable[, 'minDist'] ) )
      w2 <- var( priorTable[, 'minDist'], na.rm = TRUE ) == 0 
    if( !is.null( priorTable[, 'maxDist'] ) )
      w3 <- var( priorTable[, 'maxDist'], na.rm = TRUE ) == 0 
    if( w1 & w2 & w3 )USPEC <- FALSE
  }
  if( nrow( priorTable ) == 1 )USPEC <- FALSE
  
  priorU  <- round( ( 2*priorTable[, 'priorDist']/pi )^2 )
  priorVU <- round( ( 2/pi )^2*priorTable[, 'priorVDist']^2 )
  priorVU[ priorVU < .001] <- .001
  maxU    <- round( ( 2*priorTable[, 'maxDist']/pi )^2 )
  minU    <- round( ( 2*priorTable[, 'minDist']/pi )^2 )
  
  sex <- attributes( priorTable )$sex
  priorTable <- cbind( priorTable, priorU, priorVU, minU, maxU )
  if( !is.null( sex ) ){
    sex <- sex[ names( sex ) %in% rownames( priorTable )]
    attr( priorTable, 'sex' ) <- sex
  }
  
  umean <- mean( priorTable[, 'priorU'] )
  propU <- mean( priorTable[, 'priorU'] )/100
  uvar  <- mean( priorTable[, 'priorVU'] )
  if( is.null( ug ) )ug <- mean( priorTable[, 'priorU'] )
  
  for( k in 1:ncol( priorTable ) ){
    pk <- priorTable[, k]
    names( pk ) <- rownames( priorTable )
    assign( colnames( priorTable )[ k], pk )
  }
  
  priorTable <- priorTable[, !duplicated( colnames( priorTable ) ), drop = FALSE]
  ug   <- priorU
  maxF <- max( maxFec )
  if( !is.null( sex ) ){
    sex <- sex[ names( sex ) %in% rownames( priorTable )]
    attr( priorTable, 'sex' ) <- sex
  }
  
  npt   <- 1:nspec
  if( !USPEC )npt <- 1
  
  if( is.null( priorTauWt ) )priorTauWt <- ceiling( nn/nspec/10 )
  tau1 <- priorTauWt
  tau2 <- priorVU*( tau1 - 1 )
  
  priorU  <- mean( priorU )
  priorVU <- mean( priorVU )
  
  if( nspec == 1 ){
    maxU    <- max( maxU )
    minU    <- min( minU )
    names( minU ) <- names( maxU ) <- specNames
    priorDist  <- priorDist[ 1]
    priorVDist <- priorVDist[ 1]
    maxDist    <- maxDist[ 1]
    minDist    <- minDist[ 1]
    maxFec     <- maxFec[ 1]
  }else{
    ug <- ug[ specNames]
    minU <- minU[ specNames]
    maxU <- maxU[ specNames]
    minDiam <- minDiam[ specNames]
    maxDiam <- maxDiam[ specNames]
    maxFec  <- maxFec[ specNames]
  }
  
  if( is.null( sigmaMu ) )sigmaMu <- 5
  sigmaWt <- sqrt( nn )
  
  list( priorTable = priorTable, priorList = priorList, priorDist = priorDist, 
       priorVDist = priorVDist, maxDist = maxDist, minDist = minDist, 
       minDiam = minDiam, maxDiam = maxDiam, maxFec = maxFec, 
       sigmaMu = sigmaMu, sigmaWt = sigmaWt, 
       maxF = maxF, umean = umean, priorU = priorU, priorVU = priorVU, 
       minU = minU, maxU = maxU, propU = propU, uvar = uvar, ug = ug, 
       USPEC = USPEC, npt = npt, tau1 = tau1, tau2 = tau2 )
}

check4na <- function( tmp, functionName = '' ){
  
  if( !is.list( tmp ) & is.numeric( tmp ) ){
    mk <- min( tmp )
    if( length( mk ) > 0 )ss <- paste( 'NA produced in', functionName )
  }
  
  wn <- which( sapply( tmp, is.numeric ) )
  
  if( length( wn ) > 0 ){
    mk <- sapply( tmp[ wn], min ) 
    mk <- which( !is.finite( mk ) )
    if( length( mk ) > 0 ){
      ss <- 'NA produced'
      if( !is.null( names( mk ) ) )ss <- paste( ss, 'in', names( mk ) )
      if( length( functionName ) > 0 )ss <- paste( ss, 'from', functionName )
      if( length( mk ) > 0 )stop( ss )
    }
  }
  return( )
}

mastif <- function( inputs, formulaFec = NULL, formulaRep = NULL, 
                   ng = NULL, burnin = NULL ){   
  
  data  <-  modelYears <- NULL
  
  if( inherits( inputs, 'mastif' ) ){
    
    inputs$inputs$ng <- ng
    inputs$inputs$burnin <- burnin
    
    parameters <- inputs$parameters
    priorTable <- inputs$inputs$priorTable
    xrep       <- inputs$data$setupData$xrepUn
    
    data   <- inputs$data
    if( !is.null( modelYears ) ){
      inputs$inputs$tdataOut <- inputs$prediction$tdataOut
      inputs$inputs$sdataOut <- inputs$prediction$sdataOut
    }
    inputs <- inputs$inputs
    inputs$parameters <- parameters
    inputs$priorTable <- priorTable
    inputs$xrep  <- xrep
    class( inputs ) <- 'mastif'
  }

  if( is.null( ng ) )stop( "\nsupply no. MCMC steps, 'ng'\n" )
  if( is.null( burnin ) )stop( "\nsupply 'burnin'\n" )
  
  .mast( inputs, data, formulaFec, formulaRep, ng, burnin ) 
}

   
.mast <- function( inputs, data, formulaFec, formulaRep, ng, burnin ){
   
  upar <- xytree <- xytrap <- specNames <- treeData <- seedData <-
    seedNames <- arList <- times <- xmean <- xfecCols <- xrepCols <-
    groupByInd <- dfA <- xrands2u <- lagGroup <- lagMatrix <- xfecs2u <-
    xreps2u <- Qrand <- xfecU <- xrepU <- seedTraits <- 
    plotDims <- plotArea <- tdataOut <- sdataOut <- specPlots <- 
    plotNames <- distall <- trapRows <- fstart <- output <- 
    xsd <- notStandard <- acfMat <- reg <-
    fecMinCurrent <- fecMaxCurrent <- plotRegion <- NULL
  predList <- yearEffect <- randomEffect <- modelYears <- plotDims <- NULL
  sigmaWt <- 1
  
  notFit <- NULL
  maxU <- minU <- npt <- priorU <- priorVU <- tau1 <- tau2 <- NULL
  censMin <- censMax <- NULL
  SEEDCENSOR <- CONES <- RANDOM <- YR <- AR <- ARSETUP <- USPEC <- 
    TREESONLY <- FECWT <- verbose <- SEEDDATA <- SAMPR <- FALSE
  
  words <- inwords <- character( 0 )
  
  priorList <- priorTable <- NULL

  priorDist <- 25; priorVDist <- 40; maxDist <- 70; minDist  <- 4
  minDiam   <- 10; maxDiam    <- 40; maxFec <- maxF <- 1e+8; sigmaMu <- 1
  priorValues <- data.frame( priorDist, priorVDist, minDist, maxDist, 
                             minDiam, maxDiam, maxFec = maxF )
 
  plag  <- p  <- 0; 1e+8; priorVtau <- 6
  ug <- priorTauWt <- NULL
  alphaRand <- Arand <- priorB <- priorIVB <- betaPrior <- NULL
  
  if( 'seedData' %in% names( inputs ) ){
    if( length( inputs$seedData ) == 0 ){
      inputs <- inputs[ !names( inputs ) == 'seedData']
    }else{
      SEEDDATA <- TRUE
    }
  }
  
  PREDSEED <- TRUE
  if( is.null( predList ) )PREDSEED <- FALSE
  
  betaYr <- betaLag <- yeGr <- plots <- years <- NULL
  facLevels <- character( 0 )
  ngroup <- 1
  nng    <- ng
  
  if( inherits( inputs, 'mastif' ) ){
    
    ARSETUP <- TRUE
    
    ww <- which( !names( inputs ) %in% c( 'inputs', 'chains', 'fit', 
                                      'burnin', 'ng', 'predList' ) )
    
    for( k in ww )assign( names( inputs )[ k], inputs[[ k]] )
 #   tdata <- treeData
    
 #   xrep <- inputs$data$setupData$xrepUn
    
    for( k in 1:length( data$setupData ) ){
      assign( names( data$setupData )[ k], data$setupData[[ k]] )
    }
    if( 'arList' %in% names( data ) ){
      for( k in 1:length( data$arList ) )
        assign( names( data$arList )[ k], data$arList[[ k]] )
      AR <- TRUE
    }
    if( 'setupRandom' %in% names( data ) ){
      for( k in 1:length( data$setupRandom ) )
        assign( names( data$setupRandom )[ k], data$setupRandom[[ k]] )
      RANDOM <- TRUE
    }
    if( 'setupYear' %in% names( data ) ){
      for( k in 1:length( data$setupYear ) ){
        if( names( data$setupYear )[ k] == 'yrIndex' )next
        assign( names( data$setupYear )[ k], data$setupYear[[ k]] )
      }
      YR <- TRUE
    }
    ug <- inputs$parameters$upars[ specNames, 1]
    ug[ is.na( ug )] <- ug[ 1] 
    
    if( length( ug ) > 1 ){
      names( ug ) <- specNames
      if( !( diff( range( ug ) ) == 0 ) )USPEC <- TRUE
    }
    
    upar <- ug
    years <- sort( unique( treeData$year ) )
    years <- min( years ):max( years )
    nyr <- length( years )
    if( !is.null( predList ) ){
      predList$years <- predList$years[ predList$years %in% years]
      if( 'plots' %in% names( predList ) )
        predList$plots <- .fixNames( predList$plots, all = TRUE )$fixed
    }
    yrIndex <- yrIndex[, !duplicated( colnames( yrIndex ) )]
    
    R <- parameters$rMu
    
    seedTable   <- inputs$seedByPlot
    matYr       <- inputs$matYr 
    last0first1 <- inputs$last0first1
    
    zmat <- matrix( 0, nrow( last0first1 ), nyr )
    zmat[ cbind( 1:nrow( zmat ), matYr )] <- 1
    zmat <- t( apply( zmat, 1, cumsum ) )
    zmat[ zmat > 1] <- 1
    rownames( zmat ) <- rownames( last0first1 )
    
    ij <- cbind( match( treeData$treeID, rownames( zmat ) ), match( treeData$year, years ) )
    z <- zmat[ ij]
    
  }else{              # not class( inputs ) == 'mastif'
    
    inputs$specNames <- sort( inputs$specNames )
    nspec <- length( inputs$specNames )
    
    if( is.null( inputs$priorTable ) ){
      priorTable <- priorValues[ rep( 1, nspec ), ]
      rownames( priorTable ) <- inputs$specNames
      ptmp <- priorTable
    }else{
      ptmp <- inputs$priorTable
      ww <- names( priorValues )[ !names( priorValues ) %in% names( ptmp )]
      if( length( ww ) > 0 ){
        qtmp <- priorValues[ rep( 1, nrow( ptmp ) ), ]
        qtmp[, colnames( ptmp )] <- ptmp[, colnames( ptmp )]
        rownames( qtmp ) <- rownames( ptmp )
        ptmp <- qtmp
      }
        
      ws <- which( !inputs$specNames %in% rownames( ptmp ) )
        
      if( length( ws ) > 0 ){
        new <- ptmp[ rep( 1, length( ws ) ), ]
        rownames( new ) <- inputs$specNames[ ws]
        ptmp <- rbind( ptmp, new )
      }
    }
    inputs$priorTable <- ptmp[ inputs$specNames, ]
    
    if( !'FILLED' %in% names( inputs ) ){
      inputs <- mastFillCensus( inputs, p = plag )  
    }
    
    for( k in 1:length( inputs ) )assign( names( inputs )[ k ], inputs[[ k ]] )
    years <- unique( range( treeData$year ) )
    if( length( years ) == 1 )stop( '\nmust have > 1 year of data\n' )
    
    if( !is.null( yearEffect ) ){
      
      if( 'p' %in% names( yearEffect ) )plag <- yearEffect$p
      
      if( 'groups' %in% names( yearEffect ) ){
        
        yearEffect$groups <- .replaceString( yearEffect$groups, ' ', '' )
        
        ygg <- inputs$treeData[, yearEffect$groups, drop = FALSE]
        
        if( ncol( ygg ) > 1 )ygg <- columnPaste( ygg[, 1], ygg[, 2] )
        yee <- table( ygg )
        yee <- yee[ yee > 10]
        if( length( yee ) < 2 ){
          if( verbose ){
            cat( '\nCannot use random groups specified in yearEffect:\n' )
            print( yearEffect$groups )
            print( yee )
          }
          yearEffect <- yearEffect[ !names( yearEffect ) == 'groups']
        }
      }
    }
    
    if( SEEDDATA ){
      inputs$seedNames <- sort( inputs$seedNames )
      priorR <- mastIDmatrix( inputs$treeData, inputs$seedData, 
                              specNames = inputs$specNames, 
                              seedNames = inputs$seedNames, 
                              censMin = inputs$censMin, verbose = verbose )$R
      if( is.matrix( priorR ) ){
        inputs$specNames <- specNames <- rownames( priorR )
        inputs$seedNames <- seedNames <- colnames( priorR )
      }
      
      if( !is.null( censMin ) )SEEDCENSOR <- TRUE
      
      years <- range( c( treeData$year, seedData$year ) )
    }
    
    words <- c( words, inwords )
    years <- years[ 1]:years[ 2]
  } # end inherits
  
  keepIter <- 4000
  
  plots <- .fixNames( sort( unique( as.character( treeData$plot ) ) ), all = TRUE )$fixed
  nspec <- length( specNames )
  
  if( !is.null( randomEffect ) ){
    randomEffect$formulaRan <- .fixFormula( randomEffect$formulaRan )
    if( 'randGroups' %in% names( randomEffect ) ){
      if( randomEffect$randGroups == 'tree' )randomEffect$randGroups <- 'treeID'
      randGroups <- randomEffect$randGroups
    }
  }
  
  if( !SEEDDATA ){
    PREDSEED <- FALSE
    predList <- NULL
  }
  
  if( !is.null( predList ) ){
    
    PREDSEED <- TRUE
    
    if( !'plots' %in% names( predList ) )stop( '\npredList must include plots\n' )
    
    predList$plots <- .fixNames( predList$plots, all = TRUE )$fixed
    predList$plots <- predList$plots[ predList$plots %in% plots]
    if( length( predList$plots ) == 0 )
      stop( '\nPrediction plots do not occur in treeData\n' )
    if( !'mapGrid' %in% names( predList ) )predList$mapGrid <- 5
  }
  
  if( !is.null( yearEffect ) ){
    YR <- TRUE
    if( 'p' %in% names( yearEffect ) ){
      plag <- yearEffect$p
    }
  }
  
  if( plag > 0 ){
    AR <- TRUE
    YR <- FALSE
  }
  
  ng <- nng
  plots <- sort( unique( as.character( treeData$plot ) ) )
  
  if( SEEDDATA ){
    tmp <- checkPlotDims( plots, years, xytree, xytrap, plotDims, plotArea )
    plotDims <- tmp$plotDims
    plotArea <- tmp$plotArea
  }
  
  plist <- setupPriors( specNames, nn = nrow( treeData ), priorTable, priorList, priorDist, 
                          priorVDist, maxDist, minDist, 
                          minDiam, maxDiam, sigmaMu, maxF, maxFec, 
                          ug, priorTauWt, priorVU, ARSETUP, USPEC )
  for( k in 1:length( plist ) )assign( names( plist )[ k], plist[[ k]] )
  
  if( ARSETUP )ug <- upar
  inputs$USPEC <- USPEC
  
  if( verbose ){
    cat( '\nPrior parameter values:\n' )
    print( priorTable[ npt, ] )
  }
  
  if( !is.null( yearEffect ) )plag <- yearEffect$p
  
  
  formulaFec <- formit( formulaFec, nspec )
  formulaRep <- formit( formulaRep, nspec )
  
  if( !is.null( modelYears ) ){
    
    inputs$modelYears <- modelYears
    
    wtree <- which( treeData$year %in% modelYears )
    wtrap <- which( seedData$year %in% modelYears )
    
    tdataOut <- treeData[ -wtree, ]
    sdataOut <- seedData[ -wtrap, ]
    sdataOut$seedM2  <- round( rowSums( as.matrix( sdataOut[, seedNames] ) )/
                                sdataOut$area, 1 )
    
    xy <- xytrap[ match( sdataOut$trapID, xytrap$trapID ), c( 'x', 'y' )]
    sdataOut <- cbind( xy, sdataOut )
  }
  
  tdata <- treeData
  sdata <- seedData
  
  ccone <- grep( 'cropCount', colnames( tdata ) )
  if( length( ccone ) != 0 ){
    CONES <- TRUE
    
    if( !'cropFraction' %in% colnames( tdata ) ){
      warning( 'no treeData$cropFraction provided for treeData$cropCount, assumed = .95' )
      tdata$cropFraction <- NA
      tdata$cropFraction[ is.finite( tdata$cropCount )] <- .95
    }
    tdata$cropCount <- ceiling( tdata$cropCount )
  }
  
  if( !'seedTraits' %in% names( inputs ) ){
    if( CONES )warning( "inputs$seedTraits matrix not found for treeData$cropCount" )
    seedTraits <- matrix( 1, nspec, 2 )
    colnames( seedTraits ) <- c( 'gmPerSeed', 'seedsPerFruit' )
    rownames( seedTraits ) <- specNames
  }
  seedTraits[, 'seedsPerFruit'] <- ceiling( seedTraits[, 'seedsPerFruit'] )
  inputs$seedTraits <- seedTraits
  
  ##################
  rm( treeData )
  rm( seedData )
  ##################
  
  if( !ARSETUP ){ 
    
    # tdata$fit     - indicates there are traps for that tree ( and not too small )
    # tdata$dcol    - column in distall
    # tdata$obs     - a cropCount or seed trap
    # tdata$obsTrap - a seed trap
    
    notFit <- betaPrior$notFit
    tmp    <- .setupData( formulaFec, formulaRep, tdata, sdata, 
                         xytree, xytrap, specNames, seedNames, AR, YR, 
                         yearEffect, minDiam, maxDiam, TREESONLY, maxFec, CONES, 
                         notFit, priorTable, #plotRegion = plotRegion, 
                         seedTraits = seedTraits, verbose = verbose )
    
    for( k in 1:length( tmp ) )assign( names( tmp )[ k], tmp[[ k]] ) 
    yeGr   <- as.character( yeGr )
    ngroup <- length( yeGr )
    tdata$treeID <- as.character( tdata$treeID )
    
    xrep <- tmp$xrepUn                            # xrep is not standardized
    
    
    notFit  <- notFit[ notFit %in% colnames( xfec )]
    notCols <- match( notFit, colnames( xfec ) )
    
    tid  <- unique( tdata$treeID )
    tnum <- match( tdata$treeID, tid )
    tdata$tnum <- tnum
    if( 'tnum' %in% colnames( yrIndex ) ){
      yrIndex[, 'tnum'] <- tnum
    }else{
      yrIndex <- cbind( yrIndex, tnum )
    }
    ntree <- length( tid )
    
    
    setupData <- tmp[ !names( tmp ) %in% 
                        c( "tdata", "sdata", "seedNames", "specNames", 
                          "xytree", "xytrap" )]
    
    data      <- append( data, list( setupData = setupData ) )
    
    seedTable <- buildSeedByPlot( sdata, seedNames, specNames )
    
    if( length( censMin ) > 0 ){
      
      tmp <- trimCens( sdata, censMin, censMax )
      censMin <- as.data.frame( tmp$censMin )
      censMax <- as.data.frame( tmp$censMax )
      
      ctmp <- censMin
      ctmp$plot <- sdata[ rownames( censMin ), 'plot']
      
      censTable <- buildSeedByPlot( ctmp, seedNames, specNames )
      
      rownames( censTable ) <- .replaceString( rownames( censTable ), 'seeds', 'min' )
      
      wk <- which( !colnames( seedTable ) %in% colnames( censTable ) )
      if( length( wk ) > 0 ){
        moreCols <- matrix( 0, nrow( censTable ), length( wk ) )
        colnames( moreCols ) <- colnames( seedTable )[ wk]
        censTable <- cbind( censTable, moreCols )
        seedTable <- rbind( seedTable, censTable[ drop = FALSE, , colnames( seedTable )] )
        attr( seedTable, 'caption' ) <- 
          'min_seedNames rows give sum of minimum values for censored traps'
      }
    }
    
    if( verbose & SEEDDATA ){
      cat( '\nSeed count by plot:\n' )
      print( seedTable )
    }
    
    if( AR ){
      data      <- append( data, list( arList = arList ) )
      for( k in 1:length( arList ) )assign( names( arList )[ k], arList[[ k]] ) 
      nyrAR    <- length( times )
      
      groupYr  <- yrIndex[, 'group'] # for AR, group and groupYr identical
      yrIndex  <- cbind( yrIndex, groupYr )
      preYr    <- years[ -c( 1:plag )]
    }
    
    years <- range( tdata$year )
    years <- years[ 1]:years[ 2]

    if( YR ){
      setupYear <- list( yeGr = yeGr, yrIndex = yrIndex )
      
      data     <- append( data, list( setupYear = setupYear ) )
      
      betaYr <- matrix( 0, ngroup, length( years ) )
      rownames( betaYr ) <- yeGr
      colnames( betaYr ) <- years
      
      if( !'groupName' %in% colnames( tdata ) ){
        tdata$groupName <- yeGr[ 1]
        
        group <- match( as.character( tdata$groupName ), yeGr )
        
        tdata$group <- yrIndex[, 'group'] <- group
      }
      
      betaYrR  <- betaYr
      betaYrF  <- betaYrR[ drop = FALSE, 1, ]
    }
   } ################ end ARSETUP
   
  notFit  <- notFit[ notFit %in% colnames( xfec )]
  notCols <- match( notFit, colnames( xfec ) )
  
  tid   <- unique( tdata$treeID )
  ntree <- length( tid )
  
  years <- range( tdata$year )
  years <- years[ 1]:years[ 2]
  
  if( !'dcol' %in% colnames( yrIndex ) ){
    yrIndex <- cbind( yrIndex, tdata$dcol )
    colnames( yrIndex )[ ncol( yrIndex )] <- 'dcol'
  }
  
  yrIndex[, 'dcol'] <- tdata$dcol
  yrIndex[, 'year'] <- match( tdata$year, years )
  if( is.list( yrIndex ) )yrIndex <- as.matrix( yrIndex )
  
  obsYr <- obsTimes <- NULL
  
  if( SEEDDATA ){
    if( is.null( upar ) )upar <- ug
    
    nseed    <- nrow( sdata )
    nsobs    <- table( sdata$plot )
    ntrap    <- nrow( xytrap )
    obsYr    <- sort( unique( tdata$year[ tdata$obsTrap == 1] ) ) # there are sdata!
    obsTimes <- match( obsYr, years )                           # when there are trap years   
  }
  
  nplot <- length( plots )
  n     <- nrow( xfec )
  ntobs <- table( tdata$plot )
 
  ttab  <- table( tdata$plot, tdata$year )
  wtab  <- which( ttab > 0, arr.ind = TRUE ) 
 
  nyr    <- length( years )
  
  RANDYR <- FALSE
  tdata$species <- as.character( tdata$species )
  spp <- match( tdata$species, specNames )
  yrIndex <- cbind( yrIndex, spp )

  tdata     <- cleanFactors( tdata )
  plotYears <- sort( unique( tdata$plotYr ) )
  
  nacc   <- length( years )
  nspec  <- length( specNames )
  
  yrIndex <- yrIndex[, !duplicated( colnames( yrIndex ) )]
  
  UNSTAND <- TRUE
  if( length( xmean ) == 0 )UNSTAND <- FALSE
  
  Qfec <- ncol( xfec )
  Qrep <- ncol( xrep )
  xFecNames <- colnames( xfec )
  xRepNames <- colnames( xrep )
  
  nSpecPlot <- max( yrIndex[, 'specPlot'] )
  
  nlag <- round( nacc/2 )
  if( nlag > 15 )nlag <- 15
  
  npacf   <- ceiling( nacc/2 )
  pacfMat <- matrix( 0, nSpecPlot, npacf )
  rownames( pacfMat ) <- as.character( specPlots )
  colnames( pacfMat ) <- paste( 'lag', 0:( npacf-1 ), sep = '-' )

  pacf2  <- acf2 <- acfMat <- acN <- pacN <- gcfMat <- pacfMat
  
  if( YR | AR ){
    ngroup <- length( yeGr )
    muyr <- rep( 0, nrow( tdata ) )
    if( ngroup > 1 )RANDYR <- TRUE
    RANDYR <- TRUE
  }
  
  
  if( !ARSETUP ){        
    
    # random effects
    rnGroups <- reIndex <- reGroups <- priorVA <- NULL
    alphaRand <- Arand <- NULL
    if( !is.null( randomEffect ) ){
      RANDOM     <- TRUE
      if( 'tree' %in% randomEffect$randGroups )
        randomEffect$randGroups[ randomEffect$randGroups == 'tree'] <- 'treeID'
      
      tmp <- .setupRandom( randomEffect, tdata, xfec, xFecNames, specNames ) 
      
      we <- which( table( tmp$reIndex ) > 2 )   # replication for random groups?
      if( length( we ) < 2 ){                    # less than 2 groups
        RANDOM <- FALSE
        randomEffect <- NULL
        if( verbose )print( 'too few groups for randomEffect' )
      }else{
        for( k in 1:length( tmp ) )assign( names( tmp )[ k], tmp[[ k]] ) 
        data <- append( data, list( setupRandom = tmp ) )
        if( length( Arand ) == 1 )ONEA <- TRUE
      }
    }
  }        
  
  ##############################################
  
  if( is.null( yeGr ) )yeGr <- specNames[ 1]
  
  ONEF <- ONER <- ONEA <- FALSE     
  if( ncol( xfec ) == 1 )ONEF <- TRUE  # intercept only
  if( ncol( xrep ) == 1 )ONER <- TRUE  # intercept only
  rownames( yrIndex ) <- NULL
  
  
  obsRows <- which( tdata$obs == 1 ) ############check
  
  if( SEEDDATA ){
    
    tdata$obs[ tdata$plotYr %in% sdata$plotYr] <- 1  # note: more than just tdata$fit == 1
    
    seedPredGrid <- distPred <- NULL
    nseedPred <- 0
    
    # species to seed type
    tmp <- .setupR( sdata, tdata, seedNames, specNames, verbose = verbose )
    R         <- tmp$R
    priorR    <- tmp$priorR
    priorRwt  <- tmp$priorRwt
    SAMPR     <- tmp$SAMPR
    seedCount <- tmp$seedCount
    posR      <- tmp$posR
    
    obsRowSeed  <- which( sdata$year %in% obsYr )
    obsTrapRows <- sort( intersect( obsRows, trapRows ) )
    
    if( is.null( names( ug ) ) )names( ug ) <- specNames[ 1:length( ug )]
    
    if( PREDSEED ){
      
      if( is.character( predList$years ) ) predList$years <- 
          as.numeric( predList$years )
      
      tmp <- getPredGrid( predList, tdat = tdata[ obsTrapRows, ], sdata, xytree, xytrap, 
                         group = yrIndex[ obsTrapRows, 'group'], specNames, plotDims )
      predList  <- tmp$predList
      sdatPred  <- tmp$seedPred
      distPred  <- tmp$distPred
      tdatPred  <- tmp$treePred
      nseedPred <- nrow( sdatPred )
      
      rownames( sdatPred ) <- columnPaste( sdatPred$trapID, sdatPred$year, '_' )
      
      if( !is.null( nseedPred ) ){ 
        
        tdatPred <- tdatPred[, c( 'plot', 'treeID', 'dcol', 'species', 'specPlot', 'year' )]
        tdatPred$row <- match( rownames( tdatPred ), rownames( tdata ) )
        
        plotYrs <- sort( unique( tdata$plotYr ) )
        
        tdatPred$plotYr <- columnPaste( tdatPred$plot, tdatPred$year, '_' )
        tdatPred$plotyr <- match( tdatPred$plotYr, plotYrs )
        sdatPred$plotYr <- columnPaste( sdatPred$plot, sdatPred$year, '_' )
        sdatPred$plotyr <- match( sdatPred$plotYr, plotYrs )
      }else{
        PREDSEED <- FALSE
      }
    }
  }
  
  
  if( YR ){
    cnames  <- paste( 'yr', 1:nyr, sep = '-' )
    sygibbs <- matrix( 0, ng, nyr )
    colnames( sygibbs ) <- cnames        # variance, random years
  }
  
  if( AR )Alag   <- diag( .1, plag, plag )
  
  ##################### fecundity subset
  # tdata$fit == 1:    could be mature, on seed-trap plot, not serotinous
  # trapRows:          tdata rows to include in kernel ( have seedData )
  #                    exclude tdata$fit == 0 and tdata$serotinous == 1
  # obsTrapRows:       trapRows in years with seedData
  ####################
  
  yrIndex[, 'tnum'] <- tdata$tnum
  yrIndex[, 'year'] <- match( tdata$year, years )
  
  
  if( 'lastFec' %in% names( tdata ) ){
    
    fs <- tdata$lastFec
    fs[ !is.na( fs ) & fstart > 1] <- fstart[ !is.na( fs ) & fstart > 1] # already have lastFec
    
    fs <- tdata$lastFec
    fs[ fs == 0] <- 1e-4
    
    wu <- which( fs < 1 & z == 1 )
    if( length( wu ) > 0 )fs[ wu] <- .tnorm( length( wu ), 1, 5, 1.3, 10 )
    
    wu <- which( fs > 1 & z == 0 )
    if( length( wu ) > 0 )fs[ wu] <- NA
    
    fstart <- fs
    fg <- fstart
  }
  
  wna <- which( is.na( fstart ) )
  
  if( length( wna ) > 0 & SEEDDATA ){
    
    fg <- .initEM( last0first1, yeGr, distall, ug[ 1], tdata, sdata, 
                  specNames, seedNames, R, SAMPR, USPEC, years, trapRows, 
                  plotYears, z, xfec, fstart, verbose )
  }else{
    fg <- fstart
  }
  tdata$fecMin[ tdata$fecMin < 1e-4] <- 1e-4
  
  propF <- fg/10
  propF[ propF < .0001] <- .0001
  
  if( 'groupName' %in% colnames( tdata ) & 'site' %in% colnames( tdata ) & verbose ){
    cat( '\nTree-years by site and random group name\n' )
    print( table( tdata$site, tdata$groupName ) )
  }
  
  # reg variance
  sg <- sigmaMu
  s1 <- sigmaWt
  s2 <- sigmaMu*( s1 - 1 )
  
  bgFec <- matrix( 0, Qfec, 1 )
  bgRep <- matrix( 0, Qrep, 1 )
  rownames( bgFec ) <- xFecNames
  rownames( bgRep ) <- xRepNames
  
  diamMean <- xmean[ 'diam']
  diamSd   <- xsd[ 'diam']
  
  if( !is.null( betaPrior ) ){         # betaPrior$rep is unstandardized
    betaPriorInput <- betaPrior
    betaPrior      <- .getBetaPrior( betaPriorInput, bgFec, bgRep, specNames, diamMean, diamSd, 
                                    priorTable = priorTable )
  }
  
 # print( betaPrior )
  
  if( FECWT ){
    freq <- rep( 1, nrow( tdata ) )
    dseq <- c( seq( 0, 100, by = 10 ), 1000 )
    for( j in 1:nspec ){
      wj <- which( tdata$species == specNames[ j] )
      jtab <- table( cut( tdata$diam[ wj], dseq ) )
      jtab <- jtab/sum( jtab )
      dtab <- findInterval( tdata$diam[ wj], dseq )
      freq[ wj] <- jtab[ dtab]
    }
    freq[ is.na( freq )] <- .1
    freq[ freq < .02]    <- .02
    tdata$fecWt         <- 1/freq
  }
  
  ngroup <- length( yeGr )
  
  fitCols <- 1:Qfec
  if( length( notCols ) > 0 )fitCols <- fitCols[ -notCols]
  
  
  #prior bgRep
  rVPI <- diag( 10, nrow( bgRep ) )
  rvp  <- bgRep*0
  rvp[ 1:nspec] <- -.5
  rvp[ endsWith( rownames( bgRep ), ':diam' )] <- 1

  .updateBeta <- .wrapperBeta( rvp, rVPI, priorB, priorIVB, SAMPR, obsRows, 
                              tdata, xfecCols, xrepCols, last0first1, ntree, nyr, 
                              betaPrior, years, YR, AR, yrIndex, 
                              RANDOM, reIndex, xrandCols, RANDYR, 
                              fitCols, specNames, FECWT )
  
  if( SEEDDATA ){
    .updateU <- .wrapperU( distall, tdata, minU, maxU, priorU, priorVU, 
                          seedNames, nspec, trapRows, obsRowSeed, obsYr, 
                          tau1, tau2, SAMPR, RANDYR, USPEC )
  }
  
  predYr  <- sort( unique( tdata$year ) )
  
  tcols <- c( 'specPlot', 'species', 'dcol', 'year', 'plotYr', 'plotyr', 'obs', 'repr', 
             'fecMin', 'fecMax', 'fit' )
  if( AR )tcols <- c( tcols, 'times' )
  if( CONES )tcols <- c( tcols, 'cropCount', 'cropFraction', 'cropFractionSd' )
  if( 'cropMin' %in% colnames( tdata ) )tcols <- c( tcols, 'cropMin' )
  if( 'cropMax' %in% colnames( tdata ) )tcols <- c( tcols, 'cropMax' )
  
  wc <- which( !tcols %in% colnames( tdata ) )
  if( length( wc ) > 0 ){
    tc <- paste0( tcols[ wc], collapse = ', ' )
    stop( paste( 'columns missing from treeData:', tc ) )
  }

  updateProp <- c( 1:1000, seq( 1001, 10000, by = 100 ) )
  updateProp <- updateProp[ updateProp < .9*ng]
  
  pHMC <- .03
  if( nrow( tdata ) > 50000 ) pHMC <- 0
  
  .updateFecundity <- .wrapperStates( SAMPR, USPEC, RANDOM, SEEDDATA, obsTimes, 
                                      plotYears, sdata, tdat = tdata[, tcols], seedNames, 
                                      last0first1, distall, YR, AR, trapRows, 
                                      obsRows, obsTrapRows, obsYr, predYr, obsRowSeed, 
                                      ntree, years, nyr, xrandCols, reIndex, 
                                      yrIndex, plag, groupByInd, RANDYR, updateProp, 
                                      seedTraits, pHMC )
  
  ikeep <- 1:ng
  if( ng < keepIter )keepIter <- ng
  if( keepIter < ng ){
    ikeep <- round( seq( 1, ng, length.out = keepIter ) )
    ikeep <- ikeep[ !duplicated( ikeep )]
  }
  nkeep <- length( ikeep )
  
  bfgibbs  <- matrix( 0, nkeep, Qfec ); colnames( bfgibbs ) <- xFecNames #unstandardized
  brgibbs  <- matrix( 0, nkeep, Qrep ); colnames( brgibbs ) <- xRepNames
  bygibbsF <- bygibbsR <- NULL
  bsgibbs  <- bfgibbs              #standardized--prediction from unstandardized may not work
  
  if( SEEDDATA ){ 
    minU <- minU[ specNames]
    maxU <- maxU[ specNames]
    ug <- ug[ specNames]
    
    ugibbs <- matrix( 0, nkeep, nspec )
    colnames( ugibbs ) <- specNames
    if( !USPEC ) ugibbs <- ugibbs[, 1, drop = FALSE]
    
    if( USPEC ){
      priorUgibbs <- matrix( 0, nkeep, 2 )
      colnames( priorUgibbs ) <- c( 'mean', 'var' )
    }
    ug[ 1:nspec] <- .tnorm( nspec, minU, maxU, ug, 5 ) 
    if( !USPEC )ug[ 1:nspec] <- ug[ 1]
  }
  
  sgibbs <- matrix( 0, nkeep, 3 )
  colnames( sgibbs ) <- c( 'sigma', 'rmspe', 'deviance' )
  
  ncols <- nyr
  if( AR ){
    ncols <- plag
    cnames <- paste( 'lag', c( 1:plag ), sep = '-' )
  }
  
  betaYrF  <- betaYrR <- matrix( 0, 1, ncols )
  if( YR ) sgYr <- rep( 1, ncols )
  if( YR | AR ){
    betaYrF  <- matrix( 0, 1, ncols )
    betaYrR  <- matrix( 0, ngroup, ncols )
    rownames( betaYrR ) <- yeGr
    colnames( betaYrF ) <- colnames( betaYrR ) <- cnames
    
    bygibbsF <- matrix( NA, nkeep, length( betaYrF ) )
    bygibbsR <- matrix( 0, nkeep, length( betaYrR ) )
    colnames( bygibbsF ) <- colnames( betaYrF )
    colnames( bygibbsR ) <- .multivarChainNames( yeGr, colnames( betaYrR ) )
    bygibbsN <- bygibbsR
  }

  if( AR ){
    if( plag == 1 ){
      Gmat <- matrix( 0, 1, 1 )
    }else{
      Gmat  <- rbind( 0, cbind( diag( plag-1 ), 0 ) )
    }
    eigenMat <- eigen1 <- eigen2 <- betaYrR*0
  }
  
  if( RANDOM ){
    agibbs <- matrix( NA, nkeep, length( Arand ) )
    colnames( agibbs ) <- .multivarChainNames( xFecNames[ xrandCols], 
                                            xFecNames[ xrandCols] )
    aUgibbs <- agibbs
    asum <- asum2 <- aUsum <- aUsum2 <- alphaRand*0
  }
  
  colnames( brgibbs ) <- xRepNames
  
  if( SAMPR ){
    rgibbs <- matrix( 0, nkeep, length( R ) )
    colnames( rgibbs ) <- .multivarChainNames( rownames( R ), colnames( R ) )
    rgibbs <- rgibbs[, posR]
  }
  
  accept <- rep( 0, length( plotYears ) )
  
  
  pars  <- list( fg = fg, # fecMinCurrent = tdata$fecMin, 
              #  fecMaxCurrent = tdata$fecMax, 
                sg = sg, bgFec = bgFec, bgRep = bgRep, 
                betaYrR = betaYrR*0, betaYrF = betaYrF, alphaRand = alphaRand, 
                Arand = Arand )
  if( SEEDDATA ){
    pars$ug    <- ug
    pars$umean <- umean
    pars$uvar  <- uvar
    pars$R     <- R
  }
  
  mufec <- xfec%*%bgFec
  muyr  <- muran <- mufec*0
  
  # draw from probit
  tdata$repMu[ !is.finite( tdata$repMu )] <- .5
  wlo <- rep( -Inf, length( z ) )
  whi <- rep( Inf, length( z ) )
  whi[ z == 0] <- 0
  wlo[ z == 1] <- 0
  w <- .tnorm( length( z ), wlo, whi, tdata$repMu, 1 )
  
  tmp <- .updateBeta( pars, xfec, xrep, w, z, zmat, matYr, muyr )
  bgFec <- pars$bgFec <- tmp$bgFec
  bgRep <- pars$bgRep <- tmp$bgRep
  
  if( ARSETUP ){
    bgFec[ rownames( parameters$betaFec ), 1] <- parameters$betaFec[, 1]
    bgRep[ rownames( parameters$betaRep ), 1] <- parameters$betaRep[, 1]
    sg <- parameters$sigma[ 1, 1]
    
    pars$bgFec <- bgFec
    pars$bgRep <- bgRep
    pars$sg <- sg
  }
  
  if( SEEDDATA ){
    tmp <- .updateU( pars, z, propU, sdata )
    ug    <- pars$ug    <- tmp$ug
    umean <- pars$umean <- tmp$umean
    uvar  <- pars$uvar  <- tmp$uvar
    propU <- tmp$propU
    if( !USPEC )ug[ 1:nspec] <- pars$ug <- ug[ 1]
  }
  
  # tree correlation
  nSpecPlot <- max( yrIndex[, 'specPlot'] )
  
  fmat   <- matrix( 0, ntree, nyr )
  treeID <- unique( tdata$treeID )
  ntree  <- length( treeID )
  fmat   <- matrix( 0, ntree, nyr )
  yrIndex[, 'tnum'] <- match( tdata$treeID, treeID )
  rownames( fmat )   <- treeID
  colnames( fmat )   <- years
  
  nspec  <- length( specNames )
  omegaE <- omegaN <- matrix( 0, ntree, ntree )
  
  if( PREDSEED ){  #predict species, not seedNames
    specPredSum <- specPredSum2 <- matrix( 0, nseedPred, nspec )
    colnames( specPredSum ) <- specNames
  }
  
  gupdate <- c( 40, 80, 160, 240, 600, 800, 1200, 2000 )  
  g1      <- 1
  yupdate <- sort( sample( burnin:ng, 50, replace = TRUE ) )
  yupdate <- unique( yupdate )
  pupdate <- burnin:ng
  if( length( pupdate ) > 100 )pupdate <- 
    unique( round( seq( burnin, ng, length = 100 ) ) )

  
  if( SEEDDATA ){
    svarEst <- rep( 0, nrow( sdata ) )
    names( svarEst ) <- rownames( sdata )
    svarEst <- svarPred <- svarEst2 <- svarPred2 <- svarEst
    specSum <- specSum2  <- matrix( 0, nrow( sdata ), nspec )
    colnames( specSum )    <- colnames( specSum2 ) <- specNames
    rownames( specSum )    <- rownames( specSum2 ) <- rownames( sdata )
    activeArea <- sdata$area
    
    if( SEEDCENSOR ){                              #locations of censored seed counts
      censMin <- as.matrix( censMin )
      censMax <- as.matrix( censMax )
      censIndex <- which( censMax > censMin, arr.ind = TRUE )
      censIndex <- sort( unique( censIndex[, 1] ) )
      areaCens <- sdata[ rownames( censMin ), 'area']
      cens2sdata <- match( rownames( censMin ), rownames( sdata ) )
    }
  }
  
  ff     <- colnames( xfec )[ fitCols]
  suCols <- match( ff, colnames( xfecs2u ) )
  ntoty  <- ntotyy <- rmspe <- deviance <- 0
  ntot   <- 0
  zest   <- zpred <- fest <- fest2 <- fpred <- fpred2 <- fg*0 # fecundity 
  sumDev <- ndev <- 0                                         # for DIC
  sumDevCrop <- devianceCrop <- 0
  nPlotYr    <- max( tdata$plotyr )
  acceptRate <- nPlotYr/5
  
  ########### growth for maturation transition
  
  grow <-  smat <- rmat <- matrix( NA, ntree, nyr )
  grow[ yrIndex[, c( 'tnum', 'year' )]] <- tdata$diam
  gdev <- sweep( grow, 1, rowMeans( grow, na.rm = TRUE ), '-' )
  tdev <- c( 1:nyr ) - ( 1 + nyr )/2
  tdev <- matrix( tdev, ntree, nyr, byrow = TRUE )
  cgt  <- rowMeans( gdev * tdev, na.rm = TRUE )   # covariance growth/time
  tvr  <- apply( tdev, 1, var, na.rm = TRUE )
  slp  <- cgt/tvr                                  # mean growth ratre
  slp[ slp < .005] <- .005
  growVec <- slp[ tdata$tnum]
  
  pbar <- txtProgressBar( min = 1, max = ng, style = 1 )
  
  if( SEEDDATA )logScoreStates <- logScoreFull <- seedCount*0
  
  nprob <- 0
  
  fg[ fg > tdata$fecMax] <- tdata$fecMax[ fg > tdata$fecMax]
  fg[ fg < tdata$fecMin] <- tdata$fecMin[ fg < tdata$fecMin]
  pars$fg <- fg
  
  # trees with multiple years
  w2 <- table( tdata$treeID )
  multYear <- names( w2 )[ w2 > 1]
  MULTYR   <- tdata$treeID %in% multYear
  
  epsilon <- ( log( fg ) + log( tdata$fecMax + 1.01 - fg ) )/100000
  
  gk <- 0
  
  if( RANDOM ){
    minmax <- 4
    amu    <- rep( 0, nspec )
    names( amu ) <- colnames( xfec )[ xrandCols]
    if( nspec == 1 & length( xrandCols ) == 1 )names( amu ) <- specNames
    ispec  <- tdata$species[ match( treeID, tdata$treeID )] # species column, assumes only random intercepts
    ispec  <- match( ispec, specNames )
    imat   <- matrix( 0, ntree, nspec )
    imat[ cbind( 1:ntree, ispec )] <- 1
    rownames( imat ) <- treeID
    colnames( imat ) <- specNames
  }
  
  # individual trends
  sfmat  <- matrix( NA, ntree, nyr )
  rownames( sfmat ) <- treeID
  symat <- matrix( 1:ncol( sfmat ), nrow( sfmat ), ncol( sfmat ), byrow = T )
  #sgmat  <- matrix( NA, ntree, nyr )
  rownames( symat ) <- treeID
  slopesRate <- slopesNyr <- rep( 0, ntree )
  
  wcrop <- which( is.finite( tdata$cropCount ) )
  
 # xreps2u%*%bgRep
  
  for( g in 1:ng ){ ####################
    
    
    if( g %in% ikeep )gk <- gk + 1    
    if( gk > ng )break
    
    pars$fg <- fg
    yg      <- log( fg )      
    mufec   <- xfec%*%bgFec
    
    if( RANDOM ){
      
      yg <- yg - mufec
      if( YR ){
        if( RANDYR ){
          yg <- yg - betaYrR[ yrIndex[, c( 'group', 'year' )]] 
        }else{
          yg <- yg - betaYrF[ yrIndex[, 'year']] 
        }
      }
      if( AR )yg <- yg - muyr
      
      tt <- table( reIndex[ z == 1] )                # only mature individuals
      reGroups <- as.numeric( names( tt )[ tt > 2] )   # multiyear
      wrow     <- which( reIndex %in% reGroups )
      krow     <- which( !reIndex %in% reGroups )
      
      tmp <- .updateAlphaRand( ntree, yA = yg[ wrow, ], 
                              xfecA = xfec[ wrow, xrandCols, drop = FALSE], 
                              sg, reIndexA = reIndex[ wrow], reGroups, 
                              Arand, priorVA, dfA, specNames, minmax = 2 )
    #  check4na( tmp, '.updateAlphaRand' )
      
      Arand       <- pars$Arand <- tmp$Arand
      alphaRand   <- pars$alphaRand <- tmp$alphaRand
      meanRand    <- tmp$meanRand                      # mean RE by species
      
      if( g >= burnin )alphaRandU  <- tmp$alphaRand%*%t( xrands2u )
      
      
      if( g %in% ikeep ){
        ArandU       <- xrands2u%*%tmp$Arand%*%t( xrands2u )
        agibbs[ gk, ]  <- as.vector( Arand )   
        aUgibbs[ gk, ] <- as.vector( ArandU )
      }
      
      alphaRand  <- alphaRand*imat
      if( g >= burnin )alphaRandU <- alphaRandU*imat
      
      muran <- alphaRand[ reIndex, ]
      if( length( Arand ) > 1 )muran <- rowSums( muran )
      
      # single year - use if only random intercepts, change if there are random slopes
      
      if( length( krow ) > 0 ){
        amu[ names( meanRand )] <- meanRand
        imu <- amu[ yrIndex[ krow, 'spp']] 
        asd <- sqrt( diag( Arand )[ yrIndex[ krow, 'spp']] )
        muran[ krow] <- .tnorm( length( krow ), -minmax, minmax, imu, asd )
      }
    }
    
    if( YR ){
      yg <- log( fg ) - mufec
      if( RANDOM )yg <- yg - muran
      
      tmp      <- .updateBetaYr( yg, z, sg, sgYr, betaYrF, betaYrR, yrIndex, yeGr, 
                                RANDYR, obs = tdata$obs )
    #  check4na( tmp, '.updateBetaYr' )
      betaYrF  <- pars$betaYrF <- tmp$betaYrF
      betaYrR  <- pars$betaYrR <- tmp$betaYrR
      sgYr     <- pars$sgYr    <- tmp$sgYr
      wfinite  <- tmp$wfinite
      
      if( g %in% ikeep ){
        bygibbsF[ gk, ] <- betaYrF
        bygibbsR[ gk, ] <- betaYrR
        bygibbsN[ gk, wfinite] <-  1
        sygibbs[ gk, ]  <- sgYr
      }
      #    muyr <- betaYrF[ yrIndex[, 'year']] 
      #    if( RANDYR ) muyr <- muyr + betaYrR[ yrIndex[, c( 'group', 'year' )]]
      
      muyr <- betaYrR[ yrIndex[, c( 'group', 'year' )]]
    }
    
    if( AR ){
      yg <- log( fg ) 
      mu <- mufec
      if( RANDOM )mu <- mu + muran
      
      tmp <- .updateBetaAR_RE( betaYrF, betaYrR, Alag, yg, mu, z, 
                              lagGroup, lagMatrix, plag, ngroup, sg )
   #   check4na( tmp, '.updateBetaAR_RE' )
      betaYrF <- pars$betaYrF <- tmp$betaYrF
      betaYrR <- pars$betaYrR <- tmp$betaYrR
      wfinite <- which( betaYrR != 0 )
      Alag    <- tmp$Alag
      muyr <- tmp$ylag
      if( g %in% ikeep ){
        bygibbsF[ gk, ] <- betaYrF
        bygibbsR[ gk, ] <- betaYrR
        bygibbsN[ gk, wfinite] <-  1
      }
    }
    
    wlo   <- 10*( z - 1 )
    whi   <- 10*z
    w     <- .tnorm( length( z ), wlo, whi, xrep%*%bgRep, 1 )
    tmp   <- .updateBeta( pars, xfec, xrep, w, z, zmat, matYr, muyr )
  #  check4na( tmp, '.updateBeta' )
    bgFec <- pars$bgFec <- tmp$bgFec
    bgRep <- pars$bgRep <- tmp$bgRep
    
    if( SEEDDATA ){
      tmp   <- .updateU( pars, z, propU, sdata )
   #   check4na( tmp, '.updateU' )
      ug    <- pars$ug    <- tmp$ug
      umean <- pars$umean <- tmp$umean
      uvar  <- pars$uvar  <- tmp$uvar
      propU <- tmp$propU
    }
    
    tmp <- .updateFecundity( g, pars, xfec, xrep, propF, z, zmat, matYr, muyr, 
                            epsilon = epsilon )
  #  check4na( tmp, '.updateFecundity' )
    
    fg    <- pars$fg <- tmp$fg
    fecMinCurrent <- tmp$fecMinCurrent
    fecMaxCurrent <- tmp$fecMaxCurrent
    z     <- tmp$z
    zmat  <- tmp$zmat
    matYr <- tmp$matYr
    propF <- tmp$propF
    epsilon <- tmp$epsilon
    
    
    muf <- xfec%*%bgFec
    if( YR | AR )muf <- muf + muyr
    if( RANDOM )muf  <- muf + muran
    
    wrow   <- obsRows[ z[ obsRows] == 1]
    stmp <- .updateVariance( log( fg[ wrow] ), muf[ wrow], s1, s2 )
  #  check4na( stmp, '.updateVariance' )
    
    sg <- pars$sg <- stmp
    
    if( sg > 30 )sg <- pars$sg <- 30
    
    if( SAMPR ){
      tmp  <- .updateR( ug, fz = fg[ obsTrapRows]*z[ obsTrapRows], SAMPR, USPEC, distall, 
                       sdata, seedNames, 
                       tdat = tdata[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                       R, priorR, priorRwt, obsYr, posR, plots )
      pars$R <- R <- tmp
      if( g %in% ikeep )rgibbs[ gk, ]  <- R[ posR]
    }
    
    ################## predicted state
    
    brep <- bgRep[ -c( 1:nspec ), ]                         # d log( S )/dD = beta_diam
    names( brep ) <- .replaceString( names( brep ), 'species', '' )
    names( brep ) <- .replaceString( names( brep ), ':diam', '' )
    brep[ brep < 0] <- 0
    brep <- brep[ tdata$species]
    
    dSdt <- brep*growVec                                # d log( S )/dt = d log( S )/dD dD/dt
    
    tvec <- pnorm( xrep%*%bgRep )
    tii  <- tapply( tvec, tdata$tnum, mean, na.rm = TRUE )
    tii  <- matrix( tii, ntree, nyr )
    
    smat[ yrIndex[, c( 'tnum', 'year' )]] <- tvec
    smat[ is.na( smat )] <- tii[ is.na( smat )]
    smat[, -1] <- 1 - smat[, 1]
    
    rmat[ yrIndex[, c( 'tnum', 'year' )]] <- dSdt
    rmat[, 1] <- 0
    rmat[ is.na( rmat )] <- 0
    rcum <- t( apply( 1 - rmat, 1, cumprod ) )
    rmat <- rmat*rcum*smat
    rmat[, 1] <- smat[, 1]
    
    rmat <- cbind( rmat, 1 - rowSums( rmat ) )
    rmat <- myrmultinom( 1, rmat )[, -ncol( rmat )]
    rmat[ !is.finite( rmat )] <- 0
    rmat <- t( apply( rmat, 1, cumsum ) )
    zw   <- rmat[ yrIndex[, c( 'tnum', 'year' )]]
    
    
    flo <- fhi <- zw*0
    flo[ zw == 0] <- -9.21034
    fhi[ zw == 1] <- log( fecMaxCurrent[ zw == 1] + .1 )
    
    ymu <- .tnorm( length( muf ), flo, fhi, muf, sqrt( sg ) )
    fmu <- exp( ymu )                                       # mean prediction
    
    # save unstandardized
    bfSave <- bgFec
    brSave <- bgRep
    
    if( UNSTAND ){
      if( length( xfecs2u ) > 0 )bfSave[ fitCols, 1] <- xfecs2u[, suCols]%*%bgFec[ fitCols, 1]  
      if( length( notFit ) > 0 )bfSave[ notFit, 1] <- 0
    }
    
    if( g %in% ikeep ){
      bfgibbs[ gk, ] <- bfSave      # unstandardized
      bsgibbs[ gk, ] <- bgFec       # standardized
      brgibbs[ gk, ] <- brSave
      
      if( SEEDDATA ){
        if( USPEC ){
          ugibbs[ gk, ]  <- ug
          priorUgibbs[ gk, ] <- c( umean, uvar )
        }else{
          ugibbs[ gk, 1] <- ug[ 1]
        }
      }
    }
    
    if( g %in% gupdate & gk > 10 & SEEDDATA ){
      gi <- ( gk - 20 ):gk
      uu <- ug/4
      gi <- gi[ gi > 0]
      if( USPEC ){
        propU  <- apply( ugibbs[ drop = F, gi, ], 2, sd ) + .01
        propU[ propU > uu] <- uu[ propU > uu]
      }else{
        propU <- sd( ugibbs[ drop = F, gi, ] ) + .01
        propU <- min( c( propU, uu ) )
      }
    }
    
    if( SEEDCENSOR ){                # missing censored traps
      lf <- .getLambda( tdata[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                       sdata[ rownames( censMin ), c( 'year', 'plotyr', 'drow' )], 
                       areaCens, ug, fg[ obsTrapRows]*z[ obsTrapRows], R, 
                       SAMPR, USPEC, distall, obsYr, PERAREA = FALSE )  # per trap
      lf[ lf < 1e-9] <- 1e-9
      
      ttt   <- rtpois( lo = censMin[, seedNames, drop = F], 
                       hi = censMax[, seedNames, drop = F], mu = lf )
      sdata[ rownames( censMin ), colnames( ttt )] <- ttt
    }
    
    if( g %in% pupdate )ndev <- ndev + 1
    
    # deviance for crop counts
    if( g %in% pupdate & CONES ){
      
      fc  <- fmu[ wcrop]*zw[ wcrop]
      oss <- tdata$cropCount[ wcrop]*seedTraits[ tdata$species[ wcrop], 'seedsPerFruit']
      tf   <- tdata$cropFraction[ wcrop]
      ts   <- tdata$cropFractionSd[ wcrop]
      cnow <- dbetaBinom( oss, round( fc ), tf, ts, log = TRUE )
      devianceCrop <- sum( cnow )
      sumDevCrop   <- sumDevCrop - 2*devianceCrop
    }
    
    
    if( g %in% pupdate & SEEDDATA ){
      
      nprob <- nprob + 1
      
      # estimated fecundity per m2
      fz <- fg[ obsTrapRows]*z[ obsTrapRows]  
      lm <- .getLambda( tdat1 = tdata[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                       sdat1 = sdata[, c( 'year', 'plotyr', 'drow' )], 
                       AA = 1, ug, ff = fz, R, SAMPR, USPEC, 
                       distance = distall, yrs = obsYr, 
                       PERAREA = TRUE, SPECPRED = TRUE )    
      lm[ lm < 1e-9] <- 1e-9
      pm       <- matrix( rpois( length( lm ), lm ), nrow( lm ), ncol( lm ) )
      specSum  <- specSum + pm
      specSum2 <- specSum2 + pm^2
      
      # estimated seeds per trap
      ls <- lm*sdata$area                      
      pf <- matrix( rpois( length( ls ), ls ), nrow( ls ), ncol( ls ) )
      spf      <- rowSums( pf )
      svarEst  <- svarEst + spf
      svarEst2 <- svarEst2 + spf^2
      
      
      # predicted per trap
      la    <- .getLambda( tdata[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                          sdata[, c( 'year', 'plotyr', 'drow' )], 
                          AA = activeArea, ug, fmu[ obsTrapRows]*zw[ obsTrapRows], 
                          R, SAMPR, USPEC, distall, obsYr, PERAREA = FALSE ) 
      la[ la < 1e-9] <- 1e-9
      pg    <- matrix( rpois( length( la ), la ), nrow( la ), ncol( la ) )
      
      resid <- ( seedCount - pg )^2
      if( SEEDCENSOR )resid[ cens2sdata[ censIndex], ] <- 0
      
      rmspe     <- sqrt( mean( resid, na.rm = TRUE ) )
      spf       <- rowSums( pg )
      svarPred  <- svarPred + spf
      svarPred2 <- svarPred2 + spf^2
      
      # deviance from predicted fecundity
      dev   <- dpois( seedCount, la, log = TRUE )

      if( SEEDCENSOR ){
        mm <- match( rownames( censMin ), rownames( sdata )[ obsRowSeed] )
        
        pr <- dtpois( censMin[, seedNames, drop = F], censMax[, seedNames, drop = F], 
                     la[ cens2sdata, ], 
                     index = censIndex ) 
        dev[ cens2sdata, ] <- log( pr )
      }
      
      deviance <- sum( dev )
      sumDev <- sumDev - 2*deviance
      
      # score from predicted fecundity
      logScoreStates <- logScoreStates - dpois( seedCount, la, log = TRUE )
      logScoreFull   <- logScoreFull - dev
      
      
      if( PREDSEED ){  #NOTE: from estimated, not predicted fg
        ls <- .getLambda( tdat1 = tdatPred[, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                         sdat1 = sdatPred[, c( 'year', 'plotyr', 'drow' )], 
                         AA = 1, ug, ff = fz[ tdatPred[, 'row']], R, SAMPR, USPEC, 
                         distance = distPred, yrs = predList$years, 
                         PERAREA = TRUE, SPECPRED = TRUE )   # per m^2
        ls <- ls + 1e-9
        ps <- matrix( rpois( nseedPred*ncol( ls ), ls ), nseedPred, nspec )
        specPredSum  <- specPredSum + ps
        specPredSum2 <- specPredSum2 + ps^2
      }
    }
    
    if( g %in% ikeep )sgibbs[ gk, ]  <- c( sg, rmspe, deviance )
    
    if( g %in% yupdate ){
      
      ntoty  <- ntoty + 1
      
      # individual rate of change
      fzm <- fg*z
      
      sfmat[ yrIndex[, c( 'tnum', 'year' )]] <- log( fzm )
      sfmat[ sfmat < 2] <- NA
      sgmat <- sfmat*0 + 1
      
      # for rates
      wmat <- which( rowSums( sgmat, na.rm = T ) > 1 )
      
      if( length( wmat ) > 1 ){
        
        ntotyy <- ntotyy + 1
        
        symat[ is.na( sfmat )] <- NA
        fmm  <- rowMeans( sfmat[ wmat, ], na.rm = T )
        ymm  <- rowMeans( symat[ wmat, ], na.rm = T )
        sfmat[ wmat, ] <- sweep( sfmat[ wmat, ], 1, fmm, '-' )
        symat[ wmat, ] <- sweep( symat[ wmat, ], 1, ymm, '-' )
        snmat <- rowSums( symat[ wmat, ]*0 + 1, na.rm = T )
        cvv   <- rowSums( sfmat[ wmat, ]*symat[ wmat, ], na.rm = T )
        vvv   <- rowSums( symat[ wmat, ]^2, na.rm = T )
        slope <- cvv/vvv
        wf    <- which( is.finite( slope ) )
        
        slopesRate[ wmat[ wf]] <- slopesRate[ wmat[ wf]] + slope[ wf]
        slopesNyr[ wmat[ wf]]  <- slopesNyr[ wmat[ wf]] + snmat[ wf]
      }
      
      ########################
      
      # by group
      if( AR ){
        for( j in 1:ngroup ){
          Gmat[ 1, ] <- betaYrF + betaYrR[ j, ]
          eigenMat[ j, ] <- eigen( Gmat )$values
        }
        eigen1 <- eigen1 + eigenMat
        eigen2 <- eigen2 + eigenMat^2
      }
      
      fecRes <- fg
      yRes <- yg
      
      for( m in 1:nSpecPlot ){       ############### MATCH TREEID ROWS FOR FMAT
        
        fmat <- fmat*0
        
        wm   <- which( yrIndex[, 'specPlot'] == m & tdata$obs == 1 & fg > 1 )
        dm   <- tdata$tnum[ wm]
        ym   <- yrIndex[ wm, 'year']
        dr   <- unique( dm )
        if( length( dr ) < 2 )next
        
        fmat[ cbind( dm, ym )] <- fecRes[ wm]
        fm  <- fmat[ unique( dm ), unique( ym )]
        
        # between trees
        ff <- suppressWarnings( cor( t( fm ), use = "pairwise.complete.obs" ) ) 
        wf <- which( is.finite( ff ) )
        
        omegaE[ dr, dr][ wf] <- omegaE[ dr, dr][ wf] + ff[ wf]
        omegaN[ dr, dr][ wf] <- omegaN[ dr, dr][ wf] + 1
        
        acm <- acfEmp( yRes[ wm], irow = tdata$tnum[ wm], 
                      time = yrIndex[ wm, 'year'], nlag = nlag )
        wfin <- which( is.finite( acm ) )
        
        gcm <- acfEmp( yRes[ wm], irow = tdata$tnum[ wm], 
                      time = yrIndex[ wm, 'year'], nlag = nlag, GARCH = TRUE )
        if( length( wfin ) == 0 )next
        
        pa <- try( pacfFromAcf( acm[ wfin] )[ 1, ], T )
        
        if( !inherits( pa, 'try-error' ) ){
          pcol <- colnames( pacfMat )[ colnames( pacfMat ) %in% names( wfin )]
          acol <- colnames( acfMat )[ colnames( acfMat ) %in% names( wfin )]
          pacfMat[ m, pcol] <- pacfMat[ m, pcol] + pa[ pcol]
          pacf2[ m, pcol]   <- pacf2[ m, pcol] + pa[ pcol]^2
          acfMat[ m, acol]  <- acfMat[ m, acol] + acm[ acol]
          acf2[ m, acol]    <- acf2[ m, acol] + acm[ acol]^2
          gcfMat[ m, acol]  <- gcfMat[ m, acol] + gcm[ acol]
          acN[ m, acol]     <- acN[ m, acol] + 1
          pacN[ m, acol]    <- pacN[ m, acol] + 1
        }
      }
    }
    
    if( g >= burnin ){
      
      ntot <- ntot + 1
      
      zprob <- pnorm( xrep%*%bgRep )  # continuous version of z
      
      zest  <- zest + zprob
      fz    <- fg*zprob
      fest  <- fest + fz  
      fest2 <- fest2 + fz^2
      
      zpred  <- zpred + zw
      fz     <- fmu*zw
      fpred  <- fpred + fz
      fpred2 <- fpred2 + fz^2
      
      if( RANDOM ){
        asum   <- asum + alphaRand
        asum2  <- asum2 + alphaRand^2
        aUsum  <- aUsum + alphaRandU
        aUsum2 <- aUsum2 + alphaRandU^2
      }
    }
    setTxtProgressBar( pbar, g )
  } ###########################################################
   
   # to re-initialize
  tdata$lastFec  <- fg
  tdata$lastRepr <- z
  
  # fecundity
  matrEst  <- zest/ntot
  matrPred <- zpred/ntot
  
  fecEstMu <- fest/ntot 
  fecEstSe <- fest2/ntot - fecEstMu^2
  fecEstSe[ fecEstSe < 0] <- 0
  fecEstSe <- sqrt( fecEstSe )
  
  fecPredMu <- fpred/ntot                   #  pred|z = 1
  fecPredSe <- fpred2/ntot - fecPredMu^2
  fecPredSe[ fecPredSe < 0] <- 0
  fecPredSe <- sqrt( fecPredSe )
  
  fecPred <- tdata[, c( 'plot', 'treeID', 'species', 'year', 'diam', 'dcol' )]
  if( YR | AR ){
    ygr <- yrIndex
    colnames( ygr ) <- paste( 'ind_', colnames( ygr ), sep = '' )
    fecPred <- cbind( fecPred, ygr )
  }
  if( CONES ){
    cropCount <- seedTraits[ tdata$species, 'seedsPerFruit']*tdata$cropCount/tdata$cropFraction
    fecPred <- cbind( fecPred, cropCount )
  }
  mpm <- round( cbind( matrEst, matrPred ), 3 )
  colnames( mpm ) <- c( 'matrEst', 'matrPred' )
  
  fpm <- cbind( fecEstMu, fecEstSe, fecPredMu, fecPredSe )
  fpm[ is.na( fpm )] <- 0
  fpm <- round( fpm, 1 )
  colnames( fpm ) <- c( 'fecEstMu', 'fecEstSe', 'fecPredMu', 'fecPredSe' )
  
  fecPred <- cbind( fecPred, mpm, fpm )
  
  if( CONES ){
    rmspeCrop <- sqrt( mean( ( fecPredMu - cropCount )^2, na.rm = T ) )
  }
  
  if( SEEDDATA ){
    
    scols <- c( 'plot', 'year', 'trapID', 'drow', 'area' )
    countPerTrap <- rowSums( sdata[, seedNames, drop = FALSE] )
    
 #   seedEst <- cbind( colMeans( SvarEst ), apply( SvarEst, 2, sd ) )
    seedEst <- svarEst/nprob
    s2      <- svarEst2/nprob - seedEst^2
    seedEst <- cbind( seedEst, sqrt( s2 ) )
    colnames( seedEst ) <- c( 'estMeanTrap', 'estSeTrap' )
    
  #  seedPred <- cbind( colMeans( SvarPred ), apply( SvarPred, 2, sd ) )
    seedPred <- svarPred/nprob
    s2       <- svarPred2/nprob - seedPred^2
    seedPred <- cbind( seedPred, sqrt( s2 ) )
    colnames( seedPred ) <- c( 'predMeanTrap', 'predSeTrap' )
    
    svv <- ( countPerTrap - seedPred[, 'predMeanTrap'] )^2 
    predSeError  <- signif( sqrt( svv ) , 3 )
    
    seedSpecMu <- specSum/nprob
    seedSpecSe <- specSum2/nprob - seedSpecMu^2
    seedSpecSe[ seedSpecSe < 0] <- 0
    seedSpecSe <- sqrt( seedSpecSe )
    
    seedPred <- data.frame( cbind( sdata[, scols], countPerTrap, 
                                   signif( seedEst, 3 ), 
                                   signif( seedPred, 3 ), 
                                   predSeError ), 
                            stringsAsFactors = F )
    m1 <- paste( specNames, 'meanM2', sep = '_' )
    m2 <- paste( specNames, 'sdM2', sep = '_' )
    m2Mu <- seedSpecMu[, specNames, drop = FALSE]
    m2Se <- sqrt( seedSpecSe[, specNames, drop = FALSE]^2 ) 
    colnames( m2Mu ) <- m1
    colnames( m2Se ) <- m2
    seedPred <- cbind( seedPred, signif( m2Mu, 3 ), signif( m2Se, 3 ) )
    
    inflation <- signif( predSeError/( .1 + seedPred$predSeTrap ), 3 )
    
    pvv <- seedPred$predSeTrap^2  # predictive variance
    
    seedPred <- cbind( seedPred, inflation )
    
    #entire data set
    
    meanPredErrSd <- mean( predSeError, na.rm = TRUE )
    meanPredSd    <- mean( seedPred$predSeTrap, na.rm = TRUE )
    meanInflation <- mean( inflation, na.rm = TRUE )
    
    # fit  
    
  #  nss <- length( obsRowSeed )
    
    MM <- FALSE
    if( !all( seedTraits[, 'gmPerSeed'] == 1 ) )MM <- TRUE
    
    if( MM ){
      mss <- matrix( seedTraits[ specNames, 'gmPerSeed'], nrow( sdata ), nspec, byrow = TRUE )
      massMu <- seedSpecMu[, specNames, drop = FALSE]*mss
      massSe <- sqrt( seedSpecSe[, specNames, drop = FALSE]^2*mss^2 ) 
      m1 <- paste( colnames( massMu ), 'meanGmM2', sep = '_' )
      m2 <- paste( colnames( massSe ), 'sdGmM2', sep = '_' )
      colnames( massMu ) <- m1
      colnames( massSe ) <- m2
      seedPred <- cbind( seedPred, signif( massMu, 3 ), signif( massSe, 3 ) )
    }
    
    if( PREDSEED ){
      scols <- c( 'plot', 'trapID', 'year', 'x', 'y', 'drow', 'dgrid', 'area', 'active' )
      specMu <- specPredSum/nprob
      sse <- specPredSum2/nprob - specMu^2
      specSe <- sqrt( sse )
      colnames( specMu ) <- paste( colnames( specMu ), '_meanM2', sep = '' )
      colnames( specSe ) <- paste( colnames( specSe ), '_sdM2', sep = '' )
      
      nss <- nrow( sdatPred )
      mss <- matrix( seedTraits[ specNames, 'gmPerSeed'], nss, nspec, byrow = TRUE )
      massMu <- specMu*mss
      massSe <- sqrt( specSe^2*mss^2 ) 
      m1 <- paste( specNames, 'meanGmM2', sep = '_' )
      m2 <- paste( specNames, 'sdGmM2', sep = '_' )
      colnames( massMu ) <- m1
      colnames( massSe ) <- m2
      
      preds <- signif( cbind( specMu, specSe, massMu, massSe ), 3 )
      
      seedPredGrid <- data.frame( cbind( sdatPred[, scols], preds ) )
      treePredGrid <- cbind( tdatPred, fecPred[ tdatPred$row, ] )
      
      # out-of-sample
      if( !is.null( modelYears ) ){
        
        sdataOut$plotTrapYr <- columnPaste( sdataOut$trapID, sdataOut$year )
        sdataOut$fore <- sdataOut$year - max( modelYears )
        
        tdataOut$plotTreeYr <- columnPaste( tdataOut$treeID, tdataOut$year )
        treePredGrid$plotTreeYr <- columnPaste( treePredGrid$treeID, treePredGrid$year )
        
        fec <- matrix( NA, nrow( tdataOut ), 4 )
        colnames( fec ) <- colnames( fpm )
        ww <- which( tdataOut$plotTreeYr %in% treePredGrid$plotTreeYr )
        qq <- match( tdataOut$plotTreeYr[ ww], treePredGrid$plotTreeYr )
        fec[ ww, ] <- fpm[ qq, ]
        tdataOut <- cbind( tdataOut, fec )
      }
    }
    
    # seed, fecundity acf
    seedRes <- t( t( seedCount ) - colMeans( seedCount, na.rm = TRUE ) )
    ww <- colSums( seedCount, na.rm = TRUE )
    
    acsMat <- NULL
    
    if( sum( ww ) > 0 ){
      yrs <- range( sdata$year )
      yrs <- yrs[ 1]:yrs[ 2]
      
      seedRes <- seedRes[, ww > 0, drop = FALSE]
      
      ii <- rep( sdata$drow, ncol( seedRes ) )
      yy <- match( sdata$year, yrs )
      jj <- rep( yy, ncol( seedRes ) )
      kk <- is.finite( ii )
      ii <- ii[ kk]
      jj <- jj[ kk]
      sr <- as.vector( seedRes )[ kk]
      
      
      acm  <- acfEmp( sr, ii, jj, nlag = 10 )
      acsMat <- acm
   #   wfin <- which( is.finite( acm ) )
   #   if( length( wfin ) > 0 )acsMat <- pacfFromAcf( acm[ wfin] )
    }
  }
  
  kg <- which( ikeep >= burnin & ikeep <= ng )
  
  betaFec <- .chain2tab( bfgibbs[ drop = F, kg, ] ) # unstandardized
  betaStd <- .chain2tab( bsgibbs[ drop = F, kg, ] ) # standardized betaFec
  betaRep <- .chain2tab( brgibbs[ drop = F, kg, ] )
  
  acfMat  <- acfMat/acN
  acfSe   <- acf2/acN - acfMat^2
  acfMat[ !is.finite( acfMat )] <- 0
  acfSe[ !is.finite( acfSe )] <- 0
  acfSe <- sqrt( acfSe )
  
  wk <- which( rowSums( acfSe ) > 0 )
  acfMat <- acfMat[ wk, , drop = F]
  acfSe  <- acfSe[ wk, , drop = F]
  
  pacfMat <- pacfMat/pacN
  pacfSe  <- pacf2/pacN - pacfMat^2
  pacfMat[ !is.finite( pacfMat )] <- 0
  pacfSe[ !is.finite( pacfSe )] <- 0
  pacfSe <- sqrt( pacfSe )
  
  wk <- which( rowSums( pacfSe ) > 0 )
  pacfMat <- pacfMat[ wk, , drop = F]
  pacfSe  <- pacfSe[ wk, , drop = F]
  
  gcfMat <- gcfMat/acN
  gcfMat[ !is.finite( gcfMat )] <- 0
  gcfMat <- gcfMat[ wk, , drop = F]
  
  omegaE <- omegaE/omegaN
  
  ################ individual slopes
  
  trendRate <- slopesRate/ntotyy
  trendNyr  <- slopesNyr/ntotyy
  trendTree <- signif( cbind( trendRate, trendNyr ), 3 )
  colnames( trendTree ) <- c( 'logf/yr', 'years' )
  
  # by species-plot
  si <- tdata$species[ match( treeID, tdata$treeID )]
  ip <- tdata$plot[ match( treeID, tdata$treeID )]
  ll <- list( plot = ip, species = si )
  
  # weighted by series length
  ws <- tapply( trendRate*trendNyr, ll, sum, na.rm = T )
  wt <- tapply( trendNyr, ll, sum, na.rm = T )
  trendMu <- ws/wt
  
  vt <- tapply( trendRate^2*trendNyr, ll, sum, na.rm = T )
  ss <- vt/wt - trendMu^2
  ss[ ss < 0] <- 0
  trendSe <- sqrt( ss )
  
  colnames( trendMu ) <- paste( colnames( trendMu ), 'Mean' )
  colnames( trendSe ) <- paste( colnames( trendSe ), 'SE' )
  
  trendPlotSpec <- signif( cbind( trendMu, trendSe ), 4 )
  
  # by species
 
  # weighted by series length
  ws <- tapply( trendRate*trendNyr, si, sum, na.rm = T )
  wt <- tapply( trendNyr, si, sum, na.rm = T )
  trendMu <- ws/wt
  
  vt <- tapply( trendRate^2*trendNyr, si, sum, na.rm = T )
  vt <- vt/wt - trendMu^2
  vt[ vt < 0] <- 0
  trendSe <- sqrt( vt )
  
  names( trendMu ) <- paste( names( trendMu ), 'Mean' )
  names( trendSe ) <- paste( names( trendSe ), 'SE' )
  
  trendSpec <- signif( c( trendMu, trendSe ), 4 )
  
  trendEst <- list( trendSpec = trendSpec, trendPlotSpec = trendPlotSpec, 
                    trendTree = trendTree )
  
  
  ################ years/lags
  
  # ecoRegions in treeData
  ecodes  <- sort( unique( tdata$group ) )
  ecoRegs <- tdata$ecoReg[ match( ecodes, tdata$group )]
  
  mastScores <- NULL  # requires year effects
  
  if( YR | AR ){
    ncol <- nyr
    ccol <- years
    if( AR ){
      ncol <- plag
      ccol <- colnames( bygibbsF )
    }
    
    betaYrMu <- betaYrSe <- matrix( nrow( betaYrF ), ncol = ncol )
    wg <- which( rowSums( abs( bygibbsF ) ) != 0 )
    wg <- wg[ wg %in% kg]
    
   
    if( length( wg ) > 0 ){
      
      betaYr <- .chain2tab( bygibbsF[ drop = FALSE, wg, ] )
      betaYrMu <- matrix( colMeans( bygibbsF[ drop = FALSE, wg, ], na.rm = TRUE ), 
                          nrow( betaYrF ), ncol = ncol )
      betaYrSe <- matrix( apply( bygibbsF[ drop = FALSE, wg, ], 2, sd, na.rm = TRUE ), 
                          nrow( betaYrF ), ncol = ncol )
    }
 
    betaYrRand <- betaYrRandSE <- betaYrMu*0
    
    if( RANDYR ){
      
      betaYrRand <- betaYrRandSE <- betaYrR*0
      wg <- which( rowSums( abs( bygibbsR ) ) != 0 )
      
      wg <- wg[ wg %in% kg]
  
      if( length( wg ) > 0 ){   
        brsum <- matrix( colSums( bygibbsR[ wg, ], na.rm = TRUE ), 
                         nrow( betaYrR ), ncol )
        brn <- matrix( colSums( bygibbsN[ wg, ], na.rm = TRUE ), 
                       nrow( betaYrR ), ncol )
        betaYrRand <- brsum/brn
        brn2 <- matrix( colSums( bygibbsR[ wg, ]^2, na.rm = TRUE ), 
                        nrow( betaYrR ), ncol )
        ser <- sqrt( brn2/brn - betaYrRand^2 )
        betaYrRandSE <- ser
        betaYrRand[ !is.finite( betaYrRand )] <- 0
      }
      
      rownames( betaYrRand ) <- rownames( betaYrRandSE ) <- yeGr
      colnames( betaYrRand ) <- colnames( betaYrRandSE ) <- ccol
      
      mastScores <- numeric( 0 )
      
      for( i in 1:nrow( betaYrRand ) ){
        bk <- betaYrRand[ i, ]
        wc <- which( bk != 0 )
        
        if( length( wc ) < 5 )next
        
        my  <- length( wc )
        tt  <- mastSpectralDensity( bk[ wc] )
        
  #      scc <- paste( 'vol = ', round( tt$volatility, 3 ), ', period = ', 
  #                    round( tt$periodMu, 2 ), 
  #                    sep = '' )
        srow <- c( length( wc ), signif( tt$totVar, 3 ), signif( tt$volatility, 3 ), 
                   signif( tt$periodMu, 3 ), signif( tt$periodSd, 3 ) )
        mastScores <- rbind( mastScores, srow )
        rownames( mastScores )[ nrow( mastScores )] <- rownames( betaYrRand )[ i]
      }
      
      
      if( length( mastScores ) > 0 ){
        rg  <- grep( '_', rownames( mastScores ) )
        if( length( rg ) == 0 | rownames( mastScores )[ 1] == 'srow' )rownames( mastScores ) <- 
            paste( rownames( mastScores ), '_', specNames[ 1], sep = '' )
        ttt <- columnSplit( rownames( mastScores ), '_' )
        ecoRegionCode <- as.numeric( ttt[, 1] )
        
        colnames( mastScores ) <- c( 'years', 'spectralVariance', 'volatility', 'periodMu', 'periodSd' )
        
        mastScores <- data.frame( species = ttt[, 2], ecoRegionCode, mastScores, 
                                  stringsAsFactors = F )
        rownames( mastScores ) <- NULL
      }else{
        mastScores <- NULL
      }
    }
  }
  
  ################ REs
  
  if( RANDOM ){
    alphaMu <- asum/ntot
    av    <- asum2/ntot - alphaMu^2
    av[ av < 0] <- 0
    alphaSe <- sqrt( av )
    
    alphaUMu <- aUsum/ntot
    av    <- aUsum2/ntot - alphaUMu^2
    av[ av < 0] <- 0
    alphaUSe <- sqrt( av )
    
    if( ONEA ){
      aMu <- mean( agibbs[ kg, ] )
      aSe <- sd( agibbs[ kg, ] )
      aUMu <- mean( agibbs[ kg, ] )
      aUSe <- sd( agibbs[ kg, ] )
    }else{
      colnames( alphaMu ) <- colnames( alphaSe ) <- 
        colnames( alphaUMu ) <- colnames( alphaUSe ) <- xFecNames[ xrandCols]
      rownames( alphaMu ) <- rownames( alphaSe ) <- 
        rownames( alphaUMu ) <- rownames( alphaUSe ) <- as.character( )
      aMu <- matrix( apply( agibbs[ drop = FALSE, kg, ], 2, mean ), Qrand, Qrand )
      aSe <- matrix( apply( agibbs[ drop = FALSE, kg, ], 2, sd ), Qrand, Qrand )
      aUMu <- matrix( apply( aUgibbs[ drop = FALSE, kg, ], 2, mean ), Qrand, Qrand )
      aUSe <- matrix( apply( aUgibbs[ drop = FALSE, kg, ], 2, sd ), Qrand, Qrand )
      colnames( aMu ) <- rownames( aMu ) <- colnames( aSe ) <- rownames( aSe ) <-
        colnames( aUMu ) <- rownames( aUMu ) <- colnames( aUSe ) <- rownames( aUSe ) <-
        colnames( alphaMu )
      names( xrandCols ) <- xFecNames[ xrandCols]
    }
  }
  
  mmu <- 1
  if( SAMPR ){
    
    tmu <- apply( rgibbs[ kg, ], 2, mean )
    tse <- apply( rgibbs[ kg, ], 2, sd )
    
    mmu <- mse <- priorR*0
    mmu[ posR] <- tmu
    mse[ posR] <- tse
    
    mmu[ mmu == 0 & priorR == 1] <- 1
    
    attr( mmu, 'posR' ) <- attr( mse, 'posR' ) <- posR
    
    colnames( mmu ) <- colnames( mse ) <- seedNames
    rownames( mmu ) <- rownames( mse ) <- rownames( R )
  }
  
  #################### dispersal
  
  if( SEEDDATA ){
    
    dgibbs <- upar2dist( ugibbs )
    upars <- .chain2tab( ugibbs[ kg, , drop = FALSE], sigfigs = 4 )[, c( 1:4 )]
    dpars <- .chain2tab( dgibbs[ kg, , drop = FALSE] )[, c( 1:4 )]
    
    if( USPEC ){
      
      uByGroup <- colMeans( ugibbs[ drop = FALSE, kg, ] )
      dByGroup <- colMeans( dgibbs[ drop = FALSE, kg, ] )
      priorDgibbs <- pi*sqrt( priorUgibbs[ drop = FALSE, kg, ] )/2
      
      uall <- .chain2tab( priorUgibbs[ kg, , drop = FALSE] )[, c( 1:4 )]
      dall <- .chain2tab( priorDgibbs[, , drop = FALSE] )[, c( 1:4 )]
      
      upars <- rbind( upars, uall )
      dpars <- rbind( dpars, dall )
      
    }else{
      upars <- .chain2tab( ugibbs[ kg, , drop = FALSE] )[, c( 1:4 )]
      uByGroup <- mean( ugibbs[ kg, ] )
      
      dpars <- .chain2tab( dgibbs[ kg, , drop = FALSE] )[, c( 1:4 )]
      dByGroup <- mean( dgibbs[ kg, ] )
    }
  }
  
  su <- .chain2tab( sgibbs[ kg, ] )[, c( 1:4 )]
  
  # coefficients are saved unstandardized 
  beta <- betaStd
  
  if( UNSTAND ){
    xfec <- xfecU
    beta <- betaFec
  }
  
  zp <- pnorm( xrep%*%betaRep[, 1] )
  fp <- xfec%*%matrix( beta[, 1], ncol = 1 ) 
  
  if( YR ){
    byr <- betaYrMu[ yrIndex[, 'year']] 
    if( RANDYR )byr <- byr + betaYrRand[ yrIndex[, c( 'group', 'year' )]]
    byr[ is.na( byr )] <- 0
    fp <- fp + byr
  }
  
  ############### AR
  
  if( AR ){

    eigenMu <- eigen1/ntoty
    eigenSe <- sqrt( eigen2/ntoty - eigenMu^2 )
    
    yg   <- log( fecPred$fecPredMu )      
    yg[ !is.finite( yg )] <- 0
    ylag <- yg*0
    mu   <- fp
    
    nl <- nrow( lagMatrix )
    zp <- as.vector( zp )
    zlag <- matrix( zp[ lagMatrix[, -1]], nl, plag )
    zlag[ zlag < .5] <- 0
    zlag[ zlag > 0] <- 1
    xm <- matrix( yg[ lagMatrix[, -1]], nl, plag )*zlag
    ylag[ lagMatrix[, 1]] <- xm%*%t( betaYrMu )
    
    # random effects
    if( RANDYR ){
      for( m in 1:ngroup ){
        tg <- which( lagGroup == m )
        if( length( tg ) == 0 )next
        ylag[ lagMatrix[ tg, 1]] <- xm[ drop = FALSE, tg, ]%*%t( betaYrRand[ drop = FALSE, m, ] )
      }
    }
    ylag[ !is.finite( ylag )] <- 0
    fp <- mu + ylag
  }
  
  ################ fit
  
  DICcrop <- NULL
  
  fz <- exp( fp )*zp
  fz[ fz > tdata$fecMax] <- tdata$fecMax[ fz > tdata$fecMax]
  fit <- NULL
  
  if( CONES ){
  
      fc   <- as.vector( fz[ wcrop] )
      oss  <- tdata$cropCount[ wcrop]*seedTraits[ tdata$species[ wcrop], 'seedsPerFruit']
      tf   <- tdata$cropFraction[ wcrop]
      ts   <- tdata$cropFractionSd[ wcrop]
      cnow <- dbetaBinom( oss, round( fc ), tf, ts, log = TRUE )
      meanDevCrop <- sumDevCrop/ndev
      pd  <- meanDevCrop - 2*sum( cnow )
      DICcrop <- pd + meanDevCrop
  }
  
  if( SEEDDATA ){
    
    fp <- exp( fp )
    
    meanDev <- sumDev/ndev
    
    la <- .getLambda( tdata[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                     sdata[, c( 'year', 'plotyr', 'drow' )], activeArea, 
                     uByGroup, as.vector( fp[ obsTrapRows] )*as.vector( zp[ obsTrapRows] ), 
                     mmu, SAMPR, USPEC, distall, obsYr, PERAREA = FALSE )
    la <- la + 1e-9
    pd  <- meanDev - 2*sum( dpois( seedCount, la, log = TRUE ), na.rm = T )
    DIC <- pd + meanDev
    
    RMSPE <- mean( sgibbs[ kg, 'rmspe'] )
    
    logScoreStates <- logScoreStates/nprob
    logScoreFull   <- logScoreFull/nprob
    
    fit <- list( DICtrap = round( DIC ), scoreStates = signif( mean( logScoreStates ), 3 ), 
                 predictScore = signif( mean( logScoreFull ), 3 ), 
                 RMSPEtrap = signif( RMSPE, 3 ), 
                 meanPredErrSd = signif( meanPredErrSd, 3 ), 
                 meanPredSd = signif( meanPredSd, 3 ), 
                 meanInflation = signif( mean( inflation ), 3 ) )
  }
  if( CONES ){
    fit$RMSPEcrop <- signif( rmspeCrop, 3 )
    fit$DICcrop   <- round( DICcrop )
  }
  
  inputs$treeData    <- tdata
  inputs$seedData    <- sdata
  inputs$formulaFec  <- formulaFec
  inputs$formulaRep  <- formulaRep
  inputs$notStandard <- notStandard
 
  inputs$ng         <- ng
  inputs$burnin     <- burnin
  inputs$keepIter   <- keepIter
  inputs$plotDims   <- plotDims
  inputs$plotArea   <- plotArea
  inputs$specNames  <- specNames
 
  inputs$xytree     <- xytree
  inputs$xytrap     <- xytrap
  inputs$yrIndex    <- yrIndex
  inputs$obsRows    <- obsRows

  inputs$maxFec     <- maxFec
  inputs$summary    <- words
  inputs$priorTable <- priorTable
  
  if( !is.null( betaPrior ) ){
    fvars <- intersect( rownames( betaPrior$fec ), colnames( xfecs2u ) ) 
    inputs$bfecPriorBoundsStnd <- betaPrior$fec
    inputs$bfecPriorBoundsUnst <- xfecs2u[, fvars]%*%betaPrior$fec[ fvars, ]
    inputs$brepPriorBoundsUnst <- betaPrior$rep
  }
  
  inputs$matYr      <- matYr 
  inputs$last0first1 <- last0first1
  if( SEEDCENSOR )inputs$censIndex <- censIndex

  if( !is.null( plotDims ) )inputs$plotDims <- plotDims
  if( !is.null( seedTraits ) )inputs$seedTraits <- seedTraits
  if( !is.null( yearEffect ) & !'yearEffect' %in% names( inputs ) )
               inputs$yearEffect <- yearEffect

  chains <- list( bfec = .orderChain( bfgibbs, specNames ),  # STANDARDIZED or UNSTANDARDIZED
                 bfecStn = .orderChain( bsgibbs, specNames ), # THIS IS STANDARDIZED
                 brep = .orderChain( brgibbs, specNames ), 
                 sgibbs = sgibbs )
  parameters <- list( betaFec = betaFec, 
                      betaStd = betaStd, 
                      betaRep = betaRep, 
                      sigma = su, 
                      gcfMat = gcfMat, acfMat = acfMat, acfSe = acfSe, 
                      pacfMat = pacfMat, pacfSe = pacfSe, 
                      omegaE = omegaE, 
                      omegaN = omegaN, 
                      trendEst = trendEst )
  
  if( SAMPR ){
    chains <- append( chains, list( rgibbs = rgibbs ) )
    parameters <- append( parameters, list( rMu = signif( mmu, 3 ), 
                                          rSe = signif( mse, 3 ) ) )
    inputs$priorR     <- priorR
  }
  fecPred$obs <- tdata$obs
  prediction  <-  list( fecPred = fecPred )

  if( YR ){
    chains <- append( chains, list( sygibbs = sygibbs ) )
  }
  if( AR ){
    parameters <- append( parameters, 
                         list( eigenMu = eigenMu, eigenSe = eigenSe ) )
    prediction <- append( prediction, list( tdataOut = tdataOut ) )
  }
  
  if( AR | YR ){
    if( yeGr[ 1] %in% specNames ){
      tmp <- .orderChain( bygibbsR, specNames )
    }
    
    chains     <- append( chains, list( bygibbsF = bygibbsF, bygibbsR = bygibbsR ) )
    parameters <- append( parameters, list( betaYr = betaYr ) )
    
    if( RANDYR )parameters <- append( parameters, 
                                   list( betaYrRand = signif( betaYrRand, 3 ), 
                                        betaYrRandSE = signif( betaYrRandSE, 3 ), 
                                        mastScores = mastScores ) )
  }
  if( SEEDDATA ){
    inputs$upar       <- ug
    inputs$obsRowSeed <- obsRowSeed
    inputs$obsTrapRows <- obsTrapRows
    inputs$seedByPlot <- seedTable
    inputs$seedNames  <- seedNames
    
    parameters$upars <- upars
    parameters$dpars <- dpars
    parameters$acsMat <- acsMat
    chains$ugibbs <- ugibbs
    prediction <- append( prediction, list( seedPred = seedPred, sdataOut = sdataOut ) )
    if( USPEC )chains <- append( chains, list( priorUgibbs = priorUgibbs ) )
    
    if( PREDSEED ) {
      prediction <- append( prediction, 
                           list( seedPredGrid = seedPredGrid, 
                                treePredGrid = treePredGrid ) )
      if( !'predList' %in% names( inputs ) )inputs <- append( inputs, list( predList = predList ) )
    }
  }
  if( RANDOM ){
    inputs$randomEffect <- randomEffect
    chains     <- append( chains, list( agibbs = .orderChain( agibbs, specNames ), 
                                      aUgibbs = .orderChain( aUgibbs, specNames ) ) )
    parameters <- append( parameters, 
                         list( alphaMu = alphaMu, alphaSe = alphaSe, 
                              aMu = aMu, aSe = aSe, 
                              alphaUMu = alphaUMu, alphaUSe = alphaUSe, 
                              aUMu = aUMu, aUSe = aUSe ) )
  }
  data$setupData$distall <- distall
  
  chains     <- chains[ sort( names( chains ) )]
  inputs     <- inputs[ sort( names( inputs ) )]
  data       <- data[ sort( names( data ) )]
  inputs$ng  <- ng
  inputs$burnin <- burnin
  inputs$obsYr  <- table( tdata$plot[ tdata$obsTrap == 1], 
                         tdata$year[ tdata$obsTrap == 1] )
  parameters <- parameters[ sort( names( parameters ) )]
  
  out <- list( inputs = inputs, chains = chains, data = data, 
              parameters = parameters, prediction = prediction )
  if( length( fit ) > 0 )out$fit <- fit
  
  class( out ) <- 'mastif'
  out
} 
          
.chain2tab <- function( chain, sigfigs = 3 ){
  
  if( !is.matrix( chain ) )chain <- matrix( chain, ncol = 1 )
  
  mu <- colMeans( chain )    
  
  SE <- apply( chain, 2, sd )
  CI <- apply( chain, 2, quantile, c( .025, .975 ) )
  splus <- rep( ' ', length = length( SE ) )
  splus[ CI[ 1, ] > 0 | CI[ 2, ] < 0] <- '*'
  
  tab <- cbind( mu, SE, t( CI ) )
  tab <- signif( tab, sigfigs )
  colnames( tab ) <- c( 'estimate', 'SE', 'CI_025', 'CI_975' )
  tab <- as.data.frame( tab )
  tab$sig95 <- splus
  attr( tab, 'note' ) <- '* indicates that zero is outside the 95% CI'
  
  tab
}

upar2dist <- function( u ){ pi*sqrt( u )/2 }

dist2upar <- function( d ){ ( 2*d/pi )^2 }

mergeSeedGrid <- function( gnow, gnew, scols = NULL ){
  
  #  gnow - current seedPredGrid
  #  gnew - output$prediction$seedPredGrid to merge
  
  if( length( gnow ) == 0 )return( gnew )
  
  if( is.null( scols ) )scols <- c( "plot", "trapID", "year", "x", "y", 
                               "drow", "dgrid", "area", "active" )
  
  cnow <- colnames( gnow )[ !colnames( gnow ) %in% scols]
  cnew <- colnames( gnew )[ !colnames( gnew ) %in% scols]
  snow <- gnow[, scols]
  snew <- gnew[, scols]
  pnow <- gnow[, cnow]
  pnew <- gnew[, cnew]
  
  snow$trapID <- as.character( snow$trapID )
  snew$trapID <- as.character( snew$trapID )
  
  idnow <- columnPaste( snow$trapID, snow$year, '_' )
  idnew <- columnPaste( snew$trapID, snew$year, '_' )
  
  mm <- match( idnew, idnow )
  wf <- which( is.finite( mm ) )
  
  idfull <- sort( unique( c( idnow, idnew ) ) )
  cfull  <- sort( unique( c( cnow, cnew ) ) ) 
  
  sfull <- matrix( 0, length( idfull ), length( cfull ) )
  colnames( sfull ) <- cfull
  
  mm <- match( idnow, idfull )
  nn <- match( idnew, idfull )
  
  ifull <- vector( 'list', length( scols ) )
  names( ifull ) <- scols
  
  for( k in 1:length( scols ) ){
    knew <- rep( NA, length( idfull ) )
    knew[ mm] <- snow[, k]
    knew[ nn] <- snew[, k]
    ifull[[ k]] <- knew
  }
  ifull <- as.data.frame( ifull, stringsAsFactors = FALSE )
  
  sfull[ mm, cnow] <- as.matrix( gnow[, cnow] )
  sfull[ nn, cnew] <- as.matrix( gnew[, cnew] )
  ifull <- cbind( ifull, sfull )
  rownames( ifull ) <- idfull
  ifull
}

meanVarianceScore <- function( output, ktree = 30, #maxSite = 100, 
                                 maxArea = 20^2, cyr = 5, 
                                 LAGMAT = TRUE, Q = c( .5, .025, .975 ), nsim = 1, 
                                 CLOSE = TRUE ){
  
  # ktree   - no. trees visited
  # maxSite - no. m2 visited
  # cyr     - no. years
  # CLOSE = TRUE: sample small neighborhoods ( selected to be within maxArea )
  # CLOSE = F: random neighborhoods
  
  
  if( cyr == 1 ) cyr <- 2
  
  TOT <- F            #check this
  
  lagCanopy <- lagGround <- NULL
  
  maxDist <- sqrt( maxArea ) #maxArea is in m^2
  
  xytrap     <- output$inputs$xytrap
  xytree     <- output$inputs$xytree
  specNames  <- output$inputs$specNames
  seedNames  <- output$inputs$seedNames
  seedTraits <- output$inputs$seedTraits
  ntrap      <- nrow( xytrap )
  
  fecPred   <- output$prediction$fecPred
  seedPred  <- output$prediction$seedPred
  
  seedPredGrid <- output$prediction$seedPredGrid
  if( is.null( seedPredGrid ) )seedPredGrid <- output$prediction$seedPred
  yr <- range( seedPredGrid$year )
  years <- yr[ 1]:yr[ 2]
  nyr   <- length( years )
  
  pltab <- table( seedPredGrid$plot, seedPredGrid$year )  # only plots with multiple years
  pltab[ pltab > 1] <- 1
  plots <- rownames( pltab )[ rowSums( pltab ) > 1] 
  nplot <- length( plots )
  
  if( !'x' %in% colnames( seedPredGrid ) & !is.null(seedPred) ){ # check this use of seedPred for mm
    xytrap <- output$inputs$xytrap
    mm <- match( as.character( seedPred$trapID ), as.character( xytrap$trapID ) )
    seedPredGrid$x <- xytrap$x[ mm]
    seedPredGrid$y <- xytrap$y[ mm]
  }
  
  treeID <- sort( unique( as.character( fecPred$treeID ) ) )
  ntree  <- length( treeID )
  fecPred$dcol <- match( as.character( fecPred$treeID ), treeID ) #DIFFERENT FROM TDATA$DCOL
  
#  fmat <- matrix( 0, ntree, nyr )
#  colnames( fmat ) <- years
#  rownames( fmat ) <- treeID
  
  if( is.null( seedTraits ) ){
    seedTraits <- matrix( 1, length( specNames ), 2 )
    colnames( seedTraits ) <- c( 'gmPerSeed', 'seedsPerFruit' )
    rownames( seedTraits ) <- specNames
  }
  
  seedTraits <- seedTraits[ unique( rownames( seedTraits ) ), , drop = FALSE]
  
  scoreT <- scoreS <- deltaT <- deltaS <- numeric( 0 )
  scoreTse <- scoreSse <- deltaTse <- deltaSse <- numeric( 0 )
  treeCor <- trapCor <- numeric( 0 )
  entropy <- domain <- numeric( 0 )
  resourceScore <- resourceMean <- totalVar <- numeric( 0 )
  win <- floor( nyr/2 )
  if( win > 10 )win <- 10
  
  GRID <- SMASS <- FALSE
  meanCols <- grep( '_meanGmM2', colnames( seedPredGrid ) )
  
  sgrid <- seedPredGrid
  GRID  <- FALSE
  
  meanCols <- grep( '_meanGmM2', colnames( sgrid ) )
  
  trapID  <- as.character( sgrid$trapID )
  allTrap <- sort( unique( trapID ) )
  ntrap   <- length( allTrap )
  smat <- matrix( 0, ntrap, nyr )
  rownames( smat ) <- allTrap
  
  colnames( smat ) <- years
  meanNames <- c( 'trees_PerTree', 'sites_PerSite', 'trees_PerYr', 'sites_PerYr' )
  eNames <- c( 'tree-tree', 'site-site', 'tree-lag', 'site-lag' )
  scoreNames <- c( 'gmTree', 'gmM2', eNames )
  
  kk   <- 0
  if( nsim > 1 ){
    pbar <- txtProgressBar( min = 1, max = nplot*nsim, style = 1 )
    cat( '\nScore\n' )
  }
  
  fecAll <- seedAll <- numeric( 0 )   #mass basis
  totalScore <- numeric( 0 )
  
  if( win > 1 ){       # nyr/2
    
    rjtree <- rjtrap <- rjall <- character( 0 )
    
    for( m in 1:nplot ){
      
      wp <- fecPred$plot == plots[ m]
      wo <- fecPred$obs == 1
      wm <- fecPred$matrEst > .5
      wy <- fecPred$year %in% years
      
      wk <- wp&wo&wm&wy
      wc <- which( wk )   #observed, mature
      
      if( length( wc ) == 0 )next
      
      keepTree <- ktree[ plots[ m]]
      if( keepTree == 1 )keepTree <- 2
      
      fec <- fecPred[ wc, ]
      
      yrm <- sort( unique( c( fec$year, sgrid$year[ sgrid$plot == plots[ m]] ) ) )
      yrm <- yrm[ yrm %in% years]
      
      
      tid <- sort( unique( fec$treeID ) )
      dr <- fec$dcol <- match( fec$treeID, tid )
      
      if( length( dr ) <= 1 )next
      
      # grid area for plot
      
      splot <- sgrid[ sgrid$plot == plots[ m], ]
      splot <- splot[ !duplicated( splot$trapID ), ]
      
      dx <- round( abs( diff( splot$x ) ) )
      dy <- round( abs( diff( splot$y ) ) )
      dx <- table( dx[ dx > 1] )
      dy <- table( dy[ dy > 1] )
      dx <- as.numeric( names( dx )[ which.max( dx )] )
      dy <- as.numeric( names( dy )[ which.max( dy )] )
      darea <- dx*dy
      ddist <- round( sqrt( darea ), 0 )
      rseq  <- c( 0, seq( 10, 2000, by = ddist ) )
      maxSite <- 2 + maxArea/darea
      
      ym   <- match( fec$year, yrm )   # year index for plot
      
      
      emat <- rmat <- vmat <- matrix( 0, nsim, 4 )
      cmat <- matrix( 0, nsim, 6 )
      size <- matrix( 0, nsim, 5 )
      
      tseq  <- c( 1:length( dr ) )
      
      scols <- paste( '0_', c( 0:win ), sep = '' )
      
      ssmat <- matrix( 0, length( rseq ), length( scols ) )
      colnames( ssmat ) <- scols
      rownames( ssmat ) <- rseq
      
      tdmat <- matrix( 0, length( tseq ), length( scols ) )
      colnames( tdmat ) <- scols
      rownames( tdmat ) <- tseq
      
      sdmat <- nsdmat <- ssmat <- nstmat <- ssmat*0
      tdmat <- ntdmat <- ttmat <- nttmat <- tdmat*0
      
      sdmat2 <- ssmat2 <- ssmat*0
      tdmat2 <- ttmat2 <- tdmat*0
      
      rjtree <- c( rjtree, plots[ m] )
      
      fmat <- matrix( 0, length( tid ), length( yrm ) )
      colnames( fmat ) <- yrm
      rownames( fmat ) <- tid
      
      spec <- fec$species[ match( tid, fec$treeID )]
      rvec <- seedTraits[ spec, 'gmPerSeed']
      
      
      fmat[ cbind( dr, ym )] <- fec$fecEstMu
      
      fr <- fmat*rvec
      if( nrow( fr ) < 2 )next
      
      fecAll <- append( fecAll, list( fr ) )    # all fecund trees, mass basis
      names( fecAll )[ length( fecAll )] <- plots[ m]
      
      totTT  <- totTT2 <- totSS <- totSS2 <- rep( 0, 3 )
      ntt <- nss <- rep( 0, 3 )
      
      for( k in 1:nsim ){
        
        kk <- kk + 1
        if( nsim > 1 )setTxtProgressBar( pbar, kk )
        
        entTtree <- entTseed <- entYtree <-  entYseed <- rtot <- rTtree <- 
          rTseed <- rYtree <- rYseed <- Tk <- Ts <- Yk <- Ys <- carea <- 
          varTk <- varTs <- varYk <- varYs <- NA
        
        #   fcor <- NULL
        
        rkeep <- 1:nrow( fr )
        
        # must have cyr years
        if( length( rkeep ) > keepTree )rkeep <- sample( rkeep, keepTree )
        ykeep <- 1:ncol( fr )
        
        if( ncol( fr ) > cyr ){
          ykeep <- sample( 1:( ncol( fr ) - cyr + 1 ), 1 )
          ykeep <- ykeep:( ykeep + cyr - 1 )
        }
        
        fk <- fr[ drop = F, rkeep, ykeep]
        
        if( length( dr ) > 1 ){   # canopy 
          
      #    dd    <- runif( length( fk ), 0, 1 )
      #    fk    <- fk + dd # 0's are less than 1
          
          
          if( length( fk ) > 2 & ncol( fk ) > 1 ){
            
            nyrk <- ncol( fr )
            ntrk <- nrow( fr )
            
            ff <- sample( nrow( fk ) )
            
      #      fcor <- makeCrossCov( tmat = fk[ drop = FALSE, ff, ], win = win, 
      #                            MATRIX = TRUE, COR = TRUE )[[ 1]]
      #      fcor[ !is.finite( fcor )] <- 0
            
            if( LAGMAT ){
              
              ff <- sample( nrow( fk ) )
              
              tt <- makeCrossCov( tmat = fk[ drop = FALSE, ff, ], win = win, 
                                  MATRIX = TRUE, COR = FALSE )
              mcov <- tt$lagCov
              
              if( length( mcov ) > 1 ){
                
        #        if( k == 1 ){
        #          tcovTot <- mcov
        #        }else{
        #          tcovTot <- tcovTot + mcov
        #        }
                
        #        tmu  <- tt$lagMean
                
                ############################# total space-time covariance
                
                ml     <- as.numeric( columnSplit( colnames( mcov ), '_' )[, 2] )   
                maxLag <- 1 + max( ml )
                
                totCov <- mcov
                
                hh <- grep( '_-', colnames( mcov ) )
                if( length( hh ) > 0 )totCov <- mcov[ drop = FALSE, , -hh]
                
                nn <- cbind( rownames( totCov ), paste( rownames( totCov ), '_0', sep = '' ) )
                totVar <- totCov[ nn]*maxLag # each variance repeated for each lag ( 2nd-order stat. )
                totCov[ nn] <- 0
                scov   <- sum( totCov*2 )       # each covariance twice
                totVar <- sum( totVar ) + scov
                
                if( totVar <= 1e-5 )totVar <- 1e-5
                
                totMu    <- sum( fk[ ff, ] )     # total yield over ktree trees, lag years
                totScore <- log( totMu ) - 1/2*log( totVar )
                if( totScore == -Inf ) totScore <- 0
                
                tot <- cbind( totMu, totVar, totScore )
                wf  <- which( is.finite( tot ) )
                
                totTT[ wf]  <- totTT[ wf] + tot[ wf]
                totTT2[ wf] <- totTT2[ wf] + tot[ wf]^2
                
                ntt[ wf] <- ntt[ wf] + 1
                
           #     TOT <- F
                
                if( TOT ){
                  
                  #       gg <- grep( paste( rownames( mcov )[ 1], '_-', sep = '' ), 
                  #                   colnames( mcov ) )                      #based on first site
                  #       gg <- c( grep( paste( rownames( mcov )[ 1], '_0', sep = '' ), 
                  #                    colnames( mcov ) ), gg )
                  #       tmu <- tmu[, gg, drop = FALSE]
                  
                  scov <- mcov[, gg, drop = FALSE]
                  vars <- mcov[ cbind( rownames( mcov ), paste( rownames( mcov ), '_0', sep = '' ) )]
                  vars <- matrix( vars, nrow( scov ), ncol( scov ) )
                  
                  scov[ -1] <- scov[ -1]*2   #covariances count twice
                  
                  wtrow <- matrix( 1:nrow( scov ), nrow( scov ), ncol( scov ) ) 
                  wtcol <- matrix( 1:ncol( scov ), nrow( scov ), ncol( scov ), byrow = TRUE ) 
                  
                  v1 <- wtcol*vars[ 1]   # count diagonal elements
                  v2 <- wtrow*vars
                  
                  scov[ 1] <- 0
                  scov <- scov + v1 + v2
                  
                  scum0 <- t( apply( scov, 1, cumsum ) )
                  scum  <- apply( t( scum0 ), 1, cumsum )
                  if( !is.matrix( scum ) )scum <- scum0*0 + scum
                  
                  
                  tcum0 <- t( apply( tmu, 1, cumsum ) )
                  tcum <- apply( t( tcum0 ), 1, cumsum )
                  if( !is.matrix( scum ) )tcum <- tcum0*0 + tcum
                  
                  
                  tscore <- log( tcum ) - 1/2*log( scum )
                  tscore[ tscore == -Inf] <- 0
                  rscore <- log( sum( tmu ) ) - 1/2*log( length( tmu )*var( as.vector( fk ) ) )
                  if( !is.finite( rscore ) ) rscore <- 0
                  delta  <- tscore - rscore
                }
              }
            }
            
            rmm   <- fk               #ALREADY MASS UNITS ( SEE ABOVE )
            wm    <- which( rmm > 0 )
            rtree <- mean( rmm[ wm] ) # mean per reproductive tree
            
            Tk  <- cov( t( rmm ) )       # tree cov
            Yk  <- cov( rmm )          # year cov
            
            Tk[ is.na( Tk )] <- 0     # there is only one year
            Yk[ is.na( Yk )] <- 0     # there is only one tree
            
            
            varTk <- sum( Tk )
            varYk <- sum( Yk )
            
            rTtree <- rYtree <- sum( rmm )
            
            if( !is.na( max( Tk ) ) ){
              tmp        <- var2score( rTtree, varTk, Tk ) # var between trees 
              entTtree   <- tmp$entropy
            }
            if( !is.na( max( Yk ) ) ){
              tmp        <- var2score( rYtree, varYk, Yk ) # var between years
              entYtree   <- tmp$entropy
            }
          } #end canopy
        }
        
        ############# seed traps or seed prediction grid ##########################
        
        seedPlot <- seedPredGrid[ seedPredGrid$plot == plots[ m], ]
        
        yrm <- range( seedPlot$year )
        yrm <- yrm[ 1]:yrm[ 2]
        
        wm <- which( seedPlot$year == yrm[ 1] )
        ix <- sample( wm, 1 )
        wo <- wm[ wm != ix]
        dist <- NULL
        scor <- NULL
        
        if( CLOSE ){  # select from close locations
          distSite <- .distmat( seedPlot$x[ ix], seedPlot$y[ ix], 
                                seedPlot$x[ wo], seedPlot$y[ wo] )
          distSite <- distSite[ distSite > 0]
          oo <- order( distSite )
          if( length( oo ) > maxSite )oo <- oo[ 1:maxSite]
          wm <- c( ix, wo[ oo] )
          dist <- c( 0, distSite[ oo] )
        }
        trapIDS <- as.character( seedPlot$trapID[ wm] )
        if( !is.null( dist ) )names( dist ) <- trapIDS
        wm <- which( as.character( seedPlot$trapID ) %in% trapIDS )
        
        seedPlot <- seedPlot[ wm, ]
        yrm <- sort( unique( seedPlot$year ) )
        tid <- sort( unique( seedPlot$trapID ) )
        
        j <- match( seedPlot$year, yrm )
        i <- match( as.character( seedPlot$trapID ), tid )
        
        smat <- matrix( 0, length( tid ), length( yrm ) )
        rownames( smat ) <- tid
        colnames( smat ) <- yrm
        sx <- seedPlot$x[ match( tid, seedPlot$trapID )]
        sy <- seedPlot$y[ match( tid, seedPlot$trapID )]
        
        smat[ cbind( i, j )] <- rowSums( seedPlot[, meanCols, drop = FALSE], 
                                      na.rm = TRUE )
        
        
        rmm <- smat*darea            # scale per m2 to per grid area
    #    rmm <- zmat + runif( length( zmat ), 0, .1 )
    #    rmm <- zmat[ drop = FALSE, , ykeep]
        
        if( k == 1 ){
          seedAll <- append( seedAll, list( rmm ) )
          names( seedAll )[ length( seedAll )] <- plots[ m]
        }
        
        crr <- ncol( rmm )
        
        ykeep <- 1:crr
        
        if( crr > cyr ){
          ykeep <- sample( 1:( crr - cyr + 1 ), 1 )
          ykeep <- ykeep:( ykeep + cyr - 1 )
        }
        
        rmm <- rmm[ drop = F, , ykeep]
        
        
        
        if( LAGMAT & length( ykeep ) > 1 ){
          
     #     tmp <- rmm
          
          tt   <- makeCrossCov( tmat = rmm, win = win, MATRIX = TRUE, COR = FALSE )
          mcov <- tt$lagCov
     #     tmu  <- tt$lagMean  #covariance at zero lag
          
          if( length( mcov ) > 1 ){
            
            ml     <- as.numeric( columnSplit( colnames( mcov ), '_' )[, 2] )   
            maxLag <- 1 + max( ml )
            
            totCov <- mcov
            hh <- grep( '_-', colnames( mcov ) )
            
            if( length( hh ) > 0 )totCov <- mcov[ drop = FALSE, , -hh]
            nn <- cbind( rownames( totCov ), paste( rownames( totCov ), '_0', sep = '' ) )
            
            totVar <- totCov[ nn]*maxLag # each variance repeated for each lag ( 2nd-order stat. )
            totCov[ nn] <- 0
            scov   <- sum( totCov*2 )       # covariance twice
            totVar <- sum( totVar ) + scov
            
            if( totVar < 1e-5 ) totVar <- 1e-5
            #      totMu  <- sum( tmu[, 1] )
            totMu    <- sum( rmm )
            totScore <- log( totMu ) - 1/2*log( totVar )
            
            tot <- cbind( totMu, totVar, totScore )
            wf  <- which( is.finite( tot ) )
            
            totSS[ wf] <- totSS[ wf] + tot[ wf]
            totSS2[ wf] <- totSS2[ wf] + tot[ wf]^2
            nss[ wf] <- nss[ wf] + 1
          }
          
          if( TOT ){
            
            zrows <- rownames( mcov )
            zcols <- paste( rownames( mcov ), '_0', sep = '' )
            
            if( !is.null( dist ) ){
              
              p1 <- paste( '^', rownames( mcov )[ 1], '_', sep = '' )
              
              gg <- grep( p1, colnames( mcov ) )
              scov <- mcov
              #      if( length( gg ) > 0 ){
              scov <- mcov[, gg, drop = FALSE]
              tmu <- tmu[, gg, drop = FALSE]
              #      }
              gg <- grep( '-', colnames( scov ) )
              hh <- grep( '_0', colnames( scov ) )
              gg <- sort( c( gg, hh ) )
              scov <- scov[, gg, drop = FALSE]
              tmu <- tmu[, gg, drop = FALSE]
              
            }else{
              gg <- grep( paste( rownames( mcov )[ 1], '_-', sep = '' ), 
                          colnames( mcov ) )
              gg <- c( grep( paste( rownames( mcov )[ 1], '_0', sep = '' ), 
                           colnames( mcov ) ), gg )
              scov <- mcov[, gg]
              tmu <- tmu[, gg]
              
              wz    <- which( !zcols %in% colnames( mcov ) )
              if( is.matrix( scov ) & length( wz ) > 0 ){
                zcols <- zcols[ -wz]
                zrows <- zrows[ -wz]
                scov  <- scov[ -wz, ]
                tmu   <- tmu[ -wz, ]
              }
            }
            
            
            if( length( mcov ) > 2 )vars <- mcov[ cbind( zrows, zcols )]
            
          if( is.matrix( scov ) ){
            
            vars <- matrix( vars, nrow( scov ), ncol( scov ) )
            
            scov[ -1] <- scov[ -1]*2   #covariances count twice
            
            wtrow <- matrix( 1:nrow( scov ), nrow( scov ), ncol( scov ) ) 
            wtcol <- matrix( 1:ncol( scov ), nrow( scov ), ncol( scov ), byrow = TRUE ) 
            
            v1 <- wtcol*vars[ 1]   # count diagonal elements
            v2 <- wtrow*vars
            
            scov[ 1] <- 0
            scov    <- scov + v1 + v2
            
            scum <- t( apply( scov, 1, cumsum ) )
            scum <- apply( t( scum ), 1, cumsum )
            
            tcum <- t( apply( tmu, 1, cumsum ) )
            tcum <- apply( t( tcum ), 1, cumsum )
            
            tscore <- log( tcum ) - 1/2*log( scum )
            rscore <- log( sum( tmu ) ) - 1/2*log( length( tmu )*var( as.vector( rmm ) ) )
            delta  <- tscore - rscore
            
            delta  <- vec2mat( delta )
            tscore <- vec2mat( tscore )
            
            if( k == 1 ){
              sdmat  <- delta
              sdmat2 <- delta^2
              ssmat  <- tscore
              ssmat2 <- tscore^2
            }else{
              sdmat  <- sdmat + delta
              sdmat2 <- sdmat2 + delta^2
              ssmat  <- ssmat + tscore
              ssmat2 <- ssmat2 + tscore^2
            }
          }
          }
          
     #     scor <- makeCrossCov( tmat = rmm, win = win, MATRIX = TRUE, COR = TRUE )[[ 1]]
     #     scor[ !is.finite( scor )] <- 0
     #     if( k == 1 ){
     #       scovTot <- scor
     #     }else{
     #       scovTot <- scovTot + scor
     #     }
          
          if( k == 1 ){
            
            rjtrap   <- c( rjtrap, plots[ m] )
          }
        }
        
        if( is.matrix( rmm ) & length( rmm ) > 1 ){
          
     #     rcol <- rmm
     #     if( ncol( rcol ) < nrow( rcol ) ){
     #       ss <- sample( nrow( rcol ), ncol( rcol )-1 )
     #       rcol <- rcol[ ss, ]
     #       rcol <- rcol + .tnorm( length( rcol ), 0, .00001, .00001/2, .00001 )
     #     }
          
          rtot <- sum( rmm )
          
    #      Ts <- cov( t( rcol ) )  # site cov
          
          Ts <- cov( t( rmm ) )
          Ys <- cov( rmm )     # year cov
          
          
          
          varTs <- sum( Ts )
          varYs <- sum( Ys )
          
          rTseed <- rYseed <- sum( rmm )
          
          tmp        <- var2score( rTseed, varTs, Ts )
          entTseed   <- tmp$entropy
          tmp        <- var2score( rYseed, varYs, Ys )
          entYseed   <- tmp$entropy
          
          n1 <- n2 <- n3 <- n4 <- NA
          if( is.matrix( Tk ) )n1 <- nrow( Tk )
          if( is.matrix( Ts ) )n2 <- nrow( Ts )
          if( is.matrix( Yk ) )n3 <- nrow( Yk )
          if( is.matrix( Ys ) )n4 <- nrow( Ys )
          
          emat[ k, ] <- c( entTtree, entTseed, entYtree, entYseed )
          cmat[ k, ] <- c( rtree, rtot )
          rmat[ k, ] <- c( rTtree, rTseed, rYtree, rYseed )
          size[ k, ] <- c( n1, n2, n3, n4, round( maxArea ) ) 
          vmat[ k, ] <- c( varTk, varTs, varYk, varYs )
        }
        
        
      }#######################
      
   #   lagCanopy <- append( lagCanopy, list( tcovTot/nsim ) )
   #   lagGround <- append( lagGround, list( scovTot/nsim ) )
      
      tcm <- totTT/ntt
      tcs <- totTT2/ntt - tcm^2 
      tcs[ tcs < 0] <- 0
      tcm[ 2] <- sqrt( tcm[ 2] )
      tcs[ 2] <- sqrt( tcs[ 2] )
      tcs <- sqrt( tcs )
      
      tgm <- totSS/nss
      tgs <- totSS2/nss - tgm^2 
      tgs[ tgs < 0] <- 0
      tgm[ 2] <- sqrt( tgm[ 2] )
      tgs[ 2] <- sqrt( tgs[ 2] )
      tgs <- sqrt( tgs )
      
      t1 <- rbind( tcm, tcs )
      t2 <- rbind( tgm, tgs )
      
      totScore <- cbind( t1, t2 )
      
      ctt <- c( 'mu', 'stdDev', 'score' )
      
      colnames( totScore ) <- paste( c( rep( 'canopy', 3 ), rep( 'ground', 3 ) ), 
                                   ctt, sep = '_' )
      rownames( totScore ) <- paste( plots[ m], c( 'mu', 'se' ), sep = '_' )
      
      totalScore <- rbind( totalScore, totScore )
      
      
      if( LAGMAT ){
        TREE <- GROUND <- TRUE
        deltaTree <- scoreTree <- deltaSeed <- scoreSeed <- 
          deltaTrSe <- scoreTrSe <- deltaSdSe <- scoreSdSe <- NULL
        
        if( sum( ntdmat ) == 0 )TREE <- FALSE
        if( sum( nttmat ) == 0 )GROUND <- FALSE
        
        if( TOT ){
          if( TREE ){
            deltaTree <- tdmat/nsim
            scoreTree <- ttmat/nsim
            deltaTrSe <- tdmat2/nsim - deltaTree^2
            scoreTrSe <- ttmat2/nsim - scoreTree^2
            wr <- which( rowSums( deltaTree, na.rm = TRUE ) != 0 )
            wc <- which( colSums( deltaTree, na.rm = TRUE ) != 0 )
            deltaTree <- deltaTree[ drop = FALSE, wr, wc]
            deltaTrSe <- sqrt( deltaTrSe[ drop = FALSE, wr, wc] )
            scoreTree <- scoreTree[ drop = FALSE, wr, wc]
            scoreTrSe <- sqrt( scoreTrSe[ drop = FALSE, wr, wc] )
          }
          if( GROUND ){
            deltaSeed <- sdmat/nsim
            scoreSeed <- ssmat/nsim
            deltaSdSe <- sdmat2/nsim - deltaSeed^2
            scoreSdSe <- ssmat2/nsim - scoreSeed^2
            wr <- which( rowSums( deltaSeed, na.rm = TRUE ) != 0 )
            wc <- which( colSums( deltaSeed, na.rm = TRUE ) != 0 )
            deltaSeed <- deltaSeed[ drop = FALSE, wr, wc]
            scoreSeed <- scoreSeed[ drop = FALSE, wr, wc]
            deltaSdSe <- sqrt( deltaSdSe[ drop = FALSE, wr, wc] )
            scoreSdSe <- sqrt( scoreSdSe[ drop = FALSE, wr, wc] )
          }
          
          deltaT <- append( deltaT, list( deltaTree ) )
          deltaS <- append( deltaS, list( deltaSeed ) )
          scoreT <- append( scoreT, list( scoreTree ) )
          scoreS <- append( scoreS, list( scoreSeed ) )
          deltaTse <- append( deltaTse, list( deltaTrSe ) )
          deltaSse <- append( deltaSse, list( deltaSdSe ) )
          scoreTse <- append( scoreTse, list( scoreTrSe ) )
          scoreSse <- append( scoreSse, list( scoreSdSe ) )
        }
      }
      
      emat[ !is.finite( emat )] <- NA
      
      ee <- signif( t( apply( emat, 2, quantile, Q, na.rm = TRUE ) ), 3 )
      rownames( ee ) <- paste( plots[ m], eNames, sep = '_' )
      vv <- t( apply( vmat, 2, quantile, Q, na.rm = TRUE ) )
      rownames( vv ) <- paste( plots[ m], eNames, sep = '_' )
      
      rjall <- c( rjall, plots[ m] )
      
      ii     <- apply( size, 2, mean, na.rm = T )
      domain <- rbind( domain, ii )
      
      entropy  <- rbind( entropy, ee )
      totalVar <- rbind( totalVar, vv )
      
    } #########end plot loop
    
    if( TOT ){
      if( LAGMAT ){
        if( length( lagCanopy ) > 0 )names( lagCanopy ) <- rjtree
        if( length( lagGround ) > 0 )names( lagGround ) <- rjtrap
        names( scoreT ) <- rjtree
        names( scoreS ) <- rjtrap
        names( deltaT ) <- rjtree
        names( deltaS ) <-  rjtrap
      }
      
      if( length( domain ) > 0 ){
        rownames( domain ) <- rjall
        colnames( domain ) <- c( 'trees', 'sites', 'treeYr', 'siteYr', 'areaM2' )
      }
    }
  }     ############### end win > 1
  
  
  if( TOT ){
    if( LAGMAT ){
      tmp$lagCanopy <- lagCanopy
      tmp$lagGround <- lagGround
      tmp$scoreSeed <- scoreS
      tmp$scoreTree <- scoreT
      tmp$deltaSeed <- deltaS
      tmp$deltaTree <- deltaT
      tmp$scoreSeedSe <- scoreSse
      tmp$scoreTreeSe <- scoreTse
      tmp$deltaSeedSe <- deltaSse
      tmp$deltaTreeSe <- deltaTse
    }
  }
  
  for( k in 1:length( tmp ) ){
    if( is.null( tmp[[ k]] ) | is.numeric( 0 ) )next
    kcol <- which( sapply( tmp[[ k]], is.numeric ) )
    jcol <- which( sapply( tmp[[ k]], is.factor ) )
    kcol <- intersect( kcol, !jcol )
    for( j in kcol ){
      tmp[[ k]][, j][ is.finite( tmp[[ k]][, j] )] <- NA
    }
  }
  tmp$fecAll  <- fecAll
  tmp$seedAll <- seedAll
  tmp$totalScore <- totalScore
  tmp$gridArea <- sqrt( darea )
  
  tmp
  
}

var2score <- function( rmean, totVr, rvar ){
  
  # rmean - mean over sites or years
  # rvar  - covariance matrix
  # totVr - total variance
  # ndim  - dimension of covariance matrix
  
  if( length( rvar ) < 4 )return( list( score = NA, entropy = NA ) )
  if( nrow( rvar ) > 100 ){
    ss <- sample( nrow( rvar ), 100 )
    rvar <- rvar[ ss, ss]
  }
  
  ndim <- nrow( rvar )
  
  score <- log( rmean ) - 1/2*suppressWarnings( log( totVr ) )
  
  dt    <- determinant( rvar )$modulus
  if( !is.finite( dt ) ){
    ev <- eigen( rvar )$values
    dt <- sum( log( ev[ ev > 0] ) )
  }
  entr  <- ndim/2*( 1 + log( 2*pi ) ) + dt/2
  entr  <- entr/ndim
  list( score = score, entropy = entr )
}

crossCovSetup <- function( tmat, win ){
  
  nt <- ncol( tmat )
  if( win > nt/2 )win <- floor( nt/2 )
  
  ni    <- nrow( tmat )
  lead  <- -c( -win:win )
  ntt   <- length( lead )
  mgrid <- as.matrix( expand.grid( 1:ntt, 1:ni, 1:ni ) )
  colnames( mgrid ) <- c( 't', 'i1', 'i2' )
  
  ld    <- lead[ mgrid[, 't']]
  mgrid <- cbind( ld, mgrid )
  colnames( mgrid )[ 1] <- 'lead'
  
  cc    <- columnPaste( mgrid[, 'i1'], mgrid[, 'i2'] )
  mdex  <- columnPaste( mgrid[, 't'], cc )
  keep  <- which( mgrid[, 'i2'] >= mgrid[, 'i1'] )
  mgrid <- mgrid[ keep, ]
  mdex  <- mdex[ keep]
  
  mgrid <- as.data.frame( mgrid )
  
  rn <- rownames( tmat )
  if( !is.null( rn ) ){
    mgrid$ID1 <- rn[ mgrid[, 'i1']]
    mgrid$ID2 <- rn[ mgrid[, 'i2']]
  }
    
  list( win = win, ntt = ntt, ni = ni, mgrid = mgrid, 
       mdex = mdex, lead = lead )
}
  
makeCrossCov <- function( tmat, win = 5, MATRIX = FALSE, COR = FALSE ){
  
  # tmat - responses by time matrix
  # cross covariance of each row against population
  # MATRIX  - n by n*lag matrix
  # !MATRIX - n*n*lag vector
  # COR - correlation matrix
  
  tiny <- 1e-8
  
  nt  <- ncol( tmat )
  mid <- round( nt/2 )
  rt  <- mid + c( -win, win )
  
  if( rt[ 2] <= rt[ 1] )return( NULL )
  
  imat <- sweep( tmat, 1, rowMeans( tmat ), '-' )
  imat[ imat == 0] <- tiny                        # no variation
  
  if( win > ( ncol( tmat )-1 ) )win <- ncol( tmat ) - 1
  
  tmp <- crossCovSetup( tmat, win )
  ntt <- tmp$ntt
  ni  <- tmp$ni
  mgrid <- tmp$mgrid
  mdex  <- tmp$mdex
  lead  <- tmp$lead
  win   <- tmp$win
  
  crossCov <- rep( 0, length( mdex ) )
  names( crossCov ) <- mdex
  totSeed <- crossCov
  
  if( COR )ivar <- apply( imat, 1, var )*( nt-1 )/nt
  
  for( i in 1:( win+1 ) ){
    
    ii <- 1:( nt - win + i - 1 )
    pp <- ( win - i + 2 ):nt
    
    ii  <- ii[ ii > 0]
    pp  <- pp[ pp <= nt]
    ldd <- pp[ 1] - ii[ 1]
    
    for( m in 1:ni ){
      wm   <- which( mgrid[, 'i1'] == m & mgrid[, 'lead'] == ldd )
      mdx  <- mgrid[ drop = FALSE, wm, ]
      
      tres <- rowMeans( imat[ mdx[, 'i1'], ii, drop = FALSE]*imat[ mdx[, 'i2'], pp, drop = FALSE] )
      
      tm2 <- tmat[ mdx[, 'i2'], pp, drop = FALSE]
      if( ldd == 0 )tm2[ rownames( tm2 ) == rownames( tmat[ mdx[, 'i1'], ] )] <- 0
      tsum <- rowMeans( tmat[ mdx[, 'i1'], ii, drop = FALSE] + tm2 )
      
      if( COR )tres <- tres/sqrt( ivar[ mdx[ 1, 'i1']]*ivar[ mdx[, 'i2']] )
      crossCov[ wm] <- tres
      totSeed[ wm]  <- tsum
        
      if( ldd != 0 ){
        wm   <- which( mgrid[, 'i1'] == m & mgrid[, 'lead'] == -ldd )
        mdx  <- mgrid[ drop = FALSE, wm, ]
        tres <- rowMeans( imat[ mdx[, 'i1'], pp, drop = FALSE]*imat[ mdx[, 'i2'], ii, drop = FALSE] )
        if( identical( mdx[, 'i1'], mdx[, 'i2'] ) ){
          tres <- rowMeans( tmat[ mdx[, 'i1'], ii, drop = FALSE] )
        }else{
          tsum <- rowMeans( tmat[ mdx[, 'i1'], pp, drop = FALSE] + tmat[ mdx[, 'i2'], ii, drop = FALSE] )
        }
        
        if( COR )tres <- tres/sqrt( ivar[ mdx[ 1, 'i1']]*ivar[ mdx[, 'i2']] )
        crossCov[ wm] <- tres
        totSeed[ wm] <- tsum
      }
    }
  }
  
  totSeed <- round( totSeed, 2 )
  
  covMu <- cbind( mgrid, crossCov, totSeed )
  
  if( !MATRIX )return( lagCov = covMu, lagMean = NULL )
  
  t2 <- covMu$t[ covMu$lead == 0][ 1]
  
  rn <- columnPaste( covMu[, 'ID1'], covMu[, 'lead'], '_' )
  cn <- columnPaste( covMu[, 'ID2'], t2, '_' )
  rt <- rn[ !duplicated( rn )]
  ct <- cn[ !duplicated( cn )]
  
  stmat <- ttmat <- matrix( 0, length( rt ), length( ct ) )
  rownames( stmat ) <- rownames( ttmat ) <- rt
  colnames( stmat ) <- colnames( ttmat ) <- ct
  cii <- cbind( rn, cn )
  stmat[ cii] <- covMu[, 'crossCov']
  stmat <- t( stmat )
  
  ttmat <- stmat*0
  tmean <- rowMeans( tmat )
  rm    <- columnSplit( ct, '_' )[, 1]
  ttmat[ 1:nrow( ttmat ), ] <- tmean[ rm]
  
  rnn <- columnSplit( rownames( stmat ), '_' )[, 1]
  rownames( stmat ) <- rnn
  
  cc <- paste( rownames( stmat ), '_0', sep = '' )
  
  lagMean <- stmat[, cc]
  lagMean[ upper.tri( lagMean )] <- lagMean[ lower.tri( lagMean )] 
  
  
  list( lagCov = stmat, lagMean = lagMean )
}
  
.updateBetaAR <- function( betaYr, yg, mu, z, lagGroup, plag, ngroup, sg )  {
  
  # AR( p ), fixed groups
  
  ylag <- yg*0
  
  for( m in 1:ngroup ){
    
    lmm <- lagGroup[[ m]]
    lmm <- lmm[ drop = FALSE, z[ lmm[, plag+1]] == 1, ]
    if( nrow( lmm ) <= ( ncol( lmm )+5 ) )next
    
    ym  <- yg[ lmm[, 1]] - mu[ lmm[, 1]]
    xm  <- matrix( yg[ lmm[, -1]], nrow( lmm ) )
    V   <- solve( crossprod( xm ) )*sg
    v   <- crossprod( xm, ym )/sg
    tmp <- rmvnormRcpp( 1, V%*%v, V ) 
    whi <- which( abs( tmp ) > 1 )
    if( length( whi ) > 0 ){
      tmp <- .tnormMVNmatrix( tmp, tmp, V, tmp*0 - 1, tmp*0 + 1, 
                             whichSample = c( 1:length( tmp ) ) )
    }
    betaYr[ m, ] <- tmp
    
    lmm <- lagGroup[[ m]]
    xm  <- matrix( yg[ lmm[, -1]], nrow( lmm ) )
    ylag[ lmm[, 1]] <- xm%*%t( tmp )
  }
  
  wfinite <- which( !betaYr == 0 )
  list( betaYr = betaYr, ylag = ylag, wfinite = wfinite )
}

.updateBetaAR_RE <- function( betaYrF, betaYrR, Alag, 
                             yg, mu, z, lagGroup, lagMatrix, plag, ngroup, sg ){
  
  # AR( p ), random groups
  # betaYrF - 1 by plag fixed effects
  # betaYrR - ngroup by plag random effects
  # Alag    - random effects covariance
  
  ylag <- yg*0
  
  if( ngroup == 1 ){
    
    # fixed effects
    cg   <- which( z[ lagMatrix[, plag+1]] == 1 )  # mature plag yr ago
    
    if( length( cg ) <= plag ){
      warning( 'too few mature individuals in AR groups--fewer groups or smaller p' )
      return( list( betaYrF = betaYrF, betaYrR = betaYrR, ylag = ylag, Alag = Alag ) )
    }
    lmm  <- lagMatrix[ drop = FALSE, cg, ]
    xm   <- matrix( yg[ lmm[, -1]], nrow( lmm ) )
    mvec <- yg[ lmm[, 1]] - mu[ lmm[, 1]] - 
      rowSums( betaYrR[ lagGroup[ cg], ]*xm )  # remove random AR effects
    
    v <- crossprod( xm, mvec )/sg
    V <- solve( crossprod( xm )/sg + diag( 1, plag ) )
    
    tmp <- rmvnormRcpp( 1, V%*%v, V ) 
    whi <- which( abs( tmp ) > 1 )                               # for stability ( may not be desirable )
    if( length( whi ) > 0 ){
      tmp <- .tnormMVNmatrix( tmp, tmp, V, tmp*0 - 1, tmp*0 + 1, 
                             whichSample = c( 1:length( tmp ) ) )
    }
    
    betaYrF <- tmp
    
    ylag[ lmm[, 1]] <- ylag[ lmm[, 1]] + xm%*%t( betaYrF )
    return( list( betaYrF = betaYrF, betaYrR = betaYrR, ylag = ylag, Alag = Alag ) )
  }
  
  # random effects
  
  AIlag <- solve( Alag )
  
  for( m in 1:ngroup ){
    
    tg  <- lagGroup == m
    cg  <- z[ lagMatrix[, plag+1]] == 1  # mature plag yr ago
    wm  <- which( tg & cg )
    
    if( length( wm ) < 2 ){      #
      betaYrR[ m, ] <- 0
      next
    }
      
    if( length( wm ) < plag ){
      V <- Alag
      v <- t( betaYrF )*0
    }else{
      lmm <- lagMatrix[ drop = FALSE, wm, ]
      xm  <- matrix( yg[ lmm[, -1]], nrow( lmm ) )
      mvec <- yg[ lmm[, 1]] - mu[ lmm[, 1]] # - xm%*%t( betaYrF )  #
      v    <- crossprod( xm, mvec )/sg
      V    <- solve( crossprod( xm )/sg + AIlag )
    }
    tmp <- rmvnormRcpp( 1, V%*%v, V ) 
    whi <- which( abs( tmp ) > 1 )
    if( length( whi ) > 0 ){
      tmp <- .tnormMVNmatrix( tmp, tmp, V, tmp*0 - 1, tmp*0 + 1, 
                             whichSample = c( 1:length( tmp ) ) )
    }
    betaYrR[ m, ] <- tmp 
    if( length( wm ) > plag )ylag[ lmm[, 1]] <- ylag[ lmm[, 1]] + xm%*%betaYrR[ m, ]
  }
  
  # random effects covariance
  wr   <- which( rowSums( betaYrR ) != 0 )
  LL   <- crossprod( betaYrR[ drop = FALSE, wr, ] ) 
  Alag <- .updateCovariance( LL, diag( 1, plag ), length( wr ), plag+1 )
  
  list( betaYrF = betaYrF*0, betaYrR = betaYrR, ylag = ylag, Alag = Alag )
}

acfEmp <- function( res, irow, time, nlag = 6, detrend = T, GARCH = F ){
  
  # empirical ( for model-based use .updateBetaAc )
  # assumes res values have unique irow and time
  # detrend or demean
  
  rr <- rep( NA, nlag+1 )
  names( rr ) <- paste( 'lag', 0:nlag, sep = '-' )
  attr( rr, 'n' ) <- 0
  
  times <- sort( unique( time ) )
  time  <- match( time, times )
  mt <- max( time )
  
  if( mt < 4 )return( rr )
  
  
  st <- c( 0:( mt-1 ) )
  id <- sort( unique( irow ) )
  ir <- match( irow, id )
  ni <- length( id )
  
  if( nlag > ( mt/2 ) )nlag <- round( mt/2 )
  
  resMat <- matrix( NA, ni, mt )
  resMat[ cbind( ir, time )] <- res
  
  stMat <- matrix( st, ni, mt, byrow = TRUE )*( resMat*0 + 1 )
  fcol  <- apply( stMat, 1, min, na.rm = T ) + 1
  lcol  <- apply( stMat, 1, max, na.rm = T ) + 1
  wcol  <- min( fcol ):max( lcol )
  resMat <- resMat[, wcol]
  stMat <- stMat[, wcol]
  st    <- st[ wcol]
  nc    <- rowSums( stMat*0+1, na.rm = T )
 # resMat <- resMat[ nc > nlag, ]
 # stMat  <- stMat[ nc > nlag, ]
 # nc    <- nc[ nc > nlag]
  ymu   <- rowMeans( resMat, na.rm = T )
  mt    <- ncol( stMat )
 # nr    <- nrow( stMat )
  
  if( detrend ){    # detrend
    xy <- stMat*resMat 
    sm <- rowMeans( stMat, na.rm = T )
    xx <- stMat^2
    bs <- ( rowSums( xy, na.rm = TRUE )/nc - ymu*sm )/( rowSums( xx, na.rm = TRUE )/nc - sm^2 )
    bi <- ymu - bs*sm
    yy <- resMat - bi - matrix( bs, ncol = 1 )%*%st 
  }else{
    yy <- resMat - ymu
  }
  
  if( GARCH )yy <- abs( yy )
  
  rr <- rep( 1, nlag+1 )
  mt <- ncol( yy )
  
  for( k in 1:( nlag+1 ) ){
    yk <- yy[, 1:( mt - k + 1 )]*yy[, k:mt] 
    rr[ k] <- mean( yk, na.rm = T )
  }
  rr <- rr/rr[ 1]

  names( rr ) <- paste( 'lag', 0:nlag, sep = '-' )
  attr( rr, 'n' ) <- mt
  rr
}

pacfFromAcf <- function( xacf ){
  
  nlag <- length( xacf ) - 1
  
  n <- nlag*2
  if( !is.null( attributes( xacf )$n ) )n <- attributes( xacf )$n
  
  xpacf <- ( xacf*0 )[ 1:nlag]
  for( m in 1:nlag ){
    xpacf[ m] <- solve( toeplitz( xacf[ 1:m] ), xacf[ 2:( m+1 )] )[ m]
  }
  ci <- xacf[ -1] + matrix( c( -1, 1 )*1.96/sqrt( nlag ), 2, nlag )
  xpacf <- rbind( xpacf, ci )
  rownames( xpacf ) <- c( 'Est', '0.025', '0.975' )
  colnames( xpacf ) <- paste( 'lag', c( 1:nlag ), sep = '-' )
  xpacf
}

.mapSetup <- function( xlim, ylim, scale = NULL, widex = 10.5, widey = 6.5 ){  
  
  #scale is x per inch
  #new means not a new plot
  
  if( is.null( scale ) )scale <- 1
  
  px   <- diff( xlim )/scale
  py   <- diff( ylim )/scale
  
  if( px > widex ){
    dx <- widex/px
    px <- widex
    py <- py*dx
  }
  if( py > widey ){
    dx <- widey/py
    py <- widey
    px <- px*dx
  }
  
  par( pin = c( px, py ) )
  invisible( c( px, py ) )
}

checkPlotDims <- function( plots, years, xytree = NULL, xytrap = NULL, 
                          plotDims, plotArea, verbose = FALSE ){
  
  if( is.null( plotDims ) ){
    plotDims <- getPlotDims( xytree, xytrap )
  }else{
    rownames( plotDims ) <- .fixNames( rownames( plotDims ), all = TRUE )$fixed
    if( ncol( plotDims ) != 5 )
      stop( '\nplotDim must have 5 columns: xmin, xmax, ymin, ymax, area\n' )
    
    wc <- which( !plots %in% rownames( plotDims ) )
    if( length( wc ) > 0 ){
      xx <- paste( '\nNote', plots[ wc], ' missing from plotDims\n ' )
      if( verbose )cat( xx )
      moreRows <- matrix( NA, length( wc ), 5 )
      rownames( moreRows ) <- plots[ wc]
      plotDims <- rbind( plotDims, moreRows )
    }
  }
  ww <- which( !plots %in% rownames( plotDims ) )
  if( length( ww ) > 0 ){
    pp <- matrix( NA, length( ww ), ncol( plotDims ) )
    rownames( pp ) <- plots[ ww]
    plotDims <- rbind( plotDims, pp )
  }
  plotDims <- plotDims[ drop = FALSE, plots, ]
  
  if( is.null( plotArea ) ){
    plotArea <- matrix( plotDims[, 'area'], nrow( plotDims ), length( years ) )
    rownames( plotArea ) <- plots
    colnames( plotArea ) <- years
  }else{
    rownames( plotArea ) <- .fixNames( rownames( plotArea ), all = TRUE )$fixed
  }
  wc <- which( !plots %in% rownames( plotArea ) )
  if( length( wc ) > 0 ){
    moreRows <- matrix( NA, length( wc ), ncol( plotArea ) )
    rownames( moreRows ) <- plots[ wc]
    colnames( moreRows ) <- colnames( plotArea )
    plotArea <- rbind( plotArea, moreRows )
    plotArea <- plotArea[ drop = FALSE, plots, ]
  }
    
  list( plotDims = plotDims, plotArea = plotArea )
}

mastMap <- function( mapList ){
  
  # if PREDICT, needs seedPredGrid, treePredGrid
  
  mapPlot <- mapYears <- treeSymbol <- xlim <- ylim <- NULL
  seedMax <- fecMax <- fecPred <- seedPred <- RMD <- 
    seedPredGrid <- treePredGrid <- treeData <- seedData <- 
    specNames <- seedNames <- acfMat <- NULL
  
  SEED <- PREDICT <- LEGEND <- SCALEBAR  <- verbose <- FALSE
  MAPTRAPS <- MAPTREES <- COLORSCALE <- TRUE  
  
  treeScale  <- trapScale <- plotScale  <- 1
  scaleValue <- 20
  cex <- .9
  mfrow <- c( 1, 1 )
  
  if( 'chains' %in% names( mapList ) )class( mapList ) <- 'mastif'
  
  indat <- c( 'treeData', 'seedData', 'specNames', 'seedNames', 
              'xytree', 'xytrap' )
  
  if( inherits( mapList, 'mastif' ) ){
    
    mi    <- match( indat, names( mapList$inputs ) )
    for( i in mi ){
      mapList <- append( mapList, mapList$inputs[ i] )
    }
    fecPred  <- mapList$prediction$fecPred
    seedPred <- mapList$prediction$seedPred
    treePredGrid  <- mapList$prediction$treePredGrid
    seedPredGrid  <- mapList$prediction$seedPredGrid
  }else{
 #   mi    <- match( indat, names( mapList$inputs ) )
 #   for( i in mi ){
 #     mapList <- append( mapList, mapList$inputs[ i ] )
 #   }
  }
  
  minPars <- c( 'specNames', 'treeData', 'xytree', 'seedData', 'xytrap',
                'mapPlot', 'mapYears' )
  
  if( any( c( 'MAPTRAPS', 'seedMax', 'trapScale' ) %in% names( mapList ) ) ){
    minPars <- c( minPars, c( 'seedNames', 'xytrap' ) )
  }
  
  wk <- which( !minPars %in% names( mapList ) )
  if( length( wk ) > 0 ){
    mp <- paste0( minPars[ wk], collapse = ', ' )
    stop( '\nmissing from mapList: ', mp )
  }
  minPars <- c( minPars, 'treeSymbol' )
  for( k in 1:length( minPars ) ){
    wk <- which( names( mapList ) == minPars[ k] )
    assign( minPars[ k], mapList[[ wk[ 1]]] )
  }
  
  ALLSPECS <- mapList$ALLSPECS
  if( is.null( ALLSPECS ) )ALLSPECS <- FALSE
  
  if( !ALLSPECS )treeData <- treeData[ as.character( treeData$species ) %in% specNames, ]
  
  if( nrow( treeData ) == 0 )stop( 'species absent from plot' )
  
  
  tdat <- treeData
  sdat <- seedData

 # rm( treeData )
  rm( seedData )
  
  if( is.null( sdat ) ) MAPTRAPS <- FALSE
  
  plotVars <- c( 'fecPred', 'seedPred', 'PREDICT', 'treeScale', 
                'trapScale', 'xlim', 'ylim', 'MAPTRAPS', 'MAPTREES', 'seedMax', 'NULL', 
                'fecMax', 'mfrow', 'LEGEND', 'plotScale ', 'SCALEBAR', 'scaleValue', 
                'COLORSCALE', 'RMD' )
  
  for( k in 1:length( plotVars ) ){
    wk <- which( names( mapList ) == plotVars[ k] )
    if( length( wk ) == 0 )next
    assign( plotVars[ k], mapList[[ wk]] )
  }
  
  
  mapPlot     <- .fixNames( mapPlot, all = TRUE )$fixed
  tdat$plot   <- .fixNames( tdat$plot, all = TRUE )$fixed
  xytree$plot <- .fixNames( xytree$plot, all = TRUE )$fixed
  
  if( length( specNames ) == 1 )LEGEND <- FALSE
  

  xytree$treeID <- columnPaste( xytree$plot, xytree$tree )
  tdat$treeID <- columnPaste( tdat$plot, tdat$tree )
  
  if( MAPTRAPS ){
    sdat$plot     <- .fixNames( sdat$plot, all = TRUE )$fixed
    xytrap$plot   <- .fixNames( xytrap$plot, all = TRUE )$fixed
    xytrap$trapID <- columnPaste( xytrap$plot, xytrap$trap )
    sdat$trapID   <- columnPaste( sdat$plot, sdat$trap )
  }
  
  
  mapTreeYr <- mapYears
  
  wp <- which( tdat$plot == mapPlot )
  if( length( wp ) == 0 & MAPTREES )stop( '\nno trees on this plot\n' )
  
  censYr <- table( tdat$plot, tdat$year )[ drop = FALSE, mapPlot, ]
  cmiss  <- which( censYr[ as.character( mapYears )] == 0 )
  cmiss  <- as.numeric( names( cmiss ) )
  cmiss  <- sort( c( cmiss, mapYears[ !mapYears %in% names( censYr )] ) )
  
  if( MAPTREES & length( cmiss ) > 0 ){
    
    yy <- as.numeric( colnames( censYr ) )
    yy[ censYr == 0] <- Inf
    
    dy <- abs( outer( mapYears, yy, '-' ) )
    cy <- yy[ apply( dy, 1, which.min )]
    mapTreeYr <- cy
    
    mpp <- paste0( mapTreeYr, collapse = ', ' )
  }
  
  wtdata <- which( tdat$year %in% mapTreeYr & 
                  as.character( tdat$plot ) %in% mapPlot )
  
  if( length( wtdata ) == 0 ){
    wdata <- which( as.character( tdat$plot ) %in% mapPlot )
    ws    <- which( tdat$plot == mapPlot )
    cyr   <- RANN::nn2( tdat$year[ ws], mapTreeYr, k = 1 )[[ 1]][, 1]
    mapTreeYr <- mapTreeYr[ cyr ]
  }
  tree <- tdat[ wtdata, ]
  
  wt <- match( as.character( tree$treeID ), 
              as.character( xytree$treeID ) )
  tree$x <- xytree$x[ wt ]
  tree$y <- xytree$y[ wt ]
  
  fmat <- tree
  if( is.null( treeSymbol ) ){
    treeSymbol <- tree$diam
  }else{
    treeSymbol <- treeSymbol[ wtdata ]
  }
  
  if( MAPTRAPS ){
    wsdata <- which( sdat$year %in% mapYears & 
                      as.character( sdat$plot ) %in% mapPlot )
    if( length( wsdata ) == 0 ){
      cat( paste( '\n', mapYears, mapPlot ) )
      return( 'plot/year combo not in seed data' )
    }
    seed <- sdat[ wsdata, ]
    ws   <- match( as.character( seed$trapID ), 
                  as.character( xytrap$trapID ) )
    seed$x <- xytrap$x[ ws]
    seed$y <- xytrap$y[ ws]
  }
  
  if( is.null( seedPredGrid ) )PREDICT <- FALSE
  
  wtpred <- numeric( 0 )
  
  if( PREDICT ){
    wtpred <- which( treePredGrid$year %in% mapTreeYr & 
                      treePredGrid$plot %in% mapPlot )
    if( length( wtpred ) == 0 )PREDICT <- FALSE

    treePredGrid <- treePredGrid[ wtpred, ]

    wt <- match( as.character( treePredGrid$treeID ), 
                as.character( xytree$treeID ) )
    treePredGrid$x <- xytree$x[ wt]
    treePredGrid$y <- xytree$y[ wt]
    
    fmat <- treePredGrid
    
    if( is.null( treeSymbol ) ){
      treeSymbol <- treePredGrid$fecEstMu
      fmat <- tree
    }
    
    if( MAPTRAPS ){
      wsdata <- which( seedPred$year %in% mapYears & 
                        as.character( seedPred$plot ) %in% mapPlot )
      seedPred <- seedPred[ wsdata, ]
      wt <- match( as.character( seedPred$trapID ), 
                  as.character( xytrap$trapID ) )
      seedPred$x <- xytrap$x[ wt]
      seedPred$y <- xytrap$y[ wt]
      
      wspred <- which( seedPredGrid$year %in% mapYears & 
                        seedPredGrid$plot %in% mapPlot )
      seedPredGrid <- seedPredGrid[ wspred, ]
      
      scols <- paste( specNames, '_meanM2', sep = '' )
      scols <- c( 'plot', 'trapID', 'year', 'x', 'y', scols )
      
      seedPredGrid <- rbind( seedPred[, scols], seedPredGrid[, scols] )
    }
    
  }else{
    if( is.null( treeSymbol ) )treeSymbol <- tree$diam
  }
  
  if( length( wtdata ) == 0 & length( wtpred ) == 0 & MAPTREES ){
    if( verbose )cat( '\nNo obs or preds for mapPlot, mapYears\n' )
    return( add = FALSE )
  }
  
  if( MAPTRAPS ){
    SEED   <- TRUE
    snames <- paste( seedNames, '_meanM2', sep = '' )
    seedCount <- as.matrix( seed[, seedNames, drop = FALSE] )
    if( nrow( seed ) == 0 )SEED <- FALSE
    
    if( is.null( seedMax ) & length( seedCount ) > 0 )
      seedMax <- max( seedCount, na.rm = TRUE )
  }
  
  if( is.null( fecMax ) ){
    if( MAPTREES ){
      fecMax <- max( treeSymbol, na.rm = TRUE )
    }else{
      fecMax <- 0
    }
  }
  fecMax <- max( fecMax, na.rm = TRUE )
  treeSymbol <- treeSymbol/fecMax

  
  nspec <- length( specNames )
  
  cfun <- colorRampPalette( c( '#66c2a5', '#fc8d62', '#8da0cb' ) )
  specCol <- cfun( nspec ) 
  
  if( ALLSPECS ){
    specNames <- c( specNames, 'other' )
    specCol   <- c( specCol, 'grey' )
    tree$species[ !tree$species %in% specNames] <- 'other'
    nspec <- nspec + 1
  }
  names( specCol ) <- specNames
  
  xlimk <- ylimk <- numeric( 0 )
  dx <- dy <- numeric( 0 )
  
  npp  <- length( mapPlot )
  
  for( j in 1:npp ){
    
    if( is.null( xlim ) ){
      wxy1  <- which( xytree$plot == mapPlot[ j ] )
      xlimj <- range( xytree[ wxy1, 'x'] )
      ylimj <- range( xytree[ wxy1, 'y'] )
      
      if( MAPTRAPS ){
        wxy2  <- which( xytrap$plot == mapPlot[ j ] )
        xlimj <- range( c( xlimj, xytrap[ wxy2, 'x'] ) )
        ylimj <- range( c( ylimj, xytrap[ wxy2, 'y'] ) )
      }
      if( PREDICT ){
        wj <- which( seedPredGrid$plot == mapPlot[ j] )
        xlimj <- range( c( xlimj, seedPredGrid$x[ wj] ) )
        ylimj <- range( c( ylimj, seedPredGrid$y[ wj] ) )
      }

    }else{
      xlimj <-  xlim
      ylimj <-  ylim
    }
    dxj <- diff( xlimj )
    dyj <- diff( ylimj )
    
    dx <- c( dx, dxj )
    dy <- c( dy, dyj )
    
    xlimk <- rbind( xlimk, xlimj )
    ylimk <- rbind( ylimk, ylimj )
  }
  
  xlimit <- matrix( xlimk, npp, 2, byrow = FALSE )
  ylimit <- matrix( ylimk, npp, 2, byrow = FALSE )
  rownames( xlimit ) <- rownames( ylimit ) <- mapPlot
  
  xlimit[ 1] <- xlimit[ 1] - 1
  xlimit[ 2] <- xlimit[ 2] + 1
  ylimit[ 1] <- ylimit[ 1] - 1
  ylimit[ 2] <- ylimit[ 2] + 1
  
  rr  <- apply( rbind( xlimit, ylimit ), 1, range )
  sc  <- max( apply( rr, 2, diff ) )/20
  
  opin <- par( )$pin
  
  obs <- oyr <- numeric( 0 )
  if( SEED ){
    stab <- with( seed, table( plot, year ) )
    stab <- stab[ drop = FALSE, mapPlot, ]
    obs  <- stab[, colnames( stab ) %in% mapYears, drop = FALSE]
    oyr  <- as.numeric( colnames( obs )[ colSums( obs ) > 0] )
  }
  
  pyr  <- numeric( 0 )
  pred <- NULL
  
  if( PREDICT ){
    ptab <- with( seedPredGrid, table( plot, year ) )
    if( !mapPlot %in% rownames( ptab ) ){
      if( verbose )cat( '\nNo prediction for this plot\n' )
      PREDICT <- FALSE
    }else{
      ptab <- ptab[ drop = FALSE, mapPlot, ]
      wss  <- which( colnames( ptab ) %in% mapYears )
      if( length( wss ) == 0 ){
        if( verbose )cat( '\nNo prediction for this plot-year\n' )
        PREDICT <- FALSE
      }else{
        pred <- ptab[, colnames( ptab ) %in% mapYears, drop = FALSE]
        pyr  <- colnames( pred )[ colSums( pred ) > 0]
      }
    }
    pyr <- as.numeric( pyr )
  }
  yr  <- sort( unique( c( oyr, pyr ) ) )
  if( length( oyr ) > 0 ){
    oyr <- oyr[ oyr %in% yr]
    obs <- obs[, as.character( oyr ), drop = FALSE]
  }else{
    obs <- NULL
  }

  if( PREDICT ){
    if( length( pyr ) > 0 ){
      pyr <- pyr[ pyr %in% yr]
      pred <- pred[, as.character( pyr ), drop = FALSE]
    }
  }
  
  specAll  <- table( tree$species )
  specAll  <- specAll[ specAll > 0]
  specPred <- table( tree$species[ tree$plot %in% rownames( pred ) &
                                   tree$year %in% pyr] )
  specPred  <- names( specPred )[ specPred > 0]
  colList <- numeric( 0 )
  
  for( j in 1:npp ){
    
    WOJ <- WPJ <- FALSE
    
    jobs <- jpred <- jyr <- numeric( 0 )
    
    if( !is.null( obs ) ){
      jobs  <- obs[ drop = FALSE, mapPlot[ j], ]
      WOJ <- TRUE
    }
    if( !is.null( pred ) ){
      jpred <- pred[ drop = FALSE, mapPlot[ j], ]
      WPJ <- TRUE
    }
    jyr   <- sort( unique( as.numeric( c( colnames( jobs ), colnames( jpred ) ) ) ) )
    njyr  <- length( jyr )
    
    if( is.null( mfrow ) )mfrow <- c( 1, 1 )
    
    suppressWarnings( 
      par( bty = 'o', mar = c( 1, .4, 2, .4 ), oma = c( 3, 3, 1, 1 ) )
    )
    if( LEGEND )par( oma = c( 3, 3, 1, 3 ) )
    
    par( mfrow = mfrow )
    
    if( !is.null( RMD ) ){
      mfrow <- c( 1, 1 )
      njyr  <- 1
      par( mfrow = mfrow, mar = c( 2, 2, 2, 1 ), bty = 'o' )
    }
    
    if( njyr <= 1 ){
      scale <- max( c( dx[ j], dy[ j] ) )/2
      if( scale < 50 )scale <- 50
    }else{
      if( prod( mfrow ) == 1 )mfrow <- .getPlotLayout( njyr )$mfrow
      par( mfrow = mfrow, mar = c( 2, 2, 2, 1 ), bty = 'o' )
      scale <- max( c( dx[ j], dy[ j] ) )/plotScale/3*max( mfrow )
    }
    
    if( !is.null( RMD ) )scale <- scale*1.1
    
    if( npp > 1 ){
      .mapSetup( xlimit[ j, ], ylimit[ j, ], scale = scale )
    }
    
    cyr <- as.character( yr )
    add <- FALSE
    
    # specNames == 'other' in background ( first )
    if( 'other' %in% specNames ){
      jj <- which( tree$species == 'other' )
      kk <- which( tree$species != 'other' )
      tree <- tree[ c( kk, jj ), ] 
    }
    
    if( MAPTRAPS ){
      
      for( k in 1:njyr ){
        
        add <- WO <- WP <- WT <- FALSE
        
        if( WOJ ){
          if( cyr[ k] %in% colnames( obs ) &
              MAPTRAPS )WO <- obs[ 1, colnames( obs ) == cyr[ k]] > 0
        }
        if( WPJ ){
          if( cyr[ k] %in% colnames( pred ) )WP <- pred[, colnames( pred ) == cyr[ k]] > 0
        }
        
        if( !WO & !WP & !MAPTREES )next
        
        if( WP ){  #predicted surface, fecundity
          
          tmp <- .pmap( specNames = specNames, # xytree = xytree, 
                       plot = mapPlot[ j], MAPTREES, 
                       year = jyr[ k], seedPredGrid = seedPredGrid, 
                       treePredGrid = treePredGrid, 
                       xlim = xlimit[ j, ], ylim = ylimit[ j, ], treeScale, trapScale, 
                       sCol = specCol[ specNames], add = add )
          add <- tmp$add
          tmp <- tmp[ names( tmp ) != 'add']
          
          if( add )colList <- append( colList, list( tmp ) )
          names( colList )[ length( colList )] <- mapPlot[ j]
        }
        
        if( WO ){  #observed seed
          
          seedk <- seed[ seed$year == jyr[ k ], ]
          sx <- seedk$x
          sy <- seedk$y
          z  <- as.matrix( seedk[, seedNames] )
          z  <- rowSums( z, na.rm = TRUE )
          
          w1 <- which( z > 0 )
          w0 <- which( z == 0 )
          
          
          if( length( w1 ) > 0 ){
            z <- z/seedMax
            z <- 5*sqrt( sc*z )*trapScale
            symbols( sx[ w1 ], sy[ w1 ], squares = z[ w1 ], inches = F, 
                    xlab = '', ylab = '', bg = .getColor( 'black', .3 ), 
                    fg = .getColor( 'black', .5 ), add = add, 
                    xaxt = 'n', yaxt = 'n', xlim = xlimit[ j, ], ylim = ylimit[ j, ] )
            for( i in 1:4 )axis( i, labels = FALSE, tck = .01 )
            add <- TRUE
          }
          if( add == F ){
            plot( NULL, xlim = xlimit[ j, ], ylim = ylimit[ j, ], xlab = '', ylab = '', 
                 axes = F )
            for( i in 1:4 )axis( i, labels = FALSE, tck = .01 )
            add <- TRUE
          }
          if( length( w0 ) > 0 )points( sx[ w0], sy[ w0], pch = 3, cex = .3, 
                                   col = .getColor( 'black', .8 ) )
          add <- TRUE
        }
        
        if( MAPTREES & !PREDICT ){
          
          treek <-  fmat[ drop = FALSE, fmat$year == jyr[ k], ]
          z     <- treeSymbol[ drop = FALSE, fmat$year == jyr[ k]]
          if( nrow( treek ) == 0 & length( mapTreeYr ) >= k ){
            treek <-  fmat[ drop = FALSE, fmat$year == mapTreeYr[ k], ]
            z     <- treeSymbol[ drop = FALSE, fmat$year == mapTreeYr[ k]]
          }
          
          if( nrow( treek ) == 0 )next
          
          sx <- treek$x
          sy <- treek$y
          
          if( !all( is.na( z ) ) ){
        #    mmm <- max( z, na.rm = TRUE )
        #    if( mmm == 0 )mmm <- 1
        #    z <- 1*sc*z/mmm*treeScale
            z <- 1*sc*z*treeScale
            ic <- match( treek$species, specNames )
            
            symbols( sx, sy, circles = z*1.3, inches = F, add = add, 
                    xlim = xlim, ylim = ylim, 
                    fg = .getColor( 'white', .5 ), xlab = '', ylab = '', 
                    bg = .getColor( 'white', .5 ), xaxt = 'n', yaxt = 'n' )
            
            symbols( sx, sy, circles = z, inches = F, add = TRUE, 
                    xlab = '', ylab = '', 
                    fg = .getColor( specCol[ specNames[ ic]], .6 ), 
                    bg = .getColor( specCol[ specNames[ ic]], .3 ), xaxt = 'n', yaxt = 'n' )
            if( !add )for( i in 1:4 )axis( i, labels = FALSE, tck = .01 )
          }
        }
        
        if( !add )next
        
        cex <- sum( mfrow )^( -.1 )
        .plotLabel( jyr[ k], 'topright', cex = cex, above = TRUE ) 
        .plotLabel( mapPlot[ j], 'topleft', cex = cex, above = TRUE )
      }
      
    }else{
      
      # trees that died/disappeared
      
      ttab <- table( tree$treeID, tree$year )
      miss <- apply( ttab, 1, which.min )
      ww   <- which( miss > 1 )
      if( length( ww ) > 0 )ww <- cbind( ww, miss[ ww] )
                                             
      for( k in 1:length( mapYears ) ){
        
        ty <- tree[ tree$year == mapYears[ k], ]
        if( nrow( ty ) == 0 ){
          warning( paste( 'no census trees in year', mapYears[ k] ) )
          next
        }
        
        sx <- ty$x
        sy <- ty$y
        z  <- ty$diam
        
        if( !all( is.na( z ) ) ){
          
          wz <- which( is.finite( z ) & is.finite( sx ) & is.finite( sy ) )
          sx <- sx[ wz]
          sy <- sy[ wz]
          z  <- z[ wz]
          
          mmm <- max( z, na.rm = TRUE )
          if( mmm == 0 )mmm <- 1
          z <- 1*sc*z/mmm*treeScale
          ic <- match( ty$species, specNames )
          
          symbols( sx, sy, circles = z, inches = F, add = F, 
                  xlim = xlimit[ j, ], ylim = ylimit[ j, ], 
                  xlab = '', ylab = '', asp = 1, 
                  fg = .getColor( specCol[ specNames[ ic]], .8 ), 
                  bg = .getColor( specCol[ specNames[ ic]], .3 ), xaxt = 'n', yaxt = 'n' )
          
          if( length( ww ) > 0 ){
            wk <- which( ww[, 2] == k )
            if( length( wk ) > 0 ){
              id <- ww[ wk, 1]
              points( sx[ id], sy[ id], pch = 3, col = specCol[ specNames[ ic[ id]]], lwd = 2 )
            }
          }
          for( i in 1:4 )axis( i, labels = FALSE, tck = .01 )
          text( xlimit[ j, 1], ylimit[ j, 2] - dy/20, mapYears[ k], pos = 4 )
        }
        
      }
    }
    mtext( mapPlot[ j], side = 3, line = -1, outer = T )
  }
  
  if( PREDICT )colList <- colList[ !duplicated( names( colList ) )] 
  
  if( SCALEBAR )scaleBar( 'm', value = scaleValue, yadj = .07, cex = .8 )
  if( LEGEND ){
    cornerLegend( 'bottomright', names( specAll ), 
           text.col = specCol[ match( names( specAll ), specNames )], 
           cex = .8, bty = 'n' )
  }
  
  if( COLORSCALE & PREDICT ){
    
    # use last plot ( bottom or right side )
    cols <- colList[[ length( colList )]]
    nss   <- length( cols$species )
    endLabels <- NULL
    
    for( k in 1:nss ){
      
      if( k == nss )endLabels <- c( 0, signif( seedMax, 1 ) )
      
      ck <- .getColor( specCol[ cols$species[ k]], cols$colorLevels )
      
      clist <- list( kplot = k, ytick = NULL, text.col = 'black', 
                     cols = ck, labside = 'right', text.col = col, 
                     bg = 'grey', endLabels = endLabels ) 
      cornerScale( clist )
  #    kk <- kk + 1
    }
  }
  
  invisible( add )
}
 
cornerLegend <- function( ... ) {
  suppressWarnings( 
  opar <- par( fig = c( 0, 1, 0, 1 ), oma = c( 0, 0, 0, 0 ), 
              mar = c( 0, 0, 0, 0 ), new = TRUE )
  )
  on.exit( par( opar ) )
  plot( 0, 0, type = 'n', bty = 'n', xaxt = 'n', yaxt = 'n' )
  legend( ... )
}

cornerScale <- function( clist ) {
  
  opar <- par( fig = c( 0, 1, 0, 1 ), oma = c( 0, 0, 0, 0 ), 
              mar = c( 0, 0, 0, 0 ), new = TRUE )
  on.exit( par( opar ) )
  plot( 0, 0, type = 'n', bty = 'n', xaxt = 'n', yaxt = 'n' )
  
  .cornerLegendScale( clist )
}

.cornerLegendScale <- function( clist ){  
  
  # left and right corners: xx = ( x1, x2 ), y = ( y1, y2 )
  # bg is color of border
  # cols  - matching color sequence
   kplot <- 1
  
  opar <- par( fig = c( 0, 1, 0, 1 ), oma = c( 0, 0, 0, 0 ), 
              mar = c( 0, 0, 0, 0 ), new = TRUE )
  on.exit( par( opar ) )
  
  xx <- yy <- cols <- NULL
  ytick <- scale <- text.col <- text.col <- bg <- endLabels <- NULL
  labside <- 'right'
  
  for( k in 1:length( clist ) )assign( names( clist )[ k], clist[[ k]] ) 
  
  xx <- -1.08 + .1*( kplot - 1 ) + c( .1, .2 )
  yy <- c( -1, -.75 )
  
  nn <- length( cols )
  ys <- seq( yy[ 1], yy[ 2], length = nn )
  if( is.null( scale ) )scale <- ys
  
  for( j in 1:( length( scale )-1 ) ){
    
    rect( xx[ 1], ys[ j], xx[ 2], ys[ j+1], col = cols[ j], border = NA )
  }
  if( !is.null( bg ) )rect( xx[ 1], yy[ 1], xx[ 2], yy[ 2], border = bg, lwd = 1 )
  if( !is.null( ytick ) ){
    
    ys <- diff( yy )/diff( range( ytick ) )*ytick
    yt <- ys - min( ys ) + yy[ 1]
    
    for( j in 1:length( yt ) ){
      lines( xx, yt[ c( j, j )] )
    }
  }
  if( !is.null( endLabels ) ){ 
    if( labside == 'right' )text( diff( xx )+c( xx[ 2], xx[ 2] ), yy, endLabels )
    if( labside == 'left' )text( c( xx[ 1], xx[ 1] ), yy, endLabels, pos = 2 )
  }
}

values2grid <- function( x, y, z, nx = NULL, ny = NULL, dx = NULL, dy = NULL, 
                        ksearch = 4, MATFORMAT = TRUE ){
  
  xl <- range( x )
  yl <- range( y )
  
  xs <- seq( xl[ 1], xl[ 2], length = nx )
  ys <- seq( yl[ 1], yl[ 2], length = ny )
  
  grid <- as.matrix( expand.grid( xs, ys ) )
  
  tmp <- nn2( cbind( x, y ), grid, k = ksearch )
  nn  <- tmp[[ 1]]
  wt  <- tmp[[ 2]]
  mn  <- min( wt[ wt > 0] )
  wt  <- 1/( wt + mn )
  
  zz  <- matrix( z[ nn], nrow( nn ), ncol( nn ) )
  zz  <- rowSums( zz*wt )/rowSums( wt )
  
  if( !MATFORMAT )return(  cbind( grid, zz ) )
  
  zmat <- matrix( NA, nx, ny )
  ix  <- match( grid[, 1], xs )
  iy  <- match( grid[, 2], ys )
  zmat[ cbind( ix, iy )] <- zz
  
  rownames( zmat ) <- xs
  colnames( zmat ) <- ys
  
  list( x = xs, y = ys, z = zmat )
}

.pmap <- function( specNames = NULL, plot = NULL, MAPTREES = TRUE, 
                  year = NULL, seedPredGrid = NULL, 
                  treePredGrid, xlim, ylim, treeScale, trapScale, 
                  sCol = 'blue', add = FALSE ){
  
  #multiple species for single plot-year
  
  ADD <- FALSE
  if( add )ADD <- TRUE
  
  pnames   <- paste( specNames, '_meanM2', sep = '' )
  nspec    <- length( specNames )
  predCols <- c( 'x', 'y', pnames )
  
  if( length( sCol ) == 1 & nspec > 1 )sCol <- rep( sCol, nspec )
  
  fec  <- treePredGrid[, 'fecEstMu']
  matr <- treePredGrid[, 'matrPred']
  smat <- as.matrix( seedPredGrid[, predCols] )
  
  nx <- ceiling( diff( xlim )/3 )
  ny <- ceiling( diff( ylim )/3 )
  
  fecMax  <- max( fec, na.rm = TRUE )
  seedMax <- max( smat[, pnames], na.rm = TRUE )
  
  rr  <- apply( rbind( xlim, ylim ), 2, range )
  sc  <- max( apply( rr, 1, diff ) )/20
  
  wspec <- which( colSums( smat[, pnames, drop = FALSE] ) > 0 )
  
  sn <- 4
  if( seedMax > 1 )sn <- 3
  if( seedMax > 10 )sn <- 2
  
  q <- seq( 0, 1, length = 10 )^.3
  q[ 1] <- .3
  
  levels <- signif( quantile( smat[, pnames], q ) , sn )
  levels <- c( levels, signif( max( seedMax )*1.3, sn ) )
  levels <- sort( unique( levels ) )
  colorLevels <- seq( .001, .99, length = length( levels ) )^3
  
  for( k in wspec ){
    
    tmp <- values2grid( x = smat[, 'x'], y = smat[, 'y'], z = smat[, pnames[ k]], 
                       nx = nx, ny = ny )
    xseq <- tmp$x
    yseq <- tmp$y
    zmat <- tmp$z
    
    col <- .getColor( sCol[ specNames[ k]], colorLevels )
    contour( xseq, yseq, zmat, levels = levels, add = add, 
            col = col, labcex = 1, frame.plot = FALSE, 
            drawlabels = FALSE, axes = F )
    .filled.contour( xseq, yseq, zmat, levels = levels, col = col )
    if( !add ){
      for( m in 1:4 )axis( m, labels = FALSE, tck = .03 )
    }
    if( !ADD )add <- TRUE
    
  }
  
  if( MAPTREES ){
    for( k in wspec ){
      wk <- which( treePredGrid$species == specNames[ k] )
      if( length( wk ) == 0 ) next
      
      z   <- 5*sc*fec[ wk]*treeScale
      z[ z > 0] <- z[ z > 0]/fecMax
      .mapSpec( x = treePredGrid[ wk, 'x'], y = treePredGrid[ wk, 'y'], z*1.5, 
               add = add, 
               mapx = xlim, mapy = ylim, 
               colVec = 'white', fill = 'white' )
      .mapSpec( x = treePredGrid[ wk, 'x'], y = treePredGrid[ wk, 'y'], z, add = TRUE, 
               mapx = xlim, mapy = ylim, 
               colVec = sCol[ specNames[ k]], fill = sCol[ specNames[ k]] )
    }
  }
  invisible( list( species = wspec, colorLevels = colorLevels, add = add ) )
}

.updateCovariance <- function( SS, priorSS, n, df ){
  
  SI   <- solveRcpp( SS + df*priorSS )
  sinv <- .rwish( n + df, SI )
  solveRcpp( sinv )
}

.updateAlphaRand <- function( ntree, yA, xfecA, sg, reIndexA, reGroups, 
                             Arand, priorVA, dfA, specNames, minmax = 3 ){
  
  # any individual that is mature only one year cannot have random effects
  
  ONEA <- FALSE
  if( length( Arand ) == 1 )ONEA <- TRUE
  
  arand <- matrix( 0, ntree, ncol( Arand ) )
  
  alphaRand <- randEffectRcpp( gindex = reIndexA, groups = reGroups, 
                              xfecA, yA, sg, solve( Arand ) )
  alphaRand[ alphaRand < -minmax] <- -minmax
  alphaRand[ alphaRand > minmax]  <- minmax
  
  if( ONEA ){
    mrand     <- mean( alphaRand )
    names( mrand ) <- specNames
    mrand[ !is.finite( mrand )] <- 0
    alphaRand <- alphaRand - mrand
    arand[ reGroups, ] <- alphaRand
    Arand <- matrix( 1/rgamma( 1, 1 + length( reGroups )/2, 1 + 1/2*sum( alphaRand^2 ) ), 1 )
  }else{
    mrand <- colSums( alphaRand )/colSums( xfecA )
    mrand[ !is.finite( mrand )] <- 0
    alphaRand <- alphaRand - matrix( mrand, nrow( alphaRand ), ncol( alphaRand ), byrow = TRUE )
    arand[ reGroups, ] <- alphaRand
    AA    <- crossprod( alphaRand )
    Arand <- .updateCovariance( AA, priorVA, length( reGroups ), dfA )
  }
  arand[ arand < -minmax] <- -minmax
  arand[ arand > minmax]  <- minmax
  
  list( alphaRand = arand, Arand = Arand, meanRand = mrand )
}

.rwish <- function( df, SS ){
  z  <- matrix( rnorm( df*nrow( SS ) ), df, nrow( SS ) )%*%chol( SS )
  crossprod( z )
}

.riwish <- function( df, S ){
  solveRcpp( .rwish( df, solveRcpp( S ) ) )
}

print.mastif <- function( x, ... ){
  
  rMu <- rSe <- usigma <- betaYrMu <- betaYrSe <- NULL
  
  cat( "\nDIC:\n" )
  print( round( x$fit$DIC, 0 ) )
  
  cat( "\nFecundity coefficients:\n" )
  print( signif( x$parameters$betaFec, 3 ) )
  
  cat( "\nMaturation coefficients:\n" )
  print( signif( x$parameters$betaRep, 3 ) )
  
  if( 'betaYrMu' %in% names( x$parameters ) ){
    cat( "\nYear effects:\n" )
    print( signif( betaYrMu, 3 ) )
    print( signif( betaYrSe, 3 ) )
  }
  
  if( 'rgibbs' %in% names( x$chains ) ){
    cat( "\nSpecies to seed type matrix R:\n" )
    print( signif( rMu, 3 ) )
    print( signif( rSe, 3 ) )
  }
  
  cat( "\nSigma, RMSPE:\n" )
  usigma <- x$parameters$sigma
  print( signif( usigma, 4 ) )
  
  cat( "\nDispersal parameter u ( m^2 ):\n" )
  print( x$parameters$upars )
  
  cat( "\nKernel mean distance ( m ):\n" )
  print( x$parameters$dpars )
}

summary.mastif <- function( object, verbose = TRUE, latex = FALSE, ... ){ 
  
  SEEDDATA <- TRUE
  
  betaFec   <- object$parameters$betaFec
  betaRep   <- object$parameters$betaRep
  priorTable <- object$inputs$priorTable
  seedNames <- object$inputs$seedNames
  specNames <- object$inputs$specNames
  tdata     <- object$inputs$treeData
  sdata     <- object$inputs$seedData
  plots     <- sort( unique( as.character( tdata$plot ) ) )
  ntype     <- length( seedNames )
  nseed     <- nrow( sdata )
  nplot     <- length( plots )
  words     <- character( 0 )
  

  
  if( is.null( sdata ) )SEEDDATA <- FALSE
  
  if( latex )verbose <- FALSE
  
  out <- list( )

  AR <- YR <- RANDOM <- SAMPR <- FALSE
  
  trapRMSPE <- object$fit$RMSPEtrap
  trapDIC   <- object$fit$DICtrap
  cropRMSPE <- object$fit$RMSPEcrop
  cropDIC <- object$fit$DICcrop
  
  if( "arList" %in% names( object$data ) ){
    AR <- TRUE
    plag <- object$data$arList$p
  }
  
  #model
  model <- rbind( as.character( object$inputs$formulaRep ), 
                  as.character( object$inputs$formulaFec ) )[, 2, drop = FALSE]
  model <- .replaceString( model, 'I( ', '' )
  model <- .replaceString( model, '^2 )', '^2' )
  rownames( model ) <- c( 'Maturation:', 'Fecundity:' )
  attr( model, 'caption' ) <- 'Model terms '
  re <- object$inputs$randomEffect
  if( !is.null( re ) ){
    ref <- paste( re$randGroups, re$formulaRan, sep = '_' )[ 2]
    ref <- paste( ' + r( ', ref, ' )', sep = '' )
    model[ 2, 1] <- paste( model[ 2, 1], ref )
    attr( model, 'caption' ) <- paste( attr( model, 'caption' ), 
                                    'r( g_m ) indicates a random effect for groups g and model m. ', sep = '' )
  }
  ye <- object$inputs$yearEffect
  if( !is.null( ye ) ){
    yef <- unlist( ye )
    if( length( yef ) > 1 )yef <- paste0( yef, collapse = '_' )
    if( !AR ){
      yef <- paste( ' + y( ', yef, ' )', sep = '' )
      model[ 2, 1] <- paste( model[ 2, 1], yef )
      attr( model, 'caption' ) <- 
        paste( attr( model, 'caption' ), 
              'y( h ) indicates a year effect for random groups h. If h = 0, there are no groups. ', sep = '' )
    }
    if( AR ){
      yef <- paste( ' + AR( ', plag, ', ', yef, ' )', sep = '' )
      model[ 2, 1] <- paste( model[ 2, 1], yef )
      attr( model, 'caption' ) <- 
        paste( attr( model, 'caption' ), 
              'AR( p, h ) indicates an AR( p ) model for random group h. ', sep = '' )
    }
  }
  model <- .replaceString( model, ' * ', 'X' )
  model <- .replaceString( model, '*', 'X' )
  model <- .replaceString( model, '  ', ' ' )
  model[ 1, 1] <- paste( "'", model[ 1, 1], "'", sep = '' )
  model[ 2, 1] <- paste( "'", model[ 2, 1], "'", sep = '' )
  colnames( model ) <- 'model'
  out$amodel <- model
  
  
  prNames <- c( "priorU", "priorVU", "minU", "maxU", "minDiam", "maxDiam", "maxFec" )
  
  out$aprior <- priorTable[, prNames]
  attr( out$aprior, 'caption' ) <- 'Prior parameter values'
  
  
  #data summary
  wd <- which( !duplicated( tdata$treeID ) )
  trees <- table( tdata$species[ wd ], tdata$plot[ wd ] )[, plots, drop = FALSE]
  rownames( trees ) <- paste( 'trees', rownames( trees ), sep = '_' )
  
  treeYears <- table( tdata$species, tdata$plot )[, plots, drop = FALSE]
  rownames( treeYears ) <- paste( 'tree-yrs', rownames( treeYears ), sep = '_' )
  dataTab <- rbind( trees, treeYears )
  
  if( SEEDDATA ){
    wd <- which( !duplicated( sdata$trapID ) )
    traps <- table( sdata$plot[ wd] )[ plots]
    ntr   <- names( traps )
    traps <- matrix( traps, 1 )
    colnames( traps ) <- ntr
    rownames( traps ) <- 'traps'
    
    trapYears <- table( sdata$plot )[ plots]
    dataTab <- rbind( dataTab, traps, trapYears )
    rownames( dataTab )[ nrow( dataTab )] <- 'trap-yrs'
    
    totalSeed <- t( buildSeedByPlot( sdata, seedNames, specNames ) )
  #  censSeed  <- buildSeedByPlot( sdata, paste( seedNames, '_min', sep = '' ), specNames )
    
    ww <- which( !colnames( dataTab ) %in% colnames( totalSeed ) )
    if( length( ww ) > 0 ){
      mm <- matrix( NA, nrow( totalSeed ), ncol = length( ww ) )
      colnames( mm ) <- colnames( dataTab )[ ww]
      totalSeed <- cbind( totalSeed, mm )
    }
    
    total   <- totalSeed[, colnames( dataTab ), drop = FALSE]
    dataTab <- rbind( dataTab, total )
    
    if( nplot > 1 ){
      total   <- rowSums( dataTab )
      dataTab <- cbind( dataTab, total )
    }
  }
  
  rownames( betaFec ) <- .replaceString( rownames( betaFec ), 'species', '' )
  rownames( betaRep ) <- .replaceString( rownames( betaRep ), 'species', '' )
  
  
  attr( dataTab, 'caption' ) <- 'Summary of observations by plot'
  attr( betaFec, 'caption' ) <- 'Fecundity coefficients ( betaFec, log scale )'
  attr( betaRep, 'caption' ) <- 'Maturation coefficients ( betaRep, probit )'
  
  out$adata   <- dataTab
  out$betaFec <- betaFec[, 1:4]
  out$betaRep <- betaRep[, 1:4]
  attr( out$betaFec, 'caption' ) <- 'Fecundity coefficients ( betaFec, log scale )'
  attr( out$betaRep, 'caption' ) <- 'Maturation coefficients ( betaRep, probit )'
  
  
  out$mastScores <- object$parameters$mastScores
  if( !is.null( out$mastScores ) ){
    attr( out$mastScores, 'caption' ) <- 'Masting scores'
  }
  
  if( verbose ){
    cat( '\nData summary:\n' )
    print( dataTab )
    
    cat( "\nFecundity parameters ( log scale ):\n" )
    print( betaFec )
    
    cat( "\nMaturation parameters ( probit ):\n" )
    print( betaRep )
    
    cat( "\nMasting scores:\n" )
    print( out$mastScores )
    
  }
  
  if( 'betaYrMu' %in% names( object$parameters ) ){
    YR <- TRUE
    byr <- object$parameters$betaYr[, 1:3]
    attr( byr, 'caption' ) <- 'Year effects for fecundity ( log scale )'
    
    if( verbose ){
      cat( "\nYear effects, only mature individuals:\n" )
      print( signif( byr, 4 ) )
    }
    out$betaYr <- signif( byr, 4 )
  }
  
  if( 'betaYrRand' %in% names( object$parameters ) ){
    
    byrRand <- signif( object$parameters$betaYrRand, 4 )
    byrRSE  <- signif( object$parameters$betaYrRandSE, 4 )
    attr( byrRand, 'caption' ) <- 'Year effects mean for fecundity by random group'
    attr( byrRSE, 'caption' )  <- 'Year standard error for fecundity by random group'
    
    if( sum( byrRand ) != 0 ){
      
      if( verbose ){
        cat( "\nYear effects, random group means:\n" )
        print( byrRand )
        cat( "\nYear effects, standard deviation between groups:\n" )
        print( byrRSE )
      }
      
      out$betaYrRand   <- byrRand
      out$betaYrRandSE <- byrRSE
    }
  }
  
  if( !is.matrix( object$parameters$pacfMat ) )object$parameters$pacfMat <- 
    t( as.matrix( object$parameters$pacfMat ) )
  if( !is.matrix( object$parameters$pacfSe ) )object$parameters$pacfSe <- 
    t( as.matrix( object$parameters$pacfSe ) )
  
  pacfmu <- signif( object$parameters$pacfMat[, -1, drop = FALSE], 4 )
  pacfse <- signif( object$parameters$pacfSe[, -1, drop = FALSE], 4 )
  
  if( ncol( pacfmu ) > 8 )pacfmu <- pacfmu[, 1:8]
  if( ncol( pacfse ) > 8 )pacfse <- pacfse[, 1:8]
  
  attr( pacfmu, 'caption' ) <- 'Partial autocorrelation in fecundity ( log scale )'
  attr( pacfse, 'caption' ) <- 'Partial autocorrelation standard error in fecundity'
 
  out$pacfmu <- pacfmu
  out$pacfse <- pacfse
  
  
  if( SEEDDATA ){
    pmat <- object$parameters$acsMat
    if( !is.null( pmat ) ){
      pacfss <- signif( pmat[ -1, drop = FALSE], 4 )
      if( length( pacfss ) > 8 )pacfss <- pacfss[ 1:8]
      attr( pacfss, 'caption' ) <- 'Autocorrelation in seed rain, all plots'
      out$pacfss <- pacfss
    }
  }
  
  
  if( 'aMu' %in% names( object$parameters ) ){
    RANDOM <- TRUE
    amu <- diag( object$parameters$aMu )
    ase <- diag( object$parameters$aSe )
    
    arand <- signif( cbind( amu, ase ), 3 )
    rownames( arand ) <- .replaceString( rownames( arand ), 'species', '' )
    colnames( arand ) <- c( '  Estimate', '  Standard_error' )
    
    if( verbose ){
      cat( "\nDiagonal elements of random effects covariance matrix ( aMu ):\n" )
      print( arand )
    }
    attr( arand, 'caption' ) <- 'Diagonal elements of random effects covariance matrix ( A )'
    out$arand <- arand
  }
  
  if( 'rgibbs' %in% names( object$chains ) ){
    SAMPR <- TRUE
    
    rMu <- signif( object$parameters$rMu, 3 )
    rSe <- signif( object$parameters$rSe, 3 )
    
    attr( rMu, 'species' ) <- attr( rSe, 'species' ) <- 
      attr( rMu, 'posR' ) <- attr( rSe, 'posR' ) <- 
      attr( rMu, 'plot' ) <- attr( rSe, 'plot' ) <- NULL
    
    if( verbose ){
      cat( "\nSpecies to seed type matrix R:\n" )
      print( rMu )
      
      cat( "\nStandard errors for R:\n" )
      print( rSe )
    }
    
    attr( rMu, 'caption' ) <- 'ID error matrix mean estimate ( R )'
    attr( rSe, 'caption' ) <- 'ID error matrix standard error ( R )'
    
    out$rMu <- rMu
    out$rSe <- rSe
  }
  
  sigma <- object$parameters$sigma
  if( !SEEDDATA )sigma <- sigma[ drop = FALSE, 'sigma', ]
  
  if( verbose ){
    cat( "\nSigma, RMSPE:\n" )
    print( signif( sigma, 3 ) )
  }
  attr( sigma, 'caption' ) <- 'Sigma^2, RMSPE, and deviance'
  out$sigma <- signif( sigma, 3 )
  
  if( SEEDDATA ){
    utab <- object$parameters$upars
    
    upars <- utab[ grep( 'u', rownames( utab ) ), ]
    pu    <- rownames( utab )
    rownames( utab ) <- NULL
    utab  <- data.frame( parameter = pu, utab )
    
    rownames( utab ) <- NULL
    
    if( verbose ){
      cat( "\nKernel estimates:\n" )
      print( utab )
    }
    attr( utab, 'caption' ) <- 'Kernel estimates, parameter u in 2Dt kernel and kernel mean d'
  }
  
  if( AR ){
    out$eigenMu <- signif( object$parameters$eigenMu, 3 )
    out$eigenSe <- signif( object$parameters$eigenSe, 3 )
    attr( out$eigenMu, 'caption' ) <- 'Eigenvalues for autoregressive terms'
    attr( out$eigenSe, 'caption' ) <- 'Eigenvalue standard errors for autoregressive terms'
  }
  
  ty <- dataTab[ grep( 'tree-yrs', rownames( dataTab ) ), ]
  
  ntreeYr  <- sum( ty )
  years    <- object$data$setupData$years
  ntree    <- nrow( object$data$setupData$zmat )
  plots    <- object$data$setupData$plots
  nplot    <- length( plots )
  nyr      <- length( years )
  
  words <- paste( "The sample contains ", ntreeYr, " tree-years on ", ntree, 
                 " individuals. There are ", nplot, " plots sampled over ", nyr, 
                 " years. ", sep = "" )
  if( SEEDDATA ){
    ntrapYr  <- sum( dataTab[ 'trap-yrs', ] )
    ntrap    <- nrow( object$data$setupData$distall )
    words <- paste( words, 'There are ', ntrapYr, ' trap-years on ', ntrap, 
                 ' seed traps. The RMSPE for seed traps is ', 
                 signif( object$fit$RMSPEtrap, 3 ), 
                 ", and the DIC is ", round( object$fit$DICtrap ), ". ", 
                   sep = '' )
  }
  if( 'RMSPEcrop' %in% names( object$fit ) ){
    ww <- which( is.finite( object$inputs$treeData$cropCount ) )
    ctab <- table( object$inputs$treeData$species[ ww] )
    cnames <- paste0( names( ctab ), collapse = ', ' )
    ctot   <- sum( ctab )
    words <- paste( words, 'There are ', ctot, ' cropCounts on ', cnames, '. The RMSPE for crop counts is ', 
                   signif( object$fit$RMSPEcrop, 3 ), 
                   ", and the DIC is ", round( object$fit$DICcrop ), '. ', 
                   sep = '' )
  }
  
  if( 'trueValues' %in% names( object$inputs ) ){
    words <- paste( 'The data are generated by mastSim. ', words, sep = '' )
  }
  
  if( 'censMin' %in% names( object$inputs ) ){
    cmin <- object$inputs$censMin
    cmax <- object$inputs$censMax
    if( length( cmin ) > 0 ){
      ncens <- nrow( cmin )
      words <- paste( words, paste( "There are", ncens, 
                              "censored seed trap observations" ) )
    }
  }
  
  if( !is.null( object$inputs$inwords ) ){
    ww <- paste0( object$inputs$inwords, collapse = '. ' )
    ww <- .replaceString( ww, '\n', '. ' )
    ww <- .replaceString( ww, '\n', '' )
    ww <- .replaceString( ww, '\"', '' )
    ww <- .replaceString( ww, '. .', '. ' )
    ww <- .replaceString( ww, ':.', ': ' )
    words <- paste( words, ww, sep = '. ' )
    words <- .replaceString( words, '. .', '.' )
  }
  
  if( RANDOM ){
    
    morewords <- paste( "Random effects were fitted on ", 
                            length( object$data$setupRandom$rnGroups ), 
                            " individuals.", sep = '' )
    words <- paste( words, morewords )
  }
  
  if( verbose ){
    cat( "\n", words )
  }
  
  fit <- numeric( 0 )
  if( 'RMSPEcrop' %in% names( object$fit ) ){
    fit <- cbind( round( object$fit$DICcrop ), object$fit$RMSPEcrop )
    colnames( fit ) <- c( '  DICcrop', '  RMSPEcrop' )
  }
  if( SEEDDATA ){
    sfit <- cbind( round( object$fit$DICtrap ), object$fit$RMSPEtrap )
    colnames( sfit ) <- c( '  DICtrap', '  RMSPEtrap' )
    fit <- cbind( fit, sfit )
  }
  attr( fit, 'caption' ) <- 'Model fit'
  
  out$fit   <- fit
  out$words <- words
  
  out <- out[ order( names( out ) )]
  
  if( latex ){
    
    tnames <- names( out )
    for( k in 1:length( tnames ) ){
      xk <- out[ tnames[ k]][[ 1]]
      if( tnames[ k] %in% c( 'fit', 'words' ) )next
      print( '' )
      print( tnames[ k] )
      xp <- as.data.frame( xk )
      ww <- which( sapply( xp, is.complex ) )
      if( length( ww ) > 0 )for( w in ww )xp[[ w]] <- as.character( xp[[ w]] )
      print( xtable( xp, caption = attr( xk, 'caption' ) ) )
    }
  }
 
  class( out ) <- "summary.mastif"
  invisible( out ) 
}

mastSim <- function( sim ){       # setup and simulate fecundity data
  
  if( !'seedNames' %in% names( sim ) )
    stop( '\nsim must include seedNames\n' )
  if( !'specNames' %in% names( sim ) )
    stop( '\nsim must include specNames\n' )
  
  .dsim( sim ) 
}
 
.dsim <- function( sim ){
  
  nyr <- 5; ntree  <-  10; ntrap <- 20; plotWide  <-  100; nplot  <-  3
  meanDist <- priorDist  <-  25; Q  <-  2
  minDist <- 10
  maxDist <- 40
  minDiam <- 10
  maxDiam <- 40
  yearEffect <- NULL
  facLevels <- character( 0 )
  seedNames <- specNames <- c( 'piceaGlauca', 'piceaMariana', 'piceaUNKN' )
  SPECS <- SAMPR <- AR <- USPEC <- FALSE
  maxFec <- 1e+7
  
  for( k in 1:length( sim ) )assign( names( sim )[ k], sim[[ k]] )
  specNames <- sort( specNames )
  S         <- length( specNames )
  ntreePlot <- rpois( nplot, ntree ) + 1  # trees per plot
  ntrapPlot <- rpois( nplot, ntrap ) + 4  # traps per plot
  nyrPlot   <- rpois( nplot, nyr ) + 1
  plotNames <- paste( 'p', 1:nplot, sep = '' )
  yearNames <- 2017 - c( max( nyrPlot ):1 )
  if( length( specNames ) > 1 )SPECS <- TRUE
  if( length( seedNames ) > 1 )SAMPR <- TRUE
  nyr <- max( nyrPlot )
  
  
  upar <- priorU <- ( 2*meanDist/pi )^2
  priorVU <- 10
  minU <- ( 2*minDist/pi )^2
  maxU <- ( 2*maxDist/pi )^2
  
  year <- plot <- tree <- trap <- yrsd <- plsd <- numeric( 0 )
  
  for( j in 1:nplot ){
    
    tree <- c( tree, rep( 1:ntreePlot[ j], each = nyrPlot[ j] ) )
    year <- c( year, rep( 1:nyrPlot[ j], ntreePlot[ j] ) ) 
    plot <- c( plot, rep( j, ( nyrPlot[ j]*ntreePlot[ j] ) ) )
    trap <- c( trap, rep( 1:ntrapPlot[ j], each = nyrPlot[ j] ) )
    yrsd <- c( yrsd, rep( 1:nyrPlot[ j], ntrapPlot[ j] ) ) 
    plsd <- c( plsd, rep( j, ( nyrPlot[ j]*ntrapPlot[ j] ) ) )
  }
  
  priorTable <- setupPriors( specNames, nn = length( tree ), 
                            priorTable = NULL, priorList = NULL, 
                            priorDist, priorVDist = 10, 
                            maxDist, minDist, 
                            minDiam, maxDiam, sigmaMu = NULL, 
                            maxF = maxFec, maxFec = maxFec, 
                            ug = upar, priorTauWt = NULL, priorVU, 
                            ARSETUP = F, USPEC = F )$priorTable
  
  tree <- data.frame( plot = plotNames[ plot], year = yearNames[ year], tree = tree )
  tree$plot <- as.character( tree$plot )
  tree$tree <- as.character( tree$tree )
  tree <- tree[ order( tree$plot, tree$tree, tree$year ), ]
  
  tree$treeID  <- columnPaste( tree$plot, tree$tree )
  
  id           <- unique( as.character( tree$treeID ) )
  species      <- sample( specNames, length( id ), replace = TRUE ) 
  tree$species <- factor( species[ match( tree$treeID, id )], levels = specNames )
  
  tree$dcol <- match( as.character( tree$treeID ), id )
  
  tree$plotYr <- columnPaste( tree$plot, tree$year, '_' )
  plotyr      <- unique( tree$plotYr )
  tree$plotyr <- match( tree$plotYr, plotyr )
  
  years <- sort( unique( tree$year ) )
  
  trap <- data.frame( plot = plotNames[ plsd], year = yearNames[ yrsd], trap )
  trap$plot <- as.character( trap$plot )
  trap$trap <- as.character( trap$trap )
  trap <- trap[ order( trap$plot, trap$trap, trap$year ), ]
  
  trap$trapID  <- columnPaste( trap$plot, trap$trap )
  trapid       <- as.character( trap$trapID )
  drow         <- unique( trapid )
  trap$drow    <- match( trapid, drow )

  trap$plotYr <- columnPaste( trap$plot, trap$year, '_' )
  plotyr      <- unique( trap$plotYr )
  trap$plotyr <- match( trap$plotYr, plotyr )
  
  n <- nrow( tree )
  
  xfec <- round( matrix( .tnorm( n*( Q-1 ), 5, 50, 35, 5 ), n, ( Q-1 ) ), 3 )
  xnames <- paste( 'x', 1:( Q-1 ), sep = '' )
  xnames[ 1] <- 'diam'
  colnames( xfec ) <-  xnames
 
  xdata   <- data.frame( species = tree$species, xfec )
  
  formulaFec <- formula( ~ diam )
  formulaRep <- formula( ~ diam )
  
  if( SPECS ){
    formulaFec <- formula( ~ species*diam  ) 
    formulaRep <- formula( ~ species*diam )
  }
  xfec    <- model.matrix( formulaFec, xdata )
  Qf      <- ncol( xfec )
  xrep    <- model.matrix( formulaRep, xdata )
  Qr      <- ncol( xrep )
  
  if( !SPECS ){
    ss     <- paste( 'species', specNames, sep = '' )
    xnames <- paste( ss, colnames( xfec ), sep = ':' )
    xnames[ 1] <- .replaceString( xnames[ 1], ':( Intercept )', '' )
    colnames( xfec ) <- xnames
  }
    
  xytree <- xytrap <- distall <- numeric( 0 )
  
  for( j in 1:nplot ){
    
    xy1 <- matrix( runif( 2*ntreePlot[ j], 0, plotWide ), ntreePlot[ j], 2 )  
    xy2 <- matrix( runif( 2*ntrapPlot[ j], 0, plotWide ), ntrapPlot[ j], 2 )
    xy1 <- round( xy1, 1 )
    xy2 <- round( xy2, 1 )
    
    rownames( xy1 ) <- columnPaste( rep( plotNames[ j], ntreePlot[ j] ), 
                                 c( 1:ntreePlot[ j] ), '-' )
    rownames( xy2 ) <- columnPaste( rep( plotNames[ j], ntrapPlot[ j] ), 
                                 c( 1:ntrapPlot[ j] ), '-' )
    xytree  <- rbind( xytree, xy1 )
    xytrap  <- rbind( xytrap, xy2 )
  }
  
  xdata <- xdata[, !colnames( xdata ) %in% colnames( tree ), drop = FALSE]
  
  treeData <- cbind( tree, xdata )
  count    <- matrix( 0, nrow( trap ), length( seedNames ) )
  colnames( count ) <- seedNames
  seedData <- data.frame( trap, count )
  
  colnames( xytree ) <- colnames( xytrap ) <- c( 'x', 'y' )
  xy <- columnSplit( rownames( xytree ), '-' )
  colnames( xy ) <- c( 'plot', 'tree' )
  xytree <- data.frame( xy, xytree )
  xytree$tree <- as.character( xytree$tree )
  wws <- match( rownames( xytree ), 
               as.character( treeData$treeID ) )
  xytree$species <- as.character( treeData$species[ wws] )
  
  xy <- columnSplit( rownames( xytrap ), '-' )
  colnames( xy ) <- c( 'plot', 'trap' )
  xytrap <- data.frame( xy, xytrap )
  xytrap$trap <- as.character( xytrap$trap )
  
  xytree$treeID <- rownames( xytree )
  xytrap$trapID <- rownames( xytrap )
  
  seedData$active <- 1
  seedData$area   <- 1
  
  ntree    <- nrow( xytree )
  nyr      <- max( nyrPlot )
  dmat     <- matrix( runif( ntree*nyr, .2, .5 ), ntree, nyr )
  
  dmat[, 1] <- .tnorm( ntree, 1, 70, 35, 40 ) 
  small    <- sample( ntree, round( ntree/3 ) )
  dmat[ small, 1] <- .tnorm( length( small ), 1, 40, 7, 20 )
  if( nyr > 1 )dmat <- round( t( apply( dmat, 1, cumsum ) ), 2 )
  
  
  tyindex  <- cbind( treeData$dcol, match( treeData$year, years ) )
  treeData$diam <- dmat[ tyindex]
  
  treeData$obs <- 1
  seedData$obs <- 1
  
  plotTreeYr <- columnPaste( as.character( treeData$treeID ), 
                            as.character( tree$year ), '_' )
  rownames( treeData ) <- plotTreeYr
  rownames( seedData ) <- columnPaste( seedData$trapID, 
                                    as.character( seedData$year ), '_' )
  
  tmp <- .setupData( formulaFec, formulaRep, 
                    tdata = treeData, sdata = seedData, 
                    xytree, xytrap, specNames, seedNames, AR = FALSE, YR = FALSE, 
                    yearEffect, minDiam, maxDiam, TREESONLY = FALSE, 
                    maxFec, CONES = FALSE, 
                    notFit = NULL, priorTable = priorTable, 
                    CHECKNOSEED = FALSE, 
    #                group = NULL, 
                    seedTraits = NULL, verbose = FALSE )
  treeData  <- tmp$tdata
  seedData  <- tmp$sdata
  distall   <- tmp$distall
  zmat      <- tmp$zmat
  zknown    <- tmp$zknown
  xytree    <- tmp$xytree
  xytrap    <- tmp$xytrap
  plotNames <- tmp$plotNames
  plots     <- tmp$plots
  years     <- tmp$years
  xfec      <- tmp$xfec
  xrep      <- tmp$xrep
  nseed     <- nrow( seedData )
  scode     <- tmp$scode
  nplot     <- length( plotNames )
  n         <- nrow( xfec )
  ntobs     <- table( treeData$plot ) 
  nsobs     <- table( seedData$plot )
  ttab      <- table( treeData$plot, treeData$year )
  wtab      <- which( ttab > 0, arr.ind = TRUE ) 
  xfecMiss <- tmp$xfecMiss
  xrepMiss <- tmp$xrepMiss
  xfecCols <- tmp$xfecCols
  xrepCols <- tmp$xrepCols
  ntree    <- nrow( xytree )
  ntrap    <- nrow( xytrap )
  xfecU    <- tmp$xfecU; xfecT <- tmp$xfecT
  xrepU    <- tmp$xrepU; xrepT <- tmp$xrepT
  xfecs2u  <- tmp$xfecs2u
  xfecu2s  <- tmp$xfecu2s
  xreps2u  <- tmp$xreps2u
  xrepu2s  <- tmp$xrepu2s
  nspec    <- length( specNames )
  matYr    <- tmp$matYr
  last0first1 <- tmp$last0first1
  
  tyindex  <- cbind( as.character( treeData$treeID ), as.character( treeData$year ) )
  
  zknownVec <- zknown[ tyindex]
  z <- zmat[ tyindex]
  
  
  dmin <- dmax <- numeric( 0 )
  for( k in 1:nspec ){
    wk <- which( treeData$species == specNames[ k] )
    wm <- which.min( ( treeData$diam[ wk] - minDiam )^2 )
    wf <- xfec[ wk[ wm], ]
    dmin <- c( dmin, wf[ !wf %in% c( 0, 1 )][ 1] )
    
    wm <- which.min( ( treeData$diam[ wk] - maxDiam )^2 )
    wf <- xfec[ wk[ wm], ]
    dmax <- c( dmax, wf[ !wf %in% c( 0, 1 )][ 1] )
  }
  
  
  
   dcols <- grep( 'diam', colnames( xfec ) )
   dd    <- rowSums( xfec[, dcols, drop = FALSE] )
   
   wcol  <- grep( 'diam', colnames( xfec ) ) 
   slope <- log( maxFec )/( max( xfec[, wcol] ) - min( xfec[, wcol] ) )
   slope <- .tnorm( nspec, 1, 2, 1.5, 1 ) + slope
   int   <- -slope*dmin + .tnorm( nspec, 3, 7, 5, 1 )
   betaFec <- matrix( c( int, slope ), ncol = 1 )  # 2, 4
   rownames( betaFec ) <- colnames( xfec )
   
   fec <- xfec%*%betaFec
   
   ######################## propose z 
   tmp <- .propZ( zmat, last0first1, matYr )
   zmat  <- tmp$zmat
   matYr <- tmp$matYr
   z <- zmat[ tyindex]

   
   species <- as.factor( treeData$species )
   
   form <- formula( z ~ treeData$diam ) 
   if( nspec > 1 ) form <- formula( z ~ species*treeData$diam )
   
   br <- suppressWarnings( 
     glm( form, family = binomial( "probit" ) )$coefficients
   )
   
  names( br ) <- .replaceString( names( br ), 'treeData$', '' )
  names( br ) <- .replaceString( names( br ), 'species', '' )
  slopes <- grep( 'diam', names( br ) )
  ints   <- which( !c( 1:length( br ) ) %in% slopes )
  
  rspec <- specNames[ which( !specNames %in% names( br ) )]
  
  ints <- br[ ints]
  ints[ -1] <- ints[ -1] + br[ '( Intercept )']
  names( ints )[ 1] <- rspec
  slopes <- br[ slopes]
  slopes[ -1] <- slopes[ -1] + br[ 'diam']
  names( slopes )[ 1] <- paste( rspec, ':diam', sep = '' )
  ints <- ints[ sort( names( ints ) )]
  slopes <- slopes[ sort( names( slopes ) )]
  btmp <- matrix( c( ints, slopes ), ncol = 1 )                # unstandardized diam
  rownames( btmp ) <- c( names( ints ), names( slopes ) )
  
  betaRep <- xrepu2s%*%btmp                            # standardized diam
  
  ztrue <- z
  q <- which( ztrue == 1 )
  
  hi  <- 0*fec + log( maxFec )
  lo <- -hi/3
  hi[ z == 0] <- 0
  lo[ z == 1] <- 0
  
  for( j in 1:10 ){
    fec <- .tnorm( nrow( xfec ), lo, hi, xfec%*%betaFec, .01 )
    betaFec <- solve( crossprod( xfec ) )%*%crossprod( xfec, fec )
  }
  
 
  zmat[ sample( n, n/20 )] <- NA
  
  treeData$repr <- zmat[ tyindex]

  seedData$active <- seedData$area <- 1
  
  fec <- exp( fec )
  
  #unstandardized diam
  bfecSave <- xfecs2u%*%betaFec      
  brepSave <- xreps2u%*%betaRep

  # R matrix
  
  fill <- 0
  if( length( seedNames ) == 1 )fill <- 1
  
  R <- matrix( fill, length( plots )*nspec, length( seedNames ) )
  colnames( R ) <- seedNames
  rr <- as.vector( outer( specNames, plots, paste, sep = '-' ) )
  rownames( R ) <- rr
    
  wun <- grep( 'UNKN', seedNames )
  if( length( wun ) > 0 ){
    kk <- c( 1:length( seedNames ) )[ -wun]
    for( k in kk ){
      wsp <- grep( seedNames[ k], rownames( R ) )
      R[ wsp, seedNames[ k]] <- 1
    }
    R[, wun] <- 2
    R <- sweep( R, 1, rowSums( R ), '/' )
  }else{
    sr <- columnSplit( rr, '-' )[, 1]
    ir <- match( sr, seedNames )
    R[ cbind( 1:length( rr ), ir )] <- 1
  }
  tmp <- columnSplit( rownames( R ), '-' )
  attr( R, 'species' ) <- tmp[, 1]
  attr( R, 'plot' )    <- tmp[, 2]
  
  treeData$specPlot <- columnPaste( treeData$species, treeData$plot )
  
  obsRows <- which( treeData$fit == 1 )
  
  
  lambda <- .getLambda( tdat1 = treeData[ obsRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                       sdat1 = seedData[, c( 'year', 'plotyr', 'drow' )], 
                       AA = seedData$area, ug = upar, 
                       ff = fec[ obsRows]*z[ obsRows], R, 
                       SAMPR, USPEC, 
                       distance = distall, yrs = years, PERAREA = FALSE ) 
  rownames( lambda ) <- rownames( seedData )
  lambda <- lambda + 1e-12
  ss     <- matrix( rpois( length( lambda ), lambda ), nrow( lambda ), ncol( lambda ) )
  seedData[, seedNames] <-   ss
  seedData$active <- 1
  seedData$area   <- 1
  
  seedData$active <- 1
  seedData$area   <- 1
  
  stab <- with( seedData, table( plot, year ) )
  ttab <- with( treeData, table( plot, year ) )
  sc   <- colSums( stab )
  stab <- stab[, sc > 0, drop = FALSE]
  ttab <- ttab[, sc > 0, drop = FALSE]
  
  form <- as.character( formulaFec )
  form <- .replaceString( form, 'species *', '' )
  formulaFec <- as.formula( paste( form, collapse = ' ' ) )
  
  form <- as.character( formulaRep )
  form <- .replaceString( form, 'species *', '' )
  formulaRep <- as.formula( paste( form, collapse = ' ' ) )
  
  names( fec ) <- names( ztrue ) <- rownames( xfec )
  
  trueValues <- list( fec = fec, repr = ztrue, betaFecStnd = betaFec, 
                     betaRepStnd = betaRep, betaFec = bfecSave, 
                     betaRep = brepSave, upar = upar, R = R )
  
  rownames( treeData ) <- columnPaste( treeData$treeID, treeData$year, '_' )
  rownames( seedData ) <- columnPaste( seedData$trapID, seedData$year, '_' )
  
  treeData <- treeData[, c( 'plot', 'tree', 'year', 'species', 'diam', 'repr', 'repMu' )]
  seedData <- seedData[, c( 'plot', 'trap', 'year', 'area', 'active', seedNames )]
  xytree   <- xytree[, c( 'plot', 'tree', 'x', 'y' )]
  xytrap   <- xytrap[, c( 'plot', 'trap', 'x', 'y' )]
  
  
  out <- list( trueValues = trueValues, treeData = treeData, seedData = seedData, 
       distall = distall, xytree = xytree, xytrap = xytrap, formulaFec = formulaFec, 
       formulaRep = formulaRep, plots = plots, years = years, 
       sim = sim, seedNames = seedNames, specNames = specNames, R = R )
  orr <- order( names( out ) )
  out <- out[ orr]
  out
}
      
.seedFormat <- function( sfile, lfile, trapFile = NULL, seedNames = NULL, 
                        specNames, genusName = NULL, omitNames = NULL, plot, 
                        newplot = plot, trapID = 'trap', monthYr = 7, active = 1, 
                        area = .5, verbose = FALSE ) {
  
  # always include specNames due to ambiguous substr( genusName, 1, 4 )
  
  if( is.null( newplot ) )newplot <- plot
  
  scols      <- c( 'site', 'plot', 'trap', 'trapID', 'trapnum', 'X', 'Y', 
                  'month', 'day', 'year', 
                  'UTMx', 'UTMy' )
  
  hcols <- c( 'plot', 'trap', 'basket', 'month', 'day', 'year', 
             'site', 'trapID', 'trapNum', 'trapName', 'X', 'Y', 'UTMx', 'UTMy' )
  
  midCD <- c( 273890.6, 3938623.3 )  #plot center for ( x, y ) at GSNP_CD
  
  loc  <- read.csv( lfile, stringsAsFactors = F )
  
  loc  <- loc[ loc$plot == plot, ]
    xy <- loc[, c( 'UTMx', 'UTMy' )]
    xy <- round( sweep( xy, 2, colMeans( xy ), '-' ), 1 )
    loc$x <- xy[, 1]
    loc$y <- xy[, 2]
 
  ww <- which( is.finite( loc[, 'UTMx'] ) & is.finite( loc[, 'UTMy'] ) )
  
  if( length( ww ) == 0 ){
    if( verbose ){
      cat( '\nplot without seed trap locations:' )
      print( lfile )
    }
    return( numeric( 0 ) )
  }
  
  loc  <- loc[ ww, ]
  pcol <- rep( plot, nrow( loc ) )
  id   <- apply( cbind( plot, loc[, trapID] ), 1, paste0, collapse = '-' )
  loc  <- data.frame( trapID = id, trap = loc[, trapID], 
                     loc[, !colnames( loc ) == trapID] )
  loc$plot <- pcol

  if( plot == "GSNP_CD" | plot == "GRSM_CD" ){
    loc$x <- loc$UTMx - midCD[ 1]
    loc$y <- loc$UTMy - midCD[ 2]
  }
  
  counts <- read.csv( sfile, stringsAsFactors = F )
  counts <- counts[ counts$plot == plot, ]
  
  if( 'area' %in% colnames( counts ) )area <- counts$area[ 1]
    
  
  counts[ is.na( counts$month ), 'month'] <- 3
  counts[ counts[, 'month'] < monthYr, 'year'] <- 
    counts[ counts[, 'month'] < monthYr, 'year'] - 1
  
  #all NA
  
  mcols <- c( hcols, 'Notes', 'notes' )
  dmat <- as.matrix( counts[, !colnames( counts ) %in% mcols] )
  dmat[ is.finite( dmat )] <- 1
  miss <- which( rowSums( dmat, na.rm = TRUE ) == 0 )
  
  gee <- gregexpr( "[ A-Z]", specNames[ 1] )[[ 1]][ 1] - 1
  
  specNames <- c( specNames, paste( substr( specNames[ 1], 1, gee ), 'UNKN', sep = '' ) )  
  seedNames <- sort( unique( c( seedNames, specNames ) ) )
  
  
  sj <- numeric( 0 )
  for( k in 1:length( specNames ) ){
    sj <- cbind( sj, as.matrix( counts[, grep( specNames[ k], 
                                             colnames( counts ) ), drop = FALSE] ) )
  }
  seedNames <- colnames( sj )
  # }
  
  if( !is.null( omitNames ) ){
    sj <- sj[, !colnames( sj ) %in% omitNames, drop = FALSE]
    seedNames <- colnames( sj )
  }
  
  if( length( sj ) == 0 ){
    sj <- matrix( 0, nrow( counts ), 1 )
    seedNames <- colnames( sj ) <- paste( substr( genusName, 1, 4 ) , 'UNKN', sep = '' )
  }
  
  
  yr <- sort( unique( counts[, 'year'] ) )
  tn <- sort( unique( counts[, trapID] ) )
  jj <- match( counts[, 'year'], yr )
  ii <- match( counts[, trapID], tn )
  smat <- matrix( 0, length( tn ), length( yr ) )
  rownames( smat ) <- tn
  colnames( smat ) <- yr
  
  seedj <- numeric( 0 )
  
  for( k in 1:ncol( sj ) ){
    
    smat <- tmat <- smat*0
    
    ck <- sj[, k]
    
    # seed counts
    
    wk <- which( is.finite( ck ) )
    ck <- ck[ wk]
    ik <- tn[ ii[ wk]]
    jk <- jj[ wk]
    ky <- tapply( ck, list( trap = ik, year = jk ), sum, na.rm = TRUE )
    colnames( ky ) <- yr[ as.numeric( colnames( ky ) )]
    smat[ rownames( ky ), colnames( ky )] <- ky
    ky <- smat
    
    # missing values
    ck <- nk <- sj[, k]*0+1
    wk <- which( is.na( ck ) )
    ck[ wk] <- 0
    nk[ wk] <- 1
    ik <- tn[ ii]
    jk <- jj
    ny <- tapply( ck, list( ik, jk ), sum, na.rm = TRUE ) #active intervals
    my <- tapply( nk, list( ik, jk ), sum, na.rm = TRUE ) #total intervals
    colnames( ny ) <-  colnames( my ) <- yr[ as.numeric( colnames( ny ) )]
    smat[ rownames( ny ), colnames( ny )] <- ny
    tmat[ rownames( my ), colnames( my )] <- my
    
    ny <- smat
    my <- tmat
    
    colnames( ny ) <- yr
    rownames( ny ) <- tn
    
    seedj <- cbind( seedj, as.vector( ky ) )
    
    if( k == 1 ){
      active <- round( ny/my, 2 )
      active[ !is.finite( active )] <- 0
    }
  }
  
  colnames( seedj ) <- colnames( sj )
  seed <- matrix( 0, nrow( seedj ), length( seedNames ) )
  colnames( seed ) <- seedNames
  
  active <- as.vector( active )
  
  
  if( !is.null( trapFile ) ){
    taa <- read.table( trapFile, header = TRUE )[, c( 'plot', 'seedArea' )]
    area <- taa[ taa$plot == plot, 'seedArea']
    if( length( area ) == 0 ){
      site <- columnSplit( plot, '_' )[ 1]
      area <- taa[ grep( site, taa$plot ), 'seedArea']
    }
  }
 
  area <- area[ 1]
  
  seed[, colnames( seedj )] <- seedj
  
  year <- rep( yr, each = length( tn ) )
  trap <- rep( tn, length( yr ) )
  tr <- apply( cbind( plot, trap ), 1, paste0, collapse = '-' )
  
  sd   <- data.frame( plot, trapID = tr, trap = trap, 
                      year = year, active = active, area = area, stringsAsFactors = F ) 
  seed <- cbind( sd, seed )
  rownames( seed ) <- 
    apply( cbind( plot, trap, year ), 1, paste0, collapse = '-' )
  
  seed <- seed[ seed$trapID %in% loc$trapID, ]
  
  if( 'x' %in% colnames( loc ) & 'UTMx' %in% colnames( loc ) ){
    loc$x <- loc$UTMx
    loc$y <- loc$UTMy
  }
  
  seed$trap <- as.character( seed$trap )
  loc$trap  <- as.character( loc$trap )
  
  list( counts = seed, xy = loc[, c( 'plot', 'trap', 'x', 'y' )], active = active, 
       seedNames = seedNames )
}

multiStemBA <- function( diam ){
  
  # effective diameter for BA matching diam for multiple stems
  # can be a single vector for one tree or a matrix, with each row being a different tree
  
  if( is.data.frame( diam ) ){
    diam <- as.matrix( diam )
  }
  if( is.matrix( diam ) ){
    return( round( sqrt( apply( diam^2, 1, sum, na.rm = T ) ), 1 ) )
  }
  
  round( sqrt( sum( diam^2, na.rm = T ) ), 1 )
}


.fac2num <- function( xx ){ 
  
  dims <- dn <- NULL
  
  if( !is.null( ncol( xx ) ) ){
    dims <- dim( xx )
    dn   <- dimnames( xx )
  }
  xx <- if( is.list( xx ) )unlist( xx )
  xx <- as.numeric( as.character( xx ) ) 
  if( !is.null( dims ) )xx <- matrix( xx, dims[ 1], dims[ 2], 
                                 dimnames = dn )
  xx
}

.replaceString <- function( xx, now = '_', new = ' ' ){  #replace now string in vector with new
  
  if( !is.character( xx ) )xx <- as.character( xx )
  
  ww <- grep( now[ 1], xx, fixed = TRUE )
  if( length( ww ) == 0 )return( xx )
  
  if( length( new ) == 1 ){
    for( k in ww ){
      s  <- unlist( strsplit( xx[ k], now, fixed = TRUE ) )
      ss <- s[ 1]
      if( length( s ) == 1 )ss <- paste( ss, new, sep = '' )
      if( length( s ) > 1 )for( kk in 2:length( s ) ) ss <- paste( ss, s[ kk], sep = new )
      xx[ k] <- ss
    }
  }else{
    # new is a vector
    s  <- unlist( strsplit( xx, now, fixed = TRUE ) )
    nx <- length( xx )
    nc <- length( s )/length( xx )

    ss <- matrix( s, ncol = nc, byrow = TRUE )
    nl <- nchar( ss[ 1, ] )
    
    if( nl[ 1] == 0 )ss <- paste( new, ss[, 2], sep = '' )
    if( nl[ 2] == 0 )ss <- paste( ss[, 1], new, sep = '' )
      
    xx <- ss
  }
  xx
}

.Iformat2Var <- function( iname ){
  
  tt <- .replaceString( iname, 'I( ', '' )
  tt <- .replaceString( tt, 'log( ', '' )
  tt <- .replaceString( tt, 'sqrt( ', '' )
  tt <- .replaceString( tt, '^2', '' )
  tt <- .replaceString( tt, ' )', '' )
  tt <- .replaceString( tt, ' ', '' )
  tt
}

.get.model.frame <- function( formula, data ){
  
  tmp <- model.frame( formula, data, na.action = NULL )
  
  wchar <- which( sapply( tmp, is.character ) )
  
  if( length( wchar ) == 0 )return( tmp )
  
  for( k in 1:length( wchar ) ){
    data[, wchar[ k]] <- as.character( data[, wchar[ k]] )
  }
  model.frame( formula, data, na.action = NULL )
}
  
.getDesign <- function( formula, data, verbose = FALSE ){
  
  # one set of columns for each tree species, retain NAs
  
  specNames <- sort( unique( as.character( data$species ) ) )
  nspec     <- length( specNames )
  
  f1 <- paste0( as.character( formula ), collapse = '' )
  
  if( f1 == '~1' & nspec == 1 ){
    x  <-  matrix( 1, nrow( data ), 1 )
    colnames( x ) <- "(Intercept)"
    return( list( x = x, missx = integer( 0 ), specCols = numeric( 0 ) ) )
  }
  
  data$species <- factor( data$species )
  
  attr( data$species, 'contrasts' ) <- contrasts( data$species, contrasts = FALSE )
  
  tmp1 <- .get.model.frame( formula, data )
  tn1  <- attr( terms( tmp1 ), 'dataClasses' )
  rm( tmp1 )
  sp1  <- names( tn1 )[ tn1 == 'numeric' | tn1 == 'nmatrix.1']
  sp1  <- .Iformat2Var( sp1 )
  sp1  <- unique( sp1 )
  sp1 <- sp1[ sp1 %in% colnames(data) ]
  
  miss <- which( is.na( data[, sp1, drop = F] ), arr.ind = TRUE )
  
  if( length( miss ) > 0 ){
    xmean <- colMeans( data[, sp1, drop = F], na.rm = TRUE )
    data[, sp1][ miss] <- 1e+10
    if( verbose )cat( '\nNote: missing values in xfec filled with mean values\n' )
  }
  
  x  <- .get.model.frame( formula, data )
  x  <- model.matrix( formula, x )
  
#  colnames( x )[ colnames(x) == '(Intercept)' ] <- 'intercept'
  
  if( nspec > 1 ){
    ws <- grep( 'species', colnames( x ) )
    x  <- x[, ws]
  }
  missx <- which( x > 1e+9, arr.ind = TRUE )
  
  if( length( missx ) > 0 ){
    data[, sp1][ miss] <- xmean[ miss[, 2]]
    
    mux <- apply( x, 2, mean, na.rm = TRUE )
    x[ missx] <- mux[ missx[, 2]]
  }
  x  <- .get.model.frame( formula, data )
  x  <- model.matrix( formula, x )
  if( nspec > 1 ){
    ws <- grep( 'species', colnames( x ) )
    x  <- x[, ws]
  }
  rm( data )
  
  specCols  <- numeric( 0 )
  if( nspec > 1 ){
    for( j in 1:length( specNames ) ){
      specCols <- rbind( specCols, grep( paste( 'species', specNames[ j], sep = '' ), 
                                        colnames( x ) ) )
    }
    rownames( specCols ) <- specNames
  }
  
  
  list( x = x, missx = missx, specCols = specCols )
}

columnSplit <- function( vec, sep = '_', ASFACTOR = F, ASNUMERIC = FALSE, 
                        LASTONLY = FALSE ){
  
  vec <- as.character( vec )
  nc  <- length( strsplit( vec[ 1], sep, fixed = TRUE )[[ 1]] )
  
  mat <- matrix( unlist( strsplit( vec, sep, fixed = TRUE ) ), ncol = nc, byrow = TRUE )
  if( LASTONLY & ncol( mat ) > 2 ){
    rnn <- mat[, 1]
    for( k in 2:( ncol( mat )-1 ) ){
      rnn <- columnPaste( rnn, mat[, k] )
    }
    mat <- cbind( rnn, mat[, ncol( mat )] )
  }
  if( ASNUMERIC ){
    mat <- matrix( as.numeric( mat ), ncol = nc )
  }
  if( ASFACTOR ){
    mat <- data.frame( mat )
  }
  if( LASTONLY )mat <- mat[, 2]
  mat
}

columnPaste <- function( c1, c2, sep = '-', NOSPACE = FALSE ){
  
  c1    <- as.character( c1 )
  c2    <- as.character( c2 )
  if( NOSPACE ){
    c1   <- .replaceString( c1, ' ', '' )
    c2   <- .replaceString( c2, ' ', '' )
  }
  c12   <- apply( cbind( c1, c2 ) , 1, paste0, collapse = sep )

  c12
}

specPriorVector <- function( pVar, tdata ){
  
  if( length( pVar ) > 1 ){
    pVar <- pVar[ tdata$species]
  }else{
    pVar <- rep( pVar, nrow( tdata ) )
  }
  pVar
}

setupDistMat <- function( tdata1, sdata1, xytree1, xytrap1, verbose ){
  
  # set up distall
  # sdata$drow are rows in distall
  # 
  
  distall <- numeric( 0 )
  
  pord <- sort( tdata1$plot )
  pord <- pord[ !duplicated( pord )]
  
  treeIDs <- unique( as.character( tdata1$treeID ) )  # do not sort

  plotRm <- plotKp <- character( 0 )
  distTreeID <- numeric( 0 )
  tdata1$dcol <- sdata1$drow <- NA
  
  for( j in 1:length( pord ) ){
    
    tj <- which( xytree1$plot == pord[ j] & xytree1$fit == 1 )
    
    if( length( tj ) == 0 ){
      plotRm <- c( plotRm, pord[ j] )
      next
    }
  }
  
  if( length( plotRm ) > 0 ){
    
    kk <- which( !sdata1$plot %in% plotRm )
    sdata1 <- sdata1[ kk, ]
    kk <- which( !xytrap1$plot %in% plotRm )
    xytrap1 <- xytrap1[ kk, ]
    
    pm <- unique( substr( plotRm, 1, 8 ) )
    
    kp <- paste0( pm, collapse = ', ' )
    kwords <- paste( ' Trees absent from xytree in', kp )
    if( verbose )cat( paste( '\nNote: ', kwords, '\n' ) )
  }
  
  trapIDs <- unique( as.character( sdata1$trapID ) )
  pord <- sort( sdata1$plot )
  pord <- pord[ !duplicated( pord )]
  
  for( j in 1:length( pord ) ){
    
    tj <- which( xytree1$plot == pord[ j] & xytree1$fit == 1 )
    sj <- which( xytrap1$plot == pord[ j] )
    
    if( length( tj ) == 0 ){
      plotRm <- c( plotRm, pord[ j] )
      next
    }
    if( length( sj ) == 0 )stop( paste( 'plot', pord[ j] , 'has no traps in xytrap' ) )
    
    xy1     <- xytree1[ tj, ]
    xy2     <- xytrap1[ sj, ]
    
    species <- as.character( xytree1$species[ tj] )
    da      <- .distmat( xy1[, 'x'], xy1[, 'y'], xy2[, 'x'], xy2[, 'y'] ) 
    da      <- round( da, 1 )
    sa      <- matrix( species, nrow( da ), ncol( da ), byrow = T )
    rownames( da ) <- xy2$trapID
    
    distTreeID <- append( distTreeID, list( xy1$treeID ) )
    plotKp     <- c( plotKp, pord[ j] )
    
    jj <- match( tdata1$treeID, xy1$treeID )
    wf <- which( is.finite( jj ) )
    tdata1$dcol[ wf] <- jj[ wf]
    
    if( length( distall ) == 0 ){
      distall <- da
      specall <- sa
      
    }else{
      if( ncol( da ) > ncol( distall ) ){
        nnc     <- ncol( da ) - ncol( distall )
        newCols <- matrix( NA, nrow( distall ), nnc )
        distall <- cbind( distall, newCols )
        newCols <- matrix( species[ 1], nrow( distall ), nnc )
        specall <- cbind( specall, newCols )
      }
      if( ncol( distall ) > ncol( da ) ){
        nnc     <- ncol( distall ) - ncol( da )
        newCols <- matrix( NA, nrow( da ), nnc )
        da <- cbind( da, newCols )
        newCols <- matrix( species[ 1], nrow( da ), nnc )
        sa <- cbind( sa, newCols )
      }
      distall <- rbind( distall, da )
      specall <- rbind( specall, sa )
    }
  }
  rownames( specall ) <- rownames( distall )
  names( distTreeID ) <- plotKp
  
  sdata1$drow <- match( sdata1$trapID, rownames( distall ) )
  
  trapid  <- rownames( distall )
  attr( distall, 'species' ) <- specall
  
  list( tdata = tdata1, sdata = sdata1, distall = distall, distTreeID = distTreeID )
}


kernYrR <- function( dmat, fec, seedrow, treecol, plotyrs, 
                    treeplotYr, seedplotYr ){
  
  # kernYrRcpp in R
  
  ny <- length( plotyrs )
  nf <- ncol( fec )
  lambda <- matrix( 0, ny, nf )
  
  for( j in 1:ny ){
    
    ws <- which( seedplotYr == plotyrs[ j] )
    wt <- which( treeplotYr == plotyrs[ j] )
    ds <- seedrow[ ws]
    dt <- treecol[ wt]
    
    lambda[ ws, ] <- dmat[ ds, dt]%*%fec[ wt, ]
  }
  lambda
}

trimData <- function( treeData, xytree, seedData = NULL, xytrap = NULL, 
                     formulaFec = NULL, formulaRep = NULL, 
                     specNames = NULL, seedNames = NULL ){
  
  # when treeData is trimmed, clean other data.frames
  
  if( is.null( specNames ) )specNames <- sort( unique( treeData$species ) )
  
  nspec <- length( specNames )
  
  xid      <- columnPaste( xytree$plot, xytree$tree )
  tid      <- columnPaste( treeData$plot, treeData$tree )
  
  if( !is.null( seedData ) ){
    xytree   <- xytree[ xid %in% tid, ]
    seedData <- seedData[ seedData$plot %in% treeData$plot, ] 
    xytrap   <- xytrap[ xytrap$plot %in% treeData$plot, ]
    if( nrow( seedData ) == 0 )seedData <- xytrap <- NULL
    
    if( nrow( xytree ) == 0 ){
      xytree <- NULL
    }else{
      mm <- match( tid, xid )        # add locations to treeData
      treeData$x <- xytree$x[ mm]
      treeData$y <- xytree$y[ mm]
      xid      <- columnPaste( xytree$plot, xytree$tree )
      tid      <- columnPaste( treeData$plot, treeData$tree )
      xytree   <- xytree[ xid %in% tid, ]
    }
  }
  if( !is.null( seedNames ) )seedNames <- seedNames[ seedNames %in% colnames( seedData )]
  nold  <- nspec
  nspec <- length( specNames )
  
  if( nspec == 1 ){
    ff <- as.character( formulaFec )
  
    if( length( grep( 'species', ff[ 2] ) ) > 0 ){
      ff <- .replaceString( ff, 'species * ', '' )
      formulaFec <- as.formula( paste0( ff[ 1], ff[ 2], collapse = '' ) )
      ff <- as.character( formulaRep )
      ff <- .replaceString( ff, 'species * ', '' )
      formulaRep <- as.formula( paste0( ff[ 1], ff[ 2], collapse = '' ) )
    }
  }
  specNames <- sort( unique( treeData$species ) )
  
  list( treeData = treeData, xytree = xytree, seedData = seedData, xytrap = xytrap, 
       formulaFec = formulaFec, formulaRep = formulaRep, 
       specNames = specNames, seedNames = seedNames )
}


checkPlotName <- function( pdata ){
  
  ss <- pdata[, 'plot']
  nt <- sapply( ( gregexpr( "_", ss, fixed = TRUE ) ), function( i ) sum( i > 0 ) )
  
 # nt <- stringr::str_count( pdata[, 'plot'], "_" )
  w0 <- which( nt != 1 )
  if( length( w0 ) > 0 ){
    print( "plot names without one and only one '_'" )
    stop( pdata[ w0, 'plot'] )
  }
}


treeSeedPlots <- function( tdata, sdata, xytree, xytrap, priorTable, 
                           seedNames = NULL, minTrees = 5, minYears = 2, 
                           formulaFec = NULL, formulaRep = NULL, 
                           skipSpec = character( 0 ), omitNames = character( 0 ), 
                           combineSeeds = NULL, combineSpecs = NULL, 
                           cropCountCols = c( 'fecMin', 'fecMax', 'cropCount' ), 
                           CHECKNOSEED = TRUE, 
                           verbose = FALSE ){
  # criteria: - at least minTrees ( over all plots ), CC or ST
  #           - at least minYears ( over all plots )
  #           - non-zero cropCount or seed count somewhere
  #           - ST counts only where tree species is present
  #           - specNames get credit for UNKN seeds in same plot
  
  scols <- c( "plot", "trap", "year", "area", "active", "drow", 
             "trapID", "plotYr", "plotyr", "obs", "times" )
  SEEDDATA <- FALSE
  
#  specNames <- specNames[ specNames %in% tdata$species]
  
  tdata$plot <- .fixNames( tdata$plot, all = TRUE, MODE = 'character' )$fixed
  priorTable <- as.data.frame( priorTable )
  
  tmp <- combineSpecies( tdata$species, specNames, combineSpecs )
  tdata$species <- tmp$species
  specNames     <- tmp$specNames
  nspec <- length( specNames )
  
  
  plotBySpec <- table( tdata$plot, tdata$species )
  yearBySpec <- table( tdata$year, tdata$species )
  
  pbs <- ybs <- numeric( 0 )   # CC
  
  gcols <- which( cropCountCols %in% colnames( tdata ) )
  
  if( length( gcols ) > 0 ) {
    tvec <- rowSums( tdata[, cropCountCols[ gcols], drop = F], na.rm = T )
    tvec[ tvec == Inf] <- 9999
    pbs  <- tapply( tvec, 
                   list( tdata$plot, tdata$species ), sum, na.rm = T )
    ybs <- tapply( tvec, 
                   list( tdata$year, tdata$species ), sum, na.rm = T )
    pbs[ is.na( pbs )] <- 0
    ybs[ is.na( ybs )] <- 0
    plotBySpec <- .appendMatrix( plotBySpec, pbs  )
    yearBySpec <- .appendMatrix( yearBySpec, ybs  )
  }
  
  if( !is.null( sdata ) ){
    if( nrow( sdata ) > 1 )SEEDDATA <- T
 
    sdata$plot  <- .fixNames( sdata$plot, all = TRUE, MODE = 'character' )$fixed
    xytree$plot <- .fixNames( xytree$plot, all = TRUE, MODE = 'character' )$fixed
    xytrap$plot <- .fixNames( xytrap$plot, all = TRUE, MODE = 'character' )$fixed
    sdata$trap  <- .fixNames( sdata$trap, all = TRUE, MODE = 'character' )$fixed
    xytrap$trap <- .fixNames( xytrap$trap, all = TRUE, MODE = 'character' )$fixed
    if( is.null( seedNames ) ){
      seedNames <- colnames( sdata )[ !colnames( sdata ) %in% scols]
    }
    if( verbose ){
      cat( '\nmastif thinks these are seed types in seedData:\n' )
      stt <- colnames( sdata )
      stt <- paste0( stt[ !stt %in% scols], collapse = ', ' )
      print( stt )
      cat( '\n' )
    }
    plotBySeed <- buildSeedByPlot( sdata, seedNames, specNames, UNKN2TREE = T, SHORTNAMES = T )  
    yearBySeed <- buildSeedByYear( sdata, seedNames, specNames, UNKN2TREE = T, SHORTNAMES = T )
    yearBySpec <- .appendMatrix( yearBySeed, yearBySpec )
    yearBySpec <- yearBySpec[ drop = F, order( as.numeric( rownames( yearBySpec ) ) ), ]
    
  }
  
  #  sufficient trees on plots
  yearBySpec[ yearBySpec > 0] <- 1
  keepYear   <- colnames( yearBySpec )[ colSums( yearBySpec ) > minYears] # specs with enough years
  plotBySpec <- plotBySpec[ drop = F, , colnames( plotBySpec ) %in% keepYear]
  keepPlot   <- rownames( plotBySpec )[ rowSums( plotBySpec ) > 0]        # CC or ST 
  
  tdata  <- tdata[ tdata$plot %in% keepPlot, ]
  
  if( nrow( tdata ) == 0 ){
    cat( '\nThere are no seeds in trees or traps, abort:\n' )
    return( )
  }

  # enough trees above minimum diameter
  tid   <- columnPaste( tdata$plot, tdata$tree )
  maxd  <- tapply( tdata$diam, tid, max, na.rm = T )
  maxd  <- maxd[ tid]
  
  mm    <- match( tdata$species, rownames( priorTable ) )  
  mind  <- priorTable$minDiam[ mm]
  sites <- columnSplit( tdata$plot, '_' )[, 1]
  
  wi    <- which( !duplicated( tid ) & maxd > mind/2 )
  sbys  <- table( tdata$species[ wi], sites[ wi] )
  stot  <- rowSums( sbys )                           # trees > mind
  
  if( verbose ){
    cat( '\nnumber trees above min diam:\n\n' )
    print( stot )
  }
  
  specNames <- names( stot )[ stot > minTrees]      # minimum large trees
  if( length( specNames ) == 0 ){
    cat( '\nno trees big enough\n\n' )
    return( list( treeData = NULL ) )
  }
  
  tdata <- tdata[ tdata$species %in% specNames, ]
  keepPlot <- unique( tdata$plot )

  wfirst <- unlist( gregexpr( "[ A-Z]", tdata$species[ 1] ) ) # position where specEpith starts
  gen4   <- substr( tdata$species[ 1], 1, wfirst - 1 )
  
  # censored seed types
  
  if( SEEDDATA ){
    
    sdata  <- sdata[ sdata$plot %in% keepPlot, ]
    xytrap <- xytrap[ xytrap$plot %in% keepPlot, ]
    xytree <- xytree[ xytree$plot %in% keepPlot, ]
    
    if( is.null( seedNames ) ){
      ss <- colnames( sdata )[ startsWith( colnames( sdata ), gen4 )]
      ss <- .replaceString( ss, '_min', '' )
      ss <- .replaceString( ss, '_max', '' )
      seedNames <- sort( unique( ss ) )
    }
    if( !is.null( skipSpec ) ){
      skip  <- skipSpec
      gg    <- which( endsWith( skip, 'UNKN' ) )
      skip  <- skip[ !skip %in% skipSpec[ gg]]
      sdata <- sdata[, !colnames( sdata ) %in% skip, drop = F]
    }
    
    
    ws   <- which( startsWith( colnames( sdata ), gen4 )  )
    cc   <- colnames( sdata )[ ws]
    wk   <- grep( '_min', colnames( sdata ) )
    wm   <- grep( '_max', colnames( sdata ) )
    ws   <- ws[ !ws %in% c( wk, wm )]
    
    seedNames <- colnames( sdata )[ ws ]
    totSeed   <- sum( as.vector( as.matrix( sdata[, cc] ) ) , na.rm = T )
  #  checkPlotName( sdata )
  #  checkPlotName( xytrap )
    
    onames <- c( omitNames, paste( seedNames, 'cones', sep = '_' ), 
                 paste( seedNames, 'emptyseeds', sep = '_' ) )
    
    womit <- which( seedNames %in% onames )
    if( length( womit ) > 0 )seedNames <- seedNames[ -womit]
    
    specNames <- sort( unique( as.character( tdata$species ) ) )
    
    wc <- grep( '_caps', colnames( sdata ) )
    if( length( wc ) > 0 ){
      from <- colnames( sdata )[ wc]
      to   <- columnSplit( from, '_' )[, 1]
      wu    <- which( nchar( to ) == 4 )
      if( length( wu ) > 0 ){
        if( length( wu ) > 1 ){
          print( 'multiple short seedNames' )
          return( list( treeData = NULL ) )
        }
        to[ wu] <- paste( to[ wu], 'UNKN', sep = '' )
      }
      cmore <- cbind( from, to )
      combineSeeds <- rbind( combineSeeds, cmore )
    }
    
    tmp <- combineSeedNames( sdata, seedNames, 
                            rbind( combineSeeds, combineSpecs ) )
    sdata     <- tmp$seedData
    seedNames <- tmp$seedNames
    
    wg <- unlist( gregexpr( "[ A-Z]", specNames ) ) # position where species starts
    
    als <- c( specNames, paste( specNames, '_min', sep = '' ), 
             paste( specNames, '_max', sep = '' ), 
             paste( substr( specNames, 1, wg-1 ), 'UNKN', sep = '' ) )
    ttt <- seedNames[ seedNames %in% als]
    
    if( length( ttt ) == 0 ){
      print( specNames )
      print( seedNames )
      print( 'seedNames not in specNames' )
      return( list( treeData = NULL ) )
    }
    seedNames <- ttt
  }else{
    sdata <- NULL
  }
  
  ttt   <- trimData( tdata, xytree, sdata, xytrap, 
                    formulaFec, formulaRep, specNames, seedNames )
  tdata <- ttt$treeData
  sdata <- ttt$seedData
  xytree <- ttt$xytree
  xytrap <- ttt$xytrap
  specNames <- ttt$specNames
  seedNames <- ttt$seedNames
  formulaFec <- ttt$formulaFec
  formulaRep <- ttt$formulaRep
  
  # species by site
  if( 'site' %in% colnames( tdata ) & verbose ){
    cat( '\nSites by by tree-yrs:\n\n' )
    print( table( tdata$site, tdata$species ) )
  }
  
  list( treeData = tdata, seedData = sdata, xytree = xytree, xytrap = xytrap, 
        specNames = specNames, seedNames = seedNames, formulaFec = formulaFec, 
        formulaRep = formulaRep )
}


.setupData <- function( formulaFec, formulaRep, tdata, sdata, 
                       xytree, xytrap, specNames, seedNames, AR, YR, 
                       yearEffect, minDiam, maxDiam, TREESONLY, maxFec, CONES, 
                       notFit, priorTable, 
                       CHECKNOSEED = TRUE, 
       #                plotRegion = NULL, 
       #                group = 'ecoCode', 
                       seedTraits = NULL, verbose = FALSE ){
  SEEDDATA <- TRUE
  if( is.null( sdata ) )SEEDDATA <- FALSE
  
  # formulas have 'species *' already
  arList <- numeric( 0 )
  plag <- p <- 0
  
  if( !is.null( seedTraits ) ){
    ww <- which( !specNames %in% rownames( seedTraits ) )
    if( length( ww ) > 0 )
      stop( paste( '\nspecNames not in rownames( seedTraits ): ', specNames[ ww], 
                  sep = '' ) )
  }
  
  if( !is.null( yearEffect ) ){
    if( 'p' %in% names( yearEffect ) )p <- plag <- yearEffect$p
  }
  
  notCols <- designTable <- NULL
  words <- character( 0 )
  
  plotNames <- sort( unique( as.character( tdata$plot ) ) )
  years <- sort( unique( tdata$year[ tdata$obs == 1] ) )
  if( SEEDDATA )years <- sort( unique( c( sdata$year[ sdata$obs == 1], years ) ) )
  years <- c( min( years ):max( years ) )
  
  nplot <- length( plotNames )
  nspec <- length( specNames )
  
  if( !'treeID' %in% colnames( xytree ) )xytree$treeID <- 
    columnPaste( xytree$plot, xytree$tree )
  
  # if no crop count and seed never observed, remove
  
  ttt <- treeSeedPlots( tdata, sdata, # plotRegion, 
                        xytree, xytrap, priorTable, 
                        seedNames = seedNames, #group = group, 
                        formulaFec = formulaFec, formulaRep = formulaRep, 
                        CHECKNOSEED = CHECKNOSEED )
  tdata  <- ttt$treeData
  
  if( length( tdata ) == 0 )stop( 'insufficient data' )
  
  sdata  <- ttt$seedData
  xytree <- ttt$xytree
  xytrap <- ttt$xytrap
  specNames  <- ttt$specNames
  seedNames  <- ttt$seedNames
  formulaFec <- ttt$formulaFec
  formulaRep <- ttt$formulaRep
  
  nspec <- length( specNames )
  nseed <- length( seedNames )
  
  # note: reorganizes tdata to put known immature and serotinous at end
  # trees in plots with seeds, but only small trees: decrease minDiam
  
  minD  <- specPriorVector( minDiam, tdata )
  maxD  <- specPriorVector( maxDiam, tdata )
  wd    <- which( tdata$diam > minD )
  
  ttab <- table( tdata$plot, tdata$species )
  dtab <- ttab*0
  tmp  <- table( tdata$plot[ wd], tdata$species[ wd] )
  dtab[ rownames( tmp ), colnames( tmp )] <- tmp               # only includes > minD
  ww <- which( ttab > 0 & dtab == 0, arr.ind = TRUE )     # trees, but none > minD
  
  if( SEEDDATA ){          # transfer to UNKN type
    
    stab <- tapply( unlist( sdata[, seedNames] ), 
                    list( rep( sdata$plot, length( seedNames ) ), 
                         rep( seedNames, each = nrow( sdata ) ) ), sum, na.rm = T )
    
    # plots where tdata$species absent, seedNames present for non-UNKN
    moveToUNKN <- character( 0 )
    ktab <- ttab[ drop = F, rownames( stab ), ]
    wk   <- which( !colnames( ktab ) %in% colnames( stab ) )
  #  print( wk )
    if( length( wk ) > 0 ){                       # append seedNames
      mcols <- ktab[ drop = F, , colnames( ktab )[ wk]]*0
      stab <- cbind( stab, mcols )
      stab <- stab[ drop = F, , colnames( ktab )]
    }
    wk   <- which( !colnames( stab ) %in% colnames( ktab ) )
  #  print( wk )
    if( length( wk ) > 0 ){
      mcols <- stab[ drop = F, , colnames( stab )[ wk]]*0
      ktab <- cbind( ktab, mcols )
      ktab <- ktab[ drop = F, , colnames( stab )]
    }
    
    ucol <- grep( 'UNKN', colnames( stab ) )
    if( length( ucol ) == 0 ){
      stab <- cbind( stab, 0 )
      colnames( stab )[ ncol( stab )] <- 'UNKN'
      ucol <- ncol( stab )
    }
    ucol <- grep( 'UNKN', colnames( ktab ) )
    if( length( ucol ) == 0 ){
      ktab <- cbind( ktab, 0 )
      colnames( ktab )[ ncol( ktab )] <- 'UNKN'
      ucol <- ncol( ktab )
    }
    
    kk <- which( ktab == 0 & stab > 0, arr.ind = T ) 
    kk <- kk[ drop = F, kk[, 2] != ucol, ]
    if( nrow( kk ) > 0 ){
      moveToUNKN <- cbind( rownames( ktab )[ kk[, 1]], colnames( ktab )[ kk[, 2]] ) 
      
      us <- grep( 'UNKN', colnames( sdata ) )
      
      for( m in 1:nrow( moveToUNKN ) ){
        moveRows <- which( sdata$plot == moveToUNKN[ m, 1] )
        sdata[ moveRows, us] <- sdata[ moveRows, us] + sdata[ moveRows, moveToUNKN[ m, 2]]
        sdata[ moveRows, moveToUNKN[ m, 2]] <- 0
      }
    }
  }
  
  if( SEEDDATA & length( ww ) > 0 ){  # if there are seeds and nothing mature
    # then largest tree on plot initialized as mature
    ww <- ww[ drop = F, rownames( ww ) %in% sdata$plot, ]
    nw <- nrow( ww )
    if( nw > 0 ){
      for( k in 1:nw ){
        
        wk <- which( tdata$plot == rownames( ww )[ k] &
                       tdata$species == colnames( ttab )[ ww[ k, 2]] )
        qk <- quantile( tdata$diam[ wk], .75, na.rm = T )
        
        if( min( minDiam ) > qk )minD[ wk] <- qk
        
        tdata$repr[ wk][ tdata$diam[ wk] >= qk] <- 1
        if( 'lastRepr' %in% colnames( tdata ) ){
          tdata$lastRepr[ wk][ tdata$diam[ wk] >= qk] <- 1
          tdata$lastFec[ wk][ tdata$diam[ wk] >= qk] <- 1.1
        }
        if( 'serotinous' %in% colnames( tdata ) ){
          tdata$serotinous[ wk][ tdata$diam[ wk] > qk] <- 0
        }
      }
    }
  }
  
  if( verbose ) print( seedTraits )
  
  tmp <- setupZ( tdata, xytree, specNames, years, minD, maxD, maxFec, CONES, 
                seedTraits, verbose )
  z           <- tmp$z
  zmat        <- tmp$zmat
  zknown      <- tmp$zknown
  matYr       <- tmp$matYr 
  last0first1 <- tmp$last0first1
  tdata       <- tmp$tdata       # fecMin, fecMax included
  fecMinCurrent <- tmp$fecMinCurrent
  fecMaxCurrent <- tmp$fecMaxCurrent
  fstart        <- tmp$fstart
  seedTraits    <- tmp$seedTraits
  tdata         <- tmp$tdata
  
  if( verbose ){
    cat( '\nMaximum diameter:\n' )
    ww <- which.max( tdata$diam )
    print( tdata[ ww, c( 'plot', 'tree', 'species', 'year', 'diam' )] )
  }
  
  xytree$fit <- last0first1[ xytree$treeID, 'fit']
  
  if( SEEDDATA ){
    tdata$obsTrap <- addObsTrap( tdata, sdata )
  }else{
    tdata$obsTrap <- 0
  }
  
  mm <- last0first1[ tdata$treeID, 'fit']
  tdata$obsTrap <- tdata$obsTrap*mm
  tdata$fit      <- mm
  
  # no more reordering
  
  if( is.character( tdata$species ) )tdata$species <- as.factor( tdata$species )
  
  yeGr <- specNames[ 1]
  
  tdata$group <- 1
  
  if( YR | AR ){
    
    gnames <- character( 0 )
    if( 'groups' %in% names( yearEffect ) ){
      gnames <- yearEffect$groups
    }else{
      tdata$group <- 1
      gnames <- 'group'
    }
    
    wg <- which( !gnames %in% colnames( tdata ) )
    if( length( wg ) > 0 ){
      words <- paste( 'columns specified in yearEffect not found in treeData:\n"', 
                     gnames[ wg], '"', sep = '' )
      stop( words )
    }
    
    group <- sapply( tdata[, gnames], as.character )
    
    if( length( gnames ) > 1 ){
      ws <- which( gnames == 'species' )     # 'species' must be last
      if( length( ws ) > 0 ){
        gnames <- c( 'species', gnames )
        gnames <- gnames[ !duplicated( gnames )]
        gnames <- rev( gnames )
      }
      group <- apply( tdata[, gnames], 1, paste0, collapse = '_' )
    }
    group <- .replaceString( group, ' ', '' )
    tdata$groupName <- group
    yeGr <- sort( unique( as.character( group ) ) )
    tdata$group <- match( as.character( group ), yeGr )
  }
  
  if( !'group' %in% colnames( tdata ) )tdata$group <- 1
  
  allYears <- min( tdata$year ):max( tdata$year )
  
  if( AR ){        
    
    plag <- yearEffect$p
    tmp  <- msarSetup( tdata, plag, icol = 'treeID', jcol = 'year', 
                       gcol = 'groupName', yeGr, verbose = verbose )
    groupByInd <- tmp$groupByInd
    betaYr     <- tmp$betaYr
    ngroup     <- length( yeGr )
    
    ttt <- tmp$xdata
    rownames( ttt ) <- columnPaste( ttt$treeID, ttt$year, '_' )
    ttt <- ttt[ rownames( ttt ) %in% rownames( tdata ), ]
    ttt$obs <- tdata$obs
    ttt$obsTrap <- tdata$obsTrap
    
    if( 'cropCount' %in% colnames( tdata ) )ttt$cropCount <- tdata$cropCount
    
    tdata <- ttt
    
    rm( ttt )
    
    tdata$plotYr <- columnPaste( tdata$plot, tdata$year, '_' )
    allYears <- sort( unique( tdata$year ) )
    tdata$times  <- match( tdata$year, allYears )
    plotYrs      <- sort( unique( tdata$plotYr ) )
    tdata$plotyr <- match( tdata$plotYr, plotYrs )
    tdata$group <- match( as.character( group ), yeGr )
    
    lagMat <- msarLagTemplate( plag, tdata, icol = 'treeID', jcol = 'year', 
                              gcol = 'group', ocol = 'obs', yeGr, 
                              verbose = verbose )
    arList <- list( times = tdata$times, groupByInd = groupByInd, betaYr = betaYr, 
                   yeGr = rownames( betaYr ), ngroup = length( yeGr ), 
                   lagMatrix = lagMat$matrix, lagGroup = lagMat$group )
  }
  
  times   <- match( tdata$year, allYears )
  yrIndex <- cbind( tdata$group, tdata$tnum, times )
  colnames( yrIndex ) <- c( 'group', 'tnum', 'year' )
  
  
  seedSummary <- NULL
  if( SEEDDATA )seedSummary <- with( sdata, table( plot, year ) )
  treeSummary <- with( tdata, table( plot, year ) )
  plotNames   <- rownames( treeSummary )
  
  if( nspec == 1 ){
    fc <- .replaceString( as.character( formulaFec ), 'species *', '' )
    fr <- .replaceString( as.character( formulaRep ), 'species *', '' )
    formulaFec <- as.formula( paste( fc, collapse = ' ' ) )
    formulaRep <- as.formula( paste( fr, collapse = ' ' ) )
  }
  
  tunstand   <- .get.model.frame( formulaFec, tdata ) # check only, not yet standardized
  
  if( ncol( tunstand ) == 1 ){
    checkNA <- range( tunstand )
    if( is.na( checkNA[ 1] ) ){
      pmiss <- colnames( tunstand )
      if( verbose ){
        cat( '\nFix missing values in:\n' )
        print( pmiss )
      }
    }
  }else{
    inn     <- which( !sapply( tunstand, is.factor ) )
    checkNA <- sapply( tunstand[ inn], range )
    wna <- which( is.na( checkNA[ drop = FALSE, 1, ] ) )
    if( length( wna ) > 0 ){
      pmiss <- paste0( colnames( checkNA )[ wna], collapse = ', ' )
      if( verbose ){
        cat( '\nNote: fix missing values in these variables:\n' )
        print( pmiss )
      }
    }
  }
  
  if( length( tunstand ) == 0 )tunstand <- numeric( 0 )
  tmp1  <- .get.model.frame( formulaRep, tdata )
  
  if( length( tmp1 ) > 0 ){
    
    wnew <- which( !colnames( tmp1 ) %in% colnames( tunstand ) )
    
    if( length( wnew ) > 0 ){                               # all unique columns
      tunstand <- cbind( tunstand, tmp1[, wnew] )
    }
  }
  xallNames <- colnames( tunstand )
  
  scode <- names( tunstand[ which( sapply( tunstand, is.factor ) )] )
  if( length( scode ) > 0 ){
    for( j in 1:length( scode ) ) tdata[, scode[ j]] <- droplevels( tdata[, scode[ j]] )
  }
  ccode <- names( tunstand[ which( sapply( tunstand, is.character ) )] )
  scode <- c( ccode, scode )
  scode <- c( scode, colnames( tunstand )[ c( grep( 'slope', colnames( tunstand ) ), 
                                            grep( 'aspect', colnames( tunstand ) ) )] )
  
  
  specNames <- sort( unique( as.character( tdata$species ) ) )
  
  standX <- character( 0 )
  xmean <- xsd <- numeric( 0 )
  
  wstand <- which( !colnames( tunstand ) %in% scode )
  notStandard <- scode
  
  # standardize columns in tdata
  if( length( wstand ) > 0 ){
    
    standX <- colnames( tunstand )[ wstand]
    
    wlog <- grep( "log( ", standX, fixed = TRUE )
    if( length( wlog ) > 0 )standX <- standX[ -wlog]
    wlog <- grep( "sqrt( ", standX, fixed = TRUE )
    if( length( wlog ) > 0 )standX <- standX[ -wlog]
    wlog <- grep( "^2", standX, fixed = TRUE )
    if( length( wlog ) > 0 )standX <- standX[ -wlog]
    
    if( length( standX ) > 0 ){
      treeStand <- tdata[, standX, drop = FALSE] # original scale
      
      xmean <- colMeans( tdata[, standX, drop = FALSE], na.rm = TRUE )
      xsd   <- apply( tdata[, standX, drop = FALSE], 2, sd, na.rm = TRUE )
      xss   <- t( ( t( tdata[, standX, drop = FALSE] ) - xmean )/xsd )
      tdata[, colnames( treeStand )] <- xss
    }
  }
  
  tmp  <- .getDesign( formulaFec, tdata, verbose = verbose )
  xfec <- tmp$x
  
  if( nspec > 1 )xfec <- xfec[, grep( 'species', colnames( xfec ) ), drop = FALSE]
  xfecMiss <- tmp$missx
  xfecCols <- tmp$specCols
  
  tmp  <- .getDesign( formulaRep, tdata, verbose = verbose )
  xrep <- tmp$x
  
  if( nspec > 1 )xrep <- xrep[, grep( 'species', colnames( xrep ) ), drop = FALSE]
  xrepMiss <- tmp$missx
  xrepCols <- tmp$specCols
  
  rank <- qr( xfec )$rank
  
  if( rank < ncol( xfec ) ){
    
    for( m in 1:nspec ){
      
      sname <- "(Intercept)"
      if( nspec > 1 ){
        sname <- paste( 'species', specNames[ m], sep = '' )
        wk <- grep( sname, colnames( xfec ) )
        wn <- which( colnames( xfec )[ wk] != sname & !colnames( xfec )[ wk] %in% notFit )
        wk <- wk[ wn]
        snew <- colnames( xfec )[ wk]
        snew <- .replaceString( snew, paste( sname, ':', sep = '' ), '' )
      }else{
        wk <- colnames( xfec )[ colnames( xfec ) != sname]
        snew <- colnames( xfec )[ -1]
      }
      
      wr <- which( xfec[, sname] == 1 & z == 1 )
      
      xfecm <- xfec[ wr, wk, drop = F]
      rspec <- qr( xfecm )$rank
      
      if( rspec < ncol( xfecm ) ){
        tmp <- fullRank( xfecm )
        notFit <- unique( c( notFit, 
                            colnames( xfecm )[ !colnames( xfecm ) %in% colnames( tmp )] ) )
      }
    }
  }
  
  if( is.null( notFit ) ){
    notFit <- character( 0 )
  }else{
    if( nspec == 1 )notFit <- .replaceString( notFit, 
                                           paste( 'species', specNames, ':', sep = '' ), '' )
  }
  
  notFull <- character( 0 )
  
  diamVec <- tdata$diam
  
  nff <- character( 0 )
  ncc <- numeric( 0 )
  
  
  if( ncol( xfec )/nspec > 2 ){   # more than intercept and slope
    
    for( m in 1:nspec ){
      
      notw  <- character( 0 )
      sname <- "(Intercept)"
      pname <- paste( 'species', specNames[ m], sep = '' )
      
      if( nspec > 1 ){
        
        nff <- c( nff, notFit[ notFit %in% colnames( xfec )] )
        ncc <- c( ncc, match( nff, colnames( xfec ) ) )
        
        sname <- pname
        wk <- grep( sname, colnames( xfec ) )
        wn <- which( colnames( xfec )[ wk] != sname & !colnames( xfec )[ wk] %in% notFit )
        wk <- wk[ wn]
        snew <- colnames( xfec )[ wk]
        snew <- .replaceString( snew, paste( sname, ':', sep = '' ), '' )
      }else{
        wk <- colnames( xfec )[ colnames( xfec ) != sname]
        snew <- colnames( xfec )[ -1]
        
        pname <- paste( pname, ':', colnames( xfec ), sep = '' )
        nff   <- c( nff, notFit[ notFit %in% pname] )
        ncc   <- c( ncc, match( nff, pname ) )
      }
      
      wr    <- which( xfec[, sname] == 1 )
      xfecm <- xfec[ wr, wk, drop = FALSE]
      
      # quadratic or interactions that lack main effects
      
      gw <- grep( "^2 )", colnames( xfecm ), fixed = TRUE )
      
      if( length( gw ) > 0 ){
        
        for( i in gw ){
          fi <- colnames( xfecm )[ i]
          f2 <- .replaceString( fi, 'I( ', '' )
          f2 <- .replaceString( f2, '^2 )', '' )
          if( !f2 %in% colnames( xfecm ) )notw <- c( notw, fi )
        }
        xfecm <- xfecm[, -gw, drop = F]
        snew <- snew[ -gw]
      }
      
      gw <- grep( ":", snew, fixed = TRUE )
      if( length( gw ) > 0 ){
        for( i in gw ){
          fi <- colnames( xfecm )[ i]
          si <- columnSplit( snew[ i], ':' )
          if( !si[ 1] %in% snew | !si[ 2] %in% snew )notw <- c( notw, fi )
        }
        xfecm <- xfecm[, -gw, drop = F]
        snew <- snew[ -gw]
      }
      
      colnames( xfecm ) <- snew
      cc <- suppressWarnings( cor( xfecm ) )
      diag( cc ) <- 0
      
      ww <- which( abs( cc ) > .95 | is.na( cc ), arr.ind = TRUE )
      
      if( length( ww ) > 0 ){                                  
        mvars <- unique( c( rownames( cc )[ ww[, 1]], colnames( cc )[ ww[, 2]] ) )
        kvars <- rep( 0, length( mvars ) )
        
        for( k in 1:length( mvars ) ){
          
          xcc <- xfecm[, !colnames( xfecm ) == mvars[ k], drop = F]
          
          xcc <- cbind( 1, xcc )
          colnames( xcc )[ 1] <- 'intercept'
          xcheck <- .checkDesign( xcc )
          VIF <- xcheck$VIF
          kvars[ k] <- sum( VIF )
        }
        m0 <- mvars[ which.min( kvars )]
        m1   <- paste( 'species', specNames[ m], ':', m0, sep = '' )
        m2   <- paste( 'species', specNames[ m], ':I( ', m0, '^2 )', sep = '' )
        notw <- c( m0, m1, m2 )
        notw <- notw[ notw %in% colnames( xfec )]
      }
      
      if( length( notw ) > 0 ){
        nff <- c( nff, notw )
      }
    }
    asp <- grep( 'aspect', nff )
    if( length( asp ) > 0 ) nff <- unique( c( nff, 'aspect1', 'aspect2' ) )
    
  }
  
  notFit <- unique( c( notFit, nff ) )
  
  
  # main effects, interactions
  fecTerms <- attr( terms( formulaFec ), 'term.labels' )
  fecTerms <- fecTerms[ !startsWith( fecTerms, 'species' )]
  
  
  if( length( notFit ) > 0 ){
    
    kwords <- character( 0 )
    
    nff <- .replaceString( notFit, 'species', '' )
    nkk <- numeric( 0 )
    for( k in 1:length( fecTerms ) ){
      nkk <- c( nkk, grep( fecTerms[ k], nff ) )
    }
    nkk <- sort( unique( nkk ) )
    
    if( length( nkk ) > 0 ){
      nff <- nff[ nkk]
      notFit <- notFit[ nkk]
      kwords <- paste0( nff, collapse = ', ' )
      kwords <- paste( ' Fecundity is not full rank, omitted columns:\n', kwords )
      if( verbose )cat( paste( '\nNote: ', kwords, '\n' ) )
    }
    
    nff <- nxx <- character( 0 )
    
    for( k in 1:length( notFit ) ){  # formula contains variables without species
      
      kk <- columnSplit( notFit[ k], ':' )
      vk <- kk[ 2]
      sk <- kk[ 1]
      sk <- .replaceString( sk, 'species', '' )
      sr <- specNames[ !specNames == sk]   #species not in notFit
      
      ff <- as.character( formulaFec )[ 2]
      gg <- grep( kk[ 2], ff, fixed = T )
      if( length( gg ) == 0 )nxx <- c( nxx, notFit[ k] )
      
      if( length( sr ) == 0 ){                  #remove from formula
        
        ff <- .replaceString( ff, paste( '+', vk ), '' )
        formulaFec <- as.formula( paste( '~', ff, collapse = ' ' ) )
        nff <- c( nff, notFit[ k] )
      }
      
    }
    
    if( length( nff ) > 0 )notFit <- notFit[ notFit %in% nff]
    if( length( nxx ) > 0 )notFit <- notFit[ !notFit %in% nxx]
    
      
    if( length( notFit ) > 0 ){
      notCols <- match( notFit, colnames( xfec ) )
      if( length( kwords ) > 0 )words <- paste( words, kwords )
    }
  }
  
  rank <- qr( xrep )$rank
  if( rank < ncol( xrep ) )stop( '\nmaturation design not full rank\n' )
  
  xfecU <- xfec
  xrepU <- xrep
  xfecT <- xrepT <- NULL
  
  xfecs2u <- diag( ncol( xfec ) )
  xreps2u <- diag( ncol( xrep ) )
  colnames( xfecs2u ) <- rownames( xfecs2u ) <- colnames( xfec )
  colnames( xreps2u ) <- rownames( xreps2u ) <- colnames( xrep )
  
  xfecu2s <- xfecs2u
  xrepu2s <- xreps2u
  
  if( length( xmean ) > 0 ){   # unstandardized
    
    tdata[, standX] <- treeStand
    
    xmu <- xmean
    if( length( notStandard ) > 0 ){
      xp <- rep( 0, length( notStandard ) )
      names( xp ) <- notStandard
      xmu <- c( xmean, xp )
    }
    
    tmp <- .unstandBeta( formula = formulaFec, xdata = tdata, xnow = xfec, 
                        xmean = xmu, notCols = notCols, notFit = notFit, 
                        specNames = specNames )
    xfecU   <- tmp$x          
    xfecs2u <- tmp$s2u      # multiply by beta_s to get beta_u
    xfecu2s <- tmp$u2s      # multiply by beta_u to get beta_s
  #  notCols <- tmp$notCols
    notFit  <- tmp$notFit
    notCols <- match( notFit, colnames( xfec ) )
    
    
    tmp <- .unstandBeta( formula = formulaRep, xdata = tdata, xnow = xrep, 
                        xmean = xmu, notCols = NULL, specNames = specNames )
    xrepUn   <- tmp$x
    xreps2u <- tmp$s2u
    xrepu2s <- tmp$u2s
    
    xmean[ abs( xmean ) < 1e-10] <- 0
  }
  
  # xrep unstandardized
  
  xrepUn <- .getDesign( formulaRep, tdata )$x
  
  
  tdata <- cleanFactors( tdata )
  
  distTreeID <- NULL
  
  if( SEEDDATA ){
    
    sdata <- cleanFactors( sdata )
    tmp   <- setupDistMat( tdata, sdata, xytree, xytrap, verbose )
    tdata <- tmp$tdata
    sdata <- tmp$sdata
    distall <- tmp$distall
    distTreeID <- tmp$distTreeID
    
    # CHECK THAT TREESONLY ARE AT END
    
    fitTrees <- unique( tdata$treeID[ tdata$fit == 1] )
    
    if( !'obsTrap' %in% colnames( tdata ) ){           # observation period for traps
      tdata$obsTrap <- addObsTrap( tdata, sdata )
    }
    tdata$obsTrap <- tdata$obsTrap*tdata$fit         # only include fit
    
    trapRows  <- which( tdata$fit == 1 )
    seedNames <- seedNames[ seedNames %in% colnames( sdata )]
    
    keepCol <- c( 'plot', 'trap', 'trapID', 'year', 'plotYr', 'plotyr', 'drow', 
                 'area', 'active', 'obs', seedNames )
    sdata   <- sdata[, keepCol]
  }
  
  tdata$species <- as.character( tdata$species )
  
  ynow    <- colnames( yrIndex )
  gy      <- columnPaste( tdata$group, yrIndex[, 'year'] )
  gyall   <- unique( gy )
  groupYr <- match( gy, gyall )
  if( !'dcol' %in% colnames( tdata ) )tdata$dcol <- 0
  
  yrIndex <- cbind( yrIndex, tdata$dcol, groupYr )
  colnames( yrIndex ) <- c( ynow, 'dcol', 'groupYr' )
  
  
  
  specPlot  <- columnPaste( as.character( tdata$species ), 
                            as.character( tdata$plot ), '-' )
  tdata$specPlot <- specPlot
  specPlots <- unique( as.character( specPlot ) )
  specPlot  <- match( specPlot, specPlots )
  yrIndex   <- cbind( yrIndex, specPlot )
  
  tdata$species <- as.factor( tdata$species )
  
  vif <- numeric( 0 )
  
  if( ncol( xfec )/nspec > 2 & verbose ){
    cat( '\n\nVariance Inflation Factors, range, and correlation matrix:\n' )
  }
  
  for( k in 1:nspec ){
    
    if( nspec == 1 ){
      gg <- 1:ncol( xfec )
      xt <- xfec
      xu <- xfecU
      if( ncol( xt ) <= 2 )next
    }else{
      sk <- paste( 'species', specNames[ k], sep = '' )
      st <- paste( sk, ':', sep = '' )
      gg <- grep( sk, colnames( xfec ) )
      rr <- which( xfec[, sk] == 1 )
      xt <- xfec[ rr, gg]
      xu <- xfecU[ rr, gg]
      if( length( notFit ) > 0 ){
        xt <- xt[, !colnames( xt ) %in% notFit]
        xu <- xu[, !colnames( xu ) %in% notFit]
      }
      
      colnames( xt )[ 1] <- 'intercept'
      colnames( xt )    <- .replaceString( colnames( xt ), st, '' )
    }
    
    s2 <- grep( '^2', colnames( xt ), fixed = TRUE )
    if( length( s2 ) > 0 )xt <- xt[, -s2]
    
    if( ncol( xt ) < 3 )next
    
    xcheck <- .checkDesign( xt )
    VIF <- xcheck$VIF
    designTable <- xcheck$design
    xrange <- signif( xcheck$range, 3 )
    
    cfx <- round( xcheck$correlation, 2 )
    
    rownames( cfx ) <- colnames( cfx ) <- names( VIF ) <- .coeffNames( rownames( cfx ) )
    
    colnames( cfx ) <- substr( colnames( cfx ), 1, 6 )
    cfx <- cfx[, 1:( ncol( cfx )-1 ), drop = 0]
    
    
    vif <- append( vif, list( cbind( VIF, xrange, cfx ) ) )
    names( vif )[ length( vif )] <- specNames[ k]
    
    if( verbose ){
      cat( paste( '\n', specNames[ k], ':\n', sep = '' ) )
      print( cbind( VIF, xrange, cfx ) )
      
      if( max( xcheck$VIF, na.rm = TRUE ) > 10 | is.na( max( xcheck$VIF ) ) )
        cat( 'VIF too high or undefined--too many predictors\n' )
    }
  }
  
  tdata$species <- as.character( tdata$species )
  tdata$treeID  <- as.factor( tdata$treeID )
  if( !'repMu' %in% colnames( tdata ) )tdata$repMu <- .5
  
  tdata$repMu[ !is.finite( tdata$repMu )] <- .5
  
  
  plotYears <- sort( unique( as.character( tdata$plotYr ) ) )
  if( SEEDDATA )plotYears <- sort( unique( c( plotYears, 
                                          as.character( sdata$plotYr ) ) ) )
  
  out <- list( tdata = tdata, z = z, zmat = zmat, zknown = zknown, 
       specNames = specNames, arList = arList, plotYears = plotYears, 
       plotNames = plotNames, plots = plotNames, years = years, 
       xfec = xfec, xrepSt = xrep, xrepUn = xrepUn, scode = scode, 
       xfecMiss = xfecMiss, yeGr = yeGr, 
       xrepMiss = xrepMiss, xfecCols = xfecCols, xrepCols = xrepCols, 
       xmean = xmean, xsd = xsd, xfecU = xfecU, 
       xfecs2u = xfecs2u, xfecu2s = xfecu2s, xreps2u = xreps2u, xrepu2s = xrepu2s, 
       xrepT = xrepT, specPlots = specPlots, yrIndex = yrIndex, 
       notFit = notFit, notCols = notCols, 
       VIF = vif, fstart = fstart, 
       fecMinCurrent = fecMinCurrent, fecMaxCurrent = fecMaxCurrent, 
       matYr = matYr, last0first1 = last0first1, minDiam = minDiam, 
       distTreeID = distTreeID, notStandard = notStandard )
  
  if( SEEDDATA ){
    out$sdata <- sdata
    out$seedNames <- seedNames
    out$distall <- distall
    out$xytree <- xytree
    out$xytrap <- xytrap
    out$trapRows <- trapRows
  }
  out
}
  

.unstandBeta <- function( formula, xdata, xnow, xmean = NULL, notCols = NULL, notFit = NULL, 
                         specNames ){
  
  # xdata - data.frame, unstandardized variables
  # xnow  - current standardized matrix
  
  nspec <- length( specNames )
  
  xdata$species <- factor( xdata$species )
  
  tmp <- .get.model.frame( formula, xdata )  #unstandardized
  
  xterm <- names( tmp )
  st    <- grep( 'species', xterm )
  if( length( st ) > 0 )xterm <- xterm[ -st]
  
  xfu  <- .getDesign( formula, xdata )$x    # unstandardized
  
  if( length( st ) > 0 & length( xterm ) > 1 )
    xfu  <- xfu[, grep( 'species', colnames( xfu ) )]
  
  xuu <- xfu
  xss <- xnow  # standardized
  
  if( is.null( notFit ) & !is.null( notCols ) )notFit <- colnames( xfu )[ notCols]
  
  if( length( notFit ) > 0 ){
    xuu <- xfu[, !colnames( xfu ) %in% notFit, drop = TRUE]
    xss <- xnow[, !colnames( xfu ) %in% notFit, drop = TRUE]
  }
  
  tmp <- fullRank( xss )
  if( ncol( tmp ) < ncol( xss ) ){
    wk  <- which( !colnames( xss ) %in% colnames( tmp ) )
    notFit  <- sort( unique( c( notFit, colnames( xss )[ wk] ) ) )  
    xss <- xss[, -wk]                          
  }
  tmp <- fullRank( xuu )
  if( ncol( tmp ) < ncol( xuu ) ){
    wk <- which( !colnames( xuu ) %in% colnames( tmp ) )
    notFit  <- sort( unique( c( notFit, colnames( xuu )[ wk] ) ) )  
    xuu <- xuu[, -wk]
  }
  
  u2s <- solveRcpp( crossprod( xss ) )%*%crossprod( xss, xuu )
  s2u <- solveRcpp( crossprod( xuu ) )%*%crossprod( xuu, xss )
  
  rownames( u2s ) <- colnames( xss )
  rownames( s2u ) <- colnames( xuu )
  
  notCols <- match( notFit, xfu )
  
  list( x = xfu, s2u = s2u, u2s = u2s, notFit = notFit, notCols = notCols )
}

.blockDiag <- function( mat1, mat2 ){
  
  #creates block diagional
  
  if( length( mat1 ) == 0 )return( mat2 )
  
  if( !is.matrix( mat1 ) )mat1 <- as.matrix( mat1 )
  if( !is.matrix( mat2 ) )mat2 <- as.matrix( mat2 )
  
  namesc <- c( colnames( mat1 ), colnames( mat2 ) )
  namesr <- c( rownames( mat1 ), rownames( mat2 ) )
  
  nr1 <- nrow( mat1 )
  nr2 <- nrow( mat2 )
  nc1 <- ncol( mat1 )
  nc2 <- ncol( mat2 )
  nr  <- nr1 + nr2
  nc  <- nc1 + nc2
  
  new <- matrix( 0, nr, nc )
  new[ 1:nr1, 1:nc1] <- mat1
  new[ ( nr1+1 ):nr, ( nc1+1 ):nc] <- mat2
  colnames( new ) <- namesc
  rownames( new ) <- namesr
  new
}

.getLambda <- function( tdat1, sdat1, AA, ug, ff, R, SAMPR, USPEC, 
                       distance, yrs, PERAREA = FALSE, SPECPRED = F ){
  
  # tdat needs species, year, dcol
  # sdat needs year, drow
  
  # PERAREA - from per-trap to per-area
  # if length( AA === 1 ) then it must equal 1
  # SPECPRED - predict species rather than seed types
  
  fz <- ff
  nf <- length( fz )
  
  if( SAMPR | length( R ) > 1 ){
    if( SPECPRED ){
      ff <- matrix( 0, nf, nrow( R ) )
      jj <- match( as.character( tdat1$specPlot ), rownames( R ) ) # predict species
      ff[ cbind( 1:nf, jj )] <- fz
    }else{
      ff <- matrix( fz, length( fz ), ncol = ncol( R ) )*
            R[ drop = FALSE, tdat1$specPlot, ] # predict types
    }
  }else{
    ff <- matrix( fz, ncol = 1 )
  }
  
  uvec <- ug[ 1]
#  if( USPEC ) uvec <- ug[ attr( distance, 'species' )]
  
  if( USPEC ){
    uvec <- matrix( ug[ attr( distance, 'species' )], nrow( distance ), ncol( distance ) )
  }
 
  dmat <- uvec/pi/( uvec + distance^2 )^2
  dmat[ dmat < 1e-8] <- 0
#  dmat[ is.na( dmat )] <- 0
  
  plotyrs <- unique( sdat1$plotyr )

  lambda <- kernYrRcpp( dmat, ff, seedrow = sdat1[, 'drow'], 
                    treecol = tdat1[, 'dcol'], plotyrs, 
                    treeplotYr = tdat1[, 'plotyr'], seedplotYr = sdat1[, 'plotyr'] )
  
  if( SPECPRED ){
    colnames( lambda ) <- rownames( R )
    sname  <- sort( unique( attr( R, 'species' ) ) )
    ii     <- rep( c( 1:nrow( lambda ) ), ncol( lambda ) )
    jj     <- match( attr( R, 'species' ), sname )
    jj     <- rep( jj, each = nrow( lambda ) )
    lambda <- .myBy( as.vector( lambda ), ii, jj, fun = 'sum' )
    colnames( lambda ) <- sname
    
  }else{
    colnames( lambda ) <- colnames( R )
  }
  
  if( PERAREA | length( AA ) == 1 ) return( lambda )    # per area
  
  lambda*matrix( AA, nrow( lambda ), ncol( lambda ) )  # per trap
}

.tnormAlt <- function( n, lo, hi, mu, sig, tiny = 0 ){   
  
  #normal truncated lo and hi
  
  if( length( lo ) == 1 & length( mu ) > 1 )lo <- rep( lo, length( mu ) )
  if( length( hi ) == 1 & length( mu ) > 1 )hi <- rep( hi, length( mu ) )
  
  if( length( lo ) != length( mu ) ){
    print( length( lo ) )
    print( length( mu ) )
    stop( )
  }
  
  q1 <- pnorm( lo, mu, sig )
  q2 <- pnorm( hi, mu, sig ) 
  
  z <- runif( n, q1, q2 )
  z <- qnorm( z, mu, sig )
  
  z[ z == Inf]  <- lo[ z == Inf] + tiny
  z[ z == -Inf] <- hi[ z == -Inf] + tiny
  
  whi <- which( z > hi )         # too many standard deviations
  wlo <- which( z < lo )
  
  if( length( wlo ) > 0 | length( whi ) > 0 ){
    
    if( length( whi ) > 0 )mu[ whi] <- hi[ whi]
    if( length( wlo ) > 0 )mu[ wlo] <- lo[ wlo]
    
    wr <- c( whi, wlo )
    
    q1[ whi] <- pnorm( lo[ whi], mu[ whi], sig[ whi] )
    q2[ wlo] <- pnorm( hi[ wlo], mu[ wlo], sig[ wlo] ) 
    
    q1[ wr][ q1[ wr] > q2[ wr]] <- .99*q2[ wr][ q1[ wr] > q2[ wr]]
    
    nl <- length( wr )
    z[ wr] <- runif( nl, q1[ wr], q2[ wr] )
    z[ wr] <- qnorm( z[ wr], mu[ wr], sig[ wr] )
  }
  z
}


.tnorm <- function( n, lo, hi, mu, sig, tiny = 0 ){   
  
  #normal truncated lo and hi
  
  if( length( lo ) == 1 & length( mu ) > 1 )lo <- rep( lo, length( mu ) )
  if( length( hi ) == 1 & length( mu ) > 1 )hi <- rep( hi, length( mu ) )
  
  if( length( lo ) != length( mu ) ){
    print( length( lo ) )
    print( length( mu ) )
    stop( )
  }
  
  q1 <- pnorm( lo, mu, sig )
  q2 <- pnorm( hi, mu, sig ) 
  
  z <- runif( n, q1, q2 )
  z <- qnorm( z, mu, sig )
  
  z[ z == Inf]  <- lo[ z == Inf] + tiny
  z[ z == -Inf] <- hi[ z == -Inf] + tiny
  z[ z > hi] <- hi[ z > hi]
  z[ z < lo] <- lo[ z < lo]
  
  z
}


rtpois <- function( lo, hi, mu ){
  
  #Poisson truncated lo and hi
  
  # lo, hi, and mu are matrices
  
  ww <- which( hi > lo, arr.ind = TRUE )  #only update where there is an interval
  xx <- lo
  
  p1 <- ppois( lo[ ww], mu[ ww] )
  p2 <- ppois( hi[ ww], mu[ ww] ) 
  
  xx[ ww[ p2 == 0, ]] <- hi[ ww[ p2 == 0, ]]
  
  vv <- which( p1 < 1 )
  qq <- runif( length( vv ), p1[ vv], p2[ vv] )
  zz <- qpois( qq, mu[ ww[ vv, ]] ) - 1
  zz[ zz < 0] <- 0
  
  wx <- ww[ drop = FALSE, vv[ zz == Inf], ]
  if( length( wx ) > 0 )zz[ zz == Inf]  <- lo[ wx]
  
  wx <- ww[ drop = FALSE, vv[ zz == -Inf], ]
  if( length( wx ) > 0 )zz[ zz == -Inf] <- hi[ wx]
  
  xx[ ww[ vv, ]] <- zz
  xx
}

dtpois <- function( lo, hi, mu, index = NULL, tiny = 1e-10 ){

  # Poisson probability interval censusored lo and hi
  # index used for matrices
  
  xx <- lo*0 + 1
  
  if( !is.null( index ) ){
    hi <- hi[ index]
    lo <- lo[ index]
    mu <- mu[ index]
    pr <-  ppois( hi, mu ) - ppois( lo, mu )
    pr[ pr < tiny] <- tiny
    xx[ index] <- pr
    return( xx )
  }
  
  ppois( hi, mu ) - ppois( lo, mu )
}

.getPlotLayout <- function( np, WIDE = TRUE ){
  
  # np - no. plots
  
  if( np == 1 )return( list( mfrow = c( 1, 1 ), left = 1, bottom = c( 1, 2 ) ) )
  if( np == 2 ){
    if( WIDE )return( list( mfrow = c( 1, 2 ), left = 1, bottom = c( 1, 2 ) ) )
    return( list( mfrow = c( 2, 1 ), left = c( 1, 2 ), bottom = 2 ) )
  }
  
  if( np == 3 ){
    if( WIDE )return( list( mfrow = c( 1, 3 ), left = 1, bottom = c( 1:3 ) ) )
    return( list( mfrow = c( 3, 1 ), left = 1:3, bottom = 3 ) )
  }
  if( np <= 4 )return( list( mfrow = c( 2, 2 ), left = c( 1, 3 ), bottom = c( 3:4 ) ) )
  if( np <= 6 ){
    if( WIDE )return( list( mfrow = c( 2, 3 ), left = c( 1, 4 ), bottom = c( 4:6 ) ) )
    return( list( mfrow = c( 3, 2 ), left = c( 1, 3, 5 ), bottom = 5:6 ) )
  }
  if( np <= 9 )return( list( mfrow = c( 3, 3 ), left = c( 1, 4, 7 ), bottom = c( 7:9 ) ) )
  if( np <= 12 ){
    if( WIDE )return( list( mfrow = c( 3, 4 ), left = c( 1, 5, 9 ), bottom = c( 9:12 ) ) )
    return( list( mfrow = c( 4, 3 ), left = c( 1, 4, 7, 10 ), bottom = 10:12 ) )
  }
  if( np <= 16 )return( list( mfrow = c( 4, 4 ), left = c( 1, 5, 9, 13 ), 
                            bottom = c( 13:16 ) ) )
  if( np <= 20 ){
    if( WIDE )return( list( mfrow = c( 4, 5 ), left = c( 1, 6, 11, 15 ), 
                            bottom = c( 15:20 ) ) )
    return( list( mfrow = c( 5, 4 ), left = c( 1, 5, 9, 13 ), bottom = 17:20 ) )
  }
  if( np <= 25 )return( list( mfrow = c( 5, 5 ), left = c( 1, 6, 11, 15, 20 ), 
                            bottom = c( 20:25 ) ) )
  if( np <= 25 ){
    if( WIDE )return( list( mfrow = c( 5, 6 ), left = c( 1, 6, 11, 15, 20, 25 ), 
                            bottom = c( 25:30 ) ) )
    return( list( mfrow = c( 6, 5 ), left = c( 1, 6, 11, 16, 21, 26 ), bottom = 26:30 ) )
  }
  if( np <= 36 ){
    return( list( mfrow = c( 6, 6 ), left = c( 1, 7, 13, 19, 25, 31 ), bottom = c( 31:36 ) ) )
  }
  return( list( mfrow = c( 7, 6 ), left = c( 1, 7, 13, 19, 25, 31, 37 ), bottom = c( 37:42 ) ) )
}

.seedProb <- function( tdat1, ug, fz, distall, sdat1, 
                      seedNames, R, SAMPR, USPEC, year1 ){
  
  lambda <- .getLambda( tdat1, sdat1, sdat1$area, ug, fz, R, SAMPR, USPEC, 
                       distall, year1, PERAREA = FALSE )
  lambda <- lambda + 1e-10
  ss     <- as.matrix( sdat1[, seedNames] )
  dpois( ss, lambda, log = TRUE )
}
  
.myBy <- function( x, i, j, summat = matrix( 0, max( i ), max( j ) ), 
                    totmat = summat, fun = 'mean' ){  
  
  nn <- length( x )
  if( nn != length( i ) | nn != length( j ) )
    stop( '\nvectors unequal in byFunctionRcpp\n' )
  if( nrow( summat ) < max( i ) | ncol( summat ) < max( j ) )
    stop( '\nmatrix too small\n' )
  
  ww <- which( is.na( x ) )
  if( length( ww ) > 0 ){
    x <- x[ -ww]
    i <- i[ -ww]
    j <- j[ -ww]
  }
  
  frommat <- cbind( i, j, x )
  
  nr  <- nrow( frommat )
  
  maxmat <- summat*0 - Inf
  minmat <- summat*0 + Inf
  
  tmp <- byRcpp( nr, frommat, totmat, summat, minmat, maxmat )
  
  if( fun == 'sum' )return( tmp$sum )
  if( fun == 'mean' ){
    mu <- tmp$sum/tmp$total
    mu[ is.na( mu )] <- 0
    return( mu )
  }
  if( fun == 'min' ){
    return( tmp$min )
  }
  tmp$max
}

.tnormMVNmatrix <- function( avec, muvec, smat, 
                            lo = matrix( -1000, nrow( muvec ), ncol( muvec ) ), 
                            hi = matrix( 1000, nrow( muvec ), ncol( muvec ) ), 
                            whichSample = c( 1:nrow( smat ) ) ){
  
  # lo, hi must be same dimensions as muvec, avec
  # each sample is a row
  
  lo[ lo < -1000] <- -1000
  hi[ hi > 1000]  <- 1000
  
  if( max( whichSample ) > length( muvec ) )
    stop( '\nwhichSample outside length( muvec )\n' )
  
  whichSample <- sample( whichSample ) # randomize order
  
  nd <- dim( avec )
  
  r <- avec
  a <- trMVNmatrixRcpp( avec, muvec, smat, 
                       lo, hi, whichSample, 
                       idxALL = c( 0:( nrow( smat )-1 ) ) ) 
  r[, whichSample] <- a[, whichSample]
  r
}

.initEM <- function( last0first1, yeGr, distall, priorU, 
                    tdata, sdata, specNames, seedNames, R, 
                    SAMPR, USPEC, years, trapRows, 
                    plotYears, z, xfec, fstart, verbose, 
                    nsim = 100 ){
  FSTART <- FALSE
  tiny <- 1e-4
  id <- unique( as.character( tdata$treeID ) )
  tt <- tdata[ match( id, as.character( tdata$treeID ) ), ]  #unique trees
  zobs <- tdata$repr
  
  tdata$fecMin[ zobs == 0 & tdata$fecMin > tiny] <- tiny
  tdata$fecMin[ zobs == 1 & tdata$fecMin < 1] <- 1 + tiny
  tdata$fecMax[ zobs == 0 & tdata$fecMax > 1] <- 1
  tdata$fecMax[ zobs == 1 & tdata$fecMax < ( 1 + tiny )] <- 1 + tiny
  
  nspec  <- length( specNames )
  tnum   <- numeric( 0 )
  
  plotyrs <- unique( tdata$plotyr[ trapRows] )
  ny      <- length( plotyrs )
  
  for( j in 1:ny ){
    
    ws <- which( sdata$plotyr == plotyrs[ j] )
    wt <- which( tdata$plotyr == plotyrs[ j] )
    wt <- wt[ wt %in% trapRows]
    
    ds <- sdata$drow[ ws]
    dt <- tdata$dcol[ wt]
    
    ys <- suppressWarnings( apply( distall[ drop = F, ds, dt], 2, min, na.rm = T ) )
    
    close <- which( ys < 25 )
    
    dj   <- wt[ close]
    
    if( length( dj ) > 100 ){
      ww <- order( ys, decreasing = F )[ 1:100]
      dj <- dt[ ww]
    }
    if( length( dj ) == 0 )dj <- wt
    
    if( is.na( range( dj )[ 1] ) )stop( )
    
    tnum <- c( tnum, dj )
  }
  
  wtree <- which( tdata$tnum %in% tnum & zobs != 0 & tdata$fit == 1 )
  
  fg <- rep( .5, nrow( tdata ) )
  
  ss <- sdata[, seedNames, drop = FALSE]
  ff <- sapply( ss, is.factor )
  if( !all( !ff ) )ss <- .fac2num( ss )
  ss <- rowSums( ss, na.rm = TRUE )
  
  wfix <- which( is.finite( fstart ) )
  if( length( wfix ) > 0 )FSTART <- TRUE
  
  for( j in 1:length( plotyrs ) ){
    
    i  <- which( tdata$plotyr == plotyrs[ j] )
    m  <- i[ which( i %in% wtree )]
    
    k  <- which( sdata$plotyr == plotyrs[ j] )
    sj <- sum( ss[ k] )
    
    if( length( k ) == 0 )next
    if( length( i ) == 0 )next
    if( length( m ) == 0 & sj > 0 ){
      m <- which( tdata$plotyr == plotyrs[ j] & tdata$fit == 1 )
      if( length( m ) > 50 )m <- sample( m, 50 )
    }
    if( length( m ) == 0 )next
    
 #   d <- unique( tdata$tnum[ m] )
 #   dj <- d[ d %in% tnum]
 #   ij <- m[ d %in% tnum]
 #   dcol <- tdata$dcol[ dj]
    
    dcol <- tdata$dcol[ m]
    if( length( dj ) < 1 ){
      ij <- which( tdata$plotyr == plotyrs[ j] )# & tdata$tnum %in% d )
   #   dj <- tdata$tnum[ ij]
      dcol <- tdata$dcol[ ij]
    }
 
    dk     <- distall[ sdata[ k, 'drow'], dcol, drop = FALSE]
    
    kern   <- priorU/pi/( priorU + dk^2 )^2
    fg[ m] <- .getF( kern, gg = ss[ k]/( .1 + sdata$area[ k] ) )
  }
  
  fg[ !is.finite( fg )] <- .1
  
  nn <- length( fg )
  
  lo <- tdata$fecMin
  hi <- tdata$fecMax
  lo[ lo < tiny] <- tiny
  
  fg[ fg < lo] <- lo[ fg < lo]
  fg[ fg > hi] <- hi[ fg > hi]
  
  fg <- .tnorm( nn, lo, hi, fg, .1 )
  if( FSTART )fg[ wfix] <- fstart[ wfix]
  fg[ fg < tiny] <- tiny
  
  propF <- fg/20
  propU <- .1
  
  # by plot-yr
  sm <- matrix( 0, max( c( tdata$plotyr, sdata$plotyr ) ), 1 )
  
  pcheck <- seq( 1, nsim, by = 20 )  
  
  if( verbose )cat( "\ninitializing\n" )
  
  pbar <- txtProgressBar( min = 1, max = nsim, style = 1 )
  
  
  ug <- rep( priorU, nspec )
  names( ug ) <- specNames
  nn <- length( trapRows )
  
  pall <- -1e+10
  count <- 0
  
  trapFix <- which( trapRows %in% wfix )
  
  fk <- fg[ trapRows]
  zk <- z[ trapRows]
  pf <- propF[ trapRows]
  lk <- lo[ trapRows]
  hk <- hi[ trapRows]
  
  fss <- fstart[ trapRows]
  fss[ fss < tiny] <- tiny
  
  wwf <- which( is.finite( fss ) )
  
  
  for( g in 1:nsim ){
    
    fnew <- .tnorm( nn, lk, hk, fk, rexp( nn, 1/pf ) )
    fnew[ trapFix] <- fk[ trapFix]
    
    if( FSTART )fnew[ wwf] <- fss[ wwf]

    pnow <- .seedProb( tdat1 = tdata[ trapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                      ug, fz = fk*zk, distall, sdat1 = sdata, 
                      seedNames, R, SAMPR, USPEC, years )
    pnew <- .seedProb( tdata[ trapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                      ug, fnew*zk, distall, sdata, 
                      seedNames, R, SAMPR, USPEC, years )
    
    pnow[ pnow < -1e+8] <- -1e+8   # intensity parameter is zero
    pnew[ pnew < -1e+8] <- -1e+8
    
    # by plot-yr
    ii <- sdata[, 'plotyr']
    ii <- rep( ii, length( seedNames ) )
    
    pdif <- .myBy( as.vector( pnew - pnow ), ii, ii*0 + 1, summat = sm*0, fun = 'sum' )

    if( g == 1 )accept <- pdif*0
    
    a  <- exp( pdif )        #wt on seed data
    az  <- runif( length( a ), 0, 1 )
    aw  <- which( az < a )
    
    if( length( aw ) > 0 ){
      wa <- which( tdata[ trapRows, 'plotyr'] %in% aw )
      fk[ wa] <- fnew[ wa]
      accept[ aw] <- accept[ aw] + 1
    }
    
    if( g %in% pcheck ){
      whi <- which( accept > g/2 )
      if( length( whi ) > 0 )pf[ whi] <- pf[ whi]*2
      wlo <- which( accept < g/5 )
      if( length( wlo ) > 0 )pf[ wlo] <- pf[ wlo]/2
     
      pq   <- sum( pnow )
      dl   <- pq - pall
      pall <- pq
      
      
      
      
      if( dl < 0 ){
        count <- count + 1
        if( count > 4 )break
      }
      
    }
    setTxtProgressBar( pbar, g )
  }
  fg[ fg < tiny] <- tiny
  fg[ trapRows] <- fk

  XX <- crossprod( xfec[ wtree, ] )
  diag( XX ) <- diag( XX ) + .000001
  
  bf <- solve( XX )%*%crossprod( xfec[ wtree, ], log( fg[ wtree] ) )
  mu <- exp( xfec%*%bf )
  mu[ mu < lo] <- lo[ mu < lo]
  mu[ mu > hi] <- hi[ mu > hi]
  mu[ wtree] <- fg[ wtree]
  if( FSTART )mu[ wfix] <- fstart[ wfix]
  
  
  fstart <- .tnorm( length( mu ), lo, hi, mu, .1 )
  fstart[ wtree] <- fg[ wtree]
  fstart[ fstart >= .95 & z == 0] <- .95
  fstart[ fstart < 1 & z == 1] <- 1.01
  fstart[ fstart < 1e-4] <- 1e-4
  fstart
}

.checkDesign <- function( x, intName = 'intercept', xflag = ':', 
                          isFactor = character( 0 ) ){  # 
  
  # xflag - indicates that variable is an interaction
  # isFactor - character vector of factor names returned if not supplied
 # require( stringr )
  
  p <- ncol( x )
  
  if( ncol( x ) < 3 ){
    return( list( VIF = 0, correlation = 1, rank = 2, p = 2, isFactor = isFactor ) )
  }
  
  if( is.null( colnames( x ) ) ){
    colnames( x ) <- paste( 'x', c( 1:p ), sep = '_' )
  }
  xrange      <- apply( x, 2, range, na.rm = TRUE )
  wi          <- which( xrange[ 1, ] == 1 & xrange[ 2, ] == 1 )
  if( length( wi ) > 0 )colnames( x )[ wi] <- 'intercept'
  
  wx <- grep( xflag, colnames( x ) )
  ws <- which( startsWith( colnames( x ), 'species' ) &
                       stringr::str_count( colnames( x ), pattern = xflag ) < 2 )
  wx <- wx[ !wx %in% ws]
  
  wi <- which( colnames( x ) == intName )
  wi <- unique( c( wi, wx ) )
  
  xname <- colnames( x )
  
  wmiss <- which( is.na( x ), arr.ind = TRUE )
  
  if( length( wmiss ) > 0 ){
    rowTab <- table( table( wmiss[, 1] ) )
    colTab <- table( wmiss[, 2] )
  }
  
  VIF <- rep( NA, p )
  names( VIF ) <- xname
  
  GETF <- FALSE
  if( length( isFactor ) > 0 )GETF <- TRUE
  
  rr <- matrix( NA, p, 2 )
  
  for( k in 1:p ){
    
    if( xname[ k] %in% wi )next
    
    notk <- xname[ xname != xname[ k] & !xname %in% xname[ wi]]
    ykk  <- x[, xname[ k]]
    xkk  <- x[, notk, drop = FALSE]
    
    if( ncol( xkk ) == 0 )next
    
    wna <- which( is.na( ykk ) | is.na( rowSums( xkk ) ) )
    if( length( wna ) > 0 ){
      ykk <- ykk[ -wna]
      xkk <- xkk[ -wna, ]
    }
    
    ttt <- suppressWarnings( lm( ykk ~ xkk ) )
    
    tkk <- suppressWarnings( summary( ttt )$adj.r.squared )
    VIF[ k] <- 1/( 1 - tkk )
    
    xu <- sort( unique( x[, k] ) )
    tmp <- identical( c( 0, 1 ), xu )
    if( GETF )if( tmp )isFactor <- c( isFactor, xname[ k] )
    rr[ k, ] <- range( ykk, na.rm = TRUE )
  }
  
  VIF <- VIF[ -wi] 
  rr  <- rr[ drop = FALSE, -wi, ]
  
  rownames( rr ) <- names( VIF )
  colnames( rr ) <- c( 'min', 'max' )
  
  corx <- suppressWarnings( cor( x[, -wi, drop = F], use = "complete.obs" ) )
  
  if( length( wna ) == 0 ){
    rankx <- qr( x )$rank
  } else {
    rankx <- qr( x[ -wna, ] )$rank
  }
  corx[ upper.tri( corx, diag = TRUE )] <- NA
  
  findex <- rep( 0, p )
  
  findex[ xname %in% isFactor] <- 1
  
  designTable <- list( 'table' = rbind( round( VIF, 2 ), findex[ -wi], round( corx, 2 ) ) )
  rownames( designTable$table ) <- c( 'VIF', 'factor', xname[ -wi] )
  
  designTable$table <- designTable$table[ -3, ]
  
  if( p == rankx )designTable$rank <- paste( 'full rank:', rankx, ' = ncol( x )' )
  if( p < rankx ) designTable$rank <- paste( 'not full rank:', rankx, '< ncol( x )' )
  
  list( VIF = round( VIF, 2 ), correlation = round( corx, 2 ), rank = rankx, p = p, 
       isFactor = isFactor, designTable = designTable, range = rr )
}

.wrapperBeta <- function( rvp, rVPI, priorB, priorIVB, SAMPR, obsRows, 
                          tdata, xfecCols, xrepCols, last0first1, ntree, nyr, 
                          betaPrior, years, YR, AR, yrIndex, 
                          RANDOM, reIndex, xrandCols, RANDYR, fitCols, 
                          specNames, FECWT ){
  
  function( pars, xfec, xrep, w, z, zmat, matYr, muyr ){
    
    fg        <- pars$fg
    sg        <- pars$sg
    nspec     <- length( specNames )
    bgFec     <- pars$bgFec
    bgRep     <- pars$bgRep
    betaYrF   <- pars$betaYrF
    betaYrR   <- pars$betaYrR
    alphaRand <- pars$alphaRand
    Arand     <- pars$Arand
    ngroup    <- length( pars$ug )
    qr <- ncol( xrep )
    
    accept <- 0

    ONEF <- ONER <- ONEA <- FALSE
    if( ncol( xfec ) == 1 )ONEF <- TRUE
    if( ncol( xrep ) == 1 )ONER <- TRUE
    if( length( Arand ) == 1 )ONEA <- TRUE
    
    nxx <- length( obsRows )
    yg  <- log( fg )[ obsRows]
    
    yeffect <- reffect <- 0
    
    
    xfz <- xfec[ drop = FALSE, obsRows, ]
    bgf <- bgFec
    
    if( FECWT )weight <- tdata$fecWt[ obsRows]
    
    w0  <- which( colSums( xfz ) == 0 )  
    
    fitCols <- fitCols[ !fitCols %in% w0]
    qf <- length( fitCols )
    xfz <- xfz[, fitCols, drop = FALSE]
    bgf <- bgf[ drop = FALSE, fitCols, ]
    
    if( YR ){                            # yeffect in mean
      yg <- yg - betaYrF[ yrIndex[ obsRows, 'year']] 
      if( RANDYR ) yg <- yg - betaYrR[ yrIndex[ obsRows, c( 'group', 'year' )]]
    }
    
    if( AR ){
      yg <- yg - muyr[ obsRows]
    }
    
    if( RANDOM ){                        
      reffect <- xfec[, xrandCols]*alphaRand[ reIndex, ]
      if( !ONEA )reffect <- rowSums( reffect )
      yg <- yg - reffect[ obsRows]
    }
    
    zrow <- z[ obsRows]
    
    if( sum( zrow ) <= ncol( xfz ) ){                     # insufficient mature trees
      return( list( bgFec = bgFec, bgRep = bgRep ) )
    }
    
    if( ONEF ){
      
      if( FECWT ){
        sw <- weight[ zrow == 1]
        zz <- sum( zrow*sw )
        yy <- sum( yg[ zrow == 1]*sw )
      }else{
        zz <- sum( zrow )
        yy <- sum( yg[ zrow == 1] )
      }
      
      V <- 1/( zz/sg + .1 )
      v <- yy/sg
      if( is.null( betaPrior ) ){
        bgf <- matrix( rnorm( 1, V*v, sqrt( V ) ), 1 )
      }else{
        lims  <- betaPrior$rep
        bgf   <- matrix( .tnorm( 1, lo = lims[, 1], hi = lims[, 2], V*v, sqrt( V ) ), 1 )
      }
      
    }else{
      
      if( FECWT ){
        xw <- xfz[ zrow == 1, ]*weight[ zrow == 1]
        yw <- yg[ zrow == 1]*weight[ zrow == 1]
        XX <- 1/sg*crossprod( xw ) + diag( .1, qf )
        v  <- 1/sg*crossprod( xw, yw ) 
      }else{
        XX <- 1/sg*crossprod( xfz[ zrow == 1, ] ) + diag( .1, qf )
        v  <- 1/sg*crossprod( xfz[ zrow == 1, ], yg[ zrow == 1] ) 
      }
      
      testv <- try( chol( XX ) , T )
      if( inherits( testv, 'try-error' ) ){
        diag( XX )  <- diag( XX )*1.00001
        testv <- try( chol( XX, pivot = TRUE ), T )
      }
      V  <- chol2inv( testv )
      
      if( is.null( betaPrior ) ){
        bgf  <- t( rmvnormRcpp( 1, V%*%v, V ) )
        ww   <- which( abs( bgf ) > 10 )
        if( length( ww ) > 0 ){
          bgf <- t( .tnormMVNmatrix( avec = t( bgf ), muvec = t( bgf ), smat = V, 
                             lo = matrix( -10, 1, length( bgf ) ), 
                             hi = matrix( 10, 1, length( bgf ) ), 
                             whichSample = ww ) )
        }
      }else{
        lims <- betaPrior$fec[ fitCols, ]
        diag( V ) <- diag( V )*1.000000001
        ma   <- t( V%*%v )
        bgf  <- t( .tnormMVNmatrix( avec = t( bgf ), muvec = ma, smat = V, 
                                   lo = matrix( lims[, 1], 1 ), 
                                   hi = matrix( lims[, 2], 1 ) ) )
      }
    }
    
    bgFec <- bgFec*0
    bgFec[ fitCols, ] <- bgf
    
    ww <- which( bgFec < betaPrior$fec[, 1] )
    vv <- which( bgFec > betaPrior$fec[, 2] )
    
    if( length( ww ) > 0 | length( vv ) > 0 ){
      print( bgFec )
      stop( 'bgfec error' )
    }
    
    # maturation
    if( ONER ){
      
      V <- 1/( nxx + .1 )
      v <- sum( w[ obsRows] - .1*1 )
      if( is.null( betaPrior ) ){
        bgRep <- rnorm( 1, V*v, sqrt( V ) )
      }else{
        lims  <- betaPrior$rep
        bgRep <- .tnorm( 1, lo = lims[, 1], hi = lims[, 2], V*v, sqrt( V ) )
      }
      
    }else{
      
      V  <- solve( crossprod( xrep[ obsRows, ] ) + rVPI )
      v  <- crossprod( xrep[ obsRows, ], w[ obsRows] ) + rVPI%*%rvp
      if( is.null( betaPrior ) ){
        bgRep <- t( rmvnormRcpp( 1, V%*%v, V ) )
      }else{
        lims  <- betaPrior$rep
        bgRep <- t( .tnormMVNmatrix( avec = matrix( bgRep, 1 ), muvec = t( V%*%v ), smat = V, 
                                    lo = matrix( lims[, 1], 1 ), 
                                    hi = matrix( lims[, 2], 1 ) ) )
      }
    }
    rownames( bgFec ) <- colnames( xfec ) 
    rownames( bgRep ) <- colnames( xrep ) 
    
    list( bgFec = bgFec, bgRep = bgRep )
  }
}
    
.wrapperU <- function( distall, tdata, minU, maxU, priorU, priorVU, 
                      seedNames, nspec, trapRows, obsRowSeed, obsYr, 
                      tau1, tau2, SAMPR, RANDYR, USPEC ){
         
  tdat <- tdata[ trapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )]
  
  function( pars, z, propU, sdata ){
                    
    fg <- pars$fg
    ug <- pars$ug
    umean <- pars$umean
    uvar  <- pars$uvar
    R     <- pars$R
    
    if( USPEC ){
      unew <- .tnorm( nspec, minU, maxU, ug, rexp( nspec, 1/propU ) )
      names( unew ) <- names( ug )
    }else{
      unew <- ug
      unew[ 1] <- .tnorm( 1, minU[ 1], maxU[ 1], ug[ 1], rexp( 1, 1/propU ) )
    }
    
    if( !RANDYR ){
      umean <- priorU
      uvar  <- priorVU
    }
    
    pnow <- .seedProb( tdat1 = tdat, ug, fz = fg[ trapRows]*z[ trapRows], distall, 
                      sdat1 = sdata[ obsRowSeed, ], seedNames, 
                      R, SAMPR, USPEC, year1 = obsYr )
    pnew <- .seedProb( tdat1 = tdat, unew, fz = fg[ trapRows]*z[ trapRows], distall, 
                      sdat1 = sdata[ obsRowSeed, ], seedNames, 
                      R, SAMPR, USPEC, year1 = obsYr ) 
    
    pnow <- sum( pnow ) + sum( dnorm( ug, umean, sqrt( uvar ), log = TRUE ) )
    pnew <- sum( pnew ) + sum( dnorm( unew, umean, sqrt( uvar ), log = TRUE ) )
    pdif <- pnew - pnow
    
    a <- exp( pdif )
    if( is.finite( a ) ){
      if( runif( 1, 0, 1 ) < a ){
        ug <- unew
        propU <- min( c( ug/4, propU*2 ) )
      }else{
        propU <- propU*.9 + .0002
      }
    }
    
    if( USPEC ){  # prior
      V <- 1/( nspec/uvar + 1/priorVU )
      v <- 1/uvar*sum( ug ) + priorU/priorVU
      umean <- .tnorm( 1, min( minU ), max( maxU ), V*v, sqrt( V ) ) 
      uvar  <- 1/rgamma( 1, tau1 + nspec/2, tau2 + .5*sum( ( ug - umean )^2 ) )
    }
    
    list( ug = ug, umean = umean, uvar = uvar, propU = propU )
  }
}

############ not in use:
.lambda <- function( ug, ff, zz, R, tdata, sdata, obsRows, obsRowSeed, obsYr, 
                    distall, AA, SAMPR, PERAREA = FALSE, SPECPRED = F ){
  
  # PERAREA - from per-trap to per-area
  # if length( AA === 1 ) then it must equal 1
  # SPECPRED - predict species rather than seed types
  #AA   - area, vector or one number
  
  nf <- length( ff )
  fz <- ff*zz
  
  if( SAMPR | length( R ) > 1 ){
    if( SPECPRED ){
      fk <- matrix( 0, nf, nrow( R ) )
      jj <- match( as.character( tdata$specPlot[ obsRows] ), rownames( R ) ) 
      fk[ cbind( 1:nf, jj )] <- fz
      fz <- fk
      colnames( fz ) <- rownames( R )
    }else{
      fz <- matrix( fz, length( ff ), ncol = ncol( R ) )*
        R[ drop = FALSE, as.character( tdata$specPlot )[ obsRows], ] 
    }
  }else{
    fz <- matrix( fz, ncol = 1 )
  }
  
  uvec <- ug[ attr( distall, 'species' )]
  
  dmat <- t( uvec/pi/( uvec + t( distall )^2 )^2 )
  dmat[ dmat < 1e-8] <- 0
  
  plotyrs <- unique( sdata$plotyr[ obsRows] )
  
  lambda <- kernYrRcpp( dmat, fz, seedrow = sdata$drow[ obsRowSeed], 
                       treecol = tdata$dcol[ obsRows], plotyrs, 
                       treeplotYr = tdata$plotyr[ obsRows], 
                       seedplotYr = sdata$plotyr[ obsRowSeed] )
  if( SPECPRED ){
    colnames( lambda ) <- rownames( R )
    
    sname <- sort( unique( attr( R, 'species' ) ) )
    ii <- rep( c( 1:nrow( lambda ) ), ncol( lambda ) )
    jj <- match( attr( R, 'species' ), sname )
    jj <- rep( jj, each = nrow( lambda ) )
    
    lambda <- .myBy( as.vector( lambda ), ii, jj, fun = 'sum' )
    colnames( lambda ) <- sname
    
  }else{
    colnames( lambda ) <- colnames( R )
  }
  
  if( PERAREA | length( AA ) == 1 ) return( as.matrix( lambda ) )   # per area
  
  if( length( AA ) > 1 )AA <- AA[ obsRowSeed]
  
  as.matrix( lambda*matrix( AA, nrow( lambda ), ncol( lambda ) ) )  # per trap
}

.wrapperStates <- function( SAMPR, USPEC, RANDOM, SEEDDATA, obsTimes, plotYears, 
                            sdata, tdat, seedNames, last0first1, distall, 
                            YR, AR, trapRows, obsRows, obsTrapRows, obsYr, predYr, obsRowSeed, 
                            ntree, years, nyr, xrandCols, reIndex, yrIndex, 
                            plag, groupByInd, RANDYR, 
                            updateProp, seedTraits, pHMC ){
  
 # maxF <- specPriorVector( maxFec, tdat )
  
  function( g, pars, xfec, xrep, propF, z, zmat, matYr, muyr, 
           muran, epsilon = .00001 ){
    
    # tdat    - species, dcol, year, plotyr
    # pHMC    - fraction of steps that are Hamiltonian
    
    fg        <- pars$fg
    ug        <- pars$ug
    sg        <- pars$sg
    bgFec     <- pars$bgFec
    bgRep     <- pars$bgRep
    betaYrF   <- pars$betaYrF
    betaYrR   <- pars$betaYrR
    alphaRand <- pars$alphaRand
    Arand     <- pars$Arand
    R         <- pars$R
    fecMinCurrent <- tdat$fecMin
    fecMaxCurrent <- tdat$fecMax
    
    fecMinCurrent[ z == 1 & fecMinCurrent < 1] <- 1
    fecMinCurrent[ z == 0 & fecMinCurrent > 1e-4] <- 1e-4
    fecMaxCurrent[ z == 0 & fecMaxCurrent > .999] <- .999

    
    nxx       <- length( fg )
    ngroup    <- nrow( betaYrR )
    bottom    <- -15
    
    accept  <- 0
      
    nspec  <- nrow( R )
    
    ONEF <- ONER <- ONEA    <- FALSE
    if( ncol( xfec ) == 1 )ONEF <- TRUE
    if( ncol( xrep ) == 1 )ONER <- TRUE
    if( length( Arand ) == 1 )ONEA <- TRUE
    
    if( AR )lindex <- 1:plag
    
    ww <- which( fg > fecMaxCurrent )
    vv <- which( fg < fecMinCurrent )
    
    if( length( ww ) > 0 )fg[ ww] <- fecMaxCurrent[ ww]
    if( length( vv ) > 0 )fg[ vv] <- fecMinCurrent[ vv]
    propF[ propF > .1*fg] <- .1*fg[ propF > .1*fg]
    
    yg <- log( fg )
    yg[ yg < bottom] <- bottom
    
    yeffect <- reffect <- 0
    
    xfz <- xfec
    bgf <- bgFec 
    
    w0  <- which( colSums( xfz ) == 0 )  
    if( length( w0 ) > 0 ){
      xfz <- xfz[, -w0]
      bgf <- bgf[ drop = FALSE, -w0, ]
    }
    
    if( YR & !AR ){                            # yeffect in mean
      yeffect <- betaYrF[ yrIndex[, 'year']]
      if( RANDYR )yeffect <- yeffect + betaYrR[ yrIndex[, c( 'group', 'year' )]]
    }
    
    if( RANDOM ){                        
      reffect <- xfec[, xrandCols]*alphaRand[ reIndex, ]
      if( !ONEA )reffect <- rowSums( reffect )
    }
    
    lmu           <- xfec%*%bgFec
    if( YR )lmu     <- lmu + yeffect
    if( RANDOM )lmu <- lmu + reffect
    nall <- length( fg )
    
    tt <- rbinom( 1, 1, pHMC )
    
    if( tt == 1 & SEEDDATA & !AR ){
      
      fg[ fg < 1e-6] <- 1e-6
      
      tmp <- HMC( ff = fg[ obsTrapRows], fMin = fecMinCurrent[ obsTrapRows], 
                 fMax = fecMaxCurrent[ obsTrapRows], 
                 ep = epsilon[ obsTrapRows], 
                 L = 4, tree = tdat[ obsTrapRows, ], sdat = sdata[ obsRowSeed, ], ug, 
                 mu = lmu[ obsTrapRows], sg, zz = z[ obsTrapRows], R, SAMPR, 
                 distance = distall, obsTrapRows, obsYr, seedNames, USPEC )
      fg[ obsTrapRows] <- tmp$fg
      epsilon[ obsTrapRows] <- tmp$epsilon
      
      
      ww <- which( fg > fecMaxCurrent )
      vv <- which( fg < fecMinCurrent )
      
      if( length( ww ) > 0 )fg[ ww] <- fecMaxCurrent[ ww]
      if( length( vv ) > 0 )fg[ vv] <- fecMinCurrent[ vv]
      
      fg[ fg < 1e-6] <- 1e-6
      
      return( list( fg = fg, fecMinCurrent = fecMinCurrent, fecMaxCurrent = fecMaxCurrent, 
                   z = z, zmat = zmat, matYr = matYr, propF = propF, 
                   accept = tmp$accept, epsilon = epsilon ) )
    }
    
    # maturation
    pr  <- pnorm( xrep%*%bgRep )
    iss <- sdata$plotyr
    ii  <- rep( iss, length( seedNames ) )
    
    if( !AR ){               
      
      tmp      <- .propZ( zmat, last0first1, matYr )
      zmatNew  <- tmp$zmat
      znew     <- zmatNew[ yrIndex[, c( 'tnum', 'year' )]] 
      
    #  znew[ tdat$repr == 1] <- 1
    #  znew[ tdat$repr == 0] <- 0
      
      zmatNew[ yrIndex[, c( 'tnum', 'year' )]] <- znew
      
      matYrNew <- tmp$matYr 
      mnow <- z*log( pr ) + ( 1 - z )*log( 1 - pr )
      mnew <- znew*log( pr ) + ( 1 - znew )*log( 1 - pr )
      
      lo <- fecMinCurrent
      hi <- fecMaxCurrent
      lo[ znew == 0 & lo > 1] <- 1e-4
      lo[ znew == 1 & lo < 1] <- 1
      hi[ znew == 0 & hi > 1] <- 1
      hi[ znew == 1 & hi < 1] <- 1
      
      
      fnew <- .tnorm( nall, lo, hi, fg, rexp( nxx, 1/propF ), .001 )
      ynew <- log( fnew )
      
      # fecundity model
      bnow <- bnew <- fg*0
      
      ss   <- sqrt( sg )
      
      bnow[ z == 1]    <- dnorm( yg[ z == 1], lmu[ z == 1], ss, log = TRUE ) 
      bnew[ znew == 1] <- dnorm( ynew[ znew == 1], lmu[ znew == 1], ss, log = TRUE ) 
      
      if( !is.null( seedTraits ) ){
        
        wc <- which( z == 1 & is.finite( tdat$cropCount ) )
        
        if( length( wc ) > 0 ){
          
          fc <- round( fg[ wc] )
          
          oss <- tdat$cropCount[ wc]*seedTraits[ tdat$species[ wc], 'seedsPerFruit']
          
          cnow <- cnew <- fc*0
          tf <- tdat$cropFraction[ wc]
          ts <- tdat$cropFractionSd[ wc]
          cnow <- dbetaBinom( oss, fc, tf, ts, log = TRUE )
          
          bnow[ wc] <- bnow[ wc] + cnow
          
          fn <- round( fnew[ wc] )
          
          cnew <- dbetaBinom( oss, fn, tf, ts, log = TRUE )
          bnew[ wc] <- bnew[ wc] + cnew 
        }
      }
      
      w0 <- which( z == 0 | znew == 0 )
      bnew[ w0] <- bnow[ w0] <- 0
      
      pdif <- 0
      bdif <- tapply( bnew - bnow, tdat$plotyr, sum, na.rm = T )
      mdif <- tapply( mnew - mnow, tdat$plotyr, sum, na.rm = T )
      bdif <- bdif + mdif
      
      if( SEEDDATA ){
        
        pnow <- pnew <- matrix( 0, nrow( sdata ), length( seedNames ) )
        pnow[ obsRowSeed, ] <- .seedProb( tdat[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                                       ug, fg[ obsTrapRows]*z[ obsTrapRows], 
                                       distall, sdata[ obsRowSeed, ], seedNames, R, 
                                       SAMPR, USPEC, obsYr )
        pnew[ obsRowSeed, ] <- .seedProb( tdat[ obsTrapRows, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                                       ug, fnew[ obsTrapRows]*znew[ obsTrapRows], 
                                       distall, sdata[ obsRowSeed, ], seedNames, R, 
                                       SAMPR, USPEC, obsYr )
        pnow[ pnow < -1e+10] <- -1e+10   # intensity parameter is zero
        pnew[ pnew < -1e+10] <- -1e+10
        
        # by plot-yr
        ii   <- sdata$plotyr
        ii   <- rep( ii, length( seedNames ) )
        pdif <- tapply( as.vector( pnew - pnow ), ii, sum, na.rm = T )
        
        nm <- sort( as.numeric( unique( c( names( bdif ), names( pdif ) ) ) ) )
        tm <- rep( 0, length( nm ) )
        names( tm ) <- nm
        tm[ names( bdif )] <- bdif
        tm[ names( pdif )] <- tm[ names( pdif )] + pdif
        bdif <- tm
      }
      

      a  <- exp( bdif )        
      az  <- runif( length( a ), 0, 1 )
   #   aw  <- which( az < a )
      aw  <- as.numeric( names( bdif )[ az < a] )
      
      accept <- accept + length( aw )
      
      propF <- propF/2
      
      if( length( aw ) > 0 ){
        
        wa <- which( tdat$plotyr %in% aw )
        
        yg[ wa] <- ynew[ wa]
        z[ wa]  <- znew[ wa]
        fecMinCurrent[ wa] <- lo[ wa]
        fecMaxCurrent[ wa] <- hi[ wa]
        zmat[ yrIndex[, c( 'tnum', 'year' )]] <- z  
        
        tmp <- apply( zmat, 1, which.max )
        tmp[ rowSums( zmat ) == 0] <- ncol( zmat )
        matYr <- tmp
        
        if( g %in% updateProp ){
          propF[ wa] <- propF[ wa]*5
        }
        
      }else{
        propF <- propF*.5
      }
      
    }else{         # AR
       
      #independence sampler
      
      p2s <- rep( 0, length( plotYears ) )
      
      yy <- mu <- matrix( 0, ntree, nyr )
      yy[ yrIndex[, c( 'tnum', 'year' )]] <- yg
      mu[ yrIndex[, c( 'tnum', 'year' )]] <- lmu
      
      #prior for backcast based on obsRows
      
      yprior <- tapply( yg[ obsRows], yrIndex[ obsRows, 'tnum'], mean )
      
      
      for( t in 1:length( predYr ) ){        
        
        tii  <- which( yrIndex[, 'year'] == t )  # row in tdat
        oii  <- tii[ tdat$obs[ tii] == 1]      # with observations
        yii  <- yrIndex[ tii, 'tnum']           # location in ytmp
        nii  <- length( yii )
        fmin <- log( tdat$fecMin[ tii] )       # from data
        fmax <- log( tdat$fecMax[ tii] )
        
        zt <- zmat[ yii, t]
        zp <- rbinom( length( zt ), 1, .5 )
        
        #new and current
        ln <- lo <- fmin
        hn <- hi <- fmax
        
        wp <- last0first1[ yii, 'first1'] <= t | last0first1[ yii, 'all1'] == 1
        wn <- last0first1[ yii, 'last0'] >= t | last0first1[ yii, 'all0'] == 1
        if( t > 1 )  wp <- wp | zmat[ yii, t-1] == 1
        if( t < nyr )wn <- wn | zmat[ yii, t+1] == 0
        zp[ wp] <- 1
        zp[ wn] <- 0
        
        dz <- zp - zt
        ln[ dz == 1]  <- 0                #from zero to one
        hn[ dz == 1]  <- fmax[ dz == 1]
        ln[ dz == -1] <- -fmax[ dz == -1]  #from one to zero
        hn[ dz == -1] <- 0
        
        mnow <- zt*log( pr[ tii] ) + ( 1 - zt )*log( 1 - pr[ tii] )
        mnew <- zp*log( pr[ tii] ) + ( 1 - zp )*log( 1 - pr[ tii] )
        
        a  <- exp( mnew - mnow )        
        az  <- runif( nii, 0, 1 )
        aw  <- which( az < a )
        
        accept <- accept + length( aw )
        
        pindex <- t - ( 1:plag )
        w0     <- which( pindex > 0 )
        mt     <- mu[, t]
        VI     <- rep( 1, ntree )       # prior
        if( t > 1 ){                   # m_t and VI
          pindex <- pindex[ w0]
          byr <- matrix( betaYrF[ w0], ntree, length( w0 ), byrow = TRUE )
          if( RANDYR )byr <- byr + betaYrR[ groupByInd, w0, drop = FALSE]
          
          bv <- rowSums( byr*yy[, pindex] )
          mt <- mt + bv 
          
          bv <- rowSums( byr^2 )
          VI <- VI + bv
        }
        V <- sg/VI
        
        if( t > max( obsTimes ) ){    ###### predict forward
          
          if( length( aw ) > 0 ){
            z[ tii[ aw]] <- zp[ aw]
            zmat[ yii[ aw], t]   <- zp[ aw]
            fecMinCurrent[ tii[ aw]]  <- exp( ln[ aw] )
            fecMaxCurrent[ tii[ aw]]  <- exp( hn[ aw] )
          }
          yy[ yii, t] <- .tnorm( nii, lo, hi, mt[ yii], sqrt( sg ) )
          next
        }
        
        vt  <- mt            # v_t
        ptl <- 1:plag
        ptl <- ptl[ ( t + ptl ) <= nyr]
        
        for( k in ptl ){

          tindex <- t + k - lindex
          wt  <- which( lindex != k & tindex > 0 )
          
          if( length( wt ) == 0 )next
          
          byr1 <- matrix( betaYrF[ wt], ntree, length( wt ), byrow = TRUE ) 
          byr2 <- betaYrF[ k]
          if( RANDYR ){
            byr1 <- byr1 + betaYrR[ groupByInd, wt, drop = FALSE]
            byr2 <- byr2 + betaYrR[ groupByInd, k]
          }
          
          ntl <- yy[, t+k] - mu[, t+k] - rowSums( byr1*yy[, tindex[ wt]] )
          vt  <- vt + ntl*byr2
        }
        vt <- vt/sg 
        
        if( t <= plag ){       #### impute backward
          
          if( length( aw ) > 0 ){
            z[ tii[ aw]] <- zp[ aw]
            zmat[ yii[ aw], t] <- zp[ aw]
            fecMinCurrent[ tii[ aw]]  <- exp( ln[ aw] )
            fecMaxCurrent[ tii[ aw]]  <- exp( hn[ aw] )
            
          }
          V[ yii]  <- 1/( 1/V[ yii] + 1/.5 )
          vt[ yii] <- vt[ yii] + yprior[ yii]/.5
          yy[ yii, t] <- .tnorm( nii, lo, hi, ( V*vt )[ yii], sqrt( V[ yii] ) )
          
          next
        }
        
        # seed data
        sii  <- which( sdata$year == years[ t] ) # year row in seedData
        
        ynew <- .tnorm( nii, ln, hn, ( V*vt )[ yii], sqrt( V[ yii] ) ) # from conditional
        
        tree <- tdat[ tii, ]
        seed <- sdata[ sii, ]
        spy  <- seed$plotyr
        
        wtt <- which( !tree$plotyr %in% spy ) 
        
        if( length( wtt ) > 0 ){         #year before seed data, draw from conditional
          if( length( aw ) > 0 ){
            aww <- aw[ aw %in% wtt]   #year before and update
            z[ tii[ aww]] <- zp[ aww]
            zmat[ yii[ aww], t] <- zp[ aww]
            fecMinCurrent[ tii[ aww]]  <- exp( ln[ aww] )
            fecMaxCurrent[ tii[ aww]]  <- exp( hn[ aww] )
          }
          yy[ yii[ wtt], t] <- .tnorm( length( wtt ), lo[ wtt], hi[ wtt], 
                                   ( V*vt )[ yii[ wtt]], sqrt( V[ yii[ wtt]] ) )
          wtk <- which( tree$plotyr %in% spy )
          if( length( wtk ) > 0 ){
            tii <- tii[ wtk]
            yii <- yii[ wtk]
            
            tree <- tdat[ tii, ]
            mnow  <- mnow[ wtk]
            mnew  <- mnew[ wtk]
            ynew  <- ynew[ wtk]
            zp    <- zp[ wtk]
          }
        }
        
        cdif <- numeric( 0 )
        
        if( length( spy ) > 0 ){
          
          cnow <- cnew <- 0
          
          if( !is.null( seedTraits ) ){
            cc <- is.finite( tree$cropCount )
            wc <- which( z[ tii] == 1 & cc )
            
            if( length( wc ) > 0 ){
              
              fc <- round( fg[ tii[ wc]] )
              
              oss <- tree$cropCount[ wc]*seedTraits[ tree$species[ wc], 'seedsPerFruit']
              
              cnow <- cnew <- fc*0
              tf   <- tree$cropFraction[ wc]
              ts   <- tree$cropFractionSd[ wc]
              cnow <- dbetaBinom( oss, round( fc ), tf, ts, log = TRUE )

              fn   <- round( exp( ynew[ wc] ) )
              cnew <- dbetaBinom( oss, round( fn ), tf, ts, log = TRUE )
              ip   <- match( tree$plotYr[ wc], plotYears )
              sm   <- matrix( 0, max( ip ), 1 )
              cdif <- .myBy( cnew - cnow, ip, ip*0+1, summat = sm, fun = 'sum' )
            }
          }
          
          #########################
          
          if( SEEDDATA ){
            wii <- which( tii %in% obsTrapRows )
            qii <- tii[ wii]
            
            pnow <- .seedProb( tree[ wii, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                              ug, fg[ qii]*z[ qii], distall, seed, 
                              seedNames, R, SAMPR, USPEC, years[ t] )
            pnew <- .seedProb( tree[ wii, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                              ug, exp( ynew[ wii] )*zp[ wii], distall, seed, 
                              seedNames, R, SAMPR, USPEC, years[ t] ) ###############z[ tii]
            pnow[ pnow < -1e+10] <- -1e+10   # intensity parameter is zero
            pnew[ pnew < -1e+10] <- -1e+10
            
            iy   <- seed$plotyr
            iy   <- rep( iy, length( seedNames ) )
            pdif <- .myBy( as.vector( pnew - pnow ), iy, iy*0 + 1, fun = 'sum' )
            
            pyID <- unique( iy )       # plot yr for pnew/pnow
            p2s[ pyID] <- p2s[ pyID] + pdif[ pyID]
            
          }
          
          ip <- match( tree$plotYr, plotYears )
          sm <- matrix( 0, max( ip ), 1 )
          
          mdif <- .myBy( mnew - mnow, ip, ip*0+1, summat = sm, fun = 'sum' )
          
          myID <- unique( ip )
          p2s[ myID] <- p2s[ myID] +  mdif[ myID] 
          if( !is.null( seedTraits ) & length( cdif ) > 1 )
            p2s[ myID] <- p2s[ myID] + cdif[ myID] 
          
          a  <- exp( p2s )        
          az  <- runif( length( a ), 0, 1 )
          aw  <- which( az < a )
          
          accept <- length( aw )  # no. plot-years
          
          if( length( aw ) > 0 ){
            wa <- which( tree$plotyr %in% aw )  #rows in tdat[ tii, ]
            yy[ yii[ wa], t] <- ynew[ wa]
            z[ tii[ wa]]  <- zp[ wa]
            fecMinCurrent[ tii[ wa]]  <- exp( ln[ wa] )
            fecMaxCurrent[ tii[ wa]]  <- exp( hn[ wa] )
            #      zmat[ wa, t] <- z[ tii[ wa]]
          }
          if( is.na( max( fecMaxCurrent ) ) ) stop( )
        }
      }
      
      yg[ obsRowSeed] <- yy[ cbind( tdat$dcol[ obsRowSeed], tdat$times[ obsRowSeed] )]
      tmp <- apply( zmat, 1, which.max )
      tmp[ rowSums( zmat ) == 0] <- ncol( zmat )
      matYr <- tmp
    }
    
    fg <- exp( yg )
    wf <- which( propF < fg/100 )
    
    if( length( wf ) > 0 )propF[ wf] <- fg[ wf]/100
    
    fecMinCurrent[ fecMinCurrent < 1e-6] <- 1e-6
    fecMaxCurrent[ fecMaxCurrent < 1] <- 1
    
    fg[ fg > fecMaxCurrent] <- fecMaxCurrent[ fg > fecMaxCurrent]
    fg[ fg < fecMinCurrent] <- fecMinCurrent[ fg < fecMinCurrent]
    fg[ fg < 1e-6] <- 1e-6
            
    list( fg = fg, fecMinCurrent = fecMinCurrent, fecMaxCurrent = fecMaxCurrent, 
         z = z, zmat = zmat, matYr = matYr, propF = propF, 
         epsilon = epsilon, accept = accept ) 
  } 
}
 
.getF <- function( kern, gg ){
  
  tiny <- .0001
  
  fec <- rep( 0, ncol( kern ) )
  
  kk <- kern
  K   <- crossprod( kk )
  K   <- K + diag( tiny*diag( K ), nrow( K ), nrow( K ) )
  fec <- solve( K )%*%crossprod( kk, gg )
  
  fec[ fec < tiny] <- tiny
  fec
}

.specFormula <- function( formula, NOINTERCEPT = FALSE ){
  
  form <- paste0( as.character( formula ), collapse = ' ' )
  form <- .replaceString( form, '~', '~ species*' )
  form <- .replaceString( form, ' + ', '+ species*' )
  form <- .replaceString( form, '* 1', '' )
  form <- .replaceString( form, '*1', '' )
  if( NOINTERCEPT ) form <- paste( form, '-1' )
  as.formula( paste( form, collapse = ' ' ) )
}

.getBetaPrior <- function( betaPrior, bgFec, bgRep, specNames, diamMean, diamSd, 
                          priorTable = NULL ){
  
  rownames( bgFec ) <- short2longParName( rownames( bgFec ), specNames )
  rownames( bgRep ) <- short2longParName( rownames( bgRep ), specNames )
  fecHi <- bgFec*0 + 10
  fecLo <- bgFec*0 - 10
  repHi <- bgRep*0 + 5
  repLo <- bgRep*0 - 5
  nspec <- length( specNames )
  
  if( 'pos' %in% names( betaPrior ) ){
    for( j in 1:length( betaPrior$pos ) ){
      jn <- character( 0 )
      if( nspec > 1 )jn <- paste( 'species', specNames, ':', sep = '' )
      if( betaPrior$pos[ j] != 'intercept' )jn <- paste( jn, betaPrior$pos[ j], sep = '' )
      fecLo[ rownames( fecLo ) %in% jn] <- 0
    }
  }
  if( 'neg' %in% names( betaPrior ) ){
    for( j in 1:length( betaPrior$neg ) ){
      jn <- character( 0 )
      if( nspec > 1 )jn <- paste( 'species', specNames, ':', sep = '' )
      if( betaPrior$neg[ j] != 'intercept' )jn <- paste( jn, betaPrior$neg[ j], sep = '' )
      fecHi[ rownames( fecHi ) %in% jn] <- 0
    }
  }
  
  nr <- nrow( bgRep )
  diam0 <- -diamMean/diamSd                   # zero diameter on standardized scale
  
  r1 <- 1:( nr/2 )
  r2 <- ( nr/2 + 1 ):nr
  
  if( !is.null( priorTable ) ){
    
    wd <- character( 0 )
    if( 'sex' %in% names( attributes( priorTable ) ) ){
      sex <- attributes( priorTable )$sex
      wd  <- names( sex )[ sex == 'dioecious']
    }
    
    for( m in 1:nrow( priorTable ) ){
      
      mm <- grep( rownames( priorTable )[ m], rownames( bgRep )[ r2] )
      
      if( length( mm ) == 0 )mm <- 1                  # species name not in rownames( bgRep ) 
      
      diamMin <- priorTable$minDiam[ mm]
      diamMax <- priorTable$maxDiam[ mm]
      
      if( diamMin >= diamMax )stop( ' \nprior min diam must be smaller than max diam' )
      
      qmin <- qnorm( .0001 )                          # lower bound
      qmax <- qnorm( .8 )
      if( specNames[ m] %in% wd )qmax <- qnorm( .00011 )
      z <- cbind( 1, c( diamMin, diamMax ) )
      blo <- solve( crossprod( z ) )%*%crossprod( z, c( qmin, qmax ) )
      
      qmin <- qnorm( .2 )           
      qmax <- qnorm( .9999 )
      if( specNames[ m] %in% wd )qmin <- qnorm( .01 )
      z   <- cbind( 1, c( diamMin, diamMax ) )
      bhi <- solve( crossprod( z ) )%*%crossprod( z, c( qmin, qmax ) )
      repLo[ r1[ m], 1] <- blo[ 1]
      repHi[ r1[ m], 1] <- bhi[ 1]
      repLo[ r2[ m], 1] <- blo[ 2]
      repHi[ r2[ m], 1] <- bhi[ 2]
    }
    repLo[ repHi < repLo] <- repHi[ repHi < repLo] - 1
  }
  
  list( fec = cbind( fecLo, fecHi ), rep = cbind( repLo, repHi ) )
}

.updateBetaYr <- function( yg, z, sg, sgYr, betaYrF, betaYrR, yrIndex, yeGr, 
                          RANDYR, obs ){
  
  #fixed effects
  
  wz <- which( z == 1 & obs == 1 )
  nk <- max( yrIndex[, 'year'] )              # no. years
  yk <- yrIndex[ wz, c( 'group', 'year' ), drop = FALSE]      # year groups, years
  G  <- length( yeGr )
  bf <- betaYrF*0
  
  yfix <- yg[ wz] 
 # if( RANDYR )yfix <- yfix - betaYrR[ yrIndex[ wz, c( 'group', 'year' )]]
  
  if( !RANDYR ){
    
    ygroup <- .myBy( yfix, yk[, 2]*0+1, yk[, 2], 
                    summat = matrix( 0, 1, nk ), fun = 'sum' )
    ngr  <- .myBy( yfix*0+1, yk[, 2]*0+1, yk[, 2], 
                  summat = matrix( 0, 1, nk ), fun = 'sum' )
    v <- ygroup/sg
    V <- 1/( ngr/sg + .1 )
    bf <- matrix( .tnorm( length( v ), -2, 2, V*v, sqrt( V ) ), 1, nk )
    bf <- bf - mean( bf )                                   # sum to zero
    
    if( !RANDYR )return( list( betaYrF = bf, betaYrR = bf*0, sgYr = sgYr, 
                            wfinite = 1:nk ) )
  }
  
  # random effects
  
  summat <- matrix( 0, G, nk )
  if( nrow( yk ) > 1 ){
    ygroup <- .myBy( yfix, yk[, 1, drop = FALSE], yk[, 2, drop = FALSE], 
                    summat = summat, fun = 'sum' )
    ngr  <- .myBy( wz*0+1, yk[, 1, drop = FALSE], yk[, 2, drop = FALSE], 
                  summat = summat, fun = 'sum' )
  }else{
    ygroup <- ngr <- summat
    ygroup[ yk] <- yfix
    ngr[ yk] <- 1
  }
  
  v  <- ygroup/sg 
  V  <- 1/( ngr /sg + matrix( 1/sgYr, G, nk, byrow = TRUE ) )
  nc <- ngr 
  nc[ nc > 1] <- 1
  ns <- colSums( nc )
 # nc[, ns == 1] <- 0     # no group effect if only one group
  
  br <- matrix( .tnorm( length( v ), -3, 3, V*v, sqrt( V ) ), G, nk )
  br <- br*nc
  
  rs <- rowSums( nc )
  ws <- which( rs > 0 )
  
  br[ ws, ] <- sweep( br[ drop = FALSE, ws, ], 1, rowSums( br[ drop = FALSE, ws, ] )/rs[ ws], '-' )*nc[ drop = FALSE, ws, ]
  
  sgYr <- 1/rgamma( nk, 1 + ns/2, 1 + .5* colSums( br^2 ) )
  
  rownames( br ) <- yeGr
  
  list( betaYrF = bf, betaYrR = br, sgYr = sgYr, wfinite = which( nc > 0 ) )
}

.multivarChainNames <- function( rowNames, colNames ){
  as.vector( t( outer( colNames, rowNames, paste, sep = '_' ) ) )
}

.updateR <- function( ug, fz, SAMPR, USPEC, distall, sdata, seedNames, 
                     tdat, R, priorR, priorRwt, years, posR, plots ){
  
  mnew <- R
  mnew[ posR] <- .tnorm( length( posR ), 0, 1, R[ posR], rexp( length( posR ), 50 ) )
  
  mnew <- sweep( mnew, 1, rowSums( mnew, na.rm = TRUE ), '/' )
 # mnew[ -posR] <- 0

  qnow <- 2*priorRwt*log( R )
  qnow[ -posR] <- 0
  qnew <- 2*priorRwt*log( mnew )
  qnew[ -posR] <- 0
  
  jj <- rep( attr( R, 'plot' ), ncol( R ) )
  qnow <- tapply( as.vector( qnow ), jj, sum, na.rm = TRUE )
  qnew <- tapply( as.vector( qnew ), jj, sum, na.rm = TRUE )

  tnow <- .seedProb( tdat[, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                    ug, fz, distall, sdata, seedNames, 
                        R, SAMPR, USPEC, years )
  tnew <- .seedProb( tdat[, c( 'specPlot', 'year', 'plotyr', 'dcol' )], 
                    ug, fz, distall, sdata, seedNames, 
                    mnew, SAMPR, USPEC, years )
  tnow[ !is.finite( tnow )] <- -10   # intensity parameter is zero
  tnew[ !is.finite( tnew )] <- -10
  
  ps <- plots[ plots %in% sdata$plot]
  ii <- match( sdata$plot, ps )
  pnow <- .myBy( rowSums( tnow ), ii, ii*0+1, fun = 'sum' )[, 1]
  pnew <- .myBy( rowSums( tnew ), ii, ii*0+1, fun = 'sum' )[, 1]
  names( pnow ) <- names( pnew ) <- ps
  
  pdif <- pnew - pnow
  qdif <- qnew - qnow
  
  qdif[ ps] <- qdif[ ps] <- pdif
  
  a <- exp( qdif ) 
  wa <- which( a > runif( length( a ), 0, 1 ) )
  if( length( wa ) > 0 ){
    R[ attr( R, 'plot' ) %in% plots[ wa], ] <- mnew[ attr( R, 'plot' ) %in% plots[ wa], ]
  }
  R
}

.distmat <- function( x1, y1, x2, y2 ){
    xd <- outer( x1, x2, function( x1, x2 ) ( x1 - x2 )^2 )
    yd <- outer( y1, y2, function( y1, y2 ) ( y1 - y2 )^2 )
    t( sqrt( xd + yd ) ) 
}

.updateVariance <- function( yy, mu, s1 = 1, s2 = 1 ){
  
  ss <- ( yy - mu )^2
  u1 <- s1 + length( yy )/2
  u2 <- s2 + .5*sum( ss )
  1/rgamma( 1, u1, u2 ) 
  
}

sqrtSeq <- function( maxval ){ #labels for sqrt scale
  
  # maxval on sqrt scale
  
  by   <- signif( maxval^1.7, 1 )
  labs <- seq( 0, maxval^2, by = by )
  at   <- sqrt( labs )

  list( at = at, labs = labs )
}

.plotObsPred <- function( obs, yMean, ySE = NULL, opt = NULL ){
  
  nbin <- nPerBin <- xlimit <- ylimit <- NULL
  add <- log <- SQRT <- FALSE
  xlabel <- 'Observed'
  ylabel <- 'Predicted'
  trans <- .4
  col <- 'black'
  bins <- NULL
  atx <- aty <- labx <- laby <- NULL
  ptcol <- 'black'
  
  for( k in 1:length( opt ) )assign( names( opt )[ k], opt[[ k]] )
  
  if( !is.null( bins ) )nbin <- length( bins )
  
  if( log & SQRT )stop( '\ncannot have both log and SQRT scale\n' )
  
  yMean <- as.matrix( yMean )
  obs   <- as.matrix( obs )
  
  if( SQRT ){
    if( is.null( xlimit ) )xlimit <- c( 0, max( opt$labx ) )
    if( is.null( ylimit ) )ylimit <- c( 0, max( opt$laby ) )
    
    xlim <- sqrt( xlimit )
    ylim <- sqrt( ylimit )
    obs   <- as.vector( sqrt( obs ) )
    yMean <- as.vector( sqrt( yMean ) )
    if( !is.null( bins ) )bins <- sqrt( bins )
    xlimit <- sqrt( range( obs, na.rm = TRUE ) )
    xlimit[ 2] <- xlimit[ 2]*2
    ylimit <- sqrt( range( yMean, na.rm = TRUE ) )
    ylimit[ 2] <- 1.2*ylimit[ 2]
 
    maxy <- max( yMean, na.rm = TRUE )
    maxx   <- max( obs, na.rm = TRUE )
    maxval <- max( c( maxx, maxy ) )
    
    tt   <- sqrtSeq( 1.2*maxx )
    if( is.null( atx ) )atx   <- tt$at
    if( is.null( labx ) )labx <- tt$labs
    
    if( ylimit[ 2] < xlimit[ 2] ) ylimit[ 2] <- xlimit[ 2]
    if( xlimit[ 2] < xlim[ 2] )   xlimit[ 2] <- xlim[ 2]
    if( ylimit[ 2] < ylim[ 2] )   ylimit[ 2] <- ylim[ 2]
    
    tt   <- sqrtSeq( 1.5*ylimit[ 2] )
    if( is.null( aty ) )aty   <- tt$at
    if( is.null( laby ) )laby <- tt$labs

  }
    
  if( is.null( xlimit ) )xlimit <- range( obs )
  if( is.null( ylimit ) & !add ){                      # can only happen if !SQRT
    if( !log ){
      plot( obs, yMean, col = .getColor( ptcol, .2 ), cex = .2, xlim = xlimit, 
           xlab = xlabel, ylab = ylabel )
      if( log ) suppressWarnings( plot( obs, yMean, col = .getColor( 'black', .2 ), cex = .3, 
                                     xlim = xlimit, xlab = xlabel, ylab = ylabel, log = 'xy' ) )
    }
  }
    
  if( !is.null( ylimit ) ){
    if( !log & !add ){
      if( !SQRT ){
        plot( obs, yMean, col = .getColor( ptcol, trans ), cex = .2, 
                 xlim = xlimit, xlab = xlabel, ylab = ylabel, ylim = ylimit )
      }else{
        plot( obs, yMean, col = .getColor( ptcol, trans ), cex = .2, 
             xlim = xlimit, xlab = xlabel, ylab = ylabel, ylim = ylimit, 
             xaxt = 'n', yaxt = 'n' )
        
        axis( 1, at = atx, labels = labx )
        axis( 2, at = aty, labels = laby, las = 2 )
      }
    }
    if( log & !add ) plot( obs, yMean, col = .getColor( ptcol, trans ), cex = .2, 
                 xlim = xlimit, xlab = xlabel, ylab = ylabel, log = 'xy', ylim = ylimit )
  }
  if( !is.null( ySE ) ){
    ylo <- yMean - 1.96*ySE
    yhi <- yMean + 1.96*ySE
    for( i in 1:length( obs ) )lines( c( obs[ i], obs[ i] ), c( ylo[ i], yhi[ i] ), 
                                 col = 'grey', lwd = 2 )
  }
  
  if( !is.null( nbin ) | !is.null( nPerBin ) ){
    
    if( is.null( bins ) ){
      nbin <- 20
      bins <- seq( min( obs, na.rm = TRUE ), max( obs, na.rm = TRUE ), length = nbin )
    }else{
      nbin <- length( bins )
    }
    
    if( !is.null( nPerBin ) ){
      nbb <- nPerBin/length( obs )
      nbb <- seq( 0, 1, by = nbb )
      if( max( nbb ) < 1 )nbb <- c( nbb, 1 )
      bins <- quantile( obs, nbb, na.rm = TRUE )
      bins <- bins[ !duplicated( bins )]
      nbin <- length( bins )
    }
    
    xxk <- findInterval( obs, bins )
    
    if( SQRT & is.null( bins ) ){
      opos <- obs[ obs > 0]
      qq <- seq( 0, 1, length = 15 )
      bins <- quantile( opos, qq )
      dbb  <- diff( bins )
      bins <- c( bins[ 1], bins[ -1][ dbb > .01] )
      
      nbin <- length( bins )
      
      xxk <- findInterval( obs, bins )
      xxk[ xxk == max( xxk )] <- max( xxk ) - 1
    }
    xxk[ xxk == nbin] <- nbin - 1
    
    wide <- diff( bins )/2
    db   <- 1
    for( k in 2:( nbin-1 ) ){
      
      qk <- which( is.finite( yMean ) & xxk == k )
      q  <- quantile( yMean[ qk], c( .5, .025, .158, .841, .975 ), na.rm = TRUE )
      
      if( !is.finite( q[ 1] ) )next
      if( q[ 1] == q[ 2] )next
      
      ym <- mean( yMean[ qk] )
      xx <- mean( bins[ k:( k+1 )] )
      rwide <- wide[ k]
      
      if( k > 1 )db <- bins[ k] - bins[ k-1]
      
      if( xx > ( bins[ k] + db ) ){
        xx <- bins[ k] + db
        rwide <- wide[ max( c( 1, k-1 ) )]
      }
      
      suppressWarnings( 
        arrows( xx, q[ 2], xx, q[ 5], lwd = 2, angle = 90, code = 3, col = .getColor( col, .8 ), 
               length = .05 )
      )
      lines( c( xx-.5*rwide, xx+.5*rwide ), q[ c( 1, 1 )], lwd = 2, 
            col = .getColor( col, .8 ) )
      rect( xx-.4*rwide, q[ 3], xx+.4*rwide, q[ 4], col = .getColor( col, .5 ), border = col )
    }
  }
  invisible( list( atx = atx, labx = labx, aty = aty, laby = laby ) )
}

.getKern <- function( u, dij ){
  
  uvec <- u[ attr( dij, 'group' )]
  kk <- t( uvec/pi/( uvec + t( dij )^2 )^2 )
  
 # kk <- u/pi/( u + dij^2 )^2
  kk[ is.na( kk )] <- 0
  kk
}

.mapSpec <- function( x, y, z, mapx = range( x ), mapy = range( y ), scale = 0, 
                     add = FALSE, sym = 'circles', 
                     colVec = rep( 1, length( x ) ), fill = FALSE ){
  
  fillCol <- NA
  if( is.logical( fill ) )fillCol <- colVec
  if( is.character( fill ) )fillCol <- fill
  
  opin <- par( )$pin
  
  if( scale > 0 ).mapSetup( mapx, mapy, scale )
  if( !add ){
    plot( NA, xlim = mapx, ylim = mapy, axes = F, xlab = '', ylab = '' )
    Axis( side = 1, labels = FALSE )
    Axis( side = 2, labels = FALSE )
    add <- TRUE
  }
  
  if( sym == 'circles' ){

    symbols( x, y, circles = z/10, inches = FALSE, 
                              xlim = mapx, ylim = mapy, fg = colVec, bg = fillCol, 
                              lwd = 2, add = add )
  }
  if( sym == 'squares' ){
    symbols( x, y, squares = z/10, inches = FALSE, 
                              xlim = mapx, ylim = mapy, fg = colVec, bg = fillCol, 
                              lwd = 2, add = add )
  }
  par( pin = opin )
}

scaleBar = function( label, value = 1, fromLeft = .5, yadj = .1, 
                    lwd = 3, cex = 1 ) {
  
  xl <- par( "usr" )[ 1:2]
  yl <- par( "usr" )[ 3:4]
  
  xm <- xl[ 1] + fromLeft*diff( xl )
  x1 <- xm - value/2
  x2 <- xm + value/2
  
  y  <- yl[ 1] + .05*diff( yl )
  ym <- y + yadj*diff( yl )
    
  lines( c( x1, x2 ), c( y, y ), lwd = lwd + 2, col = 'white' )
  lines( c( x1, x2 ), c( y, y ), lwd = lwd )
  
  lab <- paste( value, label )
  text( xm, ym, lab, cex = cex )
}

.mapSetup<- function( xlim, ylim, scale ){  #scale is m per inch

  px   <- diff( xlim )/scale
  py   <- diff( ylim )/scale
  pin  <- c( px, py )
  par( pin = pin )
  invisible( pin )
}

.getColor <- function( col, trans ){
  
  # trans - transparency fraction [ 0, 1]
  
  tmp <- col2rgb( col )
  rgb( tmp[ 1, ], tmp[ 2, ], tmp[ 3, ], maxColorValue = 255, 
      alpha = 255*trans, names = paste( col, trans, sep = '_' ) )
}

.interp <- function( y, INCREASING = FALSE, minVal = -Inf, maxVal = Inf, defaultValue = NULL, 
                   tinySlope = NULL ){  #interpolate vector x
  
  if( is.null( defaultValue ) )defaultValue <- NA
  
  tiny <- .00001
  if( !is.null( tinySlope ) )tiny <- tinySlope
  
  y[ y < minVal] <- minVal
  y[ y > maxVal] <- maxVal
  
  n  <- length( y )
  wi <- which( is.finite( y ) )
  
  if( length( wi ) == 0 )return( rep( defaultValue, n ) )
  if( length( wi ) == 1 )ss <- tiny
  
  xx  <- c( 1:n )
  z  <- y
  
  if( wi[ 1] != 1 ) wi <- c( 1, wi )
  if( max( wi ) < n )wi <- c( wi, n )
  
  ss <- diff( z[ wi] )/diff( xx[ wi] )
  
  ss[ is.na( ss )] <- 0
  
  if( length( ss ) > 1 ){
    if( length( ss ) > 2 )ss[ 1] <- ss[ 2]
    ss[ length( ss )] <- ss[ length( ss )-1]
  }
  if( INCREASING )ss[ ss < tiny] <- tiny
  
  if( is.na( y[ 1] ) )  z[ 1] <- z[ wi[ 2]] - xx[ wi[ 2]]*ss[ 1]
  if( z[ 1] < minVal )z[ 1] <- minVal
  if( z[ 1] > maxVal )z[ 1] <- maxVal
  
  for( k in 2:length( wi ) ){
    
    ki <- c( wi[ k-1]:wi[ k] )
    yk <- z[ wi[ k-1]] + ( xx[ ki] - xx[ wi[ k-1]] )*ss[ k-1]
    yk[ yk < minVal] <- minVal
    yk[ yk > maxVal] <- maxVal
    z[ ki] <- yk
  }
  z
}

.interpRows <- function( x, startIndex = rep( 1, nrow( x ) ), endIndex = rep( ncol( x ), nrow( x ) ), 
                       INCREASING = FALSE, minVal = -Inf, maxVal = Inf, 
                       defaultValue = NULL, tinySlope = .001 ){  
  #interpolate rows of x subject to increasing
  
  nn  <- nrow( x )
  p  <- ncol( x )
  xx <- c( 1:p )
  
  if( length( minVal ) == 1 )minVal <- rep( minVal, nn )
  if( length( maxVal ) == 1 )maxVal <- rep( maxVal, nn )
  
  ni   <- rep( NA, nn )
  flag <- numeric( 0 )
  
  z <- x
  
  for( i in 1:nn ){
    if( startIndex[ i] == endIndex[ i] ){
      z[ i, -startIndex[ i]] <- NA
      next
    }
    z[ i, startIndex[ i]:endIndex[ i]] <- .interp( x[ i, startIndex[ i]:endIndex[ i]], 
                                             INCREASING, minVal[ i], maxVal[ i], 
                                             defaultValue, tinySlope )
  }
  
  z
}

.shadeInterval <- function( xvalues, loHi, col = 'grey', PLOT = TRUE, add = TRUE, 
                           xlab = ' ', ylab = ' ', xlim = NULL, ylim = NULL, 
                           LOG = FALSE, trans = .5 ){
  
  #draw shaded interval
  
  loHi <- as.matrix( loHi )
  
  tmp <- smooth.na( xvalues, loHi )

  xvalues <- tmp[, 1]
  loHi <- tmp[, -1]
  
  xbound <- c( xvalues, rev( xvalues ) )
  ybound <- c( loHi[, 1], rev( loHi[, 2] ) )
  if( is.null( ylim ) )ylim <- range( as.numeric( loHi ) )
  if( is.null( xlim ) )xlim <- range( xvalues )
  
  if( !add ){
    if( !LOG )plot( NULL, xlim = xlim, ylim = ylim, 
                 xlab = xlab, ylab = ylab )
    if( LOG )suppressWarnings( plot( NULL, xlim = xlim, ylim = ylim, 
                xlab = xlab, ylab = ylab, log = 'y' ) )
  }
 
  
  if( PLOT )polygon( xbound, ybound, border = NA, col = .getColor( col, trans ) )
  
  invisible( cbind( xbound, ybound ) )
  
}

smooth.na <- function( x, y ){   
  
  #remove missing values
  #x is the index
  #y is a matrix with rows indexed by x
  
  if( !is.matrix( y ) )y <- matrix( y, ncol = 1 )
  
  wy <- which( !is.finite( y ), arr.ind = TRUE )
  if( length( wy ) == 0 )return( cbind( x, y ) )
  wy <- unique( wy[, 1] )
  ynew <- y[ -wy, ]
  xnew <- x[ -wy]
  
  return( cbind( xnew, ynew ) )
}

.boxplotQuant <- function( xx, ..., boxfill = NULL, omit.na = TRUE ){
  
  pars <- list( ... )
  q    <- pnorm( c( -1.96, -1, 0, 1, 1.96 ) )
  qfec <- apply( xx, 2, quantile, q, na.rm = T )
  
  wf   <- which( is.finite( qfec[ 1, ] ) )
  if( omit.na ){
    xx <- xx[, wf, drop = F]
    qfec <- qfec[, wf, drop = F]
    if( 'border' %in% names( list ) )border = border[ wf]
    if( 'whiskcol' %in% names( list ) )whiskcol = whiskcol[ wf]
    if( 'boxfill' %in% names( list ) )boxfill = boxfill[ wf]
  }else{
    qfec[, wf, drop = F] <- 0
  }
  
  tmp <- boxplot( xx, ..., na.rm = T, plot = FALSE )
  tmp$stats <- qfec
  

  if( 'col' %in% names( pars ) )boxfill <- pars$col
  
  bxp( tmp, ..., boxfill = boxfill )
  
  invisible( tmp )
}

.fitText2Fig <- function( xx, width = TRUE, fraction = 1, cex.max = 1 ){
  
  # returns cex to fit xx within fraction of the current plotting device
  # width - horizontal labels stacked vertically
  #!width - vertical labels plotted horizontally
  
  px <- par( 'pin' )[ 1]
  py <- par( 'pin' )[ 2]
  cl <- max( strwidth( xx, units = 'inches' ) )
  ch <- strheight( xx, units = 'inches' )[ 1]*length( xx )  # ht of stacked vector
  
  if( width ){              #horizontal labels stacked vertically
    xf <- fraction*px/cl
    yf <- fraction*py/ch
  } else {                #vertical labels plotted horizontally
    xf <- fraction*px/ch
    yf <- fraction*py/cl
  }
  
  cexx <- min( c( xf, yf ) )
  if( cexx > cex.max )cexx <- cex.max
  cexx
}