die Funktion mit mehreren Ausgängen (? Nicht-Zusammenfassung fxn) Verwendung mit zusammenzufassen

Question

library(OptimalCutpoints) 

library(dplyr) 

ist hier ein Testdaten:

set.seed(123) 

df<-data.frame(label=rbinom(1000,size=1,prob=0.5),score=rnorm(1000),type=sample(c("A","B","C","D"),1000,replace=TRUE)) 

der ‚Typ‘ mit group_by Gruppiert und wollte die optimal.cutpoints zusammenzufassen mit Funktion aus der Bibliothek (OptimalCutpoints)

df%>%group_by(type)%>%summarize(Opt_cut=optimal.cutpoints(X = "score", status = "label", tag.healthy = 0, methods = "MaxSpSe",data=df[,1:2])) 

ich habe dies: Error: expecting a single value

Ich könnte eine Abhilfe wie diese erhalten, jeden "Typ" Extrahieren und optimal.cutpoints separat ausgeführt wird:

df_A<-df%>%filter(grepl("A",type)) 
opt.cut.df.A <- optimal.cutpoints(X = "score", status = "label", tag.healthy = 0, methods = "MaxSpSe", data = df_A) 

Von opt.cut.df.AI die optimale Cutoff wie so extrahieren:

opt.cut.df.A[1]$MaxSpSe$Global$optimal.cutoff$cutoff 

Aber das ist definitiv nicht der beste Weg esp. mit großen # von "Typen" Wenn ich etwas nicht verpasst habe, sieht aus wie zusammenfassen funktioniert nur mit einer einzigen Ausgabefunktion.

Frage: Wie optimaler.Cutpoints oder ähnliche Funktionen mit zusammenfassen verwenden?

Answer 1

library(data.table) 
setDT(df)[,opt(.SD), by=type] 
    type   V1 
1: A -0.07686590 
2: D 0.10719041 
3: D 0.
4: D 0.13909786 
5: B 0.16122635 
6: B 0.18304797 
7: C -0.08671413 

wo opt die Funktion für den Schnitt ist:

opt <- function(df) optimal.cutpoints(X = "score", status = "label", tag.healthy = 0, methods = "MaxSpSe", data=df)[1]$MaxSpSe$Global$optimal.cutoff$cutoff 

Der Grund dplyr nicht funktioniert, weil manchmal eine Gruppe einen Cutoff-Punkt hat, manchmal ist es mehrere Schnitte hat. summarise wartet nur auf einen Wert, die Vektoren mit gemischter Länge erzeugten Probleme.

Answer 2

Alternativ können Sie die Methode split, apply verwenden, indem Sie eine Liste von Modellen erstellen und dann Werte aus der Liste extrahieren.

listOfModels <- lapply(split(df, df$type), function(subDf) 
         optimal.cutpoints(X = "score", status = "label", 
             tag.healthy = 0, methods = "MaxSpSe",data=subDf)) 

lapply(listOfModels, function(model) model[1]$MaxSpSe$Global$optimal.cutoff$cutoff) 

$A 
[1] -0.0768659 

$B 
[1] 0.1612264 0.1830480 

$C 
[1] -0.08671413 

$D 
[1] 0.1071904 0.1155321 0.1390979 

Answer 3

Eine weitere Alternative mit purrr:

library(purrr) 

df %>% 
    split(.$type) %>% 
    map(~ optimal.cutpoints(X = "score", status = "label", 
          tag.healthy = 0, methods = "MaxSpSe", data = .)) %>% 
    map(c("MaxSpSe", "Global", "optimal.cutoff", "cutoff")) 

Welche gibt:

#$A 
#[1] -0.0768659 
# 
#$B 
#[1] 0.1612264 0.1830480 
# 
#$C 
#[1] -0.08671413 
# 
#$D 
#[1] 0.1071904 0.1155321 0.1390979 

---

Wenn Sie die Ergebnisse in einem data.frame möchten, können Sie map_df an der Kette hinzufügen:

df %>% 
    split(.$type) %>% 
    map(~optimal.cutpoints(X = "score", status = "label", 
          tag.healthy = 0, methods = "MaxSpSe", data = .)) %>% 
    map(c("MaxSpSe", "Global", "optimal.cutoff", "cutoff")) %>% 
    map_df(~data.frame(cutoff = .), .id = "type") 

Welche gibt:

# type  cutoff 
#1 A -0.07686590 
#2 B 0.16122635 
#3 B 0.18304797 
#4 C -0.08671413 
#5 D 0.10719041 
#6 D 0.
#7 D 0.13909786