小编ism*_*gal的帖子

我创建了一个R Shiny应用程序，该程序每天使用批处理文件自动运行。启动应用程序时，一切正常，但第二天崩溃，我收到以下消息：

Warning in file(open = "w+") :
  cannot open file
'C:\Users\bertin\AppData\Local\Temp\RtmpKiBPOU\Rf3f835d1a66' : No such file or directory
Warning: Error in file: cannot open the connection
  [No stack trace available]

实际上，此问题与tempdir()由执行闪亮应用程序的R会话创建的文件夹有关。一定时间后，此文件夹将自动删除。每次刷新时都必须删除所有Temp文件吗？还是相反，是否需要防止R删除Temp文件夹上的所有闪亮的临时文件？谢谢！

编辑 -这是有意产生错误的方法：

tempdir()
dir.exists(tempdir())

library(shiny)

# Windows shell required
shinyApp(
    ui = fluidPage("Please reload to see me fail."),
    server = function(input, output) {
        shell(paste("rmdir", dQuote(
            normalizePath(tempdir(), winslash = "/", mustWork = FALSE), q = FALSE
        ), "/s /q"))
    }
)

I would love to know if building something like this is possible is RShiny. I have experience with interactive plots/charts using plotly, ggplot and ggplotly but I can't see how to do something like this. I love how the graph engages the user to make a guess and then shows the real data.

If anyone could please point me in the direction of any documentation I will be forever grateful! https://www.mathematica-mpr.com/dataviz/race-to-the-top

我想更改plotly条形图中悬停框的位置。我希望它在栏上方弹出，而不是在左侧或右侧弹出。这可能吗？我一直在谷歌上搜索这个并盯着 Plotly R 参考页面几个小时，但没有运气。

这是一个示例：

library(dplyr)
library(plotly)
data.frame(x = 1:10, y = 1:10*10) %>% 
  plotly::plot_ly(data = .) %>%
  plotly::add_trace(x = ~x, 
                    y = ~y, 
                    type = 'bar', 
                    hoverinfo = "text", 
                    text = ~y)

我有一个我想要动画的仪表图（按照本教程），图的颜色根据当前值而变化。我还想要一个注释*，它显示仪表的当前值（我不希望在扇区中显示标准值）。

为了记录，我正在尝试使用plotly而不是c3::c3_gauge因为我希望最终将它plotly::subplot()与其他同时动画的情节一起嵌入。

我目前有以下几点：

library(plotly)
library(RColorBrewer)

riskToHex <- function(x) {
  x <- colorRamp(rev(brewer.pal(11, "RdYlBu")))(x / 100)
  rgb <- paste(x[,1], x[,2], x[,3], sep = ",")
  paste0("rgb(", rgb, ")")
}

dd <- data.frame(values = c(90, 60, 20))

dd <- dd %>%
  mutate(colors = riskToHex(dd$values),
         frame = seq.int(nrow(dd)))
dd <- merge(dd, data.frame(values = 200 - dd$values,
                           colors = "white",
                           frame = dd$frame),
            all = TRUE) %>%
  arrange(frame)

