Skip to content
This repository was archived by the owner on Jul 23, 2024. It is now read-only.

Commit 381a42f

Browse files
author
Arno Coomans
committedJul 4, 2019
[LE-787] Fix for the R_rapriori bug in arules
1 parent 8eebc43 commit 381a42f

14 files changed

+47
-44
lines changed
 

‎R/apriori.R

+3-2
Original file line numberDiff line numberDiff line change
@@ -53,15 +53,16 @@ apriori <- function(data, parameter = NULL, appearance = NULL, control = NULL)
5353
}
5454

5555
## call apriori
56-
result <- .Call(R_rapriori,
56+
result <- .Call("R_rapriori",
5757
## transactions
5858
items@p,
5959
items@i,
6060
items@Dim,
6161
## parameter
6262
parameter, control,
6363
appearance,
64-
data@itemInfo)
64+
data@itemInfo,
65+
PACKAGE = "arules")
6566

6667
## add some reflectance
6768
call <- match.call()

‎R/crossTable.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ setMethod("crossTable", signature(x = "itemMatrix"),
2929

3030
measure <- match.arg(measure)
3131

32-
m <- .Call(R_crosstab_ngCMatrix, x@data, NULL, TRUE)
32+
m <- .Call("R_crosstab_ngCMatrix", x@data, NULL, TRUE, PACKAGE = "arules")
3333
if (is.null(dimnames(m)))
3434
dimnames(m) <- list(itemLabels(x), itemLabels(x))
3535

‎R/eclat.R

+3-2
Original file line numberDiff line numberDiff line change
@@ -59,14 +59,15 @@ eclat <- function(data, parameter = NULL, control = NULL)
5959
}
6060

6161
## call eclat
62-
result <- .Call(R_reclat,
62+
result <- .Call("R_reclat",
6363
## transactions
6464
items@p,
6565
items@i,
6666
items@Dim,
6767
## parameter
6868
parameter, control,
69-
data@itemInfo)
69+
data@itemInfo,
70+
PACKAGE = "arules")
7071

7172
## validate sparse Matrix (this takes care of sorting vector i)
7273
validObject(result@items@data)

