R : Copyright 2005, The R Foundation for Statistical Computing
Version 2.1.1  (2005-06-20), ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for a HTML browser interface to help.
Type 'q()' to quit R.

> ### * <HEADER>
> ###
> attach(NULL, name = "CheckExEnv")
> assign(".CheckExEnv", as.environment(2), pos = length(search())) # base
> ## add some hooks to label plot pages for base and grid graphics
> setHook("plot.new", ".newplot.hook")
> setHook("persp", ".newplot.hook")
> setHook("grid.newpage", ".gridplot.hook")
> 
> assign("cleanEx",
+        function(env = .GlobalEnv) {
+ 	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
+            RNGkind("default", "default")
+ 	   set.seed(1)
+    	   options(warn = 1)
+ 	   delayedAssign("T", stop("T used instead of TRUE"),
+ 		  assign.env = .CheckExEnv)
+ 	   delayedAssign("F", stop("F used instead of FALSE"),
+ 		  assign.env = .CheckExEnv)
+ 	   sch <- search()
+ 	   newitems <- sch[! sch %in% .oldSearch]
+ 	   for(item in rev(newitems))
+                eval(substitute(detach(item), list(item=item)))
+ 	   missitems <- .oldSearch[! .oldSearch %in% sch]
+ 	   if(length(missitems))
+ 	       warning("items ", paste(missitems, collapse=", "),
+ 		       " have been removed from the search path")
+        },
+        env = .CheckExEnv)
> assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now
> assign("ptime", proc.time(), env = .CheckExEnv)
> grDevices::postscript("concord-Examples.ps")
> assign("par.postscript", graphics::par(no.readonly = TRUE), env = .CheckExEnv)
> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
> options(warn = 1)    
> library('concord')
> 
> assign(".oldSearch", search(), env = .CheckExEnv)
> assign(".oldNS", loadedNamespaces(), env = .CheckExEnv)
> cleanEx(); ..nameEx <- "cohen.kappa"
> 
> ### * cohen.kappa
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: cohen.kappa
> ### Title: kappa reliability coefficient for nominal data
> ### Aliases: cohen.kappa
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # the "C" data from Krippendorff
>  nmm<-matrix(c(1,1,NA,1,2,2,3,2,3,3,3,3,3,3,3,3,2,2,2,2,1,2,3,4,4,4,4,4,
+  1,1,2,1,2,2,2,2,NA,5,5,5,NA,NA,1,1,NA,NA,3,NA),nrow=4)
>  # first show the score to count transformation, remembering that
>  # Krippendorff's data is classifier by object and must be transposed
>  scores.to.counts(t(nmm))
      1 2 3 4 5
 [1,] 3 0 0 0 0
 [2,] 0 3 1 0 0
 [3,] 0 0 4 0 0
 [4,] 0 0 4 0 0
 [5,] 0 4 0 0 0
 [6,] 1 1 1 1 0
 [7,] 0 0 0 4 0
 [8,] 3 1 0 0 0
 [9,] 0 4 0 0 0
[10,] 0 0 0 0 3
[11,] 2 0 0 0 0
[12,] 0 0 1 0 0
>  # now calculate kappa - note that Cohen's method does not work with NAs
>  cohen.kappa(t(nmm),"score")
Different row sums, a no-classification category was added.

Can't use Cohen's method with NAs
Kappa test for nominally classified data
6 categories - 4 methods
kappa (Siegel) = 0.567568 , Z = 9.24962 , p = 0 
kappa (2*PA-1) = 0.305556 

> 
> 
> 
> cleanEx(); ..nameEx <- "coincidence.matrix"
> 
> ### * coincidence.matrix
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: coincidence.matrix
> ### Title: calculate the concordance/discordance matrix for Krippendorff's
> ###   alpha
> ### Aliases: coincidence.matrix
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # the "C" data from Krippendorff
>  nmm<-matrix(c(1,1,NA,1,2,2,3,2,3,3,3,3,3,3,3,3,2,2,2,2,1,2,3,4,4,4,4,4,
+  1,1,2,1,2,2,2,2,NA,5,5,5,NA,NA,1,1,NA,NA,3,NA),nrow=4)
>  coincidence.matrix(nmm)
$statistic
[1] NA

