-1
このR光沢のあるスクリプトを以下に実行すると、左側のトレースエクスプローラと呼ばれるbupaRライブラリの患者データセットから導出された活動経路のグラフと、アクティビティー/トレースの詳細を表示する表。左の図は、一連の活動の横断的な痕跡が連続して現れる様々な経路を観察するようなものです。特定のトレースの任意のボックスをクリックすると、トレースの詳細が右側の表に表示されます。私の要件は、特定のトレースの任意のボックスをクリックすると、 "y"または4番目の列の値を動的に取得する必要があり、トレースに発生するすべてのアクティビティを表示する列を1つだけ取得する必要があります。例えば。アタッチされたイメージでは、一番下のパスのどこかをクリックすると、アクティビティ "Registration"、 "Triage and Assessment"で1つの列を取得する必要があります。助けてくれてありがとう。Rの輝きのデータテーブルで活動の詳細を表示する
library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)
library(bupaR)
library(edeaR)
library(scales)
library(splitstackshape)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box(title = "Case Summary", status = "primary", height = "455",solidHeader
= T,
dataTableOutput("sankey_table"))
)
)
server <- function(input, output)
{
output$sankey_plot <- renderPlotly({
tr <- data.frame(traces(patients, output_traces = T, output_cases = F))
tr.df <- cSplit(tr, "trace", ",")
tr.df$af_percent <-
percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
pos <- c(1,4:ncol(tr.df))
tr.df <- tr.df[,..pos]
tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
mp1 = ggplot(data = tr.df, aes(x = variable,y = trace_id, fill = value,
label = value,
text=paste("Variable:",variable,"<br> Trace
ID:",trace_id,"<br> Value:",value,"<br> Actuals:",af_percent))) +
geom_tile(colour = "white") +
geom_text(colour = "white", fontface = "bold", size = 2) +
scale_fill_discrete(na.value="transparent") +
theme(legend.position="none") + labs(x = "Traces", y = "Activities")
ggplotly(mp1, tooltip=c("text"), height = 380, width = 605)
})
output$sankey_table <- renderDataTable({
tp2 = event_data("plotly_click")
})
}
shinyApp(ui, server)
セカンドパート：
library(lubridate)
patients1 <<- arrange(patients, patient)
patients2 <<- patients1 %>% arrange(patient, time)
patients3 <<- patients2 %>%
group_by(patient) %>%
mutate(diff_in_sec = as.POSIXct(time, format = "%m/%d/%Y %H:%M") -
lag(as.POSIXct(time, format = "%m/%d/%Y %H:%M"),
default=first(as.POSIXct(time, format = "%m/%d/%Y %H:%M"))))%>%
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% mutate(diff_in_days
= as.numeric(diff_in_hours/24))
上記のコードを実行している、あなたは下の与えられたデータでは500例があるようにbupaRライブラリから患者データを取得したら「患者」列では、すべての場合の活動が「処理中」列にあり、発生時の昇順に並べられている。私の要件は、DTテーブルの以前の解決策から得られた「値」列を比較し、患者3データセットのすべてのケース「患者」のユニークな処理（ユニークな処理）と比較することです。 「値」列が完全に一致する場合は、対応する行全体をDT表に表示する必要があります。例えば。最下位のパスのどこかをクリックすると、アクティビティ "登録"、 "トリアージ＆アセスメント"、 "値"列とアクティビティが1〜500の各アクティビティと比較されます。 "Registration"、 "Triage and Assessment"では、すべてのトレースで同様に対応する行が表示されます。ありがとう、助けてください。
第三部：
私はそれが下側から、右からオーバーシュートはならないように、それに適したPAGELENGTHを与えることによって、第2のボックス内のデータテーブルを修正したいです。
可能な構文：
datatable(Data, options = list(
searching = TRUE,
pageLength = 9
))
**and**
box(title = "Case Details", status = "primary", height = "575",solidHeader
= T,width = "6",
div(DT::dataTableOutput("Data_table"), style = "font-size: 84%; width:
65%"))
**Here is the consolidated final code to be updated**
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box(title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 6)
)
)
server <- function(input, output)
{
#Plot for Trace Explorer
dta <- reactive({
tr <- data.frame(traces(patients, output_traces = T, output_cases = F))
tr.df <- cSplit(tr, "trace", ",")
tr.df$af_percent <-
percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
pos <- c(1,4:ncol(tr.df))
tr.df <- tr.df[,..pos]
tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
tr.df
})
patients10 <- reactive({
patients11 <- arrange(patients, patient)
patients12 <- patients1 %>% arrange(patient, time,handling_id)
patients12 %>%
group_by(patient) %>%
mutate(time = as.POSIXct(time, format = "%m/%d/%Y %H:%M"),diff_in_sec =
time - lag(time)) %>%
mutate(diff_in_sec = ifelse(is.na(diff_in_sec),0,diff_in_sec)) %>%
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>%
mutate(diff_in_days = as.numeric(diff_in_hours/24))
})
output$trace_plot <- renderPlotly({
mp1 = ggplot(data = dta(), aes(x = variable,y = trace_id, fill = value,
label = value,
text=paste("Variable:",variable,"<br> Trace
ID:",trace_id,"<br>
Value:",value,"<br> Actuals:",af_percent))) +
geom_tile(colour = "white") +
geom_text(colour = "white", fontface = "bold", size = 2) +
scale_fill_discrete(na.value="transparent") +
theme(legend.position="none") + labs(x = "Traces", y = "Activities")
ggplotly(mp1, tooltip=c("text"), height = 516, width = 605)
})
output$trace_table <- renderDataTable({
req(event_data("plotly_click"))
Values <- dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
{paste0(unique(y),collapse = "")})
currentPatient <- agg$patient[agg$handling == valueText]
patients10() %>%
filter(patient %in% currentPatient)
})
}
shinyApp(ui, server)
を助けてください、私は次のようにこれがある達成するためにプロットに統合することを知っているいくつかの可能な構文は、以下の連結コードを見つけてください。あなたはすでに私が使うことができるように、別々の反応にtr.dfの計算を移動し、次のサーバーを変更plotlyからイベントをキャッチするすべてのハードワークを行っていたので、 
はストレートに、ありがとうございましたそれがポイントです。私は確かにこれをupvoteしますが、これはaddonの要件がありますが、これはちょうどサブセットであり、私はあなたの助けを求める、私はコメントでここで尋ねる必要があります、私は新しいクエリとしてそれを入れたいですか？ –
あなたはコメントの中でここにpuすることができますか、アドオンであなたのorignial質問をよりよく更新することができます。新しいクエリを配置する必要はありません –
お返事ありがとうございましたので、私が提案したように質問を更新してください。 –