Nothing
############################################################
## Auxiliary functions
############################################################
is.anomalous <- function(x)
{
# is.nan(x) doesn't work for lists
#is.null(x) || is.na(x) || is.nan(x)
#is.null(x) || is.na(x)
is.null(x) || anyNA(x)
}
is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
print_summary <- function(x, ...)
{
print(x$el, ...)
invisible(x)
}
C_erlang2 <- function(c, r)
{
ro <- r / c
totr <- 1
totn <- 1
total <- totr / totn
i <- 1
while (i <= c-1)
{
totr <- totr * r
totn <- totn * i
total <- total + (totr / totn)
i <- i + 1
}
totr <- totr * r
totn <- totn * c
numerator <- totr / totn
denominator <- (1 - ro) * (total + (numerator / (1 - ro)))
numerator / denominator
}
nodes <- function(...)
{
list(...)
}
checkNegative <- function(v)
{
return(sum(v < 0) > 0)
}
checkNegativeOrZero <- function(v)
{
return(sum(v <= 0) > 0)
}
checkAtLeastOne <- function(v)
{
return(sum(v < 1) > 0)
}
checkAllZero <- function(v)
{
return(sum(v <= 0) == length(v))
}
C_erlang3 <- function(c, r)
{
b_result <- B_erlang(c, r)
num <- c * b_result
den <- c - (r * (1 - b_result))
num / den
}
# this saves one step of B_erlang, more efficient
C_erlang <- function(c=1, r=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(r))
stop("The parameter r is anomalous. Check it!")
if (c<1)
stop(ALL_c_warning)
if (!is.wholenumber(c))
stop(ALL_c_integer)
b_result <- B_erlang(c-1, r)
( r * b_result ) / ( c - (r * (1 - b_result)) )
}
# recursive version, in R has problems of stack overflow when c is large
B_erlang2 <- function(c, u)
{
f <- function(c, u)
{
if (c == 0) 1
else ( 1 + ( f(c-1, u) * (c/u) ) )
}
1 / f(c, u)
}
# definition version
B_erlang3 <- function(c, u)
{
n_fact <- 1
u_power <- 1
tot <- u_power / n_fact
i <- 1
while (i <= c)
{
n_fact <- i * n_fact
u_power <- u_power * u
tot <- tot + (u_power / n_fact)
i <- i + 1
}
(u_power / n_fact) / tot
}
B_erlang4 <- function(c=1, u=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(u))
stop("The parameter u is anomalous. Check it!")
if (c<0)
stop("The number of servers can not be less than zero!")
tot <- 1
aux <- 1 / u
i <- 1
while (i <= c)
{
tot <- 1 + (tot * aux)
aux <- aux + (1 / u)
i <- i + 1
}
1/tot
}
B_erlang5 <- function(c=1, u=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(u))
stop("The parameter u is anomalous. Check it!")
if (c<0)
stop("The number of servers can not be less than zero!")
if (u<0)
stop("The u parameter can not be negative!")
if (!is.wholenumber(c))
stop("The parameter c has to be an integer number")
1/Reduce(function(i, j) 1 + (i * j), (1 / u) * seq(1, c), init=1)
}
B_erlang_6 <- function(c=1, u=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(u))
stop("The parameter u is anomalous. Check it!")
if (c<0)
stop("The number of servers can not be less than zero!")
if (u<0)
stop("The u parameter can not be negative!")
if (!is.wholenumber(c))
stop("The parameter c has to be an integer number")
if (c==0) return(1)
if (u==0) return(0)
val <- 1/u
tot <- 1
for (i in 1:c)
tot <- 1 + (tot * i * val)
1/tot
}
B_erlang <- function(c=1, u=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(u))
stop("The parameter u is anomalous. Check it!")
if (c<0)
stop("The number of servers can not be less than zero!")
if (u<0)
stop("The u parameter can not be negative!")
if (!is.wholenumber(c))
stop("The parameter c has to be an integer number")
if (c==0) return(1)
if (u==0) return(0)
exp(
dgamma(u, shape=c+1, scale=1, log=TRUE) -
pgamma(u, shape=c+1, scale=1, log.p=TRUE, lower.tail=FALSE)
)
}
Engset <- function(k=1, c=0, r=0)
{
if (is.anomalous(c))
stop("The parameter c is anomalous. Check it!")
if (is.anomalous(r))
stop("The parameter r is anomalous. Check it!")
if (is.anomalous(k))
stop("The parameter k is anomalous. Check it!")
if (c < 0)
stop("The number of servers can not be less than zero!")
if (r < 0)
stop("The r parameter can not be negative!")
if (!is.wholenumber(c))
stop("The parameter c has to be an integer number")
if (!is.wholenumber(k))
stop("The parameter k has to be an integer number")
if (c > k)
stop("c can not be greater than k")
if (c == k)
return(0)
if (c == 0)
return(1)
if (r == 0)
return(0)
acum <- 1
for (i in (1:c)) acum <- ( (i * acum) / ((k - i + 1) * r) ) + 1
return(1/acum)
}
Engset_def <- function(k=1, c=0, r=0)
{
num <- choose(k-1, c) * (r^c)
acum <- 0
for (i in (0:c))
acum <- acum + (choose(k-1, i) * (r^i))
den <- acum
num/den
}
engset_bin <- function(x, k=1, c=1, r=0)
{
a <- r / (1 + r)
num <- dbinom(x, k, a)
den <- pbinom(c, k, a)
num/den
}
ProbFactCalculus <- function(lambda, mu, c, k, m, limit, fAuxC, fAuxK, fAuxM)
{
pn <- c(0:limit)
pn[1] <- 0
i <- 1
while (i <= limit)
{
if (i <= c)
{
pn[i+1] <- fAuxC(i, lambda, mu, c, k, m)
#print(paste(paste(paste("pn[", i), "]: "), pn[i+1]))
}
else
{
if (i <= k)
{
pn[i+1] <- fAuxK(i, lambda, mu, c, k, m)
#print(paste(paste(paste("pn[", i), "]: "), pn[i+1]))
}
else
{
pn[i+1] <- fAuxM(i, lambda, mu, c, k, m)
#print(paste("pn[i+1]: ", pn[i+1]))
}
}
i <- i + 1
}
p0 <- -log(sum(exp(pn)))
pn <- exp(pn + p0)
pn
}
tpoisson <- function(n, maximum, lambda)
{
dpois(n, lambda)/ppois(maximum, lambda)
}
############################################################
############################################################
## FUNTION TO REPORT BASIC MARKOVIAN MODELS
############################################################
############################################################
reportAux <- function(object)
{
Ls <- object$L - object$Lq
if (inherits(object, "o_MM1"))
{
cat("The inputs of the M/M/1 model are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", n: ", object$Inputs$n, "\n", sep=""))
cat("\n")
cat("The outputs of the M/M/1 model are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pn) of the n = ", object$Inputs$n, " clients in the system are:\n", sep=""))
cat(object$Pn)
cat("\n")
}
else if (inherits(object, "o_MMCKM"))
{
cat("The inputs of the model M/M/c/K/m are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, ", k: ", object$Inputs$k, " ,m: ", object$Inputs$m, ", method: ", object$Inputs$method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c/K/m are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The mean think time is : ", 1/object$Inputs$lambda, "\n", sep=""))
}
else if (inherits(object, "o_MMC"))
{
method <- if (object$Inputs$method == 0) "Exact" else "Aprox"
cat("The inputs of the model M/M/c are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, ", n: ", object$Inputs$n, ", method: ", method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pn) of the n = ", object$Inputs$n, " clients in the system are:\n", sep=""))
cat(object$Pn)
cat("\n")
}
else if (inherits(object, "o_MM1KK"))
{
cat("The inputs of the model M/M/1/K/K are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", k: ", object$Inputs$k, ", method: ", object$Inputs$method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/1/K/K are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The mean think time is : ", 1/object$Inputs$lambda, "\n", sep=""))
}
else if (inherits(object, "o_MMCKK"))
{
cat("The inputs of the model M/M/c/K/K are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, ", k: ", object$Inputs$k, ", method: ", object$Inputs$method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c/K/K are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The mean think time is : ", 1/object$Inputs$lambda, "\n", sep=""))
}
else if (inherits(object, "o_MMCKM"))
{
cat("The inputs of the model M/M/c/K/m are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, ", k: ", object$Inputs$k, " ,m: ", object$Inputs$m, ", method: ", object$Inputs$method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c/K/m are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The mean think time is : ", 1/object$Inputs$lambda, "\n", sep=""))
}
else if (inherits(object, "o_MMInfKK"))
{
cat("The inputs of the model M/M/Inf/K/K are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", k: ", object$Inputs$k, ", method: ", object$Inputs$method, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/Inf/K/K are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The mean think time is : ", 1/object$Inputs$lambda, "\n", sep=""))
}
else if (inherits(object, "o_MMInf"))
{
cat("The inputs of the model M/M/Infinite are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", n: ", object$Inputs$n, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/Infinite are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pn) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
}
else if (inherits(object, "o_MM1K"))
{
cat("The inputs of the model M/M/1/K are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", k: ", object$Inputs$k, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/1/K are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
cat(paste("The probability (q0, q1, ..., qk-1) that a client that enters meets n clients in the system are:\n"))
cat(object$Qn)
cat("\n")
}
else if (inherits(object, "o_MMCK"))
{
cat("The inputs of the model M/M/c/K are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, ", k: ", object$Inputs$k, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c/K are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pk) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
}
else if (inherits(object, "o_MMCC"))
{
cat("The inputs of the model M/M/c/c are:\n")
cat(paste("lambda: ", object$Inputs$lambda, ", mu: ", object$Inputs$mu, ", c: ", object$Inputs$c, "\n", sep=""))
cat("\n")
cat("The outputs of the model M/M/c/c are:\n")
cat("\n")
cat(paste("The probability (p0, p1, ..., pc) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n")
}
cat(paste("The traffic intensity is: ", Ls, "\n", sep=""))
cat(paste("The server use is: ", object$RO, "\n", sep=""))
cat(paste("The mean number of clients in the system is: ", object$L, "\n", sep=""))
cat(paste("The mean number of clients in the queue is: ", object$Lq, "\n", sep=""))
cat(paste("The mean number of clients in the server is: ", Ls, "\n", sep=""))
cat(paste("The mean time spend in the system is: ", object$W, "\n", sep=""))
cat(paste("The mean time spend in the queue is: ", object$Wq, "\n", sep=""))
cat(paste("The mean time spend in the server is: ", object$W - object$Wq, "\n", sep=""))
cat(paste("The mean time spend in the queue when there is queue is: ", object$Wqq, "\n", sep=""))
cat(paste("The throughput is: ", object$Throughput, "\n", sep=""))
if (inherits(object, "o_MM1KK"))
{
cat(paste("The normalized average response time is: ", object$WWs, "\n", sep=""))
cat(paste("The saturation point is: ", object$SP, "\n", sep=""))
}
}
############################################################
############################################################
## FUNTION TO REPORT BIRTH AND DEATH PROCESS
############################################################
############################################################
reportBnD <- function(object)
{
if (inherits(object, "o_BnD"))
{
cat("The inputs of the Birth and Death model are:\n\n")
print(object$Inputs)
cat("\n\n")
cat(paste("The outputs of the Birth and Death model are:", "\n\n", sep=""))
cat(paste("The mean number of clients in the system is: ", object$L, "\n", sep=""))
cat(paste("The probability (p0, p1, ..., pn) of the clients in the system are:\n"))
cat(object$Pn)
cat("\n\n")
}
}
############################################################
############################################################
## FUNTION TO REPORT SINGLE CLASS NETWORKS
############################################################
############################################################
reportSingleClass <- function(object)
{
if (inherits(object, "o_OJN"))
cat("The inputs of the open Jackson network are:\n\n")
else # has to be o_CJN
cat("The inputs of the closed Jackson network are:\n\n")
print(object$Inputs)
cat("\n\n")
if (inherits(object, "o_OJN"))
cat(paste("The outputs of the open Jackson network are:", "\n\n", sep=""))
else # has to be o_CJN
cat("The outputs of the closed Jackson network are:\n\n")
cat("---------- Complete network -------------------------\n\n")
cat(paste("The mean number of clients in the network is: ", object$L, "\n", sep=""))
cat(paste("The mean time spend in the network is: ", object$W, "\n", sep=""))
cat(paste("The throughput of the network is: ", object$Throughput, "\n", sep=""))
cat("\n\n")
cat("--------- Per node ---------------------------------\n\n")
i <- 1
while (i <= length(object$ROk))
{
cat(paste("The use of node ", i, " is: ", object$ROk[i], "\n", sep=""))
cat(paste("The throughput of node ", i, " is: ", object$Throughputk[i], "\n", sep=""))
cat(paste("The mean number of clients in node ", i, " is: ", object$Lk[i], "\n", sep=""))
cat(paste("The mean time spend in node ", i, " is: ", object$Wk[i], "\n", sep=""))
if (inherits(object, "o_OJN"))
{
cat(paste("The probability (p0, p1, ..., pn) or visit ratio of node ", i, " is: ", "\n", sep=""))
print(object$Pn[[i]])
}
cat("\n\n")
i <- i + 1
}
}
############################################################
############################################################
## FUNTION TO REPORT MULTIPLE CLASS NETWORKS
############################################################
############################################################
reportMultiClass <- function(object)
{
if (!inherits(object, c("o_MCON", "o_MCCN", "o_MCMN")))
stop("Incorrect class")
if (inherits(object, "o_MCON"))
netType <- "open"
else if (inherits(object, "o_MCCN"))
netType <- "closed"
else
netType <- "mixed"
cat(paste("The inputs of the multiclass ", netType, " network are:", "\n", sep=""))
print(object$Inputs)
cat("\n\n")
cat(paste("The outputs of the multiclass ", netType, " network are:", sep=""))
cat("\n\n")
cat("---------- Complete network -------------------------\n\n")
cat(paste("The mean number of clients in the network is: ", object$L, "\n", sep=""))
cat(paste("The mean time spend in the network is: ", object$W, "\n", sep=""))
cat(paste("The throughput of the network is: ", object$Throughput, "\n", sep=""))
cat("\n\n")
cat("---------- Per Class -------------------------\n\n")
for (i in (1:object$Inputs$classes))
{
cat(paste("The mean number of class ", i, " clients in the network is: ", object$Lc[i], "\n", sep=""))
cat(paste("The mean time spend in the network per class ", i ," is: ", object$Wc[i], "\n", sep=""))
cat(paste("The throughput of class " , i ," of the network is: ", object$Throughputc[i], "\n", sep=""))
cat("\n\n")
}
cat("--------- Per node ---------------------------------\n\n")
for (i in (1:object$Inputs$nodes))
{
cat(paste("The use of node ", i, " is: ", object$ROk[i], "\n", sep=""))
cat(paste("The mean number of clients in node ", i, " is: ", object$Lk[i], "\n", sep=""))
cat(paste("The mean time spend in node ", i, " is: ", object$Wk[i], "\n", sep=""))
cat(paste("The throughput of node ", i, " is: ", object$Throughputk[i], "\n", sep=""))
cat("\n\n")
}
cat("--------- Per class and node -----------------------\n\n")
for (i in (1:object$Inputs$classes))
{
for (j in (1:object$Inputs$nodes))
{
cat(paste("The class ", i, " use of node ", j, " is: ", object$ROck[i, j], "\n", sep=""))
cat(paste("The mean number of class ", i, " clients in node ", j, " is: ", object$Lck[i, j], "\n", sep=""))
cat(paste("The mean time spend by class ", i, " in node ", j, " is: ", object$Wck[i, j], "\n", sep=""))
cat(paste("The throughput of class " , i, " in node ", j, " is: ", object$Throughputck[i, j], "\n", sep=""))
cat("\n\n")
}
}
}
############################################################
############################################################
## FUNTION TO TABULATE DIFFERENT MODELS
############################################################
############################################################
CompareQueueingModels2 <- function(models)
{
num_elems <- length(models)
# Check that every object has the correct class
for (i in 1:num_elems)
{
m <- models[[i]]
#print(classm)
if (!inherits(m, c("o_MM1", "o_MMC", "o_MM1K", "o_MMCK", "o_MMCC", "o_MMInf", "o_MMInfKK", "o_MM1KK", "o_MMCKK", "o_MMCKM")))
stop(paste("Function called with incorrect class: ", class(m)))
}
#build the table
lambda <- c()
mu <- c()
c <- c()
k <- c()
m <- c()
RO <- c()
Lq <- c()
Wq <- c()
Throughput <- c()
L <- c()
W <- c()
Wqq <- c()
Lqq <- c()
P0 <- c()
for (i in (1:num_elems))
{
mod <- models[[i]]
lambda <- c(lambda, mod$Inputs$lambda)
mu <- c(mu, mod$Inputs$mu)
if (inherits(mod, c("o_MMInf", "o_MMInfKK")))
c <- c(c, NA)
else if (inherits(mod, c("o_MM1", "o_MM1K", "o_MM1KK")))
c <- c(c, 1)
else
c <- c(c, mod$Inputs$c)
if (inherits(mod, c("o_MMInf", "o_MM1", "o_MMC")))
k <- c(k, NA)
else if (inherits(mod, "o_MMCC"))
k <- c(k, mod$Inputs$c)
else
k <- c(k, mod$Inputs$k)
if (!inherits(mod, "o_MMCKM"))
m <- c(m, NA)
else
m <- c(m, mod$Inputs$m)
if (inherits(mod, c("o_MMInf", "o_MM1", "o_MMC")))
{
if (mod$Inputs$n >= 0)
P0 <- c(P0, mod$Pn[1])
else
P0 <- c(P0, NA)
}
else
P0 <- c(P0, mod$Pn[1])
RO <- c(RO, mod$RO)
Lq <- c(Lq, mod$Lq)
Wq <- c(Wq, mod$Wq)
Throughput <- c(Throughput, mod$Throughput)
L <- c(L, mod$L)
W <- c(W, mod$W)
Lqq <- c(Lqq, mod$Lqq)
Wqq <- c(Wqq, mod$Wqq)
}
data.frame(
lambda=lambda, mu=mu, c=c, k=k, m=m, RO=RO, P0 = P0, Lq=Lq, Wq=Wq, X=Throughput,
L=L, W=W, Wqq=Wqq, Lqq=Lqq
)
}
CompareQueueingModels <- function(model, ...)
{
models <- c(list(model), list(...))
CompareQueueingModels2(models)
}
############################################################
############################################################
## FUNTION TO SUMMARIZE SINGLE CLASS NETWORKS
############################################################
############################################################
summarySingleClass <- function(object)
{
if (!inherits(object, c("o_OJN", "o_CJN")))
stop("Incorrect class")
#build the table
# complete network
Throughput <- c()
L <- c()
W <- c()
# Node
ROk <- c()
Throughputk <- c()
Lk <- c()
Wk <- c()
rnames <- c()
# Complete Network
L <- c(L, object$L)
W <- c(W, object$W)
Throughput <- c(Throughput, object$Throughput)
ROk <- c(ROk, NA)
Throughputk <- c(Throughputk, NA)
Lk <- c(Lk, NA)
Wk <- c(Wk, NA)
rnames <- c(rnames, "Net")
i <- 1
while (i <= length(object$ROk))
{
L <- c(L, NA)
W <- c(W, NA)
Throughput <- c(Throughput, NA)
ROk <- c(ROk, object$ROk[i])
Throughputk <- c(Throughputk, object$Throughputk[i])
Lk <- c(Lk, object$Lk[i])
Wk <- c(Wk, object$Wk[i])
rnames <- c(rnames, paste("Nd", as.character(i), sep=""))
i <- i + 1
}
res <-
data.frame(
L = L, W = W, X = Throughput,
Lk = Lk, Wk = Wk, Xk = Throughputk, ROk = ROk
)
# Rowname change
rownames(res) <- rnames
res
}
############################################################
############################################################
## FUNTION TO SUMMARIZE MULTIPLE CLASS NETWORKS
############################################################
############################################################
summaryMultiClass <- function(object)
{
if (!inherits(object, c("o_MCON", "o_MCCN", "o_MCMN")))
stop("Incorrect class")
#build the table
# complete network
L <- c()
W <- c()
Throughput <- c()
# Class
Lc <- c()
Wc <- c()
Throughputc <- c()
# Node
ROk <- c()
Lk <- c()
Wk <- c()
Throughputk <- c()
# ClassNode
ROck <- c()
Lck <- c()
Wck <- c()
Throughputck <- c()
rnames <- c()
# Complete Network
L <- c(L, object$L)
W <- c(W, object$W)
Throughput <- c(Throughput, object$Throughput)
Lc <- c(Lc, NA)
Wc <- c(Wc, NA)
Throughputc <- c(Throughputc, NA)
ROk <- c(ROk, NA)
Lk <- c(Lk, NA)
Wk <- c(Wk, NA)
Throughputk <- c(Throughputk, NA)
ROck <- c(ROck, NA)
Lck <- c(Lck, NA)
Wck <- c(Wck, NA)
Throughputck <- c(Throughputck, NA)
rnames <- c(rnames, "Net")
# Classes
for (i in (1:object$Inputs$classes))
{
L <- c(L, NA)
W <- c(W, NA)
Throughput <- c(Throughput, NA)
Lc <- c(Lc, object$Lc[i])
Wc <- c(Wc, object$Wc[i])
Throughputc <- c(Throughputc, object$Throughputc[i])
ROk <- c(ROk, NA)
Lk <- c(Lk, NA)
Wk <- c(Wk, NA)
Throughputk <- c(Throughputk, NA)
ROck <- c(ROck, NA)
Lck <- c(Lck, NA)
Wck <- c(Wck, NA)
Throughputck <- c(Throughputck, NA)
rnames <- c(rnames, paste("Cl", as.character(i), sep=""))
}
# Nodes
for (i in (1:object$Inputs$nodes))
{
L <- c(L, NA)
W <- c(W, NA)
Throughput <- c(Throughput, NA)
Lc <- c(Lc, NA)
Wc <- c(Wc, NA)
Throughputc <- c(Throughputc, NA)
ROk <- c(ROk, object$ROk[i])
Lk <- c(Lk, object$Lk[i])
Wk <- c(Wk, object$Wk[i])
Throughputk <- c(Throughputk, object$Throughputk[i])
ROck <- c(ROck, NA)
Lck <- c(Lck, NA)
Wck <- c(Wck, NA)
Throughputck <- c(Throughputck, NA)
rnames <- c(rnames, paste("Nd", as.character(i), sep=""))
}
#Per class and node
for (i in (1:object$Inputs$classes))
{
for (j in (1:object$Inputs$nodes))
{
L <- c(L, NA)
W <- c(W, NA)
Throughput <- c(Throughput, NA)
Lc <- c(Lc, NA)
Wc <- c(Wc, NA)
Throughputc <- c(Throughputc, NA)
ROk <- c(ROk, NA)
Lk <- c(Lk, NA)
Wk <- c(Wk, NA)
Throughputk <- c(Throughputk, NA)
ROck <- c(ROck, object$ROck[i, j])
Lck <- c(Lck, object$Lck[i, j])
Wck <- c(Wck, object$Wck[i, j])
Throughputck <- c(Throughputck, object$Throughputck[i, j])
rnames <- c(rnames, paste("CN", as.character(i), as.character(j), sep=""))
}
}
res <-
data.frame(
L = L, W = W, X = Throughput,
Lc = Lc, Wc = Wc, Xc = Throughputc,
Lk = Lk, Wk = Wk, Xk = Throughputk, ROk = ROk,
Lck = Lck, Wck = Wck, Xck = Throughputck, ROck = ROck
)
# Rowname change
rownames(res) <- rnames
res
}
############################################################
############################################################
## FUNTION TO SUMMARIZE BIRTH AND DEATH PROCESS
############################################################
############################################################
summaryBnD <- function(object)
{
if (!inherits(object, "o_BnD"))
stop("Incorrect class")
#build the table
n <- length(object$Pn)
lambda <- rep(NA, n)
mu <- rep(NA, n)
# complete network
lambda[1:(n-1)] <- object$Inputs$lambda
mu[2:n] <- object$Inputs$mu
Pn <- object$Pn
state <- 0:(n-1)
L <- rep(object$L, n)
res <-
data.frame(
state = state, lambda = lambda, mu = mu, Pn = Pn, L = L
)
rownames(res) <- seq(from=1, to=n, by=1)
res
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.