$coincidence.matrix
          [,1]       [,2]      [,3]      [,4] [,5]
[1,] 7.0000000  1.3333333 0.3333333 0.3333333    0
[2,] 1.3333333 10.0000000 1.3333333 0.3333333    0
[3,] 0.3333333  1.3333333 8.0000000 0.3333333    0
[4,] 0.3333333  0.3333333 0.3333333 4.0000000    0
[5,] 0.0000000  0.0000000 0.0000000 0.0000000    3

$data.values
[1] "1" "2" "3" "4" "5"

$nmatchval
[1] 40

$data.level
[1] NA

> 
> 
> 
> cleanEx(); ..nameEx <- "kendall.w"
> 
> ### * kendall.w
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: kendall.w
> ### Title: Kendall's W coefficient of concordance
> ### Aliases: kendall.w
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # fictional rankings of job applicants
>  app.mat<-matrix(c(1,3,4,2,6,5,2,4,3,1,5,6,3,2,5,1,5,4),nrow=3,byrow=TRUE)
>  # Test the hypothesis that the first three applicants are ranked higher
>  # than the last three.
>  lambda<-c(1,1,1,-1,-1,-1)
>  print(kendall.w(app.mat,lambda))

Kendall's W for ordinal data
W = 0.801282  p(table)  <0.01 

Contrasts
  1   2   3   4   5   6       Z
  1   1   1  -1  -1  -1       0.713 

> 
> 
> 
> cleanEx(); ..nameEx <- "kripp.alpha"
> 
> ### * kripp.alpha
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: kripp.alpha
> ### Title: calculate Krippendorff's alpha reliability coefficient
> ### Aliases: kripp.alpha
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # the "C" data from Krippendorff
>  nmm<-matrix(c(1,1,NA,1,2,2,3,2,3,3,3,3,3,3,3,3,2,2,2,2,1,2,3,4,4,4,4,4,
+  1,1,2,1,2,2,2,2,NA,5,5,5,NA,NA,1,1,NA,NA,3,NA),nrow=4)
>  # first assume the default nominal classification
>  kripp.alpha(nmm)

Krippendorff's alpha (data level - nominal) = 0.743421 

>  # now use the same data with the other three methods
>  kripp.alpha(nmm,"ordinal")

Krippendorff's alpha (data level - ordinal) = 0.8153875 

>  kripp.alpha(nmm,"interval")

Krippendorff's alpha (data level - interval) = 0.8491071 

>  kripp.alpha(nmm,"ratio") 

Krippendorff's alpha (data level - ratio) = 0.7974028 

> 
> 
> 
> cleanEx(); ..nameEx <- "mcnemar"
> 
> ### * mcnemar
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: mcnemar.mh
> ### Title: 2 way reliability coefficient for nominal data
> ### Aliases: mcnemar.mh
> ### Keywords: misc
> 
> ### ** Examples
> 
>  xt<-table(sample(0:1,50,TRUE),sample(0:1,50,TRUE))
>  mcnemar.mh(xt)
$statistic
[1] 2

$p
[1] 0.1572992

> 
> 
> 
> cleanEx(); ..nameEx <- "page.trend.test"
> 
> ### * page.trend.test
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: page.trend.test
> ### Title: Page test for ordered alternatives
> ### Aliases: page.trend.test
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # Craig's data from Siegel & Castellan, p 186
>  soa.mat<-matrix(c(.797,.873,.888,.923,.942,.956,
+   .794,.772,.908,.982,.946,.913,
+   .838,.801,.853,.951,.883,.837,
+   .815,.801,.747,.859,.887,.902),nrow=4,byrow=TRUE)
>  page.trend.test(soa.mat)
[1] 321 331 341
$ranks
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    2    3    4    5    6
[2,]    2    1    3    6    5    4
[3,]    3    1    4    6    5    2
[4,]    3    2    1    4    5    6

