有什麼辦法可以在R中創建「脆弱」屬性？

有沒有什麼辦法可以在被另一個函數處理的對象上設置屬性？例如，我可能會寫：有什麼辦法可以在R中創建「脆弱」屬性？

weightedMeanZr <- function(r,n) { 
    require(psych) 
    Zr <- fisherz(r) 
    ZrBar <- sum(Zr*(n-3))/(sum(n-3)) 
    attr(ZrBar,"names") <- "ZrBar" 
    return(ZrBar) 
}

計算一組相關性的加權Fisher變換Z均值。但是，如果我將它轉換回r，例如

require(psych) 
bdata <- structure(list(Sample = 1:6, n = c(4L, 13L, 9L, 5L, 11L, 14L), 
    r = c(0.93, 0.57, 0.46, -0.09, 0.12, 0.32)), .Names = c("Sample", 
"n", "r"), class = "data.frame", row.names = c(NA, -6L)) 

fisherz2r(with(bdata,weightedMeanZr(r,n)))

fisherz2r的輸出值保留了weightedMeanZr結果中的names屬性。有沒有辦法讓這個屬性變得脆弱，使得像fisherz2r這樣的函數可以去掉names屬性？

編輯事情是什麼這樣實現：

weightedMeanZr <- function(r,n) { 
    require(psych) 
    Zr <- fisherz(r) 
    ZrBar <- sum(Zr*(n-3))/(sum(n-3)) 
    class(ZrBar) <- "ZrBar" 
    return(ZrBar) 
} 
"+.ZrBar" <- function(e1,e2) { 
    return(unclass(e1)+unclass(e2)) 
} 
"-.ZrBar" <- function(e1,e2) { 
    return(unclass(e1)-unclass(e2)) 
} 
"*.ZrBar" <- function(e1,e2) { 
    return(unclass(e1)*unclass(e2)) 
} 
"/.ZrBar" <- function(e1,e2) { 
    return(unclass(e1)/unclass(e2)) 
} 
weightedMeanZr(bdata$r,bdata$n) 
weightedMeanZr(bdata$r,bdata$n)+1 
weightedMeanZr(bdata$r,bdata$n)-1 
weightedMeanZr(bdata$r,bdata$n)*2 
weightedMeanZr(bdata$r,bdata$n)/2 
fisherz2r(weightedMeanZr(bdata$r,bdata$n))

...但這只是因爲工作要求fisherz2r這些特定的方法...有一個更通用的方法？

來源

2013-03-14 russellpierce

什麼是您的使用情況？如果在將對象傳遞給_any_函數時該屬性總是被刪除，那麼您如何知道它首先出現？ 'print'會放棄它，'str'會放棄它，等等。 – 2013-03-14 22:10:40

好點的Joshua。我希望能做的是將結果的範圍與結果一起傳遞（對於原始結果和.print）。但是，一旦這個結果以某種方式變化了，我想把這個尺度從對象/結果中去掉，這樣它就不會持續地通過現在可能是錯誤的尺度引用自己。 – russellpierce 2013-03-14 22:17:44

您如何期望您的對象知道某個未知函數是否會以對象的比例現在不正確的方式更改對象？我想有一種方法可以創建一個回調，每次複製對象時都檢查屬性，但是我必須考慮這個問題... – 2013-03-14 22:25:45

您可以使用unname刪除名稱

fisherz2r(with(bdata,unname(weightedMeanZr(r,n)))) 
# or 
unname(fisherz2(with(bdata,weightedMeanZr(r,n))))

或as.vector，在這種情況下將去掉名稱

來源

2013-03-14 21:43:03 mnel

但是......當將weightMeanZr的結果傳遞給其他函數時，沒有明確的承諾會在未來發生這種事情？ – russellpierce 2013-03-14 21:49:40

沒有，沒有辦法自動做什麼，我試圖做（據我所知，至少從R 2.15.2開始）。 R中有一個回調系統（感謝@JoshuaUlrich將這個關鍵字放在腦海中），但試圖實現所需的行爲可能在計算上花費很大。

然而，這裏是一個（工作）例如：

require(psych) 
bdata <- structure(list(Sample = 1:6, n = c(4L, 13L, 9L, 5L, 11L, 14L), 
         r = c(0.93, 0.57, 0.46, -0.09, 0.12, 0.32)), .Names = c("Sample", 
                       "n", "r"), class = "data.frame", row.names = c(NA, -6L)) 

weightedMeanZr <- function(r,n) { 
    require(psych) 
    Zr <- fisherz(r) 
    ZrBar <- sum(Zr*(n-3))/(sum(n-3)) 
    attr(ZrBar,"original.value") <- ZrBar 
    class(ZrBar) <- "ZrBar" 
    attr(ZrBar,"names") <- "ZrBar" 
    return(ZrBar) 
} 

h <- taskCallbackManager() #create the callback system 

# add a callback 
h$add(function(expr, value, ok, visible) { 
    cat("In handler",george,"\n") 
    ZrBars <- names(which(lapply(sapply(ls(name=.GlobalEnv,all=TRUE),get),class) == "ZrBar")) 
    for (i in ZrBars) { 
    thisone <- get(i) 
    if(!attr(thisone,"original.value") == thisone) { 
     attr(thisone,"names") <- NULL 
     attr(thisone,"class") <- NULL 
     attr(thisone,"original.value") <- NULL 
     assign(i,thisone,envir=.GlobalEnv) 
    } 
    } 
    return(TRUE) 
}, name = "simpleHandler") 

#create some objects of the class 
thisone <- weightedMeanZr(runif(10),4:13) 
thistoo <- weightedMeanZr(runif(10),4:13) 

thisone + 1 #class kept, a print method could be added to resolve this issue 
#if we store the result, it goes away as desired 
(um <- thisone + 1) #class gone\ 

#clean out workspace so the callback system doesn't linger 
removeTaskCallback("R-taskCallbackManager")

來源

2013-03-15 19:10:51 russellpierce

有什麼辦法可以在R中創建「脆弱」屬性？

回答

相關問題