如何在 R fmsb 中为 R Shiny 移动雷达图/蜘蛛图标签，以便标签不与绘图重叠？
How to move radar chart / spider chart labels in R fmsb for R Shiny so labels don't overlap with plot?
我有一个闪亮的应用程序，它使用 fmsb 包根据用户在简短测验中的输入创建蜘蛛图。但是，其中 2 个标签与绘图重叠，我找不到将它们移得更远的方法。
我试过使用 paxislabels 参数，但我无法弄清楚，而且 help documentation or this great tutorial 在那部分不清楚。我希望水平标签像垂直标签一样——在情节之外。
这是一个可重现的例子：
library(shiny)
library(fmsb)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel( selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
actionButton("submit", "Submit")),
mainPanel(
mainPanel(plotOutput("spider_chart"))
)
)
)
server <- function(input, output) {
data_scores <- reactive({
#Make tibble of raw data
raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
`Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
`Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
`Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
#fbsm needs the first 2 rows to be the max and min values
min_max <- tibble(`Variable 1` = c(2, 0),
`Variable 2` = c(2, 0),
`Variable 3` = c(2, 0),
`Variable 4` = c(3, 0))
min_max %>%
full_join(raw_data)
})
#This is the section that needs to be updated
output$spider_chart <- renderPlot({
req(input$submit)
colors_border=rgb(.5, 0, .5, .9)
colors_in=rgb(.5, 0, .5, .5)
# plot with default options:
radarchart(data_scores(),
#custom polygon
pcol= colors_border, pfcol=colors_in , plwd=4 , plty=1,
#custom the grid
cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
#custom labels
vlcex= 1.2
) })
}
# Run the application
shinyApp(ui = ui, server = server)
我直接写信给 fmsb 的创建者 Minato Nakazawa，他提供了一个非常容易实现的答案。简而言之，所有标签都像一般文本字符串一样，因此他建议在我的 radarchart() 调用中使用 vlabel 参数重命名变量，并在两个水平轴标题中添加空格，并且成功了！下面是添加 10 个空格后的样子：
这是完整的代码，添加了：
library(shiny)
library(fmsb)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel( selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
actionButton("submit", "Submit")),
mainPanel(
mainPanel(plotOutput("spider_chart"))
)
)
)
server <- function(input, output) {
data_scores <- reactive({
#Make tibble of raw data
raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
`Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
`Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
`Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
#fbsm needs the first 2 rows to be the max and min values
min_max <- tibble(`Variable 1` = c(2, 0),
`Variable 2` = c(2, 0),
`Variable 3` = c(2, 0),
`Variable 4` = c(3, 0))
min_max %>%
full_join(raw_data)
})
#This is the section that needs to be updated
output$spider_chart <- renderPlot({
req(input$submit)
colors_border=rgb(.5, 0, .5, .9)
colors_in=rgb(.5, 0, .5, .5)
# plot with default options:
radarchart(data_scores(),
#custom polygon
pcol= colors_border, pfcol=colors_in , plwd=4 , plty=1, vlabels = c("Variable 1", "Variable 2 ", "Variable 3", " Variable 4"),
#custom the grid
cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
#custom labels
vlcex= 1.2
) })
}
# Run the application
shinyApp(ui = ui, server = server)
非常感谢 Minato Nakazawa 创建此程序包并及时回复我的询问。
这是 Minato Nakazawa 在 fmsb 包源代码中为 radarchart 功能编写的代码。
好像没有地方放这个包的pull request，所以我post在这里。
我更改了这段代码中与变量标签相关的部分（在代码块中对其进行了注释），
根据标签相对于 (0,0) 点的位置应用适当的 adj 标签。
您可以将此函数复制到您的代码或其他文件中，并将其源代码到您的主代码中，然后使用 fmsb 包中的 radarchart 函数。
radarchart <- function(df, axistype=0, seg=4, pty=16, pcol=1:8, plty=1:6, plwd=1,
pdensity=NULL, pangle=45, pfcol=NA, cglty=3, cglwd=1,
cglcol="navy", axislabcol="blue", title="", maxmin=TRUE,
na.itp=TRUE, centerzero=FALSE, vlabels=NULL, vlcex=NULL,
caxislabels=NULL, calcex=NULL,
paxislabels=NULL, palcex=NULL, ...) {
if (!is.data.frame(df)) { cat("The data must be given as dataframe.\n"); return() }
if ((n <- length(df))<3) { cat("The number of variables must be 3 or more.\n"); return() }
if (maxmin==FALSE) { # when the dataframe does not include max and min as the top 2 rows.
dfmax <- apply(df, 2, max)
dfmin <- apply(df, 2, min)
df <- rbind(dfmax, dfmin, df)
}
plot(c(-1.2, 1.2), c(-1.2, 1.2), type="n", frame.plot=FALSE, axes=FALSE,
xlab="", ylab="", main=title, asp=1, ...) # define x-y coordinates without any plot
theta <- seq(90, 450, length=n+1)*pi/180
theta <- theta[1:n]
xx <- cos(theta)
yy <- sin(theta)
CGap <- ifelse(centerzero, 0, 1)
for (i in 0:seg) { # complementary guide lines, dotted navy line by default
polygon(xx*(i+CGap)/(seg+CGap), yy*(i+CGap)/(seg+CGap), lty=cglty, lwd=cglwd, border=cglcol)
if (axistype==1|axistype==3) CAXISLABELS <- paste(i/seg*100,"(%)")
if (axistype==4|axistype==5) CAXISLABELS <- sprintf("%3.2f",i/seg)
if (!is.null(caxislabels)&(i<length(caxislabels))) CAXISLABELS <- caxislabels[i+1]
if (axistype==1|axistype==3|axistype==4|axistype==5) {
if (is.null(calcex)) text(-0.05, (i+CGap)/(seg+CGap), CAXISLABELS, col=axislabcol) else
text(-0.05, (i+CGap)/(seg+CGap), CAXISLABELS, col=axislabcol, cex=calcex)
}
}
if (centerzero) {
arrows(0, 0, xx*1, yy*1, lwd=cglwd, lty=cglty, length=0, col=cglcol)
}
else {
arrows(xx/(seg+CGap), yy/(seg+CGap), xx*1, yy*1, lwd=cglwd, lty=cglty, length=0, col=cglcol)
}
PAXISLABELS <- df[1,1:n]
if (!is.null(paxislabels)) PAXISLABELS <- paxislabels
if (axistype==2|axistype==3|axistype==5) {
if (is.null(palcex)) text(xx[1:n], yy[1:n], PAXISLABELS, col=axislabcol) else
text(xx[1:n], yy[1:n], PAXISLABELS, col=axislabcol, cex=palcex)
}
VLABELS <- colnames(df)
if (!is.null(vlabels)) VLABELS <- vlabels
##--------------------------------------------------
## Modified by Killbill-(Me)
##--------------------------------------------------
# Main code:
# if (is.null(vlcex)) text(xx*1.2, yy*1.2, VLABELS) else
# text(xx*1.2, yy*1.2, VLABELS, cex=vlcex, adj=adjVec)
# Modified code:
# Create a variable that round 'xx' value to 0 and 1 for non zero and 0.5 for 0 values.
adjVec <- ifelse(round(xx) < 0, 1, ifelse(round(xx) > 0, 0, 0.5))
#apply 'adjVec' variable to "adj" parameters of text.
for (i in seq_along(xx)){
if (is.null(vlcex)) text(xx[i]*1.1, yy[i]*1.1, VLABELS[i], adj=adjVec[i]) else
text(xx[i]*1.1, yy[i]*1.1, VLABELS[i], cex=vlcex, adj=adjVec[i])
}
##-------------------------------------------------
## End
##-------------------------------------------------
series <- length(df[[1]])
SX <- series-2
if (length(pty) < SX) { ptys <- rep(pty, SX) } else { ptys <- pty }
if (length(pcol) < SX) { pcols <- rep(pcol, SX) } else { pcols <- pcol }
if (length(plty) < SX) { pltys <- rep(plty, SX) } else { pltys <- plty }
if (length(plwd) < SX) { plwds <- rep(plwd, SX) } else { plwds <- plwd }
if (length(pdensity) < SX) { pdensities <- rep(pdensity, SX) } else { pdensities <- pdensity }
if (length(pangle) < SX) { pangles <- rep(pangle, SX)} else { pangles <- pangle }
if (length(pfcol) < SX) { pfcols <- rep(pfcol, SX) } else { pfcols <- pfcol }
for (i in 3:series) {
xxs <- xx
yys <- yy
scale <- CGap/(seg+CGap)+(df[i,]-df[2,])/(df[1,]-df[2,])*seg/(seg+CGap)
if (sum(!is.na(df[i,]))<3) { cat(sprintf("[DATA NOT ENOUGH] at %d\n%g\n",i,df[i,])) # for too many NA's (1.2.2012)
} else {
for (j in 1:n) {
if (is.na(df[i, j])) { # how to treat NA
if (na.itp) { # treat NA using interpolation
left <- ifelse(j>1, j-1, n)
while (is.na(df[i, left])) {
left <- ifelse(left>1, left-1, n)
}
right <- ifelse(j<n, j+1, 1)
while (is.na(df[i, right])) {
right <- ifelse(right<n, right+1, 1)
}
xxleft <- xx[left]*CGap/(seg+CGap)+xx[left]*(df[i,left]-df[2,left])/(df[1,left]-df[2,left])*seg/(seg+CGap)
yyleft <- yy[left]*CGap/(seg+CGap)+yy[left]*(df[i,left]-df[2,left])/(df[1,left]-df[2,left])*seg/(seg+CGap)
xxright <- xx[right]*CGap/(seg+CGap)+xx[right]*(df[i,right]-df[2,right])/(df[1,right]-df[2,right])*seg/(seg+CGap)
yyright <- yy[right]*CGap/(seg+CGap)+yy[right]*(df[i,right]-df[2,right])/(df[1,right]-df[2,right])*seg/(seg+CGap)
if (xxleft > xxright) {
xxtmp <- xxleft; yytmp <- yyleft;
xxleft <- xxright; yyleft <- yyright;
xxright <- xxtmp; yyright <- yytmp;
}
xxs[j] <- xx[j]*(yyleft*xxright-yyright*xxleft)/(yy[j]*(xxright-xxleft)-xx[j]*(yyright-yyleft))
yys[j] <- (yy[j]/xx[j])*xxs[j]
} else { # treat NA as zero (origin)
xxs[j] <- 0
yys[j] <- 0
}
}
else {
xxs[j] <- xx[j]*CGap/(seg+CGap)+xx[j]*(df[i, j]-df[2, j])/(df[1, j]-df[2, j])*seg/(seg+CGap)
yys[j] <- yy[j]*CGap/(seg+CGap)+yy[j]*(df[i, j]-df[2, j])/(df[1, j]-df[2, j])*seg/(seg+CGap)
}
}
if (is.null(pdensities)) {
polygon(xxs, yys, lty=pltys[i-2], lwd=plwds[i-2], border=pcols[i-2], col=pfcols[i-2])
} else {
polygon(xxs, yys, lty=pltys[i-2], lwd=plwds[i-2], border=pcols[i-2],
density=pdensities[i-2], angle=pangles[i-2], col=pfcols[i-2])
}
points(xx*scale, yy*scale, pch=ptys[i-2], col=pcols[i-2])
}
}
}
我有一个闪亮的应用程序，它使用 fmsb 包根据用户在简短测验中的输入创建蜘蛛图。但是，其中 2 个标签与绘图重叠，我找不到将它们移得更远的方法。
我试过使用 paxislabels 参数，但我无法弄清楚，而且 help documentation or this great tutorial 在那部分不清楚。我希望水平标签像垂直标签一样——在情节之外。
这是一个可重现的例子：
library(shiny)
library(fmsb)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel( selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
actionButton("submit", "Submit")),
mainPanel(
mainPanel(plotOutput("spider_chart"))
)
)
)
server <- function(input, output) {
data_scores <- reactive({
#Make tibble of raw data
raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
`Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
`Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
`Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
#fbsm needs the first 2 rows to be the max and min values
min_max <- tibble(`Variable 1` = c(2, 0),
`Variable 2` = c(2, 0),
`Variable 3` = c(2, 0),
`Variable 4` = c(3, 0))
min_max %>%
full_join(raw_data)
})
#This is the section that needs to be updated
output$spider_chart <- renderPlot({
req(input$submit)
colors_border=rgb(.5, 0, .5, .9)
colors_in=rgb(.5, 0, .5, .5)
# plot with default options:
radarchart(data_scores(),
#custom polygon
pcol= colors_border, pfcol=colors_in , plwd=4 , plty=1,
#custom the grid
cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
#custom labels
vlcex= 1.2
) })
}
# Run the application
shinyApp(ui = ui, server = server)
我直接写信给 fmsb 的创建者 Minato Nakazawa，他提供了一个非常容易实现的答案。简而言之，所有标签都像一般文本字符串一样，因此他建议在我的 radarchart() 调用中使用 vlabel 参数重命名变量，并在两个水平轴标题中添加空格，并且成功了！下面是添加 10 个空格后的样子：
这是完整的代码，添加了：
library(shiny)
library(fmsb)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel( selectInput("q1", label = "question 1", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q2", label = "question 2", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q3", label = "question 3", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q4", label = "question 4", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q5", label = "question 5", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q6", label = "question 6", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
selectInput("q7", label = "question 7", choices = c("", "Yes" = 1, "Somewhat" = .5, "No" = 0)),
actionButton("submit", "Submit")),
mainPanel(
mainPanel(plotOutput("spider_chart"))
)
)
)
server <- function(input, output) {
data_scores <- reactive({
#Make tibble of raw data
raw_data <- tibble(`Variable 1` = sum(c(as.numeric(input$q1), as.numeric(input$q2), na.rm = T)),
`Variable 2` = sum(c(as.numeric(input$q2), as.numeric(input$q3)), na.rm = T),
`Variable 3` = sum(c(as.numeric(input$q4), as.numeric(input$q5)), na.rm = T),
`Variable 4` = sum(c(as.numeric(input$q5), as.numeric(input$q6), as.numeric(input$q7)), na.rm = T))
#fbsm needs the first 2 rows to be the max and min values
min_max <- tibble(`Variable 1` = c(2, 0),
`Variable 2` = c(2, 0),
`Variable 3` = c(2, 0),
`Variable 4` = c(3, 0))
min_max %>%
full_join(raw_data)
})
#This is the section that needs to be updated
output$spider_chart <- renderPlot({
req(input$submit)
colors_border=rgb(.5, 0, .5, .9)
colors_in=rgb(.5, 0, .5, .5)
# plot with default options:
radarchart(data_scores(),
#custom polygon
pcol= colors_border, pfcol=colors_in , plwd=4 , plty=1, vlabels = c("Variable 1", "Variable 2 ", "Variable 3", " Variable 4"),
#custom the grid
cglcol="grey", cglty=1, axislabcol="grey",cglwd=0.8, paxislabels = c(10, 10, 10, 10),
#custom labels
vlcex= 1.2
) })
}
# Run the application
shinyApp(ui = ui, server = server)
非常感谢 Minato Nakazawa 创建此程序包并及时回复我的询问。
这是 Minato Nakazawa 在 fmsb 包源代码中为 radarchart 功能编写的代码。
好像没有地方放这个包的pull request，所以我post在这里。
我更改了这段代码中与变量标签相关的部分（在代码块中对其进行了注释），
根据标签相对于 (0,0) 点的位置应用适当的 adj 标签。
您可以将此函数复制到您的代码或其他文件中，并将其源代码到您的主代码中，然后使用 fmsb 包中的 radarchart 函数。
radarchart <- function(df, axistype=0, seg=4, pty=16, pcol=1:8, plty=1:6, plwd=1,
pdensity=NULL, pangle=45, pfcol=NA, cglty=3, cglwd=1,
cglcol="navy", axislabcol="blue", title="", maxmin=TRUE,
na.itp=TRUE, centerzero=FALSE, vlabels=NULL, vlcex=NULL,
caxislabels=NULL, calcex=NULL,
paxislabels=NULL, palcex=NULL, ...) {
if (!is.data.frame(df)) { cat("The data must be given as dataframe.\n"); return() }
if ((n <- length(df))<3) { cat("The number of variables must be 3 or more.\n"); return() }
if (maxmin==FALSE) { # when the dataframe does not include max and min as the top 2 rows.
dfmax <- apply(df, 2, max)
dfmin <- apply(df, 2, min)
df <- rbind(dfmax, dfmin, df)
}
plot(c(-1.2, 1.2), c(-1.2, 1.2), type="n", frame.plot=FALSE, axes=FALSE,
xlab="", ylab="", main=title, asp=1, ...) # define x-y coordinates without any plot
theta <- seq(90, 450, length=n+1)*pi/180
theta <- theta[1:n]
xx <- cos(theta)
yy <- sin(theta)
CGap <- ifelse(centerzero, 0, 1)
for (i in 0:seg) { # complementary guide lines, dotted navy line by default
polygon(xx*(i+CGap)/(seg+CGap), yy*(i+CGap)/(seg+CGap), lty=cglty, lwd=cglwd, border=cglcol)
if (axistype==1|axistype==3) CAXISLABELS <- paste(i/seg*100,"(%)")
if (axistype==4|axistype==5) CAXISLABELS <- sprintf("%3.2f",i/seg)
if (!is.null(caxislabels)&(i<length(caxislabels))) CAXISLABELS <- caxislabels[i+1]
if (axistype==1|axistype==3|axistype==4|axistype==5) {
if (is.null(calcex)) text(-0.05, (i+CGap)/(seg+CGap), CAXISLABELS, col=axislabcol) else
text(-0.05, (i+CGap)/(seg+CGap), CAXISLABELS, col=axislabcol, cex=calcex)
}
}
if (centerzero) {
arrows(0, 0, xx*1, yy*1, lwd=cglwd, lty=cglty, length=0, col=cglcol)
}
else {
arrows(xx/(seg+CGap), yy/(seg+CGap), xx*1, yy*1, lwd=cglwd, lty=cglty, length=0, col=cglcol)
}
PAXISLABELS <- df[1,1:n]
if (!is.null(paxislabels)) PAXISLABELS <- paxislabels
if (axistype==2|axistype==3|axistype==5) {
if (is.null(palcex)) text(xx[1:n], yy[1:n], PAXISLABELS, col=axislabcol) else
text(xx[1:n], yy[1:n], PAXISLABELS, col=axislabcol, cex=palcex)
}
VLABELS <- colnames(df)
if (!is.null(vlabels)) VLABELS <- vlabels
##--------------------------------------------------
## Modified by Killbill-(Me)
##--------------------------------------------------
# Main code:
# if (is.null(vlcex)) text(xx*1.2, yy*1.2, VLABELS) else
# text(xx*1.2, yy*1.2, VLABELS, cex=vlcex, adj=adjVec)
# Modified code:
# Create a variable that round 'xx' value to 0 and 1 for non zero and 0.5 for 0 values.
adjVec <- ifelse(round(xx) < 0, 1, ifelse(round(xx) > 0, 0, 0.5))
#apply 'adjVec' variable to "adj" parameters of text.
for (i in seq_along(xx)){
if (is.null(vlcex)) text(xx[i]*1.1, yy[i]*1.1, VLABELS[i], adj=adjVec[i]) else
text(xx[i]*1.1, yy[i]*1.1, VLABELS[i], cex=vlcex, adj=adjVec[i])
}
##-------------------------------------------------
## End
##-------------------------------------------------
series <- length(df[[1]])
SX <- series-2
if (length(pty) < SX) { ptys <- rep(pty, SX) } else { ptys <- pty }
if (length(pcol) < SX) { pcols <- rep(pcol, SX) } else { pcols <- pcol }
if (length(plty) < SX) { pltys <- rep(plty, SX) } else { pltys <- plty }
if (length(plwd) < SX) { plwds <- rep(plwd, SX) } else { plwds <- plwd }
if (length(pdensity) < SX) { pdensities <- rep(pdensity, SX) } else { pdensities <- pdensity }
if (length(pangle) < SX) { pangles <- rep(pangle, SX)} else { pangles <- pangle }
if (length(pfcol) < SX) { pfcols <- rep(pfcol, SX) } else { pfcols <- pfcol }
for (i in 3:series) {
xxs <- xx
yys <- yy
scale <- CGap/(seg+CGap)+(df[i,]-df[2,])/(df[1,]-df[2,])*seg/(seg+CGap)
if (sum(!is.na(df[i,]))<3) { cat(sprintf("[DATA NOT ENOUGH] at %d\n%g\n",i,df[i,])) # for too many NA's (1.2.2012)
} else {
for (j in 1:n) {
if (is.na(df[i, j])) { # how to treat NA
if (na.itp) { # treat NA using interpolation
left <- ifelse(j>1, j-1, n)
while (is.na(df[i, left])) {
left <- ifelse(left>1, left-1, n)
}
right <- ifelse(j<n, j+1, 1)
while (is.na(df[i, right])) {
right <- ifelse(right<n, right+1, 1)
}
xxleft <- xx[left]*CGap/(seg+CGap)+xx[left]*(df[i,left]-df[2,left])/(df[1,left]-df[2,left])*seg/(seg+CGap)
yyleft <- yy[left]*CGap/(seg+CGap)+yy[left]*(df[i,left]-df[2,left])/(df[1,left]-df[2,left])*seg/(seg+CGap)
xxright <- xx[right]*CGap/(seg+CGap)+xx[right]*(df[i,right]-df[2,right])/(df[1,right]-df[2,right])*seg/(seg+CGap)
yyright <- yy[right]*CGap/(seg+CGap)+yy[right]*(df[i,right]-df[2,right])/(df[1,right]-df[2,right])*seg/(seg+CGap)
if (xxleft > xxright) {
xxtmp <- xxleft; yytmp <- yyleft;
xxleft <- xxright; yyleft <- yyright;
xxright <- xxtmp; yyright <- yytmp;
}
xxs[j] <- xx[j]*(yyleft*xxright-yyright*xxleft)/(yy[j]*(xxright-xxleft)-xx[j]*(yyright-yyleft))
yys[j] <- (yy[j]/xx[j])*xxs[j]
} else { # treat NA as zero (origin)
xxs[j] <- 0
yys[j] <- 0
}
}
else {
xxs[j] <- xx[j]*CGap/(seg+CGap)+xx[j]*(df[i, j]-df[2, j])/(df[1, j]-df[2, j])*seg/(seg+CGap)
yys[j] <- yy[j]*CGap/(seg+CGap)+yy[j]*(df[i, j]-df[2, j])/(df[1, j]-df[2, j])*seg/(seg+CGap)
}
}
if (is.null(pdensities)) {
polygon(xxs, yys, lty=pltys[i-2], lwd=plwds[i-2], border=pcols[i-2], col=pfcols[i-2])
} else {
polygon(xxs, yys, lty=pltys[i-2], lwd=plwds[i-2], border=pcols[i-2],
density=pdensities[i-2], angle=pangles[i-2], col=pfcols[i-2])
}
points(xx*scale, yy*scale, pch=ptys[i-2], col=pcols[i-2])
}
}
}