将 instagram/youtube 嵌入 Shiny R 应用
Embed instagram/youtube into Shiny R app
我想在点击图表后播放 instagram 或 Youtube 视频(例如显示异常值等)
到目前为止,明确告诉 Shiny 视频是什么是有效的:
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)
我希望视频只在点击时出现(并且在不同点上有所不同)但是我不知道如何更改条件面板以适应这种情况。我尝试在服务器内部使用 renderImage,还有这个 GoogleGroups answer 但没有任何乐趣。
在服务器端你可以使用:
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>'))
}
})
ui 一侧:
uiOutput("video")
这是 Instagram 的替代品,在 iframe 中:
请原谅剪辑!
# 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)
好像还行,我觉得
我想在点击图表后播放 instagram 或 Youtube 视频(例如显示异常值等)
到目前为止,明确告诉 Shiny 视频是什么是有效的:
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)
我希望视频只在点击时出现(并且在不同点上有所不同)但是我不知道如何更改条件面板以适应这种情况。我尝试在服务器内部使用 renderImage,还有这个 GoogleGroups answer 但没有任何乐趣。
在服务器端你可以使用:
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>'))
}
})
ui 一侧:
uiOutput("video")
这是 Instagram 的替代品,在 iframe 中:
请原谅剪辑!
# 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)
好像还行,我觉得