loon_reactive <- function(loon.grob, output.grob, linkingInfo, buttons, position, selectBy,
linkingGroup, input, colorList, tabPanelName, outputInfo) {
obj <- character(0)
class(obj) <- names(loon.grob$children)
UseMethod("loon_reactive", obj)
}
loon_reactive.default <- function(loon.grob, output.grob, linkingInfo, buttons, position, selectBy,
linkingGroup, input, colorList, tabPanelName, outputInfo) {
list(
output.grob = loon.grob,
loon.grob = loon.grob,
outputInfo = list(
brushId = numeric(0),
linkingGroup = linkingGroup,
linkingInfo = linkingInfo
)
)
}
loon_reactive.l_plot <- function(loon.grob, output.grob, linkingInfo, buttons, position, selectBy,
linkingGroup, input, colorList, tabPanelName, outputInfo) {
# NOTE: for shiny, try to put the `input[[**]]` outside of a logical check
# why: avoid some issue that the `input[[**]]` fails to get fired.
plotBrush <- input$plotBrush
plotClick <- input$plotClick
loonWidgetsInfo <- outputInfo$loonWidgetsInfo
pull <- input[[paste0(tabPanelName, "pull")]]
initialDisplay <- is.null(output.grob)
if(!initialDisplay && (input[["navBarPage"]] != tabPanelName || pull > buttons["pull"])) {
if(pull > buttons["pull"]) {
buttons["pull"] <- pull
linkingGroup <- isolate(input[[paste0(tabPanelName, "linkingGroup")]])
}
if(linkingGroup != "none") {
linkedInfo <- linkingInfo[[linkingGroup]]
order <- match(loonWidgetsInfo$linkingKey, linkedInfo$linkingKey)
modifiedLinkingInfo <- set_linkingInfo(
loon.grob = loon.grob,
output.grob = output.grob,
linkedInfo = linkedInfo,
linkedStates = input[[paste0(tabPanelName, "linkedStates")]],
tabPanelName = tabPanelName,
order = order,
loonWidgetsInfo = loonWidgetsInfo,
roundings =loonWidgetsInfo$glyphArgs
)
selected <- linkedInfo$selected
brushId <- which(selected)
selectByColor <- linkedInfo$selectByColor
output.grob <- modifiedLinkingInfo$output.grob
loon.grob <- modifiedLinkingInfo$loon.grob
loonWidgetsInfo <- modifiedLinkingInfo$loonWidgetsInfo
} else {
brushId <- outputInfo$brushId
selectByColor <- outputInfo$selectByColor
}
} else {
output.grob <- loon.grob
loonColor <- loonWidgetsInfo$loonColor
# interactive ------------------------------------------------------
plotAxes1 <- input[[paste0(tabPanelName, "plotAxes1")]]
plotAxes2 <- input[[paste0(tabPanelName, "plotAxes2")]]
# swap, showScales, showLabels and showGuides -------------------------------------
swapInLoon <- loonWidgetsInfo$swapInLoon
swapInShiny <- "swap" %in% plotAxes1
swap <- ((swapInShiny & !swapInLoon) || (!swapInShiny & swapInLoon))
N <- loonWidgetsInfo$N
whichIsDeactive <- which(!loonWidgetsInfo$active)
output.grob <- set_deactive_grob(
loon.grob = output.grob,
index = whichIsDeactive,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loon.grob <- set_deactive_grob(
loon.grob = loon.grob,
index = whichIsDeactive,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
# labels <- get_labels(output.grob)
labels <- loonWidgetsInfo$labels
title <- labels$title
layerSet <- input[[paste0(tabPanelName, "layerSet")]]
currentLayerName <- input[[paste0(tabPanelName, "layer")]]
newLayerLabel <- isolate(input[[paste0(tabPanelName, "newLayerLabel")]])
if(layerSet > buttons["layerSet"]) {
buttons["layerSet"] <- layerSet
if(newLayerLabel == "") {
message("no valid label")
layers <- loonWidgetsInfo$layers
layersName <- names(layers)
currentLayer <- layers[which(layersName == currentLayerName)]
} else {
layers <- loonWidgetsInfo$layers
layersName <- names(layers)
whichLayerIsEdited <- which(layersName == currentLayerName)
layersName[whichLayerIsEdited] <- newLayerLabel
names(layers) <- layersName
loonWidgetsInfo$layers <- layers
currentLayer <- layers[whichLayerIsEdited]
}
} else {
layers <- loonWidgetsInfo$layers
layersName <- names(layers)
currentLayer <- layers[which(layersName == currentLayerName)]
}
# drop layers
layerMinus <- input[[paste0(tabPanelName, "layerMinus")]]
if(layerMinus > buttons["layerMinus"]) {
buttons["layerMinus"] <- layerMinus
loon.grob <- grid::setGrob(
gTree = loon.grob,
gPath = currentLayer,
newGrob = nullGrob(name = currentLayer)
)
output.grob <- grid::setGrob(
gTree = loon.grob,
gPath = currentLayer,
newGrob = nullGrob(name = currentLayer)
)
# update layers
newLayers <- setdiff(layers, currentLayer)
newLayersName <- setdiff(layersName, currentLayerName)
names(newLayers) <- newLayersName
loonWidgetsInfo$layers <- newLayers
worldView <- get_worldViewPort(loon.grob = loon.grob, parent = "scatterplot",
parentExcluded = TRUE)
loonWidgetsInfo$worldViewXlim <- range(c(loonWidgetsInfo$plotViewXlim,
worldView$xlim))
loonWidgetsInfo$worldViewYlim <- range(c(loonWidgetsInfo$plotViewYlim,
worldView$ylim))
}
# plot scale to
scaleToSelect <- input[[paste0(tabPanelName, "scaleToSelect")]]
scaleToPlot <- input[[paste0(tabPanelName, "scaleToPlot")]]
scaleToWorld <- input[[paste0(tabPanelName, "scaleToWorld")]]
scaleToLayer <- input[[paste0(tabPanelName, "scaleToLayer")]]
sliderxlim <- input[[paste0(tabPanelName, "xlim")]]
sliderylim <- input[[paste0(tabPanelName, "ylim")]]
# for plot region
brushId <- outputInfo$brushId
if(swap) {
if(scaleToSelect > buttons["select"]) {
buttons["select"] <- scaleToSelect
if(length(brushId) == 0) {
message("no points selected")
loonWidgetsInfo$ylim <- sliderxlim
loonWidgetsInfo$xlim <- sliderylim
} else {
loonWidgetsInfo$ylim <- grDevices::extendrange(
c(
min(loonWidgetsInfo$x[brushId]) - loonWidgetsInfo$stepX/2,
max(loonWidgetsInfo$x[brushId]) + loonWidgetsInfo$stepX/2
)
)
loonWidgetsInfo$xlim <- grDevices::extendrange(
c(
min(loonWidgetsInfo$y[brushId]) - loonWidgetsInfo$stepY/2,
max(loonWidgetsInfo$y[brushId]) + loonWidgetsInfo$stepY/2
)
)
}
} else if(scaleToPlot > buttons["plot"]) {
buttons["plot"] <- scaleToPlot
loonWidgetsInfo$ylim <- loonWidgetsInfo$plotViewXlim
loonWidgetsInfo$xlim <- loonWidgetsInfo$plotViewYlim
} else if(scaleToWorld > buttons["world"]) {
buttons["world"] <- scaleToWorld
loonWidgetsInfo$ylim <- loonWidgetsInfo$worldViewXlim
loonWidgetsInfo$xlim <- loonWidgetsInfo$worldViewYlim
} else if (scaleToLayer > buttons["scaleToLayer"] && length(currentLayer) > 0) {
buttons["scaleToLayer"] <- scaleToLayer
if(currentLayer == "scatterplot") {
loonWidgetsInfo$ylim <- loonWidgetsInfo$plotViewXlim
loonWidgetsInfo$xlim <- loonWidgetsInfo$plotViewYlim
} else {
layerLimits <- get_layer_worldView(loon.grob, layer = currentLayer)
loonWidgetsInfo$ylim <-layerLimits$xlim
loonWidgetsInfo$xlim <- layerLimits$ylim
}
} else {
loonWidgetsInfo$ylim <- sliderxlim
loonWidgetsInfo$xlim <- sliderylim
}
# swap label
ylabel <- labels$xlabel
xlabel <- labels$ylabel
# swap output grob
output.grob <- swapCoords_grob(output.grob,
x = loonWidgetsInfo$y,
y = loonWidgetsInfo$x,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
# swap layer
output.grob <- swap_layer_grob(output.grob, parent = "scatterplot")
} else {
if(scaleToSelect > buttons["select"]) {
buttons["select"] <- scaleToSelect
if(length(brushId) == 0) {
message("no points selected")
loonWidgetsInfo$xlim <- sliderxlim
loonWidgetsInfo$ylim <- sliderylim
} else {
loonWidgetsInfo$xlim <- grDevices::extendrange(
c(
min(loonWidgetsInfo$x[brushId]) - loonWidgetsInfo$stepX/2,
max(loonWidgetsInfo$x[brushId]) + loonWidgetsInfo$stepX/2
)
)
loonWidgetsInfo$ylim <- grDevices::extendrange(
c(
min(loonWidgetsInfo$y[brushId]) - loonWidgetsInfo$stepY/2,
max(loonWidgetsInfo$y[brushId]) + loonWidgetsInfo$stepY/2
)
)
}
} else if(scaleToPlot > buttons["plot"]) {
buttons["plot"] <- scaleToPlot
loonWidgetsInfo$xlim <- loonWidgetsInfo$plotViewXlim
loonWidgetsInfo$ylim <- loonWidgetsInfo$plotViewYlim
} else if(scaleToWorld > buttons["world"]) {
buttons["world"] <- scaleToWorld
loonWidgetsInfo$xlim <- loonWidgetsInfo$worldViewXlim
loonWidgetsInfo$ylim <- loonWidgetsInfo$worldViewYlim
} else if(scaleToLayer > buttons["scaleToLayer"] && length(currentLayer) > 0) {
buttons["scaleToLayer"] <- scaleToLayer
if(currentLayer == "scatterplot") {
loonWidgetsInfo$xlim <- loonWidgetsInfo$plotViewXlim
loonWidgetsInfo$ylim <- loonWidgetsInfo$plotViewYlim
} else {
layerLimits <- get_layer_worldView(loon.grob, layer = currentLayer)
loonWidgetsInfo$xlim <-layerLimits$xlim
loonWidgetsInfo$ylim <- layerLimits$ylim
}
} else {
loonWidgetsInfo$xlim <- sliderxlim
loonWidgetsInfo$ylim <- sliderylim
}
xlabel <- labels$xlabel
ylabel <- labels$ylabel
}
xaxis <- grid::grid.pretty(loonWidgetsInfo$xlim)
yaxis <- grid::grid.pretty(loonWidgetsInfo$ylim)
# reset margins
loonMargins <- loonWidgetsInfo$loonDefaultMargins
margins <- rep(0, 4)
if("scales" %in% plotAxes2) {
output.grob <- set_scales_grob(loon.grob = output.grob,
xaxis = xaxis,
yaxis = yaxis)
margins <- margins + loonMargins$scalesMargins
loonWidgetsInfo$showScales <- TRUE
} else {
output.grob <- grid::setGrob(
gTree = output.grob,
gPath = "axes",
newGrob = nullGrob(name = "axes")
)
loonWidgetsInfo$showScales <- FALSE
}
if("labels" %in% plotAxes1) {
output.grob <- set_labelsGrob(
loon.grob = output.grob,
showScales = loonWidgetsInfo$showScales,
xlabel = xlabel,
ylabel = ylabel,
title = title
)
if(is.null(xlabel) || xlabel == "") loonMargins$labelMargins[1] <- loonMargins$minimumMargins[1]
if(is.null(ylabel) || ylabel == "") loonMargins$labelMargins[2] <- loonMargins$minimumMargins[2]
if(is.null(title) || title == "") loonMargins$labelMargins[3] <- loonMargins$minimumMargins[3]
margins <- margins + loonMargins$labelMargins
loonWidgetsInfo$showLabels <- TRUE
} else {
output.grob <- grid::setGrob(
gTree = output.grob,
gPath = "labels",
newGrob = nullGrob(name = "labels")
)
loonWidgetsInfo$showLabels <- FALSE
}
if("guides" %in% plotAxes2) {
output.grob <- set_guidesGrob(loon.grob = output.grob,
xaxis = xaxis,
yaxis = yaxis,
loonColor = loonColor)
loonWidgetsInfo$showGuides <- TRUE
} else {
output.grob <- grid::setGrob(
gTree = output.grob,
gPath = "guides",
newGrob = nullGrob(name = "guides")
)
loonWidgetsInfo$showGuides <- FALSE
}
if(loonWidgetsInfo$showLabels || loonWidgetsInfo$showScales) {
margins <- apply(cbind(margins, loonMargins$minimumMargins), 1, max)
}
loonWidgetsInfo$margins <- margins
loonWidgetsInfo$swapInShiny <- swapInShiny
loonWidgetsInfo$swapInLoon <- swapInLoon
loonWidgetsInfo$swap <- swap
# set viewport
vp <- grid::vpStack(
grid::plotViewport(margins = margins, name = "plotViewport"),
grid::dataViewport(xscale = if(swap) loonWidgetsInfo$ylim else loonWidgetsInfo$xlim,
yscale = if(swap) loonWidgetsInfo$xlim else loonWidgetsInfo$ylim,
name = "dataViewport")
)
############ Begin: set brushId ############
brushId <- if(initialDisplay) {
outputInfo$brushId
} else {
# sweeping or brushing
if(is.null(plotBrush) && is.null(plotClick)) {
outputInfo$brushId
} else {
if(!is.null(position))
get_brushId(
loon.grob = output.grob,
coord = list(
x = loonWidgetsInfo$x,
y = loonWidgetsInfo$y
),
swapInShiny = swapInShiny,
swapInLoon = swapInLoon,
position = position,
brushInfo = plotBrush,
vp = vp,
clickInfo = plotClick
)
}
}
# query the `offset`
loonWidgetsInfo$offset <- get_offset(vp = vp,
l = plotBrush$domain$left %||% plotClick$domain$left %||% -0.04,
r = plotBrush$domain$right %||% plotClick$domain$right %||% 1.04,
b = plotBrush$domain$bottom %||% plotClick$domain$bottom %||% -0.04,
t = plotBrush$domain$top %||% plotClick$domain$top %||% 1.04)
sticky <- input[[paste0(tabPanelName, "sticky")]]
selectByColor <- input[[paste0(tabPanelName, "selectByColor")]]
# select dynamic
selectDynamic <- input[[paste0(tabPanelName, "selectDynamic")]]
if(sticky == "off") {
if(!is.null(selectByColor)) {
# when selectByColor is on, we can use brush to clear selection but keep brush id
loonWidgetsInfo$lastSelection <- if(!is.null(plotBrush) || !is.null(plotClick)) brushId else integer(0)
brushId <- which(loonWidgetsInfo$color %in% selectByColor)
} else {
if(!is.null(outputInfo$selectByColor))
brushId <- loonWidgetsInfo$lastSelection
}
if("deselect" == selectDynamic) {
if(!is.null(plotBrush) || !is.null(plotClick))
brushId <- integer(0)
}
} else {
# sticky is on
if(!is.null(selectByColor)) {
whichIsSelected <- union(which(loonWidgetsInfo$color %in% selectByColor), which(loonWidgetsInfo$selected))
} else {
whichIsSelected <- which(loonWidgetsInfo$selected)
}
if("invert" == selectDynamic) {
if(is.null(plotBrush) & is.null(plotClick)) {
brushId <- whichIsSelected
} else {
brushId <- union(setdiff(whichIsSelected, brushId), setdiff(brushId, whichIsSelected))
}
} else if("deselect" == selectDynamic) {
if(is.null(plotBrush) & is.null(plotClick)) {
brushId <- whichIsSelected
} else {
brushId <- setdiff(whichIsSelected, brushId)
}
} else {
if(is.null(plotBrush) & is.null(plotClick)) {
brushId <- whichIsSelected
} else {
brushId <- union(whichIsSelected, brushId)
}
}
}
# select panel -------------------------------------
selectStaticAll <- input[[paste0(tabPanelName, "selectStaticAll")]]
selectStaticNone <- input[[paste0(tabPanelName, "selectStaticNone")]]
selectStaticInvert <- input[[paste0(tabPanelName, "selectStaticInvert")]]
if(selectStaticAll > buttons["all"]) {
buttons["all"] <- selectStaticAll
brushId <- seq(N)
} else if(selectStaticNone > buttons["none"]) {
buttons["none"] <- selectStaticNone
brushId <- integer(0)
} else if(selectStaticInvert > buttons["invert"]) {
buttons["invert"] <- selectStaticInvert
brushId <- setdiff(seq(N), brushId)
} else NULL
# brushId must be active points
brushId <- setdiff(brushId, whichIsDeactive)
############ End: set brushId ############
loonWidgetsInfo$selected <- rep(FALSE, N)
loonWidgetsInfo$selected[brushId] <- TRUE
# highlight color
output.grob <- set_color_grob(
loon.grob = output.grob,
index = brushId,
newColor = select_color(),
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
# adjust color -------------------------------
colorApply <- input[[paste0(tabPanelName, "colorApply")]]
colorListButtons <- setNames(
lapply(colorList, function(col) input[[paste0(tabPanelName, col)]]),
colorList
)
colorPicker <- isolate(input[[paste0(tabPanelName, "colorPicker")]])
if(colorApply > buttons["colorApply"]) {
buttons["colorApply"] <- colorApply
loon.grob <- set_color_grob(
loon.grob = loon.grob,
index = brushId,
newColor = colorPicker,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loonWidgetsInfo$color[brushId] <- colorPicker
}
for(col in colorList) {
if(colorListButtons[[col]] > buttons[col]) {
buttons[col] <- colorListButtons[[col]]
loon.grob <- set_color_grob(
loon.grob = loon.grob,
index = brushId,
newColor = col,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loonWidgetsInfo$color[brushId] <- col
}
}
# adjust transparency
alphaApply <- input[[paste0(tabPanelName, "alphaApply")]]
if(alphaApply > buttons["alphaApply"]) {
buttons["alphaApply"] <- alphaApply
alpha <- isolate(input[[paste0(tabPanelName, "alpha")]])
loon.grob <- set_alpha_grob(
loon.grob = loon.grob,
index = brushId,
newAlpha = alpha,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
output.grob <- set_alpha_grob(
loon.grob = output.grob,
index = brushId,
newAlpha = alpha,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loonWidgetsInfo$alpha[brushId] <- alpha
}
# adjust deactive--------------------------------
modifyDeactive <- input[[paste0(tabPanelName, "modifyDeactive")]]
if(modifyDeactive > buttons["deactive"]) {
buttons["deactive"] <- modifyDeactive
output.grob <- set_deactive_grob(
loon.grob = output.grob,
index = brushId,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loon.grob <- set_deactive_grob(
loon.grob = loon.grob,
index = brushId,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loonWidgetsInfo$active[brushId] <- FALSE
whichIsDeactive <- union(whichIsDeactive, brushId)
}
# set reactive
modifyReactive <- input[[paste0(tabPanelName, "modifyReactive")]]
if (modifyReactive > buttons["reactive"]) {
buttons["reactive"] <- modifyReactive
output.grob <- set_reactive_grob(
loon.grob = output.grob,
index = whichIsDeactive,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
loon.grob <- set_reactive_grob(
loon.grob = loon.grob,
index = whichIsDeactive,
pointsTreeName = loonWidgetsInfo$pointsTreeName
)
whichIsDeactive <- numeric(0)
loonWidgetsInfo$active <- rep(TRUE, N)
}
# modify move
modifyMoveHalign <- input[[paste0(tabPanelName, "modifyMoveHalign")]]
modifyMoveValign <- input[[paste0(tabPanelName, "modifyMoveValign")]]
modifyMoveHdist <- input[[paste0(tabPanelName, "modifyMoveHdist")]]
modifyMoveVdist <- input[[paste0(tabPanelName, "modifyMoveVdist")]]
modifyMoveGrid <- input[[paste0(tabPanelName, "modifyMoveGrid")]]
modifyMoveJitter <- input[[paste0(tabPanelName, "modifyMoveJitter")]]
modifyMoveReset <- input[[paste0(tabPanelName, "modifyMoveReset")]]
if(modifyMoveHalign > buttons["halign"]) {
buttons["halign"] <- modifyMoveHalign
# to determine if the default widget is swapped
halignY <- if(swap) mean(loonWidgetsInfo$x[brushId]) else mean(loonWidgetsInfo$y[brushId])
output.grob <- move_halign_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
halignY = halignY,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_halign_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
halignY = halignY,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) loonWidgetsInfo$x[brushId] <- halignY else loonWidgetsInfo$y[brushId] <- halignY
} else if(modifyMoveValign > buttons["valign"]) {
buttons["valign"] <- modifyMoveValign
valignX <- if(swap) mean(loonWidgetsInfo$y[brushId]) else mean(loonWidgetsInfo$x[brushId])
output.grob <- move_valign_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
valignX = valignX,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_valign_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
valignX = valignX,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) loonWidgetsInfo$y[brushId] <- valignX else loonWidgetsInfo$x[brushId] <- valignX
} else if(modifyMoveHdist > buttons["hdist"]) {
buttons["hdist"] <- modifyMoveHdist
hdistY <- if(swap) {
seq(
from = min(loonWidgetsInfo$x[brushId]),
to = max(loonWidgetsInfo$x[brushId]),
length.out = length(brushId)
)
} else {
seq(
from = min(loonWidgetsInfo$y[brushId]),
to = max(loonWidgetsInfo$y[brushId]),
length.out = length(brushId)
)
}
output.grob <- move_hdist_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
hdistY = hdistY,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_hdist_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
hdistY = hdistY,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) loonWidgetsInfo$x[brushId] <- hdistY else loonWidgetsInfo$y[brushId] <- hdistY
} else if(modifyMoveVdist > buttons["vdist"]) {
buttons["vdist"] <- modifyMoveVdist
vdistX <- if(swap) {
seq(
from = min(loonWidgetsInfo$y[brushId]),
to = max(loonWidgetsInfo$y[brushId]),
length.out = length(brushId)
)
} else {
seq(
from = min(loonWidgetsInfo$x[brushId]),
to = max(loonWidgetsInfo$x[brushId]),
length.out = length(brushId)
)
}
output.grob <- move_vdist_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
vdistX = vdistX,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_vdist_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
vdistX = vdistX,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) loonWidgetsInfo$y[brushId] <- vdistX else loonWidgetsInfo$x[brushId] <- vdistX
} else if(modifyMoveJitter > buttons["jitter"]) {
buttons["jitter"] <- modifyMoveJitter
jitterxy <- jitter_coord(
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
index = brushId
)
output.grob <- move_jitter_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
jitterxy = jitterxy,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_jitter_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
jitterxy = jitterxy,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) {
loonWidgetsInfo$y[brushId] <- jitterxy$x
loonWidgetsInfo$x[brushId] <- jitterxy$y
} else {
loonWidgetsInfo$x[brushId] <- jitterxy$x
loonWidgetsInfo$y[brushId] <- jitterxy$y
}
} else if(modifyMoveGrid > buttons["grid"]) {
buttons["grid"] <- modifyMoveGrid
squarexy <- square_coord(
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
index = brushId
)
output.grob <- move_grid_grob(loon.grob = output.grob,
index = brushId,
swap = swap,
squarexy = squarexy,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_grid_grob(loon.grob = loon.grob,
index = brushId,
swap = swap,
squarexy = squarexy,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
if(swap) {
loonWidgetsInfo$y[brushId] <- squarexy$x
loonWidgetsInfo$x[brushId] <- squarexy$y
} else {
loonWidgetsInfo$x[brushId] <- squarexy$x
loonWidgetsInfo$y[brushId] <- squarexy$y
}
} else if(modifyMoveReset > buttons["reset"]) {
buttons["reset"] <- modifyMoveReset
output.grob <- move_reset_grob(loon.grob = output.grob,
index = seq(N),
swap = swap,
xyOriginal = loonWidgetsInfo$xyOriginal,
temporary = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loon.grob <- move_reset_grob(loon.grob = loon.grob,
index = seq(N),
swap = swap,
xyOriginal = loonWidgetsInfo$xyOriginal,
temporary = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
loonWidgetsInfo$x <- loonWidgetsInfo$xOriginal
loonWidgetsInfo$y <- loonWidgetsInfo$yOriginal
} else NULL # none of move buttons is active
# adjust glyph --------------------------------
modifyGlyphCircle <- input[[paste0(tabPanelName, "modifyGlyphCircle")]]
modifyGlyphCcircle <- input[[paste0(tabPanelName, "modifyGlyphCcircle")]]
modifyGlyphOcircle <- input[[paste0(tabPanelName, "modifyGlyphOcircle")]]
modifyGlyphSquare <- input[[paste0(tabPanelName, "modifyGlyphSquare")]]
modifyGlyphCsquare <- input[[paste0(tabPanelName, "modifyGlyphCsquare")]]
modifyGlyphOsquare <- input[[paste0(tabPanelName, "modifyGlyphOsquare")]]
modifyGlyphTriangle <- input[[paste0(tabPanelName, "modifyGlyphTriangle")]]
modifyGlyphCtriangle <- input[[paste0(tabPanelName, "modifyGlyphCtriangle")]]
modifyGlyphOtriangle <- input[[paste0(tabPanelName, "modifyGlyphOtriangle")]]
newGlyph <- NULL
if(modifyGlyphCircle > buttons["circle"]) {
buttons["circle"] <- modifyGlyphCircle
newGlyph <- "circle"
}
if(modifyGlyphOcircle > buttons["ocircle"]) {
buttons["ocircle"] <- modifyGlyphOcircle
newGlyph <- "ocircle"
}
if(modifyGlyphCcircle > buttons["ccircle"]) {
buttons["ccircle"] <- modifyGlyphCcircle
newGlyph <- "ccircle"
}
if(modifyGlyphSquare > buttons["square"]) {
buttons["square"] <- modifyGlyphSquare
newGlyph <- "square"
}
if(modifyGlyphOsquare > buttons["osquare"]) {
buttons["osquare"] <- modifyGlyphOsquare
newGlyph <- "osquare"
}
if(modifyGlyphCsquare > buttons["csquare"]) {
buttons["csquare"] <- modifyGlyphCsquare
newGlyph <- "csquare"
}
if(modifyGlyphTriangle > buttons["triangle"]) {
buttons["triangle"] <- modifyGlyphTriangle
newGlyph <- "triangle"
}
if(modifyGlyphOtriangle > buttons["otriangle"]) {
buttons["otriangle"] <- modifyGlyphOtriangle
newGlyph <- "otriangle"
}
if(modifyGlyphCtriangle > buttons["ctriangle"]) {
buttons["ctriangle"] <- modifyGlyphCtriangle
newGlyph <- "ctriangle"
}
if(!is.null(newGlyph)) {
newPch <- glyph_to_pch(newGlyph)
loon.grob <- set_glyph_grob(
loon.grob = loon.grob,
index = brushId,
newPch = newPch,
tmp = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
color = loonWidgetsInfo$color,
size = loonWidgetsInfo$size,
alpha = loonWidgetsInfo$alpha,
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
grobIndex = loonWidgetsInfo$index
)
output.grob <- set_glyph_grob(
loon.grob = output.grob,
index = brushId,
newPch = newPch,
tmp = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
color = loonWidgetsInfo$color,
size = loonWidgetsInfo$size,
alpha = loonWidgetsInfo$alpha,
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
grobIndex = loonWidgetsInfo$index
)
loonWidgetsInfo$glyph[brushId] <- newGlyph
loonWidgetsInfo$pch[brushId] <- newPch
loonWidgetsInfo$glyphNames <-
names(
grid::getGrob(loon.grob, loonWidgetsInfo$pointsTreeName)[["children"]]
)
}
glyphSet <- input[[paste0(tabPanelName, "glyphSet")]]
modifyGlyph <- input[[paste0(tabPanelName, "modifyGlyph")]]
if(glyphSet > buttons["glyphSet"]) {
buttons["glyphSet"] <- glyphSet
if(modifyGlyph != "") {
# loonGrob only provides displayed glyph info
loon.grob <- set_specifiedGlyph_grob(
loon.grob = loon.grob,
index = brushId,
tmp = FALSE,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
color = loonWidgetsInfo$color,
size = loonWidgetsInfo$size,
pch = loonWidgetsInfo$pch,
alpha = loonWidgetsInfo$alpha,
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
loonColor = loonColor,
roundings = loonWidgetsInfo$glyphArgs,
nonePrimitiveGlyphSettings = loonWidgetsInfo$nonePrimitiveGlyphSettings,
oldSize = loonWidgetsInfo$oldSize
)
output.grob <- set_specifiedGlyph_grob(
loon.grob = loon.grob,
index = brushId,
tmp = TRUE,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
color = loonWidgetsInfo$color,
size = loonWidgetsInfo$size,
pch = loonWidgetsInfo$pch,
x = if(swap) loonWidgetsInfo$y else loonWidgetsInfo$x,
y = if(swap) loonWidgetsInfo$x else loonWidgetsInfo$y,
loonColor = loonColor,
roundings = loonWidgetsInfo$glyphArgs,
nonePrimitiveGlyphSettings = loonWidgetsInfo$nonePrimitiveGlyphSettings,
oldSize = loonWidgetsInfo$oldSize
)
loonWidgetsInfo$glyphNames <-
names(
grid::getGrob(loon.grob, loonWidgetsInfo$pointsTreeName)[["children"]]
)
}
}
# adjust size--------------------------------
absToPlus <- input[[paste0(tabPanelName, "absToPlus")]]
if(absToPlus > buttons["absToPlus"]) {
buttons["absToPlus"] <- absToPlus
if(length(brushId) > 0) {
oldSize <- loonWidgetsInfo$size
minSize <- min(loonWidgetsInfo$size[brushId])
newSize <- minSize + 1 # 1 fontsize
loonWidgetsInfo$size[brushId] <- newSize
loon.grob <- set_size_grob(loon.grob = loon.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
output.grob <- set_size_grob(loon.grob = output.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
}
}
absToMinus <- input[[paste0(tabPanelName, "absToMinus")]]
if(absToMinus > buttons["absToMinus"]) {
buttons["absToMinus"] <- absToMinus
if(length(brushId) > 0) {
oldSize <- loonWidgetsInfo$size
minSize <- min(loonWidgetsInfo$size[brushId])
newSize <- minSize - 1 # 1 fontsize
if(any(newSize <= 0)) {
newSize[newSize <= 0] <- 1
warning("new size is less than 0 and will be set as 1",
call. = FALSE)
}
loonWidgetsInfo$size[brushId] <- newSize
loon.grob <- set_size_grob(loon.grob = loon.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
output.grob <- set_size_grob(loon.grob = output.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
}
}
relToPlus <- input[[paste0(tabPanelName, "relToPlus")]]
if(relToPlus > buttons["relToPlus"]) {
buttons["relToPlus"] <- relToPlus
if(length(brushId) > 0) {
oldSize <- loonWidgetsInfo$size
newSize <- loonWidgetsInfo$size[brushId] + 1 # 1 fontsize
loonWidgetsInfo$size[brushId] <- newSize
loon.grob <- set_size_grob(loon.grob = loon.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
output.grob <- set_size_grob(loon.grob = output.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
}
}
relToMinus <- input[[paste0(tabPanelName, "relToMinus")]]
if(relToMinus > buttons["relToMinus"]) {
buttons["relToMinus"] <- relToMinus
if(length(brushId) > 0) {
oldSize <- loonWidgetsInfo$size
newSize <- loonWidgetsInfo$size[brushId] - 1 # 1 fontsize
if(any(newSize <= 0)) {
newSize[newSize <= 0] <- 1
warning("new size is less than 0 and will be set as 1",
call. = FALSE)
}
loonWidgetsInfo$size[brushId] <- newSize
loon.grob <- set_size_grob(loon.grob = loon.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
output.grob <- set_size_grob(loon.grob = output.grob,
index = brushId,
newSize = loonWidgetsInfo$size,
roundings = loonWidgetsInfo$glyphArgs,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
oldSize = oldSize)
}
}
# glyph setting (serialaxes and pointrange)
nonePrimitiveGlyphSettings <- input[[paste0(tabPanelName, "nonePrimitiveGlyphSettings")]]
if(all(!is.na(loonWidgetsInfo$glyphNames))) {
if(any(grepl(loonWidgetsInfo$glyphNames, pattern = "serialaxes"))) {
showEnclosing <- ("showEnclosing" %in% nonePrimitiveGlyphSettings)
if(loonWidgetsInfo$nonePrimitiveGlyphSettings$showEnclosing != showEnclosing) {
loon.grob <- set_serialAxes_enclosing_grob(
loon.grob = loon.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showEnclosing = showEnclosing,
swap = swap,
whichIsDeactive = whichIsDeactive
)
output.grob <- set_serialAxes_enclosing_grob(
loon.grob = output.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showEnclosing = showEnclosing,
swap = swap,
whichIsDeactive = whichIsDeactive
)
loonWidgetsInfo$nonePrimitiveGlyphSettings$showEnclosing <- showEnclosing
}
showAxes <- "showAxes" %in% nonePrimitiveGlyphSettings
if(loonWidgetsInfo$nonePrimitiveGlyphSettings$showAxes != showAxes) {
loon.grob <- set_serialAxes_scales_grob(
loon.grob = loon.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showAxes = showAxes,
swap = swap,
whichIsDeactive = whichIsDeactive
)
output.grob <- set_serialAxes_scales_grob(
loon.grob = output.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showAxes = showAxes,
swap = swap,
whichIsDeactive = whichIsDeactive
)
loonWidgetsInfo$nonePrimitiveGlyphSettings$showAxes <- showAxes
}
showArea <- "showArea" %in% nonePrimitiveGlyphSettings
if(loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea != showArea) {
loon.grob <- set_serialAxes_area_grob(
loon.grob = loon.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
whichIsDeactive = whichIsDeactive
)
output.grob <- set_serialAxes_area_grob(
loon.grob = output.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
whichIsDeactive = whichIsDeactive
)
loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea <- showArea
}
} else if (any(grepl(loonWidgetsInfo$glyphNames, pattern = "polygon"))) {
showArea <- "showArea" %in% nonePrimitiveGlyphSettings
if(loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea != showArea) {
loon.grob <- set_polygon_area_grob(
loon.grob = loon.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
whichIsDeactive = whichIsDeactive
)
output.grob <- set_polygon_area_grob(
loon.grob = output.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
whichIsDeactive = whichIsDeactive
)
loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea <- showArea
}
} else if (any(grepl(loonWidgetsInfo$glyphNames, pattern = "pointrange"))) {
showArea <- "showArea" %in% nonePrimitiveGlyphSettings
if(loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea != showArea) {
loon.grob <- set_pointrange_grob(
loon.grob = loon.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
color = loonWidgetsInfo$color,
whichIsDeactive = whichIsDeactive
)
output.grob <- set_pointrange_grob(
loon.grob = output.grob,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
glyphNames = loonWidgetsInfo$glyphNames,
showArea = showArea,
color = loonWidgetsInfo$color,
whichIsDeactive = whichIsDeactive
)
loonWidgetsInfo$nonePrimitiveGlyphSettings$showArea <- showArea
}
} else NULL # Not implemented yet
}
# reorder selected points
output.grob <- reorder_grob(output.grob,
number = N,
brushId,
pointsTreeName = loonWidgetsInfo$pointsTreeName)
## up, down, visible, invisible, ... layer
layerUp <- input[[paste0(tabPanelName, "layerUp")]]
layerDown <- input[[paste0(tabPanelName, "layerDown")]]
layerVisible <- input[[paste0(tabPanelName, "layerVisible")]]
layerInvisible <- input[[paste0(tabPanelName, "layerInvisible")]]
layerPlus <- input[[paste0(tabPanelName, "layerPlus")]]
if(layerUp > buttons["layerUp"]) {
buttons["layerUp"] <- layerUp
loon.grob <- move_layerUp_grob(loon.grob = loon.grob,
currentLayer = currentLayer,
parent = "l_plot_layers")
output.grob <- move_layerUp_grob(loon.grob = output.grob,
currentLayer = currentLayer,
parent = "l_plot_layers")
}
if(layerDown > buttons["layerDown"]) {
buttons["layerDown"] <- layerDown
loon.grob <- move_layerDown_grob(loon.grob = loon.grob,
currentLayer = currentLayer,
parent = "l_plot_layers")
output.grob <- move_layerDown_grob(loon.grob = output.grob,
currentLayer = currentLayer,
parent = "l_plot_layers")
}
if(layerVisible > buttons["layerVisible"]) {
buttons["layerVisible"] <- layerVisible
loon.grob <- move_layerVisible_grob(loon.grob = loon.grob,
currentLayer = currentLayer,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
N = N)
output.grob <- move_layerVisible_grob(loon.grob = output.grob,
currentLayer = currentLayer,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
N = N)
}
if(layerInvisible > buttons["layerInvisible"]) {
buttons["layerInvisible"] <- layerInvisible
loon.grob <- move_layerInvisible_grob(loon.grob = loon.grob,
currentLayer = currentLayer,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
N = N)
output.grob <- move_layerInvisible_grob(loon.grob = output.grob,
currentLayer = currentLayer,
pointsTreeName = loonWidgetsInfo$pointsTreeName,
N = N)
}
if(layerPlus > buttons["layerPlus"]) {
buttons["layerPlus"] <- layerPlus
message("adding layers has not been inplemented so far")
}
# reset vp
output.grob <- set_viewPort_grob(
loon.grob = output.grob,
margins = margins,
xlim = loonWidgetsInfo$xlim,
ylim = loonWidgetsInfo$ylim
)
# reset boundary
output.grob <- set_boundaryGrob(loon.grob = output.grob,
margins = margins,
loonColor = loonColor)
# set linking info
push <- input[[paste0(tabPanelName, "push")]]
if(push > buttons["push"]) {
buttons["push"] <- push
linkingGroup <- isolate(input[[paste0(tabPanelName, "linkingGroup")]])
} else {
newLinkingGroup <- isolate(input[[paste0(tabPanelName, "linkingGroup")]])
if(newLinkingGroup == "none") linkingGroup <- newLinkingGroup else NULL
}
linkingInfo <- update_linkingInfo(loon.grob,
tabPanelName = tabPanelName,
linkingInfo = linkingInfo,
linkingGroup = linkingGroup,
linkingKey = loonWidgetsInfo$linkingKey,
selected = loonWidgetsInfo$selected,
color = loonWidgetsInfo$color,
size = loonWidgetsInfo$size,
pch = loonWidgetsInfo$pch,
active = loonWidgetsInfo$active,
selectByColor = selectByColor,
linkedStates = input[[paste0(tabPanelName, "linkedStates")]])
}
list(
output.grob = output.grob,
loon.grob = loon.grob,
outputInfo = list(
brushId = brushId,
selectByColor = selectByColor,
linkingGroup = linkingGroup,
linkingInfo = linkingInfo,
loonWidgetsInfo = loonWidgetsInfo,
buttons = buttons
)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.