‎R/interestMeasures.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -313,14 +313,14 @@ setMethod("interestMeasure", signature(x = "rules"),
313313
imp <- numeric(length(x))
314314

315315
### do it by unique rhs
316-
rr <- .Call(R_pnindex, rhs(x)@data, NULL, FALSE)
316+
rr <- .Call("R_pnindex", rhs(x)@data, NULL, FALSE, PACKAGE = "arules")
317317

318318
for(r in unique(rr)) {
319319
pos <- which(rr==r)
320320

321321
q2 <- q[pos]
322322
### FALSE is for verbose
323-
qsubmax <- .Call(R_pnmax, lhs(x[pos])@data, q2, FALSE)
323+
qsubmax <- .Call("R_pnmax", lhs(x[pos])@data, q2, FALSE, PACKAGE = "arules")
324324

325325
imp[pos] <- q2 - qsubmax
326326
}

‎R/is.closed.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,8 @@ setMethod("is.closed", signature(x = "itemsets"),
4444
## since R_pnclosed only supports abs. support counts
4545
size <- x@info$ntransactions
4646
if (!is.null(size))
47-
isclosed <- .Call(R_pnclosed, x@items@data,
48-
as.integer(support * size), FALSE)
47+
isclosed <- .Call("R_pnclosed", x@items@data,
48+
as.integer(support * size), FALSE, PACKAGE = "arules")
4949
else {
5050
cat("legacy approach can take a while ...\n")
5151

‎R/is.maximal.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ setMethod("is.maximal", signature(x = "itemMatrix"),
2424
function(x) {
2525
##
2626
u <- unique(x)
27-
m <- .Call(R_pncount, u@data, u@data, TRUE, TRUE, FALSE) == 1
27+
m <- .Call("R_pncount", u@data, u@data, TRUE, TRUE, FALSE, PACKAGE = "arules") == 1
2828
i <- match(x, u)
2929
m[i]
3030
})

‎R/is.superset.R

+3-3
Original file line numberDiff line numberDiff line change
@@ -51,8 +51,8 @@ setMethod("is.subset", signature(x = "itemMatrix"),
5151

5252
if(sparse) return(.is.subset_sparse(x, y, proper))
5353

54-
if (is.null(y)) m <- .Call(R_crosstab_ngCMatrix, x@data, NULL, FALSE)
55-
else m <- .Call(R_crosstab_ngCMatrix, x@data, y@data, FALSE)
54+
if (is.null(y)) m <- .Call("R_crosstab_ngCMatrix", x@data, NULL, FALSE, PACKAGE = "arules")
55+
else m <- .Call("R_crosstab_ngCMatrix", x@data, y@data, FALSE, PACKAGE = "arules")
5656

5757
m <- m == size(x)
5858

@@ -81,7 +81,7 @@ setMethod("is.subset", signature(x = "associations"),
8181
if(is.null(y)) y <- x
8282

8383
p <- as.integer(rep(0, x@data@Dim[2]+1))
84-
i <- .Call(R_is_subset, x@data@p, x@data@i, x@data@Dim,
84+
i <- .Call("R_is_subset", x@data@p, x@data@i, x@data@Dim,
8585
y@data@p, y@data@i, y@data@Dim,
8686
as.logical(proper), p, PACKAGE = "arules")
8787

‎R/itemCoding.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ setMethod("recode", signature(x = "itemMatrix"),
114114

115115
## recode items
116116
if (any(k != seq(length(k))))
117-
x@data <- .Call(R_recode_ngCMatrix, x@data, k)
117+
x@data <- .Call("R_recode_ngCMatrix", x@data, k, PACKAGE = "arules")
118118

119119
## enlarge
120120
if (x@data@Dim[1] < length(itemLabels))

‎R/itemFrequency.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -37,14 +37,14 @@ setMethod("itemFrequency", signature(x = "itemMatrix"),
3737
stop("transactions do not contain weights. Add a weight column to transactionInfo.")
3838

3939
weight <- as.numeric(transactionInfo(x)[["weight"]])
40-
support <- .Call(R_rowWSums_ngCMatrix, x@data, weight)
40+
support <- .Call("R_rowWSums_ngCMatrix", x@data, weight, PACKAGE = "arules")
4141
total <- sum(weight)
4242

4343
}else {
4444
## we could also use rowSums
4545
##support <- tabulate(x@data@i + 1L, nbins = x@data@Dim[1])
4646

47-
support <- .Call(R_rowSums_ngCMatrix, x@data)
47+
support <- .Call("R_rowSums_ngCMatrix", x@data, PACKAGE = "arules")
4848
total <- length(x)
4949
}
5050

‎R/itemMatrix.R

+11-11
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ setMethod("size", signature(x = "itemMatrix"),
4646
## diff(x@data@p) is nearly as fast as colSums(x@data).
4747

4848
## FIXME: Add transactionID or itemsetID as names
49-
cnt <- .Call(R_colSums_ngCMatrix, x@data)
49+
cnt <- .Call("R_colSums_ngCMatrix", x@data, PACKAGE = "arules")
5050
cnt
5151
}
5252
)
@@ -134,11 +134,11 @@ setAs("itemMatrix", "list",
134134
setMethod("LIST", signature(from = "itemMatrix"),
135135
function(from, decode = TRUE) {
136136
if (decode) {
137-
to <- .Call(R_asList_ngCMatrix, from@data, itemLabels(from))
137+
to <- .Call("R_asList_ngCMatrix", from@data, itemLabels(from), PACKAGE = "arules")
138138
names(to) <- itemsetInfo(from)[["itemsetID"]]
139139
to
140140
} else
141-
.Call(R_asList_ngCMatrix, from@data, NULL)
141+
.Call("R_asList_ngCMatrix", from@data, NULL, PACKAGE = "arules")
142142
}
143143
)
144144

@@ -291,7 +291,7 @@ setMethod("[", signature(x = "itemMatrix", i = "ANY", j = "ANY", drop = "ANY"),
291291

292292
i <- .translate_index(i, rownames(x), nrow(x))
293293
## faster than: x@data <- x@data[,i, drop=FALSE]
294-
x@data <- .Call(R_colSubset_ngCMatrix, x@data, i)
294+
x@data <- .Call("R_colSubset_ngCMatrix", x@data, i, PACKAGE = "arules")
295295

296296
### only subset if we have rows
297297
if(nrow(x@itemsetInfo)) x@itemsetInfo <- x@itemsetInfo[i,, drop = FALSE]
@@ -311,7 +311,7 @@ setMethod("[", signature(x = "itemMatrix", i = "ANY", j = "ANY", drop = "ANY"),
311311

312312
j <- .translate_index(j, colnames(x), ncol(x))
313313
## faster than: x@data <- x@data[j,, drop=FALSE]
314-
x@data <- .Call(R_rowSubset_ngCMatrix, x@data, j)
314+
x@data <- .Call("R_rowSubset_ngCMatrix", x@data, j, PACKAGE = "arules")
315315

316316
x@itemInfo <- x@itemInfo[j,, drop = FALSE]
317317
}
@@ -341,12 +341,12 @@ setMethod("c", signature(x = "itemMatrix"),
341341
y@itemInfo[n,, drop = FALSE])
342342
}
343343
if (any(k != seq_len(length(k))))
344-
y@data <- .Call(R_recode_ngCMatrix, y@data, k)
344+
y@data <- .Call("R_recode_ngCMatrix", y@data, k, PACKAGE = "arules")
345345
if (y@data@Dim[1] < x@data@Dim[1])
346346
y@data@Dim[1] <- x@data@Dim[1]
347347

348348
## this is faste than x@data <- cbind(x@data, y@data)
349-
x@data <- .Call(R_cbind_ngCMatrix, x@data, y@data)
349+
x@data <- .Call("R_cbind_ngCMatrix", x@data, y@data, PACKAGE = "arules")
350350
}
351351
validObject(x, complete = TRUE)
352352
x
@@ -360,7 +360,7 @@ setMethod("merge", signature(x="itemMatrix"),
360360
if(nrow(x)!=nrow(y)) stop("The number of rows in x and y do not conform!")
361361

362362
## this is faster than dc <- rbind(x@data, y@data)
363-
dc <- t(.Call(R_cbind_ngCMatrix, t(x@data), t(y@data)))
363+
dc <- t(.Call("R_cbind_ngCMatrix", t(x@data), t(y@data)), PACKAGE = "arules")
364364

365365
## fix itemInfo
366366
iix <- itemInfo(x)
@@ -383,7 +383,7 @@ setMethod("merge", signature(x="itemMatrix"),
383383
setMethod("duplicated", signature(x = "itemMatrix"),
384384
function(x, incomparables = FALSE) {
385385
## use a prefix tree
386-
i <- .Call(R_pnindex, x@data, NULL, FALSE)
386+
i <- .Call("R_pnindex", x@data, NULL, FALSE, PACKAGE = "arules")
387387
duplicated(i)
388388
}
389389
)
@@ -403,10 +403,10 @@ setMethod("match", signature(x = "itemMatrix", table = "itemMatrix"),
403403
table@data@Dim[1] <- table@data@Dim[1] + length(n)
404404
}
405405
if (any(k != seq_len(length(k))))
406-
x@data <- .Call(R_recode_ngCMatrix, x@data, k)
406+
x@data <- .Call("R_recode_ngCMatrix", x@data, k, PACKAGE = "arules")
407407
if (x@data@Dim[1] < table@data@Dim[1])
408408
x@data@Dim[1] <- table@data@Dim[1]
409-
i <- .Call(R_pnindex, table@data, x@data, FALSE)
409+
i <- .Call("R_pnindex", table@data, x@data, FALSE, PACKAGE = "arules")
410410
match(i, seq_len(length(table)), nomatch = nomatch,
411411
incomparables = incomparables)
412412
}

‎R/ruleInduction.R

+3-3
Original file line numberDiff line numberDiff line change
@@ -180,7 +180,7 @@ ruleInduction.apriori <- function(x, transactions, confidence = 0.8,
180180

181181
ruleInduction.tidlists <- function(x, transactions, confidence = 0.8, verbose = FALSE) {
182182
tid <- as(transactions, "tidLists")
183-
data <- .Call(R_tid_rules ,tid@data, x@items@data)
183+
data <- .Call("R_tid_rules" ,tid@data, x@items@data, PACKAGE = "arules")
184184
names(data) <- c("support", "confidence",
185185
"lhs_i", "lhs_p", "rhs_i", "rhs_p", "Dim")
186186

@@ -202,7 +202,7 @@ ruleInduction.tidlists <- function(x, transactions, confidence = 0.8, verbose =
202202

203203
ruleInduction.ptree <-
204204
function(x, transactions, confidence = 0.8, reduce = FALSE, verbose = FALSE) {
205-
r <- .Call(R_pncount, x@items@data, transactions@data, FALSE, reduce, verbose)
205+
r <- .Call("R_pncount", x@items@data, transactions@data, FALSE, reduce, verbose, PACKAGE = "arules")
206206

207207
names(r) <- c("data.lhs","data.rhs","support","confidence","lift", "itemset")
208208

@@ -228,7 +228,7 @@ function(x, confidence = 0.8, verbose = FALSE) {
228228
if (is.null(quality(x)$support))
229229
stop("cannot induce rules because support is missing! Specify transactions.")
230230

231-
r <- data.frame(.Call(R_pnrindex, x@items@data, verbose))
231+
r <- data.frame(.Call("R_pnrindex", x@items@data, verbose, PACKAGE = "arules"))
232232
names(r) <- c("i", "li", "ri")
233233

234234
if (!all(r$li) || !all(r$ri))

‎R/support.R

+5-5
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ setMethod("support", signature(x = "itemMatrix"),
5858
}
5959
if (any(k != seq_len(length(k))))
6060
transactions@data <-
61-
.Call(R_recode_ngCMatrix, transactions@data, k)
61+
.Call("R_recode_ngCMatrix", transactions@data, k, PACKAGE = "arules")
6262
if (transactions@data@Dim[1] < x@data@Dim[1])
6363
transactions@data@Dim[1] <- x@data@Dim[1]
6464

@@ -116,7 +116,7 @@ support.tidlists <- function(x, transactions, control = NULL) {
116116

117117
tid <- as(transactions, "tidLists")
118118

119-
support <- .Call(R_tid_support ,tid@data, x@data)
119+
support <- .Call("R_tid_support" ,tid@data, x@data, PACKAGE = "arules")
120120

121121
#names(supports) <- labels(x)
122122
support
@@ -126,17 +126,17 @@ support.ptree <- function(x, transactions, control = NULL) {
126126
reduce <- if(is.null(control$r)) FALSE else control$r
127127
verbose <- if(is.null(control$v)) FALSE else control$v
128128

129-
.Call(R_pncount, x@data, transactions@data, TRUE, reduce, verbose)
129+
.Call("R_pncount", x@data, transactions@data, TRUE, reduce, verbose, PACKAGE = "arules")
130130
}
131131

132132
support.weighted <- function(x, transactions, control = NULL) {
133133
verbose <- if(is.null(control$v)) FALSE else control$v
134134
weights <- as.numeric(transactionInfo(transactions)[["weight"]])
135135

136-
.Call(R_wcount_ngCMatrix, x@data,
136+
.Call("R_wcount_ngCMatrix", x@data,
137137
#t(transactions@data),
138138
selectMethod("t", class(transactions@data))(transactions@data),
139-
weights, NULL, NULL, verbose)
139+
weights, NULL, NULL, verbose, PACKAGE = "arules")
140140
}
141141

142142
## wrapper method for associations

‎R/tidLists.R

+6-6
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ setMethod("length", signature(x = "tidLists"),
6868

6969
## produces a vector of element sizes
7070
setMethod("size", signature(x = "tidLists"),
71-
function(x) .Call(R_colSums_ngCMatrix, x@data))
71+
function(x) .Call("R_colSums_ngCMatrix", x@data, PACKAGE = "arules"))
7272

7373
##*******************************************************
7474
## show/summary
@@ -143,7 +143,7 @@ setMethod("c", signature(x = "tidLists"),
143143

144144
if(ncol(x) != ncol(y)) stop("transactions not conforming.")
145145

146-
dat <- .Call(R_cbind_ngCMatrix, dat, y@data)
146+
dat <- .Call("R_cbind_ngCMatrix", dat, y@data, PACKAGE = "arules")
147147
itemI <- rbind(itemI, itemInfo(y))
148148
}
149149

@@ -167,7 +167,7 @@ setMethod("[", signature(x = "tidLists", i = "ANY", j = "ANY", drop = "ANY"),
167167
}
168168

169169
i <- .translate_index(i, rownames(x), nrow(x))
170-
x@data <- .Call(R_colSubset_ngCMatrix, x@data, i)
170+
x@data <- .Call("R_colSubset_ngCMatrix", x@data, i, PACKAGE = "arules")
171171

172172
x@itemInfo <- x@itemInfo[i,, drop = FALSE]
173173
}
@@ -180,7 +180,7 @@ setMethod("[", signature(x = "tidLists", i = "ANY", j = "ANY", drop = "ANY"),
180180
}
181181

182182
j <- .translate_index(j, colnames(x), ncol(x))
183-
x@data <- .Call(R_rowSubset_ngCMatrix, x@data, j)
183+
x@data <- .Call("R_rowSubset_ngCMatrix", x@data, j, PACKAGE = "arules")
184184

185185
x@transactionInfo <- x@transactionInfo[j,, drop = FALSE]
186186
}
@@ -202,11 +202,11 @@ setMethod("LIST", signature(from = "tidLists"),
202202
i <- from@transactionInfo[["transactionID"]]
203203
if (!is.null(i))
204204
i <- as.character(i)
205-
to <- .Call(R_asList_ngCMatrix, from@data, i)
205+
to <- .Call("R_asList_ngCMatrix", from@data, i, PACKAGE = "arules")
206206
names(to) <- from@itemInfo[["labels"]]
207207
to
208208
} else
209-
.Call(R_asList_ngCMatrix, from@data, NULL)
209+
.Call("R_asList_ngCMatrix", from@data, NULL, PACKAGE = "arules")
210210
}
211211
)
212212

‎R/warm.R

+4-3
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ hits <- function(data, iter = 16L, tol = NULL,
2828
data <- as(data, "transactions")
2929
type <- match.arg(type)
3030

31-
r <- .Call(R_hits_ngCMatrix, data@data, iter, tol, verbose)
31+
r <- .Call("R_hits_ngCMatrix", data@data, iter, tol, verbose, PACKAGE = "arules")
3232
names(r) <- transactionInfo(data)[["transactionID"]]
3333

3434
switch(type,
@@ -70,11 +70,12 @@ weclat <- function(data, parameter = NULL, control = NULL) {
7070
}
7171
## r <- .Call(R_transpose_ngCMatrix, data@data)
7272
r <- selectMethod("t", class(data@data))(data@data)
73-
r <- .Call(R_weclat_ngCMatrix, r, weight,
73+
r <- .Call("R_weclat_ngCMatrix", r, weight,
7474
parameter@support,
7575
parameter@minlen,
7676
parameter@maxlen,
77-
control@verbose)
77+
control@verbose,
78+
PACKAGE = "arules")
7879
names(r) <- c("data", "support")
7980
validObject(r$data)
8081

0 commit comments

Comments
 (0)
This repository has been archived.