plot_ly() %>%
  add_pie(values = dd$values,
          frame = dd$frame,
          rotation …

我正在尝试用线条连接堆积的酒吧。

期望值：

但是，我无法在条之间画线。尝试使用以下脚本，但未添加行。

使用add_trace而不是'add_lines'无效。

df = data.frame(Aria = 20:25, Acqua = 21:26, Fuoco = 22:27, 
                Terra = 23:28, Cielo = 24:29, 
                Labels = c( 'Antonio', 'Maria', 'Giovanni',
                            'Sergio', 'Giorgio', 'Michele' ) )

evo_bar_plot_variant = function(plot_data, var_x, x_name = 'X axis', 
                                y_name = 'Y axis', ... ){
  df = data.frame(plot_data) 
  df = na.omit(df)
  var = quos(...) 
  names_vars = names( var )
  y_vars = names_vars[ startsWith( names_vars, 'var_y' ) ]
  y_var_names = sapply(1:length(y_vars), function(j){ 
                          quo_name(var[[y_vars[j]]] )})
  row_sum = df %>% …

我正在使用shinydashboardPlus并希望更改右侧边栏的宽度，我知道可以通过width在函数调用中指定参数来完成rightSidebar，但是当我这样做时（按照从这里获取的下面的示例），冗余空间出现在右侧菜单（请参阅下面屏幕截图中右侧菜单旁边的深灰色列/空间）。

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)

data(iris)
mychoices <- c("pick me A", 
               "pick me - a very long name here", 
               "no pick me - B", 
               "another one that is long")

## my css
CSS <- function(colors){
  template <- "
.checkboxGroupButtons div.btn-group:nth-child(%s) button {
  background: %s !important;
  color: black !important;
  padding: 5px;
  margin-bottom: 8px
}"
  paste0(
    apply(cbind(seq_along(colors), colors), 1, function(vc){
      sprintf(template, vc[1], vc[2])
    }),
    collapse = "\n"
  )
}
cols <- c("red", "blue", "yellow", …

这个问题之前已经被问过，但由于没有reprex而没有得到答案，所以让我试一下。

假设我有两个跨越不同日期范围的数据集。我想使用滑块控制每个的可视化。以下 reprex 将直接在下面创建视觉效果。

---
title: "Untitled"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

#+ message = FALSE, warning = FALSE
library(plotly)
library(crosstalk)
library(dplyr)
#+
```

```{r}
df1 <- data.frame(d = seq.Date(from = as.Date("2020-01-01"), by = "months", length.out = 100), v = runif(100))
df2 <- data.frame(d = seq.Date(from = as.Date("2020-6-01"), by = "months", length.out = 20), other_v = runif(20))

both_df <- full_join(df1, df2, by = 'd')

both_df_sh <- both_df %>% SharedData$new(group = "boom")

selector <- filter_slider(id …

我正在使用附加的代码根据组生成子表。由于某种原因，每个表仅呈现数据的最后一部分。如果有人能告诉我出了什么问题，那就太好了。

BR

library(shiny)
library(shinydashboard)
library(DT)
library(data.table)

tabnames <- LETTERS[1:6]

DT <- data.table(mtcars[1:30,], keep.rownames=TRUE)
DT[, grp:=rep(tabnames, each=trunc(nrow(mtcars)/length(tabnames)))]


ui = dashboardPage(
  dashboardHeader(title = "Dynamic DTs"),
  dashboardSidebar(),
  dashboardBody(
    uiOutput("tables"),
    p(),
    verbatimTextOutput("selectedCells")
  )
  )


server <- function(input, output, session) {
  output$tables <- renderUI({
    output_list <- list()
    for(i in seq(tabnames)){
      output_list[[i]] <- column(4, DT::dataTableOutput(outputId=tabnames[i]))
    }
    print(fluidRow(output_list))
    return(fluidRow(output_list))
  })


  for(i in seq(tabnames)){
    tabname <- tabnames[i]
    local({
      print(DT[grp %in% tabname, 1:3])
      output[[tabname]] <- DT::renderDataTable({
        DT[grp %in% tabname, 1:3]
      }, selection=list(mode="multiple", target="cell"))
    })
  }
  output$selectedCells <- renderPrint(input$A_cells_selected)
} …

我正在尝试创建一个表（使用 DT，请不要使用 rhandsontable），该表几乎没有现有列，一个 selectinput 列（其中每行都有可供选择的选项），最后是另一列，该列将根据用户选择进行填充从每行的 selectinput 下拉列表中。

在我的示例中，“反馈”列是用户下拉选择列。我无法更新“分数”列，该列将基于“反馈”列下拉列表中的选择。

if(interactive()){
  library(DT)
  library(shiny)
  tbl1 <- data.frame(A = c(1:10), B = LETTERS[1:10], C = c(11:20), D = LETTERS[1:10])
  ui <- fluidPage(
    DT::dataTableOutput(outputId = 'my_table')
  )
  server <- function(input, output, session) {
    rv <- reactiveValues(tbl = tbl1)
    observe({
      for (i in 1:nrow(rv$tbl)) {
        rv$tbl$Feedback[i] <- as.character(selectInput(paste0("sel", i), "",
                                                       choices = c(1,2,3,4)
        ))
        
        if(!is.null(input[[paste0("sel", i)]])) {
          if(input[[paste0("sel", i)]] == 1) {
            rv$tbl$Score[i] <- 10
          } else if(input[[paste0("sel", i)]] == 2) {
            rv$tbl$Score[i] <- 20
          } …

我在网上到处查了一下没有结果。我似乎无法让这些图在最大化盒子时将其高度和宽度最大化到整个窗口大小。这是我使用的要求bs4Dash。我查看了这篇文章，但提供的解决方案似乎对我不起作用。我缺少什么？

library(shiny)
library(bs4Dash)
library(circlepackeR) # devtools::install_github("jeromefroe/circlepackeR")
library(wordcloud2) # devtools::install_github("lchiffon/wordcloud2")
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(id="histbox", 
          title = "hist box", 
          plotOutput("plot1", 
                     height = 250),
          maximizable = T),
      
      box(id = "circlebox", title="circle box", 
          circlepackeR::circlepackeROutput("circles"), maximizable = T)
      
    ),
    fluidRow(
      box(id="wordlcoudbox", 
          title = "wordcloud box", 
          wordcloud2::wordcloud2Output("cloud"), 
          maximizable = T),
      
      box(id = "plotlybox",
          title = "plotly box", 
          plotly::plotlyOutput("plotlyplot"), 
          maximizable = T))
  )
) …