https://github.com/cran/BDgraph
Raw File
Tip revision: 9895d06622cc75a24d2b055040302cd3af7355ea authored by Abdolreza Mohammadi on 21 June 2017, 13:59:00 UTC
version 2.39
Tip revision: 9895d06
plotroc.R
# To plot ROC curve
plotroc = function( sim.obj, bdgraph.obj, bdgraph.obj2 = NULL, bdgraph.obj3 = NULL, 
                    bdgraph.obj4 = NULL, cut = 20, smooth = FALSE, label = TRUE, main = "ROC Curve" )
{
    if ( class( sim.obj ) == "sim" ) G = as.matrix( sim.obj $ G ) else G = as.matrix( sim.obj )
	G[ lower.tri( G, diag = TRUE ) ] = 0
	
    output_tp_fp = compute_tp_fp( G = G, bdgraph.obj = bdgraph.obj, cut = cut, smooth = smooth )
    fp           = output_tp_fp $ fp
    tp           = output_tp_fp $ tp
 	
	# par( mar = c( 3.8, 4.2, 1.8, 1 ) )
    plot( NA, type = "l", col = "black", cex.lab = 1.3, cex.main = 2, cex.axis = 1.2,
          main = main, xlab = "False Postive Rate", ylab = "True Postive Rate", 
          ylim = c( 0, 1 ), xlim = c( 0, 1 ) )
    points( x = fp, y = tp, type = "l", col = "black", lty = 1, lw = 2 )
  
    if( !is.null( bdgraph.obj2 ) )
    {
        output_tp_fp = compute_tp_fp( G = G, bdgraph.obj = bdgraph.obj2, cut = cut, smooth = smooth )
		fp_2         = output_tp_fp $ fp
		tp_2         = output_tp_fp $ tp
	
        points( x = fp_2, y = tp_2, type = "l", col = "blue", lty = 2, lw = 2 )
    }
    
    if( !is.null( bdgraph.obj3 ) )
    {   
        output_tp_fp = compute_tp_fp( G = G, bdgraph.obj = bdgraph.obj3, cut = cut, smooth = smooth )
		fp_3         = output_tp_fp $ fp
		tp_3         = output_tp_fp $ tp
   		
        points( x = fp_3, y = tp_3, type = "l", col = "green", lty = 3, lw = 2 )
    }
    
    if( !is.null( bdgraph.obj4 ) )
    {   
        output_tp_fp = compute_tp_fp( G = G, bdgraph.obj = bdgraph.obj4, cut = cut, smooth = smooth )
		fp_4         = output_tp_fp $ fp
		tp_4         = output_tp_fp $ tp
   		
        points( x = fp_4, y = tp_4, type = "l", col = "red", lty = 4, lw = 2 )
    }
    
	if ( label )
	{ 
		if( !is.null( bdgraph.obj2 ) && is.null( bdgraph.obj3 ) )  legend( "bottomright", c( "bdgraph.obj", "bdgraph.obj2" ), lty = 1:2, col = c( "black", "blue" ), lwd = c( 2, 2 ), cex = 1.5 )
		if( !is.null( bdgraph.obj3 ) && is.null( bdgraph.obj4 ) )  legend( "bottomright", c( "bdgraph.obj", "bdgraph.obj2", "bdgraph.obj3" ), lty = 1:3, col = c( "black", "blue", "green" ), lwd = c( 2, 2 ), cex = 1.5 )
		if( !is.null( bdgraph.obj4 ) ) legend( "bottomright", c( "bdgraph.obj", "bdgraph.obj2", "bdgraph.obj3", "bdgraph.obj4" ), lty = 1:4, col = c( "black", "blue", "green", "red" ), lwd = c( 2, 2 ), cex = 1.5 )
	}   
}
       
# function for ROC plot
compute_tp_fp = function( G, bdgraph.obj, cut, smooth )
{
	p           = nrow( G )
	sum_edges   = sum( G )
	sum_no_dges = p * ( p - 1 ) / 2 - sum_edges

    if( class( bdgraph.obj ) != "huge" )
    {
		if( class( bdgraph.obj ) == "bdgraph" )
		{
			p_links = bdgraph.obj $ p_links
			if( is.null( p_links ) ) p_links = plinks( bdgraph.obj, round = 10 )
			p_links = as.matrix( p_links )
		}else{
			p_links = as.matrix( bdgraph.obj )
		}
		
		tp = c( 1, rep( 0, cut ) )
		fp = tp

		cut_points = ( 0 : cut ) / cut
		
		for( i in 2 : cut )
		{
			# checking for cut pints
			est_G = matrix( 0, p, p )
			est_G[ p_links > cut_points[i] ] = 1

			tp[i] = sum( ( G != 0 ) * ( est_G != 0 ) ) / sum_edges
			fp[i] = sum( ( G == 0 ) * ( est_G != 0 ) ) / sum_no_dges
		}
	}else{
		path = bdgraph.obj $ path
		tp   = numeric( length( path ) )
		fp   = tp

		for( i in 1 : length( path ) )
		{
			est_G = as.matrix( path[[i]] )
			est_G[ lower.tri( est_G, diag = TRUE ) ] = 0
			
			tp[i] = sum( ( G != 0 ) * ( est_G != 0 ) ) / sum_edges
			fp[i] = sum( ( G == 0 ) * ( est_G != 0 ) ) / sum_no_dges
		}
		
		tp = c( tp, 1 )
		fp = c( fp, 1 )
	}
	
	if ( smooth == TRUE )
	{
		fit = smooth.spline( x = fp, y = tp )
		fp  = c( 0, fit $ x )
		tp  = c( 0, fit $ y )
	}	
	
	return( list( tp = tp, fp = fp ) )
}
    
back to top