Nothing
performance.pcor <- function(inferred.pcor, true.pcor=NULL, fdr=TRUE, cutoff.ggm=0.8,verbose=FALSE,plot.it=FALSE)
{
p <- ncol(inferred.pcor) # number of variables
if (fdr==TRUE){
test.results <-ggm.test.edges(inferred.pcor,verbose=verbose,plot=plot.it)
# extract network containing edges with prob > cutoff.ggm
prob.results<-diag(p)
for (i in 1:length(test.results$prob)){
prob.results[test.results$node1[i],test.results$node2[i]]<-test.results$prob[i]
prob.results[test.results$node2[i],test.results$node1[i]]<-test.results$prob[i]
dim(prob.results)
}
net <- extract.network(test.results, cutoff.ggm=cutoff.ggm)
adj <- diag(p)
if (nrow(net)!=0)
{
for (j in 1:nrow(net))
{
adj[net[j,2], net[j,3]] <- 1
adj[net[j,3], net[j,2]] <- 1
}
}
}
if (fdr==FALSE)
{
adj <- inferred.pcor
adj[adj!=0] <- 1
}
#
num.selected <- ( sum(abs(adj)>0)-p )/2 # number of selected edges
connectivity<-apply(adj,2,FUN=function(x) return(sum(x!=0)))-1
positive.cor<-NULL
if (num.selected>0){
if (fdr==TRUE){
positive.cor<-sum(net[,1]>0)/num.selected
}
if (fdr==FALSE){
positive.cor<-((sum(inferred.pcor>0)-ncol(inferred.pcor))/2)/num.selected
}
}
num.true<-power<-ppv<-NULL
if (is.null(true.pcor)==FALSE){
num.true <- ( sum(abs(true.pcor)>0)-p )/2 # number of true edges
num.true.positives <- ( sum(abs(true.pcor*adj)>0)-p )/2
num.false.positives<-num.selected-num.true.positives
## power
power <- -Inf
if (num.true>0) {
power <- num.true.positives/num.true
}
## true discovery rate (positive predictive value)
ppv <- -Inf
if (num.selected>0) {
ppv <- num.true.positives/num.selected
}
}
## ROC curves and AUC score
auc<-NA
tpr<-fpr<-NA
TPR<-FPR<-NA
if ((fdr==TRUE) & (is.null(true.pcor)==FALSE)){
xx<-seq(0,1,length=500) # scale of the x and y axis of the ROC curve
true.binary=(abs(true.pcor)>0) # logical matrix indicating the true partial correlations
predicted<-sym2vec(prob.results)
if (var(predicted)>0){ # there is an error message if all probabilities are zero, weird
if (plot.it==TRUE){
plot.roc="ROC"
}
if (plot.it==FALSE){
plot.roc=NA
}
myroc<-ROC(predicted,sym2vec(true.binary),plot=plot.roc)
auc<-myroc$AUC # area under the curve
TPR<-myroc$res[,1] # sensitivity =TPR
#cat(paste("length of TPR ", length(TPR),"\n"))
FPR<-1-myroc$res[,2] # 1-specifity =FPR
#cat(paste("length of TPR ", length(TPR),"\n"))
#TPR<-c(1,TPR,0)
#FPR<-c(1,FPR,0)
#yy<-approx(TPR,FPR,xout=xx,yleft=0,yright=1)
#tpr<-xx
#fpr<-yy$y
# rest later
}
}
if ((is.null(true.pcor)==FALSE)){
tpr<-power
#fpr<--Inf
if (num.true>0){
fpr<-num.false.positives/((p^2-p)/2 - num.true) # false positives/true false
}
}
# also return the number of positive and negative correlations
return(list(num.selected=num.selected, power=power,TPR=TPR,FPR=FPR, tpr=tpr,fpr=fpr,ppv=ppv,adj=adj,connectivity=connectivity,positive.cor=positive.cor,auc=auc))
}
# fpr and tpr are for the optimal parameters
# FPR and TPR are vectors
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.