Eu gostaria de elaborar a resposta aceita para esta pergunta .
Estou procurando melhorar o aplicativo mínimo brilhante abaixo (extraído da resposta aceita) com os seguintes recursos:
- 1) desenhe o retângulo + um rótulo de texto . O rótulo vem de R (
input$foo), por exemplo, de uma lista suspensa. Para evitar os casos em que as etiquetas ficam fora das imagens, as etiquetas devem ser colocadas dentro de seus retângulos. - 2) use uma cor diferente para os retângulos e seus rótulos, dependendo do rótulo
- 3) capacidade de o usuário excluir um retângulo clicando duas vezes dentro dele . No caso de várias correspondências (sobreposição, aninhado), o retângulo com a menor área deve ser excluído.
Brownie aponta para 1): o menu suspenso pode aparecer ao lado do cursor, como é feito aqui (código aqui ). Se possível, a lista suspensa deve ser passada do server.R e não ser fixa / codificada. O motivo é que, dependendo de alguma entrada do usuário, um menu suspenso diferente pode ser mostrado. Por exemplo, podemos ter uma lista suspensa para frutas c('banana','pineapple','grapefruit'), uma lista suspensa para animais 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
fonte
fonte
Respostas:
Esta solução usa o bbox_annotator do kyamagu e é baseada em demo.html. Eu não estou familiarizado com JS, por isso não é o mais bonito. As limitações são:
ui.R
server.R
www / bbox_annotation.js
fonte