1any_dup <- function(x) length(x) && any(duplicated(x@.Data))
2
3which_dup_lab <- function(x){
4    ii <- duplicated(x@.Data)
5    dup_lab <- unique(x@.Data[ii])
6    structure(lapply(dup_lab,get_labs,labels=x@.Data,value=x@values),
7              names=dup_lab)
8}
9
10get_labs <- function(which,labels,values){
11    i <- labels == which
12    values[i]
13}
14
15duplicated_labels <- function(x) UseMethod("duplicated_labels")
16
17duplicated_labels.item <- function(x){
18    l <- labels(x)
19    ii <- duplicated(l@.Data)
20    if(any(ii)){
21        dup_lab <- unique(l@.Data[ii])
22        structure(lapply(dup_lab,
23                         get_labs,
24                         labels=l@.Data,
25                         value=l@values),
26                  names=dup_lab,
27                  class="dupLabelsReport1")
28    }
29    else NULL
30}
31
32print.dupLabelsReport1 <- function(x,...){
33    n <- paste0(names(x),":")
34    l <- sapply(x,paste,collapse=", ")
35    r <- cbind(format(n),format(l))
36    r <- apply(r,1,paste,collapse=" ")
37    writeLines(r)
38}
39
40duplicated_labels.item.list <- function(x){
41    ll <- lapply(as.list(x),labels)
42    ii <- sapply(ll,any_dup)
43    ll <- ll[ii]
44    d <- description(x)
45    d <- d[ii]
46    if(length(ll))
47        structure(lapply(ll,which_dup_lab),
48                  description=d,
49                  class="dupLabelsReport")
50    else NULL
51}
52
53print.dupLabelsReport <- function(x,...){
54    width <- getOption("width",80)
55    toprule <- paste(rep("=",width),collapse="")
56    midrule <- paste(rep("-",width),collapse="")
57    n <- names(x)
58    d <- attr(x,"description")
59    for(i in seq_along(x)){
60        cat("\n",toprule,sep="")
61        cat("\n ",n[i],": ",sQuote(d[i]),sep="")
62        cat("\n",midrule,"\n",sep="")
63        x.i <- x[[i]]
64        l.i <- sapply(x.i,paste,collapse=", ")
65        w <- width - max(nchar(l.i)) - 5
66        n.i <- names(x.i)
67        cutit <- nchar(n.i) > w
68        n.i[cutit] <- paste0(substr(n.i[cutit],start=1,stop=w-3),"...")
69        n.i <- paste0(n.i,":")
70        r.i <- cbind(" ",format(n.i),format(l.i))
71        r.i <- apply(r.i,1,paste,collapse=" ")
72        writeLines(r.i)
73    }
74}
75
76warn_if_duplicate_labels <- function(variables){
77    ll <- lapply(variables,labels)
78    ii <- sapply(ll,any_dup)
79    if(any(ii)){
80        n <- names(variables)[ii]
81        nn <- paste(n,collapse=", ")
82        nn <- strwrap(nn,prefix="  ")
83        nn <- paste(nn,collapse="\n")
84        warning(sprintf("%d variables have duplicated labels:\n%s",
85                        length(n),
86                        nn),
87             call.=FALSE)
88    }
89}
90