Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commita14e61c

Browse files
0.99.60.21
1 parentd95d1e7 commita14e61c

File tree

5 files changed

+207
-14
lines changed

5 files changed

+207
-14
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: DescTools
22
Type: Package
33
Title: Tools for Descriptive Statistics
4-
Version: 0.99.60.20
5-
Date: 2025-08-12
4+
Version: 0.99.60.21
5+
Date: 2025-08-14
66
Authors@R: c(
77
person(given="Andri", family="Signorell",
88
email = "andri@signorell.net",

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -423,3 +423,5 @@ S3method(ToBaseR, tbl_df)
423423
S3method(ToBaseR, haven_labelled)
424424
S3method(ToBaseR, default)
425425

426+
S3method(Agree, formula)
427+
S3method(Agree, default)

‎NEWS‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,8 @@ UPDATED FUNCTIONS:
2525
base R (as ansari.test or kruskal.test). lm-interface has been defunct.
2626
* Format() looses the two predefined formats for displaying confidence
2727
intervals, fmt="ci" and fmt="ci%".
28-
* Agree has been fundamentally rewritten to act more robust depending
29-
on the structure of the provideddata.
28+
* Agree has been fundamentally rewritten to act more robust. It also got
29+
a much more sophisticated interface for differentdata structures.
3030

3131

3232
BUGFIXES:
@@ -48,7 +48,7 @@ BUGFIXES:
4848

4949
DEFUNCT:
5050
* OddsRatio.multinom() has been moved to the package ModTools, where it
51-
better fits.
51+
better fits in.
5252
* ReadSPSS() has been replaced by ToBaseR(), which is more general.
5353

5454

‎R/Agree.R‎

Lines changed: 125 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -32,14 +32,135 @@
3232

3333

3434

35-
Agree<-function(x,grp=NULL,tolerance=0,na.rm=FALSE){
35+
36+
.LongToSquare<-function (formula,data,subset,na.action,...) {
37+
38+
# returns a 2-dim matrix of a subject-rater-rating formula
39+
40+
# originally based on: stats:::friedman.test.formula
41+
42+
if (missing(formula))
43+
stop("formula missing")
44+
45+
if ((length(formula)!=3L)||
46+
(length(formula[[3L]])!=3L)||
47+
(formula[[3L]][[1L]]!= as.name("|"))||
48+
(length(formula[[3L]][[2L]])!=1L)||
49+
(length(formula[[3L]][[3L]])!=1L))
50+
stop("incorrect specification for 'formula'")
51+
52+
formula[[3L]][[1L]]<- as.name("+")
53+
54+
m<- match.call(expand.dots=FALSE)
55+
m$formula<-formula
56+
if (is.matrix(eval(m$data, parent.frame())))
57+
m$data<- as.data.frame(data)
58+
59+
m[[1L]]<- quote(stats::model.frame)
60+
mf<- eval(m, parent.frame())
61+
62+
DNAME<- gettextf("%s by %s (rows) and %s (columns)",
63+
names(mf)[1], names(mf)[2], names(mf)[3])
64+
65+
# result of base test
66+
# y <- friedman.test(mf[[1L]], mf[[2L]], mf[[3L]])
67+
68+
# now reshaping to matrix form
69+
m<- reshape(mf,idvar=colnames(mf)[2],timevar=colnames(mf)[3],
70+
direction="wide")
71+
72+
# get better order for rows and columns
73+
m<-m[order(m[,1]), ]
74+
m<- cbind(m[,1,drop=FALSE],m[,-1][, order(colnames(m)[-1])])
75+
# remove response variable part from columnnames
76+
colnames(m)<- gsub(gettextf("%s\\.", names(mf)[1]),"", colnames(m))
77+
rownames(m)<-NULL
78+
79+
if(!is.null(na.action))
80+
m<- na.action(m)
81+
82+
attr(m,"data.name")<-DNAME
83+
84+
return(m)
85+
86+
}
87+
88+
89+
Agree<-function(x,...) {
90+
UseMethod("Agree")
91+
}
92+
93+
94+
Agree.formula<-function(formula,data,subset,na.action,...){
95+
96+
# returns a 2-dim matrix of a subject-rater-rating formula
97+
98+
# originally based on: stats:::friedman.test.formula
99+
100+
if (missing(formula))
101+
stop("formula missing")
102+
103+
if ((length(formula)!=3L)||
104+
(length(formula[[3L]])!=3L)||
105+
(formula[[3L]][[1L]]!= as.name("|"))||
106+
(length(formula[[3L]][[2L]])!=1L)||
107+
(length(formula[[3L]][[3L]])!=1L))
108+
stop("incorrect specification for 'formula'")
109+
110+
formula[[3L]][[1L]]<- as.name("+")
111+
112+
m<- match.call(expand.dots=FALSE)
113+
m$formula<-formula
114+
if (is.matrix(eval(m$data, parent.frame())))
115+
m$data<- as.data.frame(data)
116+
117+
m[[1L]]<- quote(stats::model.frame)
118+
# in order to delete potential tolerance or na.rm arguments to be passed
119+
# later on
120+
m$...<-NULL
121+
mf<- eval(m, parent.frame())
122+
123+
DNAME<- gettextf("%s by %s (rows) and %s (columns)",
124+
names(mf)[1], names(mf)[2], names(mf)[3])
125+
126+
# result of base test
127+
# y <- friedman.test(mf[[1L]], mf[[2L]], mf[[3L]])
128+
129+
# now reshaping to matrix form
130+
m<- reshape(mf,idvar=colnames(mf)[2],timevar=colnames(mf)[3],
131+
direction="wide")
132+
133+
# get better order for rows and columns
134+
m<-m[order(m[,1]), ]
135+
m<- cbind(m[,1,drop=FALSE],m[,-1][, order(colnames(m)[-1])])
136+
# remove response variable part from columnnames
137+
colnames(m)<- gsub(gettextf("%s\\.", names(mf)[1]),"", colnames(m))
138+
rownames(m)<-NULL
139+
140+
if(!missing(na.action)){
141+
subj<-m[, names(mf)[2]]
142+
m<- na.action(m)
143+
}
144+
145+
attr(m,"data.name")<-DNAME
146+
147+
res<- Agree(m[,-1],...)
148+
149+
if(!is.null(attr(m,"na.action"))){
150+
attr(res,"na.action")<-subj[attr(m,"na.action")]
151+
}
152+
153+
return(res)
154+
155+
}
156+
157+
158+
159+
Agree.default<-function(x,tolerance=0,na.rm=FALSE,...){
36160

37161
# coercing to matrix is a good idea, as ratings should be the same type
38162
# for all the raters
39163

40-
if(!is.null(grp))
41-
x<- ToWide(x=x,g=grp)
42-
43164
if(inherits(x,"list"))
44165
x<- do.call(cbind,x)
45166
else

‎man/Agree.Rd‎

Lines changed: 75 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,40 @@
11
\name{Agree}
22
\alias{Agree}
3+
\alias{Agree.default}
4+
\alias{Agree.formula}
5+
36
\title{RawSimpleAndExtendedPercentageAgreement}
47
\description{
58
Computesrawsimpleandextendedpercentageagreementamongraters.
69
}
710
\usage{
8-
Agree(x,grp=NULL,tolerance=0,na.rm=FALSE)
11+
Agree(x,...)
12+
\method{Agree}{formula}(formula,data,subset,na.action, \dots)
13+
\method{Agree}{default}(x,tolerance=0,na.rm=FALSE,...)
14+
915
}
1016
\arguments{
1117
\item{x}{adata.frame,alistora \eqn{k \timesm}{kxm}matrix,k subjects (inrows)m raters (incolumns).
1218
If \code{grp}isprovideditmustbeavaluevectorofsamelength.}
13-
\item{grp}{agroupingvector,ifthisisprovided,xmustbeasuitablevaluevector.}
1419
\item{tolerance}{numberofsuccessiveratingcategoriesthatshouldberegardedasrater agreement (seedetails).}
1520
\item{na.rm}{
16-
logical,indicatingwhether \code{NA}valuesshouldbestrippedbeforethecomputationproceeds.Ifsetto \code{TRUE}onlythecompletecasesoftheratingswillbeused.Defaultsto \code{FALSE}.
17-
%%~~Describe\code{na.rm}here~~
21+
logical,indicatingwhether \code{NA}valuesshouldbestrippedbeforethecomputationproceeds.
22+
Ifsetto \code{TRUE}onlythecompletecasesoftheratingswillbeused.Defaultsto\code{FALSE}.
1823
}
19-
24+
\item{formula}{aformulaoftheform \code{lhs~rhs}where \code{lhs}
25+
givesthedatavaluesand \code{rhs}thecorrespondinggroups.}
26+
\item{data}{anoptionalmatrixordata frame (orsimilar:see
27+
\code{\link{model.frame}})containingthevariablesinthe
28+
formula \code{formula}.Bydefaultthevariablesaretakenfrom
29+
\code{environment(formula)}.}
30+
\item{subset}{anoptionalvectorspecifyingasubsetofobservations
31+
tobeused.}
32+
\item{na.action}{afunctionwhichindicateswhatshouldhappenwhen
33+
thedatacontain \code{NA}s.Defaultsto
34+
\code{getOption("na.action")}.}
2035

36+
\item{\dots}{furtherargumentstobepassedtoorfrommethods.}
37+
2138
}
2239
\details{
2340
Extendedpercentageagreementcanbecalculatedwitha \code{tolerance>0}.Iftoleranceequals1e.g.,
@@ -89,5 +106,58 @@ Agree(exam[, -1], tolerance=1)
89106

90107
# release difference to max 2, we have 2 agreements (2, 4)
91108
Agree(exam[,-1],tolerance=2)
109+
110+
111+
# *********************************************************
112+
# Operating the Formula Interface
113+
114+
# we have 5 subjects and 4 raters (in wide form)
115+
(d.ratings<-data.frame(
116+
subj= c("1","2","3","4","5"),
117+
rtr1= structure(c(1,1,1,1,3),
118+
levels= c("V","N","P"),class="factor"),
119+
rtr2= structure(c(1,2,1,1,3),
120+
levels= c("V","N","P"),class="factor"),
121+
rtr3= structure(c(1,3,1,1,3),
122+
levels= c("V","N","P"),class="factor"),
123+
rtr4= structure(c(1,1,1,1,2),
124+
levels= c("V","N","P"),class="factor")
125+
))
126+
127+
# this structure can be directly send to the function
128+
Agree(d.ratings[,-1])
129+
130+
# or we can coerce to a matrix before (if we want..)
131+
Agree(as.matrix(d.ratings[,-1]))
132+
133+
# but what, when our structure is in long format?
134+
d.long<- reshape(d.ratings,
135+
varying=2:5,
136+
idvar=c("subj"),
137+
times=colnames(d.ratings)[2:5],
138+
v.names="rat",timevar="rater",
139+
direction="long",
140+
new.row.names=seq(prod(dim(d.ratings))))
141+
head(d.long)
142+
143+
# for that we can use the formulat interface
144+
# note the structure: response ~ subjects (rows) | raters (columns)
145+
Agree(rat~subj|rater,d.long)
146+
147+
# but what, when we have missings?
148+
# we leave out rtr1's rating for subj 2
149+
150+
# if we do nothing, we clearly get NA
151+
Agree(rat~subj|rater,d.long[-2,])
152+
153+
# setting na.action to na.omit omits the subject "1"
154+
# as reported in attr(,"na.action"), number of subjects is yet 4
155+
Agree(rat~subj|rater,d.long[-2,],na.action=na.omit)
156+
157+
# setting na.rm only ignores missings, subject 1 remains in the matrix
158+
Agree(rat~subj|rater,d.long[-2,],na.rm=TRUE)
92159
}
160+
161+
162+
93163
\keyword{univar}

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp