duplicated.R 4.61 KB
Newer Older
1
#  File src/library/base/R/duplicated.R
2
#  Part of the R package, https://www.R-project.org
3
#
4
#  Copyright (C) 1995-2014 The R Core Team
5
#
6 7 8 9 10 11 12 13 14 15 16
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
17
#  https://www.R-project.org/Licenses/
18

19
duplicated <- function(x, incomparables = FALSE, ...) UseMethod("duplicated")
20

21 22 23 24
duplicated.default <-
    function(x, incomparables = FALSE, fromLast = FALSE, nmax = NA, ...)
    .Internal(duplicated(x, incomparables, fromLast,
                         if(is.factor(x)) min(length(x), nlevels(x) + 1L) else nmax))
25

26 27
duplicated.data.frame <-
    function(x, incomparables = FALSE, fromLast = FALSE, ...)
28
{
29
    if(!isFALSE(incomparables))
30
	.NotYetUsed("incomparables != FALSE")
31
    if(length(x) != 1L)
32
        duplicated(do.call(Map, `names<-`(c(list, x), NULL)), fromLast = fromLast)
33
    else duplicated(x[[1L]], fromLast = fromLast, ...)
34 35
}

36
duplicated.matrix <- duplicated.array <-
37
    function(x, incomparables = FALSE, MARGIN = 1L, fromLast = FALSE, ...)
38
{
39
    if(!isFALSE(incomparables))
40
	.NotYetUsed("incomparables != FALSE")
41 42
    dx <- dim(x)
    ndim <- length(dx)
43
    if (length(MARGIN) > ndim || any(MARGIN > ndim))
44 45
        stop(gettextf("MARGIN = %d is invalid for dim = %d", MARGIN, dx),
             domain = NA)
46 47 48
    temp <- if((ndim > 1L) && (prod(dx[-MARGIN]) > 1L))
                apply(x, MARGIN, list)
            else x
49
    res <- duplicated.default(temp, fromLast = fromLast, ...)
50 51 52 53 54
    dim(res) <- dim(temp)
    dimnames(res) <- dimnames(temp)
    res
}

55 56
anyDuplicated <- function(x, incomparables = FALSE, ...)
    UseMethod("anyDuplicated")
57

58 59
anyDuplicated.default <-
    function(x, incomparables = FALSE, fromLast = FALSE, ...)
60 61
    .Internal(anyDuplicated(x, incomparables, fromLast))

62 63 64

anyDuplicated.data.frame <-
    function(x, incomparables = FALSE, fromLast = FALSE, ...)
65
{
66
    if(!isFALSE(incomparables))
67
	.NotYetUsed("incomparables != FALSE")
68
    anyDuplicated(do.call(Map, `names<-`(c(list, x), NULL)), fromLast = fromLast)
69 70 71 72 73
}

anyDuplicated.matrix <- anyDuplicated.array <-
    function(x, incomparables = FALSE, MARGIN = 1L, fromLast = FALSE, ...)
{
74
    if(!isFALSE(incomparables))
75
	.NotYetUsed("incomparables != FALSE")
76 77
    dx <- dim(x)
    ndim <- length(dx)
78
    if (length(MARGIN) > ndim || any(MARGIN > ndim))
79 80
        stop(gettextf("MARGIN = %d is invalid for dim = %d", MARGIN, dx),
             domain = NA)
81 82 83
    temp <- if((ndim > 1L) && (prod(dx[-MARGIN]) > 1L))
                apply(x, MARGIN, list)
            else x
84
    anyDuplicated.default(temp, fromLast = fromLast)
85 86
}

87 88
unique <- function(x, incomparables = FALSE, ...) UseMethod("unique")

89

90 91
## NB unique.default is used by factor to avoid unique.matrix,
## so it needs to handle some other cases.
92 93
unique.default <-
    function(x, incomparables = FALSE, fromLast = FALSE, nmax = NA, ...)
94
{
95 96 97 98 99 100 101 102
    if(is.factor(x)) {
        z <- .Internal(unique(x, incomparables, fromLast,
                              min(length(x), nlevels(x) + 1L)))
 	return(factor(z, levels = seq_len(nlevels(x)), labels = levels(x),
               ordered = is.ordered(x)))
    }
    z <- .Internal(unique(x, incomparables, fromLast, nmax))
    if(inherits(x, "POSIXct"))
103 104 105
        structure(z, class = class(x), tzone = attr(x, "tzone"))
    else if(inherits(x, "Date"))
        structure(z, class = class(x))
106
    else z
107 108
}

109
unique.data.frame <- function(x, incomparables = FALSE, fromLast = FALSE, ...)
110
{
111
    if(!isFALSE(incomparables))
112
	.NotYetUsed("incomparables != FALSE")
113
    x[!duplicated(x, fromLast = fromLast, ...),  , drop = FALSE]
114
}
115 116

unique.matrix <- unique.array <-
117
    function(x, incomparables = FALSE , MARGIN = 1, fromLast = FALSE, ...)
118
{
119
    if(!isFALSE(incomparables))
120
	.NotYetUsed("incomparables != FALSE")
121 122 123
    dx <- dim(x)
    ndim <- length(dx)
    if (length(MARGIN) > ndim || any(MARGIN > ndim))
124 125
        stop(gettextf("MARGIN = %d is invalid for dim = %d", MARGIN, dx),
             domain = NA)
126 127 128
    temp <- if((ndim > 1L) && (prod(dx[-MARGIN]) > 1L))
                apply(x, MARGIN, list)
            else x
129 130
    args <- rep(alist(a=), ndim)
    names(args) <- NULL
131 132
    args[[MARGIN]] <- !duplicated.default(temp, fromLast = fromLast, ...)
    do.call("[", c(list(x), args, list(drop = FALSE)))
133
}