私は光沢のあるアプリを作成しています。その一部は、ユーザーがアップロードおよび変更したデータに基づいて線形回帰モデルを計算しています。すべてを段階的に行っているため、ここでは主な問題に関するテスト アプリのコードのみを示します。アイデアは次のとおりです。
fileInputユーザーは、光沢のあるを使用して .csv ファイルからデータをアップロードします- データが表示され、それを調べた後、ユーザーは選択した変数を変更できます
- 選択および変更されたすべての変数は、新しいリアクティブ データ テーブルとして古い変数とともに表示されます 。
初期データセットが指定されている場合、以下のコードですべて正常に動作します。
test_df <- data.frame(a = seq(1000, 21000, 1000), b = seq(1:21), c = seq(100, 300, 10))
library(shiny)
runApp(list(
ui=pageWithSidebar(headerPanel("Adding entries to table"),
sidebarPanel(uiOutput("select1"),
selectInput("select2", "Choose modification",
choices = c("log", "different"),
selected = NULL, multiple = F),
actionButton("update", "Update Table")),
mainPanel(tableOutput("table1"))),
server=function(input, output, session) {
values <- reactiveValues()
### specifing the dataset ###
values$df <- data.frame(test_df)
nr <<- nrow(test_df)
### this will contain the modified values ###
values$d <- data.frame(1:nr)
### selecting a variable to modify ###
output$select1 <- renderUI({
nc <- ncol(values$df)
nam <- colnames(values$df)
selectInput("var", label = "Select var:",
choices = c(nam), multiple = F,
selected = nam[1])
})
### calculations needed for modifactions ###
newEntry <- observeEvent(input$update, {
if(input$select2 == "log") {
newCol <- isolate(
c(log(values$df[input$var]))
)
newCol <- as.data.frame(newCol)
colnames(newCol) <- paste0("Log of ", input$var)
}
else if(input$select2 == "different") {
newCol <- isolate(
c(1-exp(-(values$df[input$var]/100)))
)
newCol <- as.data.frame(newCol)
colnames(newCol) <- paste0(input$var, "Diff of", input$dr1)
}
### adding new modified columns to the dataframe ###
isolate(
values$d <- dplyr::bind_cols(values$d, newCol)
)
})
output$table1 <- renderTable({
d1 <- values$d
nc <- ncol(d1)
### printing the whole dataframe (initial+modified) - skipping ###
### the first column of modified values, as it doesn't contain our data ###
if(input$update == 0) {
print(data.frame(test_df))
} else {
data.frame(values$df, d1[2:nc])
}
})
}))
ただし、アプリの実行後にデータセットをアップロードすることを意味する最初のステップを含めたい場合、おそらく存在しないリアクティブコンテンツを参照しているため、アプリは起動しません。独自のソースからデータをアップロードする機能を備えた、更新されたコードを次に示します。
library(shiny)
runApp(list(
ui=pageWithSidebar(headerPanel("Adding entries to table"),
sidebarPanel(fileInput("file1", "Choose file to upload", accept = c("text/csv", "text/comma-separated-values", "text/tab-separated-values", "text/plain", ".csv",".tsv")),
checkboxInput("header", "Header", TRUE),
radioButtons("sep", "Separator",c(Comma=",",Semicolon=";",Tab="\t"),","),
radioButtons("dec", "Decimal",c(Comma=",",Dot="."),","),
actionButton("Load", "Load the File"),
uiOutput("select1"),
selectInput("select2", "Choose modification",
choices = c("log", "different"),
selected = NULL, multiple = F),
actionButton("update", "Update Table")),
mainPanel(tableOutput("table1"))),
server=function(input, output, session) {
values <- reactiveValues()
### uploading data from external source ###
data1 <- reactive({
if(input$Load == 0){return()}
inFile <- input$file1
if (is.null(inFile)){return(NULL)}
isolate({
input$Load
my_data <- read.csv(inFile$datapath, header = input$header, sep = input$sep, stringsAsFactors = FALSE, dec = input$dec)
})
my_data
})
### specifing the dataset ###
values$df <- data.frame(data1())
nr <<- nrow(data1())
### this will contain the modified values ###
values$d <- data.frame(1:nr)
### selecting a variable to modify ###
output$select1 <- renderUI({
nc <- ncol(values$df)
nam <- colnames(values$df)
selectInput("var", label = "Select var:",
choices = c(nam), multiple = F,
selected = nam[1])
})
### calculations needed for modifactions ###
newEntry <- observeEvent(input$update, {
if(input$select2 == "log") {
newCol <- isolate(
c(log(values$df[input$var]))
)
newCol <- as.data.frame(newCol)
colnames(newCol) <- paste0("Log of ", input$var)
}
else if(input$select2 == "different") {
newCol <- isolate(
c(1-exp(-(values$df[input$var]/100)))
)
newCol <- as.data.frame(newCol)
colnames(newCol) <- paste0(input$var, "Diff of", input$dr1)
}
### adding new modified columns to the dataframe ###
isolate(
values$d <- dplyr::bind_cols(values$d, newCol)
)
})
output$table1 <- renderTable({
d1 <- values$d
nc <- ncol(d1)
### printing the whole dataframe (initial+modified) - skipping the first ###
### column of modified values, as it doesn't contain our data ###
if(input$update == 0) {
print(data.frame(test_df))
} else {
data.frame(values$df, d1[2:nc])
}
})
}))
私が得るエラー：
.getReactiveEnvironment()$currentContext のエラー: 操作は許可されていません >アクティブなリアクティブ コンテキストがありません。(リアクティブ式またはオブザーバー内からのみ実行できる > ことをしようとしました。)
確かに、Shiny の反応性について何かが欠けていますが、さまざまな記事や質問などを徹底的に読みましたが、これに対する答えが見つかりません。ファイル自体をアップロードすることは問題ではありません。その内容を参照する前に、リアクティブ データセットを通常の変数に書き込んでいるときに、このコード ブロックが別のアプリで完全に機能するためです。しかし、データを書き込むときに、ここでこれを行うにはどうすればよいvalues$...ですか? それとも、この種の方法で、外部ソースからのリアクティブ データを操作するための別のソリューションがあるのでしょうか? 私がすべてを明確にしたことを願っています。