Wykresy radarowe/pajęcze

Wykresy radarowe wciąż nie są tak powszechne jak ich inne siostry i bracia. Pozwalają one pokazać różnice między grupami dla wielu zmiennych jednocześnie. Działają dobrze, jeśli masz jakieś maksimum dla tych zmiennych. Ponadto, jeśli nie masz zbyt wielu grup do porównania, najlepiej 2-3. I jeśli nie jesteś zainteresowany samymi rozkładami.
Mimo to, są one atrakcyjne wizualnie i mogą być miłą częścią dynamicznej aplikacji Shiny.

Poniżej znajduje się prosty kod wykresu radarowego dla danych dotyczących objawów choroby Parkinsona. Każdy objaw jest oceniany w skali 0-100. Ponieważ dane są podłużne, funkcja umożliwia wykreślenie ich w określonym punkcie w czasie. Włączone jest również porządkowanie według nasilenia.

Funkcja działa dla grupy binarnej.

Plot.Bin.Radar<-function(timepoint,group,order_by_severity = FALSE){

#reading symptomy data#

data.symptoms<-data.frame(ID=m.data$participant_id,slow=m.data$slow,constipation=m.data$constipation,walk=m.data$walk,freezing=m.data$freezing,falls=m.data$falls, wstawanie=m.data$rising, ubieranie=m.data$dressing, motywacja=m.data$motivation, pismo odręczne=m.data$handwriting,
depresja=m.data$depresja, wycofanie=m.data$wycofanie,
anxiety=m.data$anxiety, fatigue=m.data$fatigue,
senność=m.data$sleepy,dyskineza=m.data$dyskinesia,
drżenie=m.data$tremor,równowaga=m.data$balance,
dizzy=m.data$dizzy, visual=m.data$visual, insomnia=m.data$insomnia,
rbd=m.data$rbd,restlesslegs=m.data$restlesslegs,
musclepain=m.data$musclepain, speech=m.data$speech,
drool=m.data$drool, stoop=m.data$stoop,
memory=m.data$memory,comprehension=m.data$comprehension,smell=m.data$smell,
seksualne=m.data$seksualne, moczowe=m.data1TP4Moczowe,
halucynacje=m.data$hallucinations, nudności=m.data$nausea, czas=m.data$TimeCont)

#where zmienna grupy w danych#
where.group<-which(names(m.data)==group)
  
data.symptoms.0<-data.symptoms[(data.symptoms$time==timepoint)&(m.data[,where.group]==0),]
data.symptoms.12<-data.symptoms[(data.symptoms$time==timepoint)&(m.data[,where.group]==1),]
  
  
all.symptoms.0 <- data.frame(sapply(data.symptoms.0, function(x) as.numeric(as.character(x))))
all.symptoms.12 <- data.frame(sapply(data.symptoms.12, function(x) as.numeric(as.character(x))))
  
  
av.symp.0<-colMeans(all.symptoms.0, na.rm=TRUE)
av.symp.12<-colMeans(all.symptoms.12, na.rm=TRUE)
  
data <- as.data.frame(rbind(av.symp.0[2:34],av.symp.12[2:34]))

1TP5Porządkowanie według nasilenia#
  
  if (order_by_severity) {
    # Oblicz średnią dotkliwość w obu grupach
    mean_severity <- colMeans(data, na.rm = TRUE)
    ordered_symptoms <- names(sort(mean_severity, decreasing = TRUE))
    data <- data[, ordered_symptoms]
  }
  
get.labels<-names.data$Field.Label[names.data$Variable.Field.Name==group]
  
rownames(data) <- c(paste0(" No ", timepoint, "m."),paste0(" Yes ", timepoint, "m."))
  
# Aby użyć pakietu fmsb, muszę dodać 2 wiersze do ramki danych: maksimum i minimum każdej zmiennej do pokazania na wykresie!
  
 data <- rbind(rep(100,33) , rep(0,33) , data)
  
# Wektor kolorów (obramowanie i wypełnienie)#

colors_border=c( rgb(0.2,0.5,0.5,0.9), rgb(0.8,0.2,0.5,0.9) , rgb(0.7,0.5,0.1,0.9),rgb(0.1,0.1,0.9,0.9))
colors_in=c( rgb(0.2,0.5,0.5,0.4), rgb(0.8,0.2,0.5,0.4) , rgb(0.7,0.5,0.1,0.4),rgb(0.1,0.1,0.9,0.4) )
  
  Wykres # z domyślnymi opcjami:
  radarchart( data , axistype=1 ,
              #custom polygon
              pcol=colors_border , pfcol=colors_in , plwd=4 , plty=1,
              #custom siatka
              cglcol="grey", cglty=1, axislabcol="grey", caxislabels=seq(0,20,5), cglwd=0.8, vlcex=0.8,title=get.labels)
  legend(x=0.8, y=1.3, legend = rownames(data[-c(1,2),]), bty = "n", pch=20 ,
         col=colors_border , text.col = "black", cex=1, pt.cex=2)
  if (order_by_severity) {
    mtext("Objawy uporządkowane według średniego nasilenia we wszystkich grupach",
          side = 1, line = 4, cex = 0.9, col = "grey40")
  }
  
}
Plot.Bin.Radar(0, "gender",order_by_severity = TRUE) 

W wyniku wywołania funkcji Plot.Bin.Radar(0, "gender",order_by_severity = TRUE) otrzymujemy wykres jak powyżej. Dla płci, dla 0 miesięcy (linia bazowa). Wyobraźmy sobie teraz aplikację Shiny z czasem jako suwakiem:

library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Parkinson dashboard"),
  dashboardSidebar(),
  dashboardBody(
    Pola # muszą być umieszczone w rzędzie (lub kolumnie)
    fluidRow(
      box(width = 6,plotOutput("plot1", height = 450)),
      
      box(
        title = "Linia bazowa a inny punkt czasowy",
        sliderInput("slider", "Wybierz punkt czasowy:", 0, 24, 6)
      )
    )
  )
)

server <- function(input, output) {
  
 library(fmsb)
 
  
  your.data <- read.csv("mydata.csv")
  #do some data management here#
 

  source("park_functions.R")
  
  output$plot1 <- renderPlot({
    Plot.Radar(input$slider)
   
  })
}

shinyApp(ui, server)

Następnie wgraj aplikację na serwer shiny i viola! Oszczędza to 1000 wątków i jest naprawdę zabawne!

Powodzenia!