2017-11-16 34 views
1

Shinyの出力ウィジェットで文字列を検索するための一般的な検索ボックスを追加することは可能ですか?以下の例では、私はtextInputウィジェット内の文字列を入力するためにユーザを希望し、シャイニーはverbatimTextOutput(または類似した何か)で一致するテキストをハイライト表示していますRの検索ボックスShiny

library(shiny) 

text <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce nec quam ut tortor interdum pulvinar id vitae magna. Curabitur commodo consequat arcu et lacinia. Proin at diam vitae lectus dignissim auctor nec dictum lectus. Fusce venenatis eros congue velit feugiat, ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus. Suspendisse tincidunt, nisi non finibus consequat, ex nisl condimentum orci, et dignissim neque est vitae nulla." 

ui <- fluidPage(
    sidebarPanel(
     textInput("search", "", placeholder = "Search term") 
    ), 
     verbatimTextOutput("text") 
) 
) 


server <- function(input, output) { 

    output$text <- renderText(paste(text)) 
} 

shinyApp(ui = ui, server = server) 

これまでのところ、私はこの問題を回避取り組んできましたテキストを固定長の行に分割し、grepを使用して、テキスト内の文字列の位置を表示します。 (たとえば、文字列loremが最初の行にあることをユーザーに警告する)。

もっと直感的にできますか?

編集

Aurèleの答え@上のスポットです。 DT::dataTableOutputは、ハイライトなしでdata.tables内の文字列を検索するための検索ボックス機能も提供します。 (?それがより直感的であることの要件を満たしてない)

答えて

1

は、ここに私の素朴な試みです:

library(shiny) 
library(stringr) 
library(purrr) 

text <- paste(
    "Lorem ipsum dolor sit amet,", 
    "consectetur adipiscing elit. Fusce nec quam ut tortor", 
    "interdum pulvinar id vitae magna.", 
    "Curabitur commodo consequat arcu et lacinia.", 
    "Proin at diam vitae lectus dignissim auctor nec dictum lectus.", 
    "Fusce venenatis eros congue velit feugiat,", 
    "ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus.", 
    "Suspendisse tincidunt, nisi non finibus consequat, ex nisl", 
    "condimentum orci, et dignissim neque est vitae nulla." 
) 
insert_mark_tag <- function(s, loc_index, all_locs) { 
    str_sub(s, all_locs[loc_index, 2] + 1, all_locs[loc_index, 2]) <- "</mark>" 
    str_sub(s, all_locs[loc_index, 1], all_locs[loc_index, 1] - 1) <- "<mark>" 
    s 
} 
ui <- fluidPage(
    sidebarPanel(
    textInput("search", "", placeholder = "Search term") 
), 
    htmlOutput("text") 
) 
server <- function(input, output) { 
    output$text <- renderText({ 
    m <- if (nchar(input$search)) 
     str_locate_all(text, fixed(input$search))[[1]] else 
     matrix(ncol = 2)[FALSE, ] 
    HTML(reduce_right(seq_len(nrow(m)), insert_mark_tag, all_locs = m, .init = text)) 
    }) 
} 
shinyApp(ui = ui, server = server) 

キーがstr_locate_all()str_sub<-です。

(パフォーマンスへの影響が測定可能になる場合は、fixed()の代わりにcoll()を使用し、多分stringistringrを交換したいかもしれませんが、私は考えています)。

私はところで、私はこの素朴なreduce()よりきれいな方法があるかどうかのコメントで尋ね、@bartektartanus'(stringiの共著)答えhereを使用。

編集

私はそれがとても複雑になぜ実は、私は考えています。これは(はるかに)簡単です(正規表現とは少し違った動作をしますが)。

ui <- fluidPage(
    sidebarPanel(
    textInput("search", "", placeholder = "Search term") 
), 
    htmlOutput("text") 
) 
server <- function(input, output) { 
    output$text <- renderText(HTML(
    if (nchar(input$search)) 
     str_replace_all(text, sprintf("(%s)", input$search), "<mark>\\1</mark>") else 
     text 
)) 
} 
shinyApp(ui = ui, server = server) 
+0

これは洗練されたソリューションです。私はそれがどのように反応するのでしょうか? – amrrs

+0

私は尋ねたことを正確に行います。しかし、私はちょうど 'DT :: dataTableOutput'が自動的に検索ボックス機能を提供することに気付きました。 –

+0

@amrrs:あなたが何を求めているかわからない'renderText()'は 'input $ search'(それは無効な値です)を見て、それが変わったら再実行します。下のレベルでは、わかりませんが、それはすべて私にとってシャイニーな魔法です... –

関連する問題