<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/"></div></div><div><a data-url="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/" data-counturl="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/" data-count="horizontal" data-text="Visualizing ROC Curves in R using Plotly" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="http://moderndata.plot.ly/visualizing-roc-curves-in-r-using-plotly/"> R – Modern Data</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>In this post we’ll create some simple functions to generate and chart a Receiver Operator (ROC) curve and visualize it using Plotly. See Carson’s <a target="_blank" href="https://cpsievert.github.io/plotly_book/merging-plotly-objects.html">plotly book</a> for more details around changes in syntax.</p>
<p>We’ll do this from a credit risk perspective i.e. validating a bank’s internal rating model (we’ll create a sample dataset keeping this in mind)</p>
<p>We’ll replicate computations highlighted in <a target="_blank" href="http://www.qfrc.uts.edu.au/research/research_papers/rp181.pdf">this paper</a>.</p>
<div>
<pre>library(plotly)
library(dplyr)
library(flux)</pre>

<h2>Sample data</h2>

<pre>set.seed(123)
n &lt;- 100000
lowest.rating &lt;- 10

# Sample internal ratings
# Say we have a rating scale of 1 to 10̥
ratings &lt;- sample(1:lowest.rating, size = n, replace = T)

# Defaults
# We'll randomly assign defaults concentrating more defaults 
# in the lower rating ranges. We'll do this by creating exponentially
# increasing PDs across the rating range

power &lt;- 5
PD &lt;- log(1:lowest.rating)
PD &lt;- PD ^ power

#PD &lt;- exp((1:lowest.rating))
PD &lt;- PD/(max(PD) * 1.2)  # increased denominator to make the PDs more realistic
Now given PD for eac rating category sample from a binomial distribution
# to assign actual defaults
defaults &lt;- rep(0, n)
k &lt;- 1
for(i in ratings){
  defaults[k] &lt;- rbinom(1, 1, PD[i])
  
  k &lt;- k + 1
}

dataset &lt;- data.frame(Rating = ratings,
                      Default = defaults)

# Check if dataset looks realistic̥
# df &lt;- dataset %>% 
#   group_by(Rating) %>% 
#   summarize(Def = sum(Default == 1), nDef = sum(Default == 0))</pre>

</div>
<div>
<h2>ROC Curve Computation</h2>
<p>Now that we have a sample dataset to work with we can start to create the ROC curve</p>

<pre>ROCFunc &lt;- function(cutoff, df){
  
  # Function counts the number of defaults hap̥pening in all the rating
  # buckets less than or equal to the cutoff
  
  # Number of hits = number of defaults with rating &lt; cutoff / total defaults
  # Number of false alarms = number ofnon defaults with rating &lt; cutoff / total non defaults

  nDefault &lt;- sum(df$Default == 1)
  notDefault &lt;- sum(df$Default == 0)

  temp &lt;- df %>% filter(Rating >= cutoff)
  hits &lt;- sum(temp$Default == 1)/nDefault
  falsealarm &lt;- sum(temp$Default == 0)/notDefault
  ret &lt;- matrix(c(hits, falsealarm), nrow = 1)
  colnames(ret) &lt;- c(&quot;Hits&quot;, &quot;Falsealarm&quot;)

  return(ret)
}

# Arrange ratings in decreasing order
# A lower rating is better than a higher rating
vec &lt;- sort(unique(ratings), decreasing = T)
ROC.df &lt;- data.frame()

for(i in vec){
  ROC.df &lt;- rbind(ROC.df, ROCFunc(i, dataset))
}

# Last row to complete polygon

labels &lt;- data.frame(x = ROC.df$Falsealarm, 
                     y = ROC.df$Hits,
                     text = vec)

ROC.df &lt;- rbind(c(0,0), ROC.df)

# Area under curve
AUC &lt;- round(auc(ROC.df$Falsealarm, ROC.df$Hits),3)</pre>

</div>
<div>
<h2>Plot</h2>

<pre>plot_ly(ROC.df, y = ~Hits, x = ~Falsealarm, hoverinfo = &quot;none&quot;) %>% 
  
  add_lines(name = &quot;Model&quot;,
            line = list(shape = &quot;spline&quot;, color = &quot;#737373&quot;, width = 7), 
            fill = &quot;tozeroy&quot;, fillcolor = &quot;#2A3356&quot;) %>% 
  
  add_annotations(y = labels$y, x = labels$x, text = labels$text,
                  ax = 20, ay = 20,
                  arrowcolor = &quot;white&quot;,
                  arrowhead = 3,
                  font = list(color = &quot;white&quot;)) %>% 
  
  add_segments(x = 0, y = 0, xend = 1, yend = 1, 
               line = list(dash = &quot;7px&quot;, color = &quot;#F35B25&quot;, width = 4), 
               name = &quot;Random&quot;) %>% 
  
  add_segments(x = 0, y = 0, xend = 0, yend = 1, 
               line = list(dash = &quot;10px&quot;, color = &quot;black&quot;, width = 4), 
               showlegend = F) %>%
  
  add_segments(x = 0, y = 1, xend = 1, yend = 1, 
               line = list(dash = &quot;10px&quot;, color = &quot;black&quot;, width = 4), 
               showlegend = F) %>% 
  
  add_annotations(x = 0.8, y = 0.2, showarrow = F, 
                  text = paste0(&quot;Area Under Curve: &quot;, AUC),
                  font = list(family = &quot;serif&quot;, size = 18, color = &quot;#E8E2E2&quot;)) %>%
  
  add_annotations(x = 0, y = 1, showarrow = F, xanchor = &quot;left&quot;, 
                  xref = &quot;paper&quot;, yref = &quot;paper&quot;,
                  text = paste0(&quot;Receiver Operator Curve&quot;),
                  font = list(family = &quot;arial&quot;, size = 30, color = &quot;#595959&quot;)) %>%
  
  add_annotations(x = 0, y = 0.95, showarrow = F, xanchor = &quot;left&quot;, 
                  xref = &quot;paper&quot;, yref = &quot;paper&quot;,
                  text = paste0(&quot;Charts the percentage of correctly identified defaults (hits) against the percentage of non defaults incorrectly identifed as defaults (false alarms)&quot;),
                  font = list(family = &quot;serif&quot;, size = 14, color = &quot;#999999&quot;)) %>% 
  
   
  layout(xaxis = list(range = c(0,1), zeroline = F, showgrid = F,
                      title = &quot;Number of False Alarms&quot;),
         yaxis = list(range = c(0,1), zeroline = F, showgrid = F,
                      domain = c(0, 0.9),
                      title = &quot;Number of Hits&quot;),
         plot_bgcolor = &quot;#E8E2E2&quot;,
         height = 800, width = 1024)</pre>

<p><iframe height="700" width="1024" src="https://plot.ly/~riddhiman/391.embed"></iframe></p>
<p><div><div><div><div data-width="55" data-show-faces="false" data-send="true" data-layout="box_count" data-height="62" data-href="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/"></div></div><div><a data-url="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/" data-counturl="https://www.r-bloggers.com/visualizing-roc-curves-in-r-using-plotly/" data-count="vertical" data-text="Visualizing ROC Curves in R using Plotly" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="http://moderndata.plot.ly/visualizing-roc-curves-in-r-using-plotly/"> R – Modern Data</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/?s=data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/?s=Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/?s=map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/?s=animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/?s=sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/?s=LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/?s=SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/?s=git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/?s=hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/?s=Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/?s=PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/?s=time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/?s=trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/tPptcO6Z6rQ"></a></div></div>