Nothing
R/plot.fdt.multiple.R
In fdth: Frequency Distribution Tables, Histograms and Polygons
plot.fdt.multiple <- function (x,
type = c('fh', 'fp',
'rfh', 'rfp', 'rfph', 'rfpp',
'd', 'cdh', 'cdp',
'cfh', 'cfp', 'cfph', 'cfpp'),
v = FALSE,
v.round = 2,
v.pos = 3,
xlab = 'Class limits',
xlas = 0,
ylab = NULL,
col = 'gray',
xlim = NULL,
ylim = NULL,
main = NULL,
main.vars = TRUE,
x.round = 2,
grouped = FALSE,
args.legend = NULL, ...)
{
typearg <- match.arg(type)
if(!grouped){
is.whole.number <- function (x,
tol = .Machine$double.eps^0.5)
abs(x - round(x)) < tol
old.mf <- par("mfrow")
old.oma <- par("oma")
old.mar <- par("mar")
on.exit(par(mfrow = old.mf,
oma = old.oma,
mar = old.mar))
mf <- old.mf
if (length(mf) == 0)
mf <- c(1, 1)
if ((n <- length(x)) > 1 & max(mf) == 1)
mf <- if (n <= 2) c(2, 1)
else if (n <= 4) c(2, 2)
else if (n <= 6) c(2, 3)
else if (n <= 9) c(3, 3)
else if (n <= 12) c(3, 4)
else if (n <= 16) c(4, 4)
else c(4, 5)
par(mfrow = mf)
nplot.device <- prod(mf)
if (!is.null(main))
main <- rep(main, length(x))
else if (main.vars)
main <- names(x)[names(x)!='call']
xx <- x[names(x)!='call']
i <- 0
repeat {
if ((i != 0) & is.whole.number(i/nplot.device)) {
dev.new()
par(mfrow = mf)
}
i <- i + 1
plot.fdt.default(xx[[i]],
type = type,
v = v,
v.round = v.round,
v.pos = v.pos,
xlab = xlab,
xlas = xlas,
ylab = ylab,
col = col,
xlim = xlim,
ylim = ylim,
main = main[i],
x.round = x.round, ...)
if (i == length(xx))
break
}
} else if(typearg == 'fp' | typearg == 'rfp' | typearg == 'rfpp' | typearg == 'cdp' | typearg == 'cfp' | typearg == 'cfpp'){
DFagain <- eval(getCall(x)$x)
byagain <- eval(getCall(x)$by)
varis <- sapply(DFagain, is.numeric)
varisnum <- names(varis)[varis]
namesx <- names(x)[names(x)!='call']
namesvar <- gsub('([\\w\\W]+)\\.\\b',
'',
namesx,
perl = TRUE)
posvaris <- list()
tabsc <- list()
aux1 <- list()
aux2 <- list()
auxk <- list()
for(i in seq_along(varisnum)){
posvaris[[i]] <- which(namesvar==varisnum[i])
tabsc[[i]] <- x[posvaris[[i]]]
aux1[[i]] <- lapply(tabsc[[i]], function(x)x$breaks)
aux2[[i]] <- do.call('rbind', aux1[[i]])
auxk[[i]] <- lapply(tabsc[[i]], function(x)x$table[, 5])
}
liis <- lapply(aux2, function(x)min(x[, 1]))
lsss <- lapply(aux2, function(x)max(x[, 2]))
auxk1 <- lapply(auxk, unlist)
k <- lapply(auxk1, function(x)nclass.Sturges(1:max(x))) # Taking the factor with the greatest observation, as the number of classes will be greater and will encompass the other factors if you have a smaller sample!
hh <- mapply(function(x, y, z) (y - x)/z,
liis,
lsss,
k)
# THE NEXT STEP IS TO MAKE A TABLE FOR EACH FACTOR AND EACH VARIABLE
factors <- levels(DFagain[[byagain]])
subgroups <- list()
for(i in seq_along(factors)){
subgroups[[i]] <- subset(DFagain,
eval(parse(text = byagain))%in%factors[i])
}
tabsfactors <- rep(list(rep(list(NA), length(varisnum))), length(factors))
for(i in seq_along(factors)){
for(j in seq_along(varisnum)){
ifelse(length(varisnum)==1,
groups <- subgroups[[i]][, ((ncol(DFagain)-length(varisnum))+1):ncol(DFagain)],
groups <- subgroups[[i]][, ((ncol(DFagain)-length(varisnum))+1):ncol(DFagain)][, j])
tabsfactors[[i]][[j]] <- fdt(groups,
start = liis[[j]],
end = lsss[[j]],
h = hh[j])
}
}
mids <- mapply(function(x, y, z) seq(x+z/2, y-z/2, z),
liis,
lsss,
as.list(hh))
typearg <- match.arg(type)
old.mf <- par("mfrow")
old.oma <- par("oma")
old.mar <- par("mar")
on.exit(par(mfrow = old.mf,
oma = old.oma,
mar = old.mar))
mf <- old.mf
if (length(mf) == 0){
mf <- c(1, 1)
}
if((n <- length(varisnum)) > 1 & max(mf) == 1){
mf <- if(n <= 2){
c(2, 1)
} else if(n <= 4){
c(2, 2)
} else if(n <= 6){
c(2, 3)
} else if(n <= 9){
c(3, 3)
} else if(n <= 12){
c(3, 4)
} else if(n <= 16){
c(4, 4)
} else {
c(4, 5)
}
}
par(mfrow = mf)
nplot.device <- prod(mf)
if(!is.null(main)){
main <- rep(main, length(x))
} else if(main.vars){
main <- varisnum
}
if(is.null(xlim)){
xlim <- cbind(unlist(liis), unlist(lsss))
}
if(is.null(ylab)){
ylab <- 'Frequency'
}
if(length(col)==1){
col = c(col, colors()[152:253][2:length(varisnum)])
}
switch(typearg,
# f (absolute frequency) - polygon
fp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 2]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# rfp (relative frequency percentual) - polygon
rfp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 3]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# rfpp (relative frequency percentual percentual) - polygon
rfpp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 4]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cdp (cumulative density) - polygon
cdp = {
onlyfreq <- list()
onlyden <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 3]))
onlyden[[i]] <- mapply(function(y, z)cumsum(y/z),
onlyfreq[[i]],
as.list(hh))
}
if(is.null(ylim)){
ylim2 <- do.call('rbind', onlyden)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyden[[1]][, i],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyden[[j]][, i],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cfp (cumulative frequency) - polygon
cfp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 5]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- lapply(ylim1, function(x)apply(x, 2, max))
ylim3 <- do.call('rbind', ylim2)
ylim4 <- apply(ylim3,
2,
max) * 1.2
ylim5 <- rbind(rep(0, length(varisnum)), ylim4)
ylim <- t(ylim5)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cfpp (cumulative frequency%) - polygon
cfpp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 6]))
}
if(is.null(ylim)){
ylim <- matrix(rep(c(0, 1.2*100), length(varisnum)),
byrow = TRUE,
nrow = length(varisnum))
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
})
if(is.null(args.legend)){
args.2Kl <- list(x = 'right',
legend = factors,
col = col,
lty = rep(1, length(factors)),
xpd = T)
do.call('legend',
args.2Kl)
} else {
args.2Kl <- list(x = 'right',
legend = factors,
col = col,
lty = rep(1, length(factors)),
xpd = T)
args.2Kl[names(args.legend)] <- args.legend
do.call('legend',
args.2Kl)
}
} else {
warning("Set an of the options to the type argument: fp, rfp, rfpp, cdp, cfp or cfpp!")
}
}
Try the fdth package in your browser
Any scripts or data that you put into this service are public.
fdth documentation built on May 26, 2026, 1:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
plot.fdt.multiple <- function (x,
type = c('fh', 'fp',
'rfh', 'rfp', 'rfph', 'rfpp',
'd', 'cdh', 'cdp',
'cfh', 'cfp', 'cfph', 'cfpp'),
v = FALSE,
v.round = 2,
v.pos = 3,
xlab = 'Class limits',
xlas = 0,
ylab = NULL,
col = 'gray',
xlim = NULL,
ylim = NULL,
main = NULL,
main.vars = TRUE,
x.round = 2,
grouped = FALSE,
args.legend = NULL, ...)
{
typearg <- match.arg(type)
if(!grouped){
is.whole.number <- function (x,
tol = .Machine$double.eps^0.5)
abs(x - round(x)) < tol
old.mf <- par("mfrow")
old.oma <- par("oma")
old.mar <- par("mar")
on.exit(par(mfrow = old.mf,
oma = old.oma,
mar = old.mar))
mf <- old.mf
if (length(mf) == 0)
mf <- c(1, 1)
if ((n <- length(x)) > 1 & max(mf) == 1)
mf <- if (n <= 2) c(2, 1)
else if (n <= 4) c(2, 2)
else if (n <= 6) c(2, 3)
else if (n <= 9) c(3, 3)
else if (n <= 12) c(3, 4)
else if (n <= 16) c(4, 4)
else c(4, 5)
par(mfrow = mf)
nplot.device <- prod(mf)
if (!is.null(main))
main <- rep(main, length(x))
else if (main.vars)
main <- names(x)[names(x)!='call']
xx <- x[names(x)!='call']
i <- 0
repeat {
if ((i != 0) & is.whole.number(i/nplot.device)) {
dev.new()
par(mfrow = mf)
}
i <- i + 1
plot.fdt.default(xx[[i]],
type = type,
v = v,
v.round = v.round,
v.pos = v.pos,
xlab = xlab,
xlas = xlas,
ylab = ylab,
col = col,
xlim = xlim,
ylim = ylim,
main = main[i],
x.round = x.round, ...)
if (i == length(xx))
break
}
} else if(typearg == 'fp' | typearg == 'rfp' | typearg == 'rfpp' | typearg == 'cdp' | typearg == 'cfp' | typearg == 'cfpp'){
DFagain <- eval(getCall(x)$x)
byagain <- eval(getCall(x)$by)
varis <- sapply(DFagain, is.numeric)
varisnum <- names(varis)[varis]
namesx <- names(x)[names(x)!='call']
namesvar <- gsub('([\\w\\W]+)\\.\\b',
'',
namesx,
perl = TRUE)
posvaris <- list()
tabsc <- list()
aux1 <- list()
aux2 <- list()
auxk <- list()
for(i in seq_along(varisnum)){
posvaris[[i]] <- which(namesvar==varisnum[i])
tabsc[[i]] <- x[posvaris[[i]]]
aux1[[i]] <- lapply(tabsc[[i]], function(x)x$breaks)
aux2[[i]] <- do.call('rbind', aux1[[i]])
auxk[[i]] <- lapply(tabsc[[i]], function(x)x$table[, 5])
}
liis <- lapply(aux2, function(x)min(x[, 1]))
lsss <- lapply(aux2, function(x)max(x[, 2]))
auxk1 <- lapply(auxk, unlist)
k <- lapply(auxk1, function(x)nclass.Sturges(1:max(x))) # Taking the factor with the greatest observation, as the number of classes will be greater and will encompass the other factors if you have a smaller sample!
hh <- mapply(function(x, y, z) (y - x)/z,
liis,
lsss,
k)
# THE NEXT STEP IS TO MAKE A TABLE FOR EACH FACTOR AND EACH VARIABLE
factors <- levels(DFagain[[byagain]])
subgroups <- list()
for(i in seq_along(factors)){
subgroups[[i]] <- subset(DFagain,
eval(parse(text = byagain))%in%factors[i])
}
tabsfactors <- rep(list(rep(list(NA), length(varisnum))), length(factors))
for(i in seq_along(factors)){
for(j in seq_along(varisnum)){
ifelse(length(varisnum)==1,
groups <- subgroups[[i]][, ((ncol(DFagain)-length(varisnum))+1):ncol(DFagain)],
groups <- subgroups[[i]][, ((ncol(DFagain)-length(varisnum))+1):ncol(DFagain)][, j])
tabsfactors[[i]][[j]] <- fdt(groups,
start = liis[[j]],
end = lsss[[j]],
h = hh[j])
}
}
mids <- mapply(function(x, y, z) seq(x+z/2, y-z/2, z),
liis,
lsss,
as.list(hh))
typearg <- match.arg(type)
old.mf <- par("mfrow")
old.oma <- par("oma")
old.mar <- par("mar")
on.exit(par(mfrow = old.mf,
oma = old.oma,
mar = old.mar))
mf <- old.mf
if (length(mf) == 0){
mf <- c(1, 1)
}
if((n <- length(varisnum)) > 1 & max(mf) == 1){
mf <- if(n <= 2){
c(2, 1)
} else if(n <= 4){
c(2, 2)
} else if(n <= 6){
c(2, 3)
} else if(n <= 9){
c(3, 3)
} else if(n <= 12){
c(3, 4)
} else if(n <= 16){
c(4, 4)
} else {
c(4, 5)
}
}
par(mfrow = mf)
nplot.device <- prod(mf)
if(!is.null(main)){
main <- rep(main, length(x))
} else if(main.vars){
main <- varisnum
}
if(is.null(xlim)){
xlim <- cbind(unlist(liis), unlist(lsss))
}
if(is.null(ylab)){
ylab <- 'Frequency'
}
if(length(col)==1){
col = c(col, colors()[152:253][2:length(varisnum)])
}
switch(typearg,
# f (absolute frequency) - polygon
fp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 2]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# rfp (relative frequency percentual) - polygon
rfp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 3]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# rfpp (relative frequency percentual percentual) - polygon
rfpp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 4]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- do.call('rbind', ylim1)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cdp (cumulative density) - polygon
cdp = {
onlyfreq <- list()
onlyden <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 3]))
onlyden[[i]] <- mapply(function(y, z)cumsum(y/z),
onlyfreq[[i]],
as.list(hh))
}
if(is.null(ylim)){
ylim2 <- do.call('rbind', onlyden)
ylim3 <- apply(ylim2,
2,
max) * 1.2
ylim4 <- rbind(rep(0, length(varisnum)), ylim3)
ylim <- t(ylim4)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyden[[1]][, i],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyden[[j]][, i],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cfp (cumulative frequency) - polygon
cfp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 5]))
}
if(is.null(ylim)){
ylim1 <- lapply(onlyfreq, function(x)do.call('cbind', x))
ylim2 <- lapply(ylim1, function(x)apply(x, 2, max))
ylim3 <- do.call('rbind', ylim2)
ylim4 <- apply(ylim3,
2,
max) * 1.2
ylim5 <- rbind(rep(0, length(varisnum)), ylim4)
ylim <- t(ylim5)
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
},
# cfpp (cumulative frequency%) - polygon
cfpp = {
onlyfreq <- list()
for(i in seq_along(factors)){
onlyfreq[[i]] <- lapply(tabsfactors[[i]],
function(x)with(x, table[, 6]))
}
if(is.null(ylim)){
ylim <- matrix(rep(c(0, 1.2*100), length(varisnum)),
byrow = TRUE,
nrow = length(varisnum))
}
par(mfrow = mf)
for(i in seq_along(varisnum)){
plot(mids[, i],
onlyfreq[[1]][[i]],
type = 'b',
xaxt = 'n',
bty = 'n',
xlim = xlim[i, ],
ylim = ylim[i, ],
xlab = xlab,
ylab = ylab,
col = col[1],
main = main[i])
axis(1, at = round(mids[, i], x.round))
j <- 2
while(j <= length(factors)){
points(mids[, i],
onlyfreq[[j]][[i]],
type = 'b',
col = col[j])
j <- j+1
}
}
})
if(is.null(args.legend)){
args.2Kl <- list(x = 'right',
legend = factors,
col = col,
lty = rep(1, length(factors)),
xpd = T)
do.call('legend',
args.2Kl)
} else {
args.2Kl <- list(x = 'right',
legend = factors,
col = col,
lty = rep(1, length(factors)),
xpd = T)
args.2Kl[names(args.legend)] <- args.legend
do.call('legend',
args.2Kl)
}
} else {
warning("Set an of the options to the type argument: fp, rfp, rfpp, cdp, cfp or cfpp!")
}
}
Try the fdth package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.