Clickable Links in Shiny Datatable

Shiny - display URL's in datatable

Slightly adjust the provided code and it should yield the desired output:

createLink <- function(val) {
  sprintf(paste0('<a href="', URLdecode(val),'" target="_blank">', substr(val, 1, 25) ,'</a>'))
}
websites$url <- createLink(websites$url)

HTML works like this: <a href="LINK", otherOptions,...> Linktext </a>
So you can paste your link together with paste0() and substr().

Convert a column of text URLs into active hyperlinks in Shiny

You need to do two things:

1. Modify the last column so that the KEGGLINK is changed into a proper HTML link that looks like: <a href='url'>link text</a>.

2. Pass DT the escape = FALSE argument so that it doesn't escape the HTML code.

The DT web page has an example of this in section 2.9:
https://rstudio.github.io/DT/

A simple way to do #1 would be something like:

mydata$url <- paste0("<a href='",mydata$url,"'>",mydata$url,"</a>")

How to Create hyperlink to cell value in R shiny

Here is a way.

library(DT)

render <- c(
  "function(data, type, row){",
  "  if(type === 'display'){",
  "    var a = '<a href=\"http://www.mywebsite.com?loc=' + row[2] + '\">' + data + '</a>';",
  "    return a;",
  "  } else {",
  "    return data;",
  "  }",
  "}"
)

data_input <- data.frame(
  List = c("A", "B", "C"), 
  Feature = c("X", "Y", "Z"),
  Location = c("1:02", "2:04", "5:10")
)

datatable(data_input, rownames = FALSE, 
          options = list(
            columnDefs = list(
              list(targets = 1, render = JS(render)),
              list(targets = "_all", className = "dt-center")
            )
          )
)

R shiny datatable link to another tab

I am not so deeply involved with DT but this JS callback function works:

function(settings, json) {
  var table = this.DataTable();
  table.on("click.dt", "tr", function() {
    Shiny.onInputChange("rows", table.row( this ).index());
    var tabs = $(".tabbable .nav.nav-tabs li a");
    $(tabs[1]).click();
  });
}

MRE:

library(shiny)
library(ggplot2)  # for the diamonds dataset
library(htmlwidgets)

ui <- fluidPage(
  title = "Examples of DataTables",
  sidebarLayout(
    sidebarPanel(
      conditionalPanel(
        'input.dataset === "diamonds"',
        checkboxGroupInput("show_vars", "Columns in diamonds to show:",
                           names(diamonds), selected = names(diamonds))
      ),
      conditionalPanel(
        'input.dataset === "mtcars"',
        helpText("Click the column header to sort a column.")
      ),
      conditionalPanel(
        'input.dataset === "iris"',
        helpText("Display 5 records by default.")
      )
    ),
    mainPanel(
      tabsetPanel(
        id = 'dataset',
        tabPanel("diamonds", DT::dataTableOutput("mytable1")),
        tabPanel("mtcars", DT::dataTableOutput("mytable2")),
        tabPanel("iris", DT::dataTableOutput("mytable3"))
      )
    )
  )
)

jss <- '
function(settings, json) {
  var table = this.DataTable();
  table.on("click.dt", "tr", function() {
    Shiny.onInputChange("rows", table.row( this ).index());
    var tabs = $(".tabbable .nav.nav-tabs li a");
    $(tabs[1]).click();
  });
}'

server <- function(input, output) {

  # choose columns to display
  diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
  output$mytable1 <- DT::renderDataTable({
    DT::datatable(diamonds2[, input$show_vars, drop = FALSE], options = list(initComplete = JS(jss)))
  })

  # sorted columns are colored now because CSS are attached to them
  output$mytable2 <- DT::renderDataTable({
    DT::datatable(mtcars, options = list(orderClasses = TRUE))
  })

  # customize the length drop-down menu; display 5 rows per page by default
  output$mytable3 <- DT::renderDataTable({
    DT::datatable(iris, options = list(initComplete = JS(jss)))})
}

shinyApp(ui, server)

Hyperlink to cell value in R shiny (with many columns)

@Stéphane Laurent will know better than me, but you could try this as your JS renderer. You can check if data is NULL if your if statement, and probably should include data in your hyperlink reference instead of "row". Try this out and and let me know if this helps.

render <- c(
  "function(data, type, row){",
  "  if(type === 'display' && data){",
  "    var a = '<a href=\"http://www.swisslipids.org/#/search/' + data + '\">' + data + '</a>';",
  "    return a;",
  "  } else {",
  "    return data;",
  "  }",
  "}"
)

Edit: If you have "Cer(d18:1_16:0)+OH" as an entry in a cell, but want to use "Cer(d18:1/16:0)" in your link, you could use the replace function and chain them for multiple replacements. In this case use /g for global modifier. You can adjust the regex for your particular needs.

