r - “如何有条件地格式化数据表中的字母?
问题描述
我是 R 的新手,我目前正在尝试制作一张表格,向我展示 2 天之间的变化,并且一旦计算出这种变化,如果它是负面的,那么大海就会变成红色字母,如果不是那么绿色
标题:“地区商业消费”输出:flexdashboard::flex_dashboard:orientation: columns
垂直布局:填充
################## librerias #####################
library(flexdashboard)
library(tidyverse)
library(readxl)
library(shiny)
library(formattable)
library(DT)
library(htmlTable)
library(sqldf)
library(ggplot2)
library(data.table)
library(dplyr)
library(tidyr)
library(shinydashboard)
################## Datos #######################
base1 <- read_excel("C:/Karlo disco duro/AVANCE.xlsx",sheet = "Base1")
base2 <- read_excel("C:/Karlo disco duro/AVANCE.xlsx",sheet = "Base2")
finmes <- read_excel("C:/Karlo disco duro/AVANCE.xlsx",sheet = "Finmes")
{宽度=20%} {宽度=6%}
Avance de colocaciones 日记
Green0 = "#DeF7E9"
Green = "#71CA97"
Red = "#ff7f7f"
data1<-subset(base1,select = c("TipoCredito","SaldoCapital"))
data2<-subset(base2,select = c("TipoCredito","SaldoCapital"))
finmes1<-subset(finmes,select = c("TipoCredito","SaldoCapital"))
final1<-data.frame(sqldf(
"select TipoCredito, sum(SaldoCapital) as SALDO from data1 group by TipoCredito"
))
final2<-data.frame(sqldf(
"select TipoCredito, sum(SaldoCapital) as SALDO from data2 group by TipoCredito"
))
finmes2<-data.frame(sqldf(
"select TipoCredito, sum(SaldoCapital) as SALDO from finmes1 group by TipoCredito"
))
tablaa<-data.frame(final1)
tablab<-data.frame(final2)
tablafinmes<-data.frame(finmes2)
final3<-data.frame(sqldf(
"select A.TipoCredito, A.SALDO as '23Agosto', B.SALDO as '24Agosto', (B.SALDO - A.SALDO) as VARIACION
from tablaa A
join tablab B on A.TipoCredito = B.TipoCredito
group by A.TipoCredito"
))
finalfinmes <- data.frame(sqldf(
"select F.TipoCredito, F.SALDO as '31Julio', B.SALDO as '24Agosto', (B.SALDO - F.SALDO) as VARIACION
from tablafinmes F
join tablab B on F.TipoCredito = B.TipoCredito
group by F.TipoCredito"
))
my.options <- list (autoWidth = FALSE,
searching = FALSE,
ordering = FALSE,
lengthChange = FALSE,
lengthMenu = FALSE,
pageLength = FALSE,
paging = FALSE,
info = FALSE)
##final<-formattable(final3,list(VARIACION = color_tile("red", "green")))
##final3.1<-formattable(final3, list(`VARIACION`=formatter("span", style = x ~ style(color = ifelse(x < 0, "red", "green")))))
##finalfinmes1<-formattable(finalfinmes, list(`VARIACION`=formatter("span", style = x ~ style(color = ifelse(x < 0, "red", "green")))))
Tablafinal<-datatable(final3,options = list(autoWidth = TRUE, columnDefs =
list(list(width = '190px', targets = c(1,2,3,4))),pageLength = 7,searching = TRUE,
ordering = TRUE,
lengthChange = TRUE,
lengthMenu = FALSE,
pageLength = FALSE,
paging = FALSE,
info = FALSE), colnames = c('Tipo de credito','23 de Agosto','24 de Agosto', 'Variacion Diaria'))
Tablafinalfinmes<-datatable(finalfinmes,options = list(autoWidth = TRUE, columnDefs =
list(list(width = '190px', targets = c(1,2,3,4))),pageLength = 7,searching = TRUE,
ordering = TRUE,
lengthChange = TRUE,
lengthMenu = FALSE,
pageLength = FALSE,
paging = FALSE,
info = FALSE),colnames = c('Tipo de credito','31 de Julio','24 de Agosto', 'Variacion fin de mes'))
##%>% formatStyle('VARIACION',color = ifelse('VARIACION'>0,'Green','Red')))
##Tablafinal$VARIACION <- ifelse(Tablafinal$VARIACION < 0, 1, ifelse(Tablafinal$VARIACION > 0, 2,3))
Tablafinal1<- formatStyle(Tablafinal,
columns = c(4),
fontFamily = "Arial",
fontSize = "16px",
color = ifelse('VARIACION'< -0,'#ed1c16','#0ca649'))
## backgroundColor = styleEqual(c(1, 2,3), c('green', 'yellow','red')))
##color = styleEqual(c(-1,0,1),c('green','blue','Yellow')))
Tablafinalfinmes1<- formatStyle(Tablafinalfinmes,
columns = c(4),
fontFamily = "Arial",
fontSize = "16px",
color = ifelse('VARIACION'< -0,'#ed1c16','#0ca649'))
Tablafinal1$VARIACION <- ifelse(Tablafinal1$VARIACION < 0, 1,
ifelse(Tablafinal1$VARIACION > 0, 2))
ab <- Tablafinal1 %>% formatCurrency (c('X23Agosto','X24Agosto','VARIACION'), 's/ ') %>% formatStyle('TipoCredito',target = 'row',backgroundColor = styleEqual(c('CONSUMO NO REVOLVENTE','CONSUMO REVOLVENTE','HIPOTECARIO'),c('#f8fb63','#f8fb63','#f8fb63'))) %>% formatStyle('VARIACION',fontWeight = 'bold',fontSize = "13px")
##ab1 <- ab %>% formatStyle(columns = c('VARIACION'),valueColumns = c('VARIACION'),target='row',Color = styleEqual(c(-1,1),
## c('red','green')))
tf <- Tablafinalfinmes1 %>% formatCurrency (c('X31Julio','X24Agosto','VARIACION'),'s/ ')%>% formatStyle('TipoCredito',target = 'row',backgroundColor = styleEqual(c('CONSUMO NO REVOLVENTE','CONSUMO REVOLVENTE','HIPOTECARIO'),c('#f8fb63','#f8fb63','#f8fb63'))) %>% formatStyle('VARIACION',fontWeight = 'bold',fontSize = "13px")
##ui<- fluidPage (navlistPanel(tabPanel("Variacion Diaria",ab),
## tabPanel("Variacion Mensual")))
##ui<-formattable(ab, list(VARIACION = color_tile("red", "green")))
ui<- fluidPage (tabsetPanel(tabPanel("Variacion Diaria",ab),
tabPanel("Variacion Mensual",tf)))
INICIO
行{.tabset} {width=80}
ui
解决方案
目前,color = ifelse('VARIACION'< -0,'#ed1c16','#0ca649')
正在评估字符串 VARIACION 是否小于 0。虽然这不是一个特别有意义的问题,但 R 确实将其评估为 FALSE(在所有情况下),因此结果以绿色打印。
更一般地说,您不想ifelse()
在这种情况下使用。改用类似的东西formatStyle('VARIACION', color = styleInterval(0, c("red", "green"))
。
这里的关键是styleInterval()
定义间隔的切割点和颜色。当您放置一个切割点(例如在 0 处)和两种颜色时,它使用切割点之前的第一种颜色和之后的第二种颜色。不过,您可以有多个间隔(切点> 1)。你只需要比切割点多一种颜色(例如,试试color = styleInterval(c(0,300000), c("red", "green","blue")))
下面我的例子)。
下面是一个从https://rstudio.github.io/DT/functions.html修改的工作示例:
library(DT)
m = cbind(matrix(rnorm(60, 1e5, 1e6), 20), runif(20), rnorm(20, 100))
m[, 1:3] = round(m[, 1:3])
m[, 4:5] = round(m[, 4:5], 7)
colnames(m) = head(LETTERS, ncol(m))
head(m)
datatable(m) %>%
formatCurrency(c('A', 'C')) %>%
formatStyle('A', color = styleInterval(0, c("red", "green")))
进一步注意,使用更合适的实现ifelse()
仍然失败,因为它返回一个向量并且颜色选项不需要向量(因此它不会抛出错误但也不会绘图)。再说一次,不要ifelse()
在这里使用。
#this fails
datatable(m) %>%
formatCurrency(c('A', 'C')) %>%
formatStyle('A', color = ifelse(m[,"A"] < 0, "red", "green"))
推荐阅读
- python - 使用 Python 的 requests.post 函数对动态 HTML 进行网页抓取时,如何指定“页码”?
- java - 从非 EDT 触发 Java 重绘很慢
- c# - 如何在 Mac 上通过 Visual Studio 使用 csharp 处理 IOS 中的后台任务
- elasticsearch - Elasticsearch:自定义令牌过滤器
- vert.x - Vert.X 4 Web OpenAPI 路由器blockingHandler
- ios - 以可保存的短信形式发送 ICS 文件
- signalr - SignalR 发出从客户端调用服务器方法的问题
- javascript - 刷新页面时清除上下文值(来自状态)
- javascript - 使用数组更改更新/刷新 kendo ui 自动完成
- kubernetes - 如何在卷挂载中使用 pod 名称?