[BACK]Return to extinction_risk_1.R CVS log [TXT][DIR] Up to [local] / ext

Diff for /ext/extinction_risk_1.R between version 1.3 and 1.4

version 1.3, 2015/05/25 12:51:56 version 1.4, 2015/06/25 15:16:22
Line 1 
Line 1 
 # extinction_risk_1.R, ver. 1.5 2015/4/30  # extinction_risk_1.R, ver. 1.6 2015/6/24
 # $Id$  
 #  #
 # Author: Hiroshi Hakoyama <hako@affrc.go.jp>  # Author: Hiroshi Hakoyama <hako@affrc.go.jp>
 # Copyright (c) 2013-2015 Hiroshi Hakoyama <hako@affrc.go.jp>, All rights reserved.  # Copyright (c) 2013-2015 Hiroshi Hakoyama <hako@affrc.go.jp>, All rights reserved.
Line 51 
Line 50 
 # the ML estimate of the probability of extinction within a specific time period t (G*psi), and  # the ML estimate of the probability of extinction within a specific time period t (G*psi), and
 # a lower 95 % confidence limit of parameter * (Low.CL.*), and  # a lower 95 % confidence limit of parameter * (Low.CL.*), and
 # a higher 95 % confidence limit of parameter * (High.CL.*)  # a higher 95 % confidence limit of parameter * (High.CL.*)
   # formatted     If set to TRUE, give the result by formatted output. If set to FALSE, give a list of estimates.
 #  #
 # References:  # References:
 #  R. Lande and S. H. Orzack. Extinction dynamics of age-structured populations  #  R. Lande and S. H. Orzack. Extinction dynamics of age-structured populations
Line 61 
Line 61 
 # 61:115-143, 1991.  # 61:115-143, 1991.
 #  #
   
 ext1 <- function(dat, t = 100, ne = 1, alpha = 0.05, verbose = FALSE) {  ext1 <- function(dat, t = 100, ne = 1, alpha = 0.05, verbose = FALSE, formatted = TRUE) {
   yr <- ts(dat[, 1], start = c(dat[, 1][1])) # Year    yr <- ts(dat[, 1], start = c(dat[, 1][1])) # Year
   ps <- ts(dat[, 2], start = c(dat[, 1][1])) # Population size    ps <- ts(dat[, 2], start = c(dat[, 1][1])) # Population size
   complete <- complete.cases(yr, ps)    complete <- complete.cases(yr, ps)
Line 159  ext1 <- function(dat, t = 100, ne = 1, alpha = 0.05, v
Line 159  ext1 <- function(dat, t = 100, ne = 1, alpha = 0.05, v
       Extinction.probability = G(t, xd, mu, s) * psi(xd, mu, s),        Extinction.probability = G(t, xd, mu, s) * psi(xd, mu, s),
       Low.CL.Gpsi = Low.CL.Gpsi,        Low.CL.Gpsi = Low.CL.Gpsi,
       High.CL.Gpsi = High.CL.Gpsi)        High.CL.Gpsi = High.CL.Gpsi)
     class(results) <- "ext1"      if (formatted == TRUE) {
         class(results) <- "ext1"
       }
     return(results)      return(results)
   } else {    } else {
     results <- list(ne = ne, t = t, verbose = verbose,      results <- list(ne = ne, t = t, verbose = verbose,
       Extinction.probability = G(t, xd, mu, s) * psi(xd, mu, s))        Extinction.probability = G(t, xd, mu, s) * psi(xd, mu, s))
     class(results) <- "ext1"      if (formatted == TRUE) {
         class(results) <- "ext1"
       }
     return(results)      return(results)
   }    }
 }  }
Line 213  print.ext1 <- function(obj, digits = 5) {
Line 217  print.ext1 <- function(obj, digits = 5) {
 #  #
 # Examples  # Examples
 # Yellowstone grizzly bears (from Dennis et al., 1991)  # Yellowstone grizzly bears (from Dennis et al., 1991)
 # dat <- data.frame(Year = c(1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987),   # dat <- data.frame(Year = c(1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987),
 # Population = c(44, 47, 46, 44, 46, 45, 46, 40, 39, 39, 42, 44, 41, 40, 33, 36, 34, 39, 35, 34, 38, 36, 37, 41, 39, 51, 47, 57, 47))  # Population = c(44, 47, 46, 44, 46, 45, 46, 40, 39, 39, 42, 44, 41, 40, 33, 36, 34, 39, 35, 34, 38, 36, 37, 41, 39, 51, 47, 57, 47))
 # The probability of extinction (of decline to population size 1) within 100 years  # The probability of extinction (of decline to population size 1) within 100 years
 # ext1(dat, 100)  # ext1(dat, 100)
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4