Question

我正在尝试使用带有搜索框的导航列表，我的代码如下所示。

在UI中，我想点击每个项目，然后页面将被导航列表选择项目替换如果选择公司然后公司页面将显示在iframe中，如果我选择指示，将显示指示页面。但是对于查询框中的搜索词，只输出要显示的$ frame html iframe。我可能会错过一些可以实现这一目标的事。任何帮助都会受到赞赏吗？

ui.r

library(shiny)
types = c("Company","Medical Devices","Gene/Protein","Indication","MicroRNA","Drug","Adverse Event","DRUGTYP","Technology","Protein Type")
state.name = c("BRCA1","FITM2","ERS1","BST2","BTK","data","democrat","Republic","love")
shinyUI(navbarPage(
"docsearch",fluidPage(
                      fluidRow(
                          column(8, align="center", offset = 2,
                                 selectizeInput(
                                     'foo', label = "Search For ..",multiple =FALSE, width= '500px', choices = state.name,
                                     options = list(create = TRUE)
                                 )
                          )
                      ),fluidRow(
                          column(6, align="center", offset = 3,
                                 actionButton("searchterm", "Rocket Search"),
                                 tags$style(type='text/css', "#button { vertical-align: middle; height: 40px; width: 60%; font-size: 30px;}")
                          ),br()
                      ), uiOutput('mainframe'),
                          navlistPanel(

                              widths = c(3, 9),id="termlist",
                              tabPanel('Company',value='company',
                                       uiOutput('out')
                              ),
                              tabPanel('Indication',value='indication',
                                       uiOutput('out')
                          ))


)))

我的server.R在下面给出

shinyServer(function(input, output) {


################
# search box 
################


observe({ 
  query <- input$foo
  print(query)
  test <<- paste0("http://news.scibite.com/scibites/news.html?  q=GENE$",query)
})
 output$frame <- renderUI({
  input$searchterm
  my_test <- tags$iframe(src=test,frameBorder=0,marginheight=0,height=600, width=1000)
  print(my_test)
  my_test
})

 observe({ 
   if(!is.null(input$termlist)){
  id <- input$termlist
  print (id)
if(id=="company"){
    st <- sprintf("%s&ampspecial=&ampfel=COMPANY&ampsl=",as.character(input$foo))
    test_co <<- paste0("https://news.scibite.com/scibites/facet.html?q=GENE%24",st,sep="")
} else if(id=="indication"){
    st <- sprintf("%s&ampspecial=&ampfel=COMPANY&ampsl=",as.character(input$foo))
    test_co <<- paste0("https://news.scibite.com/scibites/facet.html?q=GENE%24",st,sep="")
   }
  }

 })

output$topic <- renderUI({
#input$Choice
input$termlist
print (input$termlist)
co_test <- tags$iframe(src=test_co,frameBorder=0,marginheight=0,height=600, width=1000)
print(co_test)
co_test
  })

 output$mainframe <- renderUI({

 x <- htmlOutput("frame")
 x

 })
 output$out <- renderUI({

    x <- htmlOutput("topic")
    x
  })
  })

Answer 1

我认为问题是显示跨源内容，您可以尝试检查http标头内容以查看X-frame-options设置为什么。如果将其设置为DENY或SAMEORIGIN，则必须具有相同的来源才能在iframe中显示网站内容。否则，将阻止内容呈现。

如果页面具有相同的来源，您可以尝试更改Web服务器的标题选项。

This链接有一些很好的信息。

Answer 2

嗨，我做了它，但有很多代码和复制粘贴。

这是ui.R

library(shiny)
types = c("Company","Medical        Devices","Gene/Protein","Indication","MicroRNA","Drug","Adverse Event","DRUGTYP","Technology","Protein Type")
state.name =    c("BRCA1","FITM2","ERS1","BST2","BTK","data","democrat","Republic","love")
shinyUI(navbarPage(
"docsearch",fluidPage(
    fluidRow(
        column(8, align="center", offset = 2,
               selectizeInput(
                   'foo', label = "Search For ..",multiple =FALSE, width= '500px', choices = state.name,
                   options = list(create = TRUE)
               )
        )
    ),fluidRow(
        column(6, align="center", offset = 3,
               actionButton("searchterm", "Rocket Search"),
               tags$style(type='text/css', "#button { vertical-align: middle; height: 40px; width: 60%; font-size: 30px;}")
        ),br()
    ),
    navlistPanel(id="terms",well =FALSE,widths = c(2, 6),
                 tabPanel("Main",value="main",
                          htmlOutput("main")
                 ),

                 tabPanel("Drug",value="drug",
                                  htmlOutput("drug")),
                 tabPanel("DrugType/MOA",value="dtmoa",
                                  htmlOutput("dtmoa")))


    )))

这是server.R

shinyServer(function(input, output) {
            observe({ 
    filterquery <- input$terms
    query <- input$foo
    print(query)
    print(filterquery)
    #if (length(query) == 1){

        if(filterquery == "main"){  
            test_main <<- paste0("http://news.scibite.com/scibites/news.html?q=GENE$",query)
        } else if (filterquery == "company"){
            st <- sprintf("%s&special=&fel=COMPANY&sl=",as.character(input$foo))
            test_com <<- paste0("https://news.scibite.com/scibites/facet.html?q=GENE%24",st,sep="")
        } else if (filterquery == "drug"){
            st <- sprintf("%s&special=&fel=DRUG&sl=",as.character(input$foo))
            test_drug <<- paste0("https://news.scibite.com/scibites/facet.html?q=GENE%24",st,sep="")
        }
     })

  output$main <- renderUI({
    input$searchterm
    m_terms <-       tags$iframe(src=test_main,frameBorder=0,marginheight=0,height=600, width=800)
    print(m_terms)
    m_terms
})
  output$drug <- renderUI({
  input$terms
  d_terms <-    tags$iframe(src=test_drug,frameBorder=0,marginheight=0,height=600, width=800)
   print(d_terms)
    d_terms
  })

  output$dtmoa <- renderUI({
  input$terms
  dtm_terms <- tags$iframe(src=test_dtmoa,frameBorder=0,marginheight=0,height=600, width=800)
  print(dtm_terms)
  dtm_terms
  })


})

无法使用R闪亮的navlist和iframe

2 个答案: