Разделить элементы символов в таблицах данных R - PullRequest
Новая
       25

Разделить элементы символов в таблицах данных R

1 голос
/ 01 июля 2019

У меня блестящее приложение, которое возвращает данные в зависимости от ввода пользователя.

Я бы хотел отформатировать датируемые элементы, вставив разрывы строк в отдельные строки символов.

Например, если я введу «fact» в column1, «data» в column2, «are» в row1 и «more» в row2, выходные данные в datatable должны быть такими, как показано ниже:

enter image description here

Пример моего блестящего приложения приведен ниже: 

  library(shiny)
  library(shinydashboard)
  library(statquotes)
  library(sqldf)
  library(DT)

    data(quotes)
    quotes

ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(
      sidebarMenu(  )),    

  dashboardBody(
     tabItem(tabName = "Tabs",
          fluidRow(
           column(width=3, 
                 box(
                   title="Search ",
                   solidHeader=TRUE,
                   collapsible=TRUE,
                   width=NULL,
                   textInput("column1", " Col 1 ",  '', placeholder = "Type keyword/statement"),
                   textInput("column2", " Col 2  ",  '', placeholder = "Type keyword/statement"),
                   textInput("row1", " Row 1  ",  '', placeholder = "Type keyword/statement"),
                   textInput("row2", " Row 2 ",  '', placeholder = "Type keyword/statement"),
                   submitButton("Search")
                 )
          ),

          column( width=9,
                  tabBox(
                    width="100%",
                    tabPanel("tab1", 
                             DT::dataTableOutput("matrix")
                    ))))) 
           ))


 server <- function(input, output) {
        output$matrix <- DT::renderDataTable({
          if (input$column1  != "") { 

          col1row1 <- reactive({ sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column1,"%'
                               AND text LIKE '%",input$row1,"%'
                               )"))
                               })
          col1row2 <- reactive({ sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column1,"%'
                               AND text LIKE '%",input$row2,"%'
                               )"))
                               })
          col2row1 <- reactive({ sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column2,"%'
                               AND text LIKE '%",input$row1,"%'
                               )"))
                               })
          col2row2 <- reactive({ sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column2,"%'
                               AND text LIKE '%",input$row2,"%'
                               )"))
                               })



    tabledata <- reactive({ matrix(c(col1row1 (), col1row2 (), col2row1 (), 
                         col2row2 ()), ncol = 2) })      
    tabledata <- tabledata ()
     colnames(tabledata) <- c(input$column1, input$column2)
     row.names(tabledata) <- c (input$row1, input$row2)
   tabledata
  }  
  }, 
  rownames = TRUE , 
  filter = "top", server = FALSE,
  extensions = c("Buttons"),
  options = list(
  scrollY = 400,
  scrollX = TRUE,
  scroller = TRUE,
  dom = 'Bfrtip',
  buttons = c('copy', 'excel', 'pdf', 'print')
   ))
   }
shinyApp(ui, server)

Если вы запустите приложение, вы увидите, что элементы символов в таблице разделены запятыми, как отформатировать их так, чтобы они имели разрыв строки и дефис в начале

1 Ответ

2 голосов
/ 01 июля 2019

Вы можете преобразовать ваши столбцы в строку, а затем перебрать каждую строку и добавить htmltags. mutate также сделает эту работу. В конце вы должны передать escape = FALSE, чтобы заставить работать теги HTML. 

library(shiny)
library(shinydashboard)
library(statquotes)
library(sqldf)
library(DT)

data(quotes)
quotes


ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
        sidebarMenu(  )),    

    dashboardBody(
        tabItem(tabName = "Tabs",
                fluidRow(
                    column(width=3, 
                           box(
                               title="Search ",
                               solidHeader=TRUE,
                               collapsible=TRUE,
                               width=NULL,
                               textInput("column1", " Col 1 ",  '', placeholder = "Type keyword/statement"),
                               textInput("column2", " Col 2  ",  '', placeholder = "Type keyword/statement"),
                               textInput("row1", " Row 1  ",  '', placeholder = "Type keyword/statement"),
                               textInput("row2", " Row 2 ",  '', placeholder = "Type keyword/statement"),
                               submitButton("Search")
                           )
                    ),

                    column( width=9,
                            tabBox(
                                width="100%",
                                tabPanel("tab1", 
                                         DT::dataTableOutput("matrix")
                                ))))) 
    ))


server <- function(input, output) {
    output$matrix <- DT::renderDataTable({
        if (input$column1  != "") { 

            col1row1 <- reactive({ 
                               resultstring <- ""
                               df1 <- sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column1,"%'
                               AND text LIKE '%",input$row1,"%'
                               )"))

                               for(i in 1:nrow(df1)) {
                                       resultstring <- paste0(resultstring, "<br>-", df1$topic[i])
                               }
                               return(resultstring)
            })
            col1row2 <- reactive({ 

                               resultstring <- ""         
                               df1 <-sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column1,"%'
                               AND text LIKE '%",input$row2,"%'
                               )"))
                                for(i in 1:nrow(df1)) {
                                    resultstring <- paste0(resultstring, "<br>-", df1$topic[i])
                                }
                                return(resultstring)

            })
            col2row1 <- reactive({ 
                               resultstring <- ""  
                               df1 <- sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column2,"%'
                               AND text LIKE '%",input$row1,"%'
                               )"))
                               for(i in 1:nrow(df1)) {
                                   resultstring <- paste0(resultstring, "<br>-", df1$topic[i])
                               }
                               return(resultstring)

            })
            col2row2 <- reactive({ 
                               resultstring <- ""  
                               df1 <- sqldf(paste0("SELECT  topic
                               FROM quotes
                               WHERE  (text LIKE '%",input$column2,"%'
                               AND text LIKE '%",input$row2,"%'
                               )"))
                               for(i in 1:nrow(df1)) {
                                   resultstring <- paste0(resultstring, "<br>-", df1$topic[i])
                               }
                               return(resultstring)
            })



            tabledata <- reactive({ matrix(c(col1row1 (), col1row2 (), col2row1 (), 
                                             col2row2 ()), ncol = 2) })      
            tabledata <- tabledata ()
            colnames(tabledata) <- c(input$column1, input$column2)
            row.names(tabledata) <- c (input$row1, input$row2)
            tabledata
        }  
    }, 
    rownames = TRUE , 
    filter = "top", server = FALSE,
    extensions = c("Buttons"),
    options = list(
        scrollY = 400,
        scrollX = TRUE,
        scroller = TRUE,
        dom = 'Bfrtip',
        buttons = c('copy', 'excel', 'pdf', 'print')
    ),
    escape = FALSE)
}
shinyApp(ui, server)

enter image description here

...