Me gustaría dar más detalles sobre la respuesta aceptada a esta pregunta .
Estoy buscando mejorar la aplicación brillante mínima a continuación (extraída de la respuesta aceptada) con las siguientes características:
- 1) dibuja el rectángulo + una etiqueta de texto . La etiqueta proviene de R (
input$foo), por ejemplo, de un menú desplegable. Para evitar los casos de borde donde las etiquetas caen fuera de las imágenes, las etiquetas deben colocarse dentro de sus rectángulos. - 2) use un color diferente para los rectángulos y sus etiquetas dependiendo de la etiqueta
- 3) capacidad para que el usuario elimine un rectángulo haciendo doble clic dentro de él . En el caso de múltiples coincidencias (superposición, anidadas), el rectángulo con el área más pequeña debe eliminarse.
Brownie señala 1): el menú desplegable podría aparecer al lado del cursor como se hace aquí (código aquí ). Si es posible, la lista desplegable se debe pasar desde server.R y no se debe corregir / codificar. La razón es que dependiendo de alguna entrada del usuario, se podría mostrar un menú desplegable diferente. Por ejemplo, podríamos tener un menú desplegable para frutas c('banana','pineapple','grapefruit'), un menú desplegable para animales c('raccoon','dog','cat'), etc.
# JS and CSS modified from: https://stackoverflow.com/a/17409472/8099834
css <- "
#canvas {
width:2000px;
height:2000px;
border: 10px solid transparent;
}
.rectangle {
border: 5px solid #FFFF00;
position: absolute;
}
"
js <-
"function initDraw(canvas) {
var mouse = {
x: 0,
y: 0,
startX: 0,
startY: 0
};
function setMousePosition(e) {
var ev = e || window.event; //Moz || IE
if (ev.pageX) { //Moz
mouse.x = ev.pageX + window.pageXOffset;
mouse.y = ev.pageY + window.pageYOffset;
} else if (ev.clientX) { //IE
mouse.x = ev.clientX + document.body.scrollLeft;
mouse.y = ev.clientY + document.body.scrollTop;
}
};
var element = null;
canvas.onmousemove = function (e) {
setMousePosition(e);
if (element !== null) {
element.style.width = Math.abs(mouse.x - mouse.startX) + 'px';
element.style.height = Math.abs(mouse.y - mouse.startY) + 'px';
element.style.left = (mouse.x - mouse.startX < 0) ? mouse.x + 'px' : mouse.startX + 'px';
element.style.top = (mouse.y - mouse.startY < 0) ? mouse.y + 'px' : mouse.startY + 'px';
}
}
canvas.onclick = function (e) {
if (element !== null) {
var coord = {
left: element.style.left,
top: element.style.top,
width: element.style.width,
height: element.style.height
};
Shiny.onInputChange('rectCoord', coord);
element = null;
canvas.style.cursor = \"default\";
} else {
mouse.startX = mouse.x;
mouse.startY = mouse.y;
element = document.createElement('div');
element.className = 'rectangle'
element.style.left = mouse.x + 'px';
element.style.top = mouse.y + 'px';
canvas.appendChild(element);
canvas.style.cursor = \"crosshair\";
}
}
};
$(document).on('shiny:sessioninitialized', function(event) {
initDraw(document.getElementById('canvas'));
});
"
library(shiny)
ui <- fluidPage(
tags$head(
tags$style(css),
tags$script(HTML(js))
),
fluidRow(
column(width = 6,
# inline is necessary
# ...otherwise we can draw rectangles over entire fluidRow
uiOutput("canvas", inline = TRUE)),
column(
width = 6,
verbatimTextOutput("rectCoordOutput")
)
)
)
server <- function(input, output, session) {
output$canvas <- renderUI({
tags$img(src = "https://www.r-project.org/logo/Rlogo.png")
})
output$rectCoordOutput <- renderPrint({
input$rectCoord
})
}
shinyApp(ui, server)
javascript
r
browser
shiny
Antoine
fuente
fuente
Respuestas:
Esta solución utiliza bbox_annotator de kyamagu y se basa en demo.html. No estoy familiarizado con JS, por lo que no es el más bonito. Las limitaciones son:
ui.R
servidor.R
www / bbox_annotation.js
fuente