render <- c(
  "function(data, type, row){",
  "  if(type === 'display' && data){",
  "    var newstr = data.replace(/_/g, '/').replace(/\\).*/g, ')');",
  "    var a = '<a href=\"http://www.swisslipids.org/#/search/' + newstr + '\">' + data + '</a>';",
  "    return a;",
  "  } else {",
  "    return data;",
  "  }",
  "}"
)

Create a table with clickable hyperlink

You can use the escape argument to datatables, see https://rstudio.github.io/DT/#escaping-table-content.

shinyApp(
    shinyUI(
        fluidPage(
            dataTableOutput('PM_output')
        )
    ),
    shinyServer(function(input, output, session) {
        require(DT)
        dat <- read.table(text="Col1     Col2                  Col3
          Google   '5 lines description'   www.google.com
          Yahoo    '5 lines description'   www.yahoo.com", header=T, strings=F)
        dat$Col3 <- sapply(dat$Col3, function(x) 
            toString(tags$a(href=paste0("http://", x), x)))

        output$PM_output <- renderDataTable(expr = datatable(dat, escape=FALSE),
          options = list(autoWidth = T))
    })
)

setting escape=3 (the column number) also seems to work, or passing escape argument to renderDataTable.

Hyperlink from one DataTable to another in Shiny

This should give you the tools to do what you want:

library(shiny)
library(DT)
ui <- fluidPage(
  tabsetPanel(
    tabPanel("One",
             DT::dataTableOutput("test1")
    ),
    tabPanel("two",
             numericInput("length","Length",0,0,10)
    )))
server <- function(input, output, session) {
  df <- reactive({
    cbind(seq_len(nrow(mtcars)),mtcars)
  })
  output$test1 <- DT::renderDataTable({
    df()
  },rownames=FALSE,options=list(dom="t"),
  callback=JS(
    'table.on("click.dt", "tr", function() {

    tabs = $(".tabbable .nav.nav-tabs li a");
    var data=table.row(this).data();

    document.getElementById("length").value=data[0];
    Shiny.onInputChange("length",data[0]);
    $(tabs[1]).click();
    table.row(this).deselect();})'
  ))

}
shinyApp(ui = ui, server = server)

When you click a row in the datatable, it switches tabs, and changes the value of the numeric input to the value of the first column in the row you selected.

edit: you will probably have to put your datatables explicitly in the shiny app and not include them from a r markdown script, since I don't believe shiny objects in R Markdown have html Ids in a reliably readable way.

edit: I took your code and got it to work:

library(shiny)
library(dplyr)
## Create item pricing data
set.seed(1234)
init_items = function() {
  item.id=1:1000
  ensemble.id=rep(1:100,each=10)
  cost=round(runif(1000,10,100), 2)
  profit=round(cost*runif(1000,0.01,0.15), 2)
  price=cost+profit

  data.frame(item.id, ensemble.id, cost, price, profit)
}
items = init_items()

## Create ensemble pricing data
init_ensembles = function(items) {
  items %>% group_by(ensemble.id) %>% summarize_each(funs(sum), cost, price, profit)
}
ensembles = init_ensembles(items)

## Attach dependencies
## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431
getdeps <- function() {
  htmltools::attachDependencies(
    htmltools::tagList(),
    c(
      htmlwidgets:::getDependency("datatables","DT")
    )
  )
}

# Define UI for application
ui <- shinyUI(fluidPage(
  tabsetPanel(#id="Linked Table Test",
    tabPanel("Page 1", DT::dataTableOutput("page1")),
    tabPanel("Page 2", inputPanel(
      numericInput("ensemble.id", label = "Ensemble ID:", 0, min(ensembles$ensemble.id), max(ensembles$ensemble.id))
    ),
    textOutput("page2"), DT::dataTableOutput("table2"),getdeps())
  )
))

# Define server logic
server <- shinyServer(function(input, output, session) {
  output$page1 <- DT::renderDataTable(ensembles, rownames = FALSE,
                                      callback=JS(
                                        'table.on("click.dt", "tr", function() {

    tabs = $(".tabbable .nav.nav-tabs li a");
    var data=table.row(this).data();
    document.getElementById("ensemble.id").value=data[0];
    Shiny.onInputChange("ensemble.id",data[0]);
    $(tabs[1]).click();
    table.row(this).deselect();
    })'                     
                                      ))

  output$table2 <- DT::renderDataTable(items %>% filter(ensemble.id==input$ensemble.id) %>% select(-ensemble.id), rownames = FALSE)

  output$page2 <- renderText({
    print(input$ensemble.id)
    paste0("Detailed pricing information for ensemble #",input$ensemble.id,":")
  })
})

# Run the application
shinyApp(ui = ui, server = server)

---

Related Topics