4

I would like to play an instagram or Youtube video upon a click of a graph (e.g. showing what an outlier could be etc)

So far, telling Shiny explicitly what the video is works:

require(shiny)
require(ggplot2)

# data
df <- data.frame(ID=c(1,2),x=c(33,7),y=c(50,16),name=c("Vid1","Vid2"),link=c("https://www.youtube.com/embed/Gyrfsrd4zK0","https://anotherlink.com"), stringsAsFactors=FALSE)

# video is explicitly embedded with the youtube link (i.e. not dynamic)
ui <- basicPage(
  plotOutput("plot", click = "plot_click"),
  verbatimTextOutput("selection"),
  conditionalPanel("plot_click!=null",
                   h4(textOutput("nametext")),
                   HTML('<iframe width="200" height="100" src="https://www.youtube.com/embed/Gyrfsrd4zK0" frameborder="0" allowfullscreen></iframe>'))
)

server <- function(input, output,session) {

  output$plot <- renderPlot({
    ggplot(data=df,aes(x=x,y=y))+
      geom_point()+
      scale_x_continuous(limits = c(0, 68))+
      scale_y_continuous(limits = c(0, 52.5))
  })

  output$selection <- renderPrint({
    nearPoints(df, input$plot_click)
  })

  info <- reactive({

    t <- as.data.frame(nearPoints(df, input$plot_click))
    s <- t[1,4]
    u <- t[1,5]
    list(s=s,u=u)

  })

  output$nametext <- renderText({if(!is.na(info()$s)){info()$s}})
  output$urltext <- renderText({if(!is.na(info()$u)){info()$u}})
}

runApp(shinyApp(ui, server), launch.browser = TRUE)

I would like the video only to appear on click (and be different for different points) however I don't know how to change the conditionalPanel to suit this. I tried with renderImage inside server, and also this GoogleGroups answer but got no joy.

Sam
  • 1,400
  • 13
  • 29
  • Possible duplicate of [embed iframe inside shiny app](http://stackoverflow.com/questions/33020558/embed-iframe-inside-shiny-app) – Pork Chop May 02 '17 at 15:05

2 Answers2

8

On server side you can use:

 library(memisc) 
 output$video <- renderUI({
    click <- input$plot_click
    if(!is.null(click)){
      link = cases(
        "Gyrfsrd4zK0" = click$x > 40,
        "b518URWajNQ" = click$x > 20,
        "I5Z9WtTBZ_w "= click$x > 0
      )
      HTML(paste0('<iframe width="200" height="100" src="https://www.youtube.com/embed/', link ,'" frameborder="0" allowfullscreen></iframe>'))
    }
  })

and on ui side:

uiOutput("video")
Tonio Liebrand
  • 17,189
  • 4
  • 39
  • 59
  • thank you, this works nicely for a given youtube video, but I cant get it to work for Instagram, i'll keep fiddling – Sam May 02 '17 at 15:30
  • ur welcome. Sure just post a new question and i can take a look,..should be doable in a similar way i guess. – Tonio Liebrand May 02 '17 at 15:33
  • ok will do, ta, basically Instagram embed code is a HTML blockquote which only seems to work when pasted directly inside HTML() with no other arguments (however it wont show in the code above) – Sam May 02 '17 at 15:36
  • well it is not restricted on doing it with iframe, so i think its fine. Provide a small example for instagram is also fine for me, i make an edit then. – Tonio Liebrand May 02 '17 at 15:43
2

this is an alternative for Instagram, inside an iframe:

pardon the clip!

# make some data

df <- data.frame(ID=c(1,2),x=c(33,7),y=c(50,16),name=c("Vid1","Vid2"),link=c("https://www.instagram.com/p/BTke9pwjEvu","AnotherWeblink"), stringsAsFactors=FALSE)

# remove original instagram link
df$link <- gsub("https://www.instagram.com/p/","",df$link)

ui <- basicPage(
  plotOutput("plot", click = "plot_click"),
  verbatimTextOutput("selection"),
  conditionalPanel("plot_click!=null",
                   h4(textOutput("nametext")),
                   uiOutput("frame"))
)

server <- function(input, output,session) {

  output$plot <- renderPlot({
    ggplot(data=df,aes(x=x,y=y))+
      geom_point()+
      scale_x_continuous(limits = c(0, 68))+
      scale_y_continuous(limits = c(0, 52.5))
  })

  output$selection <- renderPrint({
    nearPoints(df, input$plot_click)
  })

  info <- reactive({

    t <- as.data.frame(nearPoints(df, input$plot_click))
    s <- t[1,4]
    u <- t[1,5]
    list(s=s,u=u)

  })

  output$nametext <- renderText({if(!is.na(info()$s)){info()$s}})

  output$frame <- renderUI({
    click <- input$plot_click
    if(!is.null(click)){
      link = info()$u
      HTML(paste0('<iframe width="400" height="270" src="http://instagram.com/p/', link,"/embed",'" frameborder="0" allowfullscreen></iframe>'))
      }
  })

}

runApp(shinyApp(ui, server), launch.browser = TRUE)

seems to work ok, i think

Sam
  • 1,400
  • 13
  • 29