$mean.ranks
[1] 2.25 1.50 2.75 5.00 5.00 4.50

$L
[1] 342

$p.table
[1] "<=.001"

$Z
[1] NA

$pZ
[1] NA

> 
> 
> 
> cleanEx(); ..nameEx <- "rater.bias"
> 
> ### * rater.bias
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: rater.bias
> ### Title: coefficient of rater bias
> ### Aliases: rater.bias
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # fake a 2xn matrix of three way classification scores
>  ratings<-matrix(sample(1:3,60,TRUE),nrow=2)
>  rater.bias(ratings)
   
    1 2 3
  1 2 5 1
  2 4 2 4
  3 2 7 3
$statistic
[1] 0.3913043

$p
[1] 0.5316146

> 
> 
> 
> cleanEx(); ..nameEx <- "scores.to.counts"
> 
> ### * scores.to.counts
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: scores.to.counts
> ### Title: transform a score matrix to a count matrix
> ### Aliases: scores.to.counts
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # the "C" data from Krippendorff
>  nmm<-matrix(c(1,1,NA,1,2,2,3,2,3,3,3,3,3,3,3,3,2,2,2,2,1,2,3,4,4,4,4,4,
+  1,1,2,1,2,2,2,2,NA,5,5,5,NA,NA,1,1,NA,NA,3,NA),nrow=4)
>  # remember to transpose the data to the expected format
>  scores.to.counts(t(nmm))
      1 2 3 4 5
 [1,] 3 0 0 0 0
 [2,] 0 3 1 0 0
 [3,] 0 0 4 0 0
 [4,] 0 0 4 0 0
 [5,] 0 4 0 0 0
 [6,] 1 1 1 1 0
 [7,] 0 0 0 4 0
 [8,] 3 1 0 0 0
 [9,] 0 4 0 0 0
[10,] 0 0 0 0 3
[11,] 2 0 0 0 0
[12,] 0 0 1 0 0
> 
> 
> 
> cleanEx(); ..nameEx <- "stuart.maxwell"
> 
> ### * stuart.maxwell
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: stuart.maxwell.mh
> ### Title: between rater concordance coefficient for classification
> ### Aliases: stuart.maxwell.mh
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # fake a 2xn matrix of three way classification scores
>  ratings<-matrix(sample(1:3,60,TRUE),nrow=2)
>  stuart.maxwell.mh(ratings)
$statistic
          [,1]
[1,] 0.8181818

$p
          [,1]
[1,] 0.3657123

$df
[1] 1

attr(,"class")
[1] "stewart.maxwell"
> 
> 
> 
> cleanEx(); ..nameEx <- "wtpc"
> 
> ### * wtpc
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: wtpc
> ### Title: calculate weighted percentages for nominal classification data
> ### Aliases: wtpc
> ### Keywords: misc
> 
> ### ** Examples
> 
>  # the "C" data from Krippendorff
>  nmm<-matrix(c(1,1,NA,1,2,2,3,2,3,3,3,3,3,3,3,3,2,2,2,2,1,2,3,4,4,4,4,4,
+  1,1,2,1,2,2,2,2,NA,5,5,5,NA,NA,1,1,NA,NA,3,NA),nrow=4)
>  # Krippendorff's data is classifier by object and must be transposed
>  wtpc(t(nmm),4,12,"score")
       1        2        3        4        5 
18.75000 27.08333 22.91667 10.41667  6.25000 
> 
> 
> 
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", env = .CheckExEnv),"\n")
Time elapsed:  0.21 0 0.21 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')