在 R Shiny 中，如何创建用于格式化 renderTable 输出中数字的函数？
In R Shiny, how to create a function for formatting numbers in renderTable output?
下面的 MWE 代码格式化数字渲染 table 输出。但是，您可以在 MWE 中看到，在 (i) 生成首次调用应用程序时出现的默认值 table，以及 (ii) 在单击后生成 table 时，重复了相当多的格式化代码“修改”操作按钮。
所以我创建了一个函数 formatDF1 来捕获这个重复的代码。但它不起作用！当我注释掉下面“BEGIN TEST ...”和“END TEST”之间的代码部分，并在“BEGIN TEST ...”上方取消注释 formatDF1(df) 时，formatDF1 函数被完全忽略，并且生成默认的 table 而没有所需的数字格式。
我做错了什么？
MWE 代码：
library(shiny)
library(shinyMatrix)
library(shinyjs)
# Function that I'm trying to implement...
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
}
matrix3Headers <- function(){
c('Issuance period',
'Scheduled amort period',
'3m average XS trigger',
'Percentage of capital')}
# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(
c( # Below are default values for table1
1,
24,
0,
100
), # close concatenate
4, # specify default number of matrix rows
1, # specify default number of matrix columns
dimnames=list(matrix3Headers(), NULL)
) # close matrix function
# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
# Matrix input function
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel('Inputs'),
fluidRow(actionButton('modify','Modify'),
tableOutput('table1'))
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
output$table1 <- renderTable({
if(!isTruthy(input$modify)){ # << Generates default table when first invoking the App
df <- matrix3Default
# formatDF1(df)
# BEGIN TEST >>> Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
# <<< END TEST
}
else{ # << Generates table after user clicks "Modify" action button
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
# Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table1
} # close server
shinyApp(ui, server)
在函数的末尾return改变了x-
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
x
}
并将 formatDF1 的输出分配给 df -
library(shiny)
library(shinyMatrix)
library(shinyjs)
# Function that I'm trying to implement...
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
x
}
matrix3Headers <- function(){
c('Issuance period',
'Scheduled amort period',
'3m average XS trigger',
'Percentage of capital')}
# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(
c( # Below are default values for table1
1,
24,
0,
100
), # close concatenate
4, # specify default number of matrix rows
1, # specify default number of matrix columns
dimnames=list(matrix3Headers(), NULL)
) # close matrix function
# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
# Matrix input function
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel('Inputs'),
fluidRow(actionButton('modify','Modify'),
tableOutput('table1'))
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
output$table1 <- renderTable({
if(!isTruthy(input$modify)){
df <- matrix3Default
df <- formatDF1(df)
df
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
# Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table1
} # close server
shinyApp(ui, server)
下面的 MWE 代码格式化数字渲染 table 输出。但是，您可以在 MWE 中看到，在 (i) 生成首次调用应用程序时出现的默认值 table，以及 (ii) 在单击后生成 table 时，重复了相当多的格式化代码“修改”操作按钮。
所以我创建了一个函数 formatDF1 来捕获这个重复的代码。但它不起作用！当我注释掉下面“BEGIN TEST ...”和“END TEST”之间的代码部分，并在“BEGIN TEST ...”上方取消注释 formatDF1(df) 时，formatDF1 函数被完全忽略，并且生成默认的 table 而没有所需的数字格式。
我做错了什么？
MWE 代码：
library(shiny)
library(shinyMatrix)
library(shinyjs)
# Function that I'm trying to implement...
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
}
matrix3Headers <- function(){
c('Issuance period',
'Scheduled amort period',
'3m average XS trigger',
'Percentage of capital')}
# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(
c( # Below are default values for table1
1,
24,
0,
100
), # close concatenate
4, # specify default number of matrix rows
1, # specify default number of matrix columns
dimnames=list(matrix3Headers(), NULL)
) # close matrix function
# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
# Matrix input function
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel('Inputs'),
fluidRow(actionButton('modify','Modify'),
tableOutput('table1'))
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
output$table1 <- renderTable({
if(!isTruthy(input$modify)){ # << Generates default table when first invoking the App
df <- matrix3Default
# formatDF1(df)
# BEGIN TEST >>> Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
# <<< END TEST
}
else{ # << Generates table after user clicks "Modify" action button
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
# Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table1
} # close server
shinyApp(ui, server)
在函数的末尾return改变了x-
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
x
}
并将 formatDF1 的输出分配给 df -
library(shiny)
library(shinyMatrix)
library(shinyjs)
# Function that I'm trying to implement...
formatDF1 <- function(x){
dfA <- format(x[1,],nsmall=0)
dfB <- format(x[2,],nsmall=0)
dfC <- paste(format(x[3,],nsmall=2),'%')
dfD <- paste(format(x[4,],nsmall=2),'%')
x <- rbind(x[0,],dfA,dfB,dfC,dfD)
n <- dim(x)[2]
colnames(x) <- paste("Series", 1:n)
rownames(x) <- matrix3Headers()
x
}
matrix3Headers <- function(){
c('Issuance period',
'Scheduled amort period',
'3m average XS trigger',
'Percentage of capital')}
# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(
c( # Below are default values for table1
1,
24,
0,
100
), # close concatenate
4, # specify default number of matrix rows
1, # specify default number of matrix columns
dimnames=list(matrix3Headers(), NULL)
) # close matrix function
# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
# Matrix input function
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel('Inputs'),
fluidRow(actionButton('modify','Modify'),
tableOutput('table1'))
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
output$table1 <- renderTable({
if(!isTruthy(input$modify)){
df <- matrix3Default
df <- formatDF1(df)
df
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
# Below indented code adds numeric formats to table output
dfA <- format(df[1,],nsmall=0)
dfB <- format(df[2,],nsmall=0)
dfC <- paste(format(df[3,],nsmall=2),'%')
dfD <- paste(format(df[4,],nsmall=2),'%')
df <- rbind(df[0,],dfA,dfB,dfC,dfD)
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table1
} # close server
shinyApp(ui, server)