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