# R/polyplot.R In ConsRank: Compute the Median Ranking(s) According to the Kemeny's Axiomatic Approach

#### Documented in polyplot

```#' Plot rankings on a permutation polytope of 3 o 4 objects containing all possible ties
#'
#' Plot rankings a permutation polytope that is the geometrical space of preference rankings. The plot is available for 3 or for 4 objects
#'
#' @param X the sample of rankings. Most of the time it is returned by tabulaterows
#' @param L labels of the objects
#' @param Wk frequency associated to each ranking
#' @param nobj number of objects. It must be either 3 or 4
#'
#' @return the permutation polytope
#'
#' @details polyplot() plots the universe of 3 objecys. polyplot(nobj=4) plots the universe of 4 objecys.
#'
#' @references Thompson, G. L. (1993). Generalized permutation polytopes and exploratory graphical methods for ranked data. The Annals of Statistics, 1401-1430.
#' #
#' Heiser, W. J., and D'Ambrosio, A. (2013). Clustering and prediction of rankings within a Kemeny distance framework. In Algorithms from and for Nature and Life (pp. 19-31). Springer International Publishing.
#'
#' @author Antonio D'Ambrosio \email{antdambr@unina.it} and Sonia Amodio \email{sonia.amodio@unina.it}
#'
#' @seealso \code{\link{tabulaterows}} frequency distribution for ranking data.
#'
#' @examples
#' polyplot()
#' #polyplot(nobj=4)
#' data(BU)
#' polyplot(BU[,1:3],Wk=BU[,4])
#'
#' @keywords Permutation polytope
#'
#' @export
#'
#' @import rgl
#' @importFrom graphics lines plot points text

polyplot <- function(X=NULL,L=NULL,Wk=NULL,nobj=3){

if (nobj==3){

#rankings in the polytope
ranks<-rbind(
c(1,2,3),
c(1,2,2),
c(1,3,2),
c(1,2,1),
c(2,3,1),
c(2,2,1),
c(3,2,1),
c(2,1,1),
c(3,1,2),
c(2,1,2),
c(2,1,3),
c(1,1,2),
c(1,1,1)
)

if (is(L,"NULL")){
rr<-labelsn(ranks,3,labs=2)
} else {
rr<-labelsn(ranks,3,L,labs=1)
}

#coordinates of polytope
coord<-rbind(
c(  0.000000e+00,  4.082483e-01), #ABC
c(  1.767767e-01,  3.061862e-01), #A(BC)
c(  3.535534e-01,  2.041241e-01), #ACB
c(  3.535534e-01,  1.817407e-16), #(AC)B
c(  3.535534e-01, -2.041241e-01), #CAB
c(  1.767767e-01, -3.061862e-01), #C(AB)
c(  5.192593e-17, -4.082483e-01), #CBA
c( -1.767767e-01, -3.061862e-01), #(BC)A
c( -3.535534e-01, -2.041241e-01), #BCA
c( -3.535534e-01, -1.038519e-16), #B(AC)
c( -3.535534e-01,  2.041241e-01), #BAC
c( -1.767767e-01,  3.061862e-01), #(AB)C
c(  5.517130e-17,  4.543519e-17)  #(ABC)
)

plot(coord,ylim=c(-0.5,0.5),xlim=c(-0.5,0.5),axes=FALSE,ann=FALSE)
lines(coord[1:11,])
lines(c(coord[11,1],coord[1,1]),c(coord[11,2],coord[1,2]))
lines(c(coord[2,1],coord[8,1]),c(coord[2,2],coord[8,2]),lty=2)
lines(c(coord[4,1],coord[10,1]),c(coord[4,2],coord[10,2]),lty=2)
lines(c(coord[6,1],coord[12,1]),c(coord[6,2],coord[12,2]),lty=2)

t1<-c(1,2,3,11,12,13)
t2<-c(4,10)
t3<-c(5,6,7,8,9)
tcoord=coord #text coordinates
tcoord[t1,2]<-tcoord[t1,2]+0.1
tcoord[t3,2]<-tcoord[t3,2]-0.1
tcoord[t2[1],1]<-tcoord[t2[1],1]+0.1
tcoord[t2[2],1]<-tcoord[t2[2],1]-0.1
#text(tcoord,rr)

if (is(X,"NULL")){
indplot<-matrix(1:13,ncol=1)
} else {

#o = outer(seq_len(nrow(X)), seq_len(nrow(ranks)), Vectorize(
#  function(i, j) all(X2[i,]==ranks[j,])
#))
#ranksinplot=ranks[apply(o, 2, any),]

o2 <- outer(seq_len(nrow(ranks)), seq_len(nrow(X)), Vectorize(
function(i, j) which(all(ranks[i,]==X[j,]))
))

indexing<-o2==1
#print(indexing)
indexing[indexing==TRUE]<-1
indexing[is.na(indexing)]<-0
indplot<-which(rowSums(indexing)==1)
#print(indplot)
}

# if (is.null(X)){
#   X=ranks
# }
#X
#put labels to rankings
if (is(Wk,"NULL")){

points(coord[indplot,1],coord[indplot,2],pch=16,cex=0.8,col="blue")

}else{

if (is(Wk,"numeric")) {

Wk<-matrix(Wk,ncol=1)

}

idwk<-matrix(0,nrow(X),1)
counter<-0
for (i in 1:13){
for (j in 1:nrow(X)){
check<-sum(pos=X[j,]==ranks[i,])
if (check==3){
counter<-counter+1
idwk[counter]<-j
break}
}
}

points(coord[indplot,1],coord[indplot,2],pch=16,cex=sqrt(100*((Wk[idwk]/sum(Wk))/pi)/2),col="blue")

}

text(tcoord[indplot,],rr[indplot,])

}else{ ##4 objects

#---------------------------------------------

#-Exagon A first
E1<-rbind(
c(0.5,  0.5,  1.4142135),  #   ...    %%'A B C D'     [1 2 3 4]   1
c(1.0,  1.0,  0.70710677), #  ...    %%'A C B D'     [1 3 2 4]   2
c(1.5,  0.5,  0.0), #                 %%'A C D B'     [1 4 2 3]   3
c(1.5, -0.5,  0.0), #         ...    %%'A D C B'     [1 4 3 2]   4
c(1.0, -1.0,  0.70710677), #  ...    %%'A D B C'     [1 3 4 2]   5
c(0.5, -0.5,  1.4142135) #   ...    %%'A B D C'     [1 2 4 3]   6
)

MA<-apply(E1,2,mean) #  center of exagon A   A(BCD)  [1 2 2 2]  7
E1T<-rbind(
c(1.2500,    0.7500,    0.3536),#;...  %% 'A C {BD}'   [1 3 2 3]   8
c(0.7500,   -0.7500,    1.0607),#;...  %% 'A {BD} C'   [1 2 3 2]   9
c(0.5000,         0,    1.4142),#;...  %% 'A B {CD}'   [1 2 3 3]   10
c(1.5000,         0,         0),#;...  %% 'A {CD} B'   [1 3 2 2]   11
c(1.2500,   -0.7500,    0.3536),#;...  %% 'A D {BC}'   [1 3 3 2]   12
c(0.7500,    0.7500,    1.0607)# ;...  %% 'A {BC} D'   [1 2 2 3]   13
)

ranksA<-rbind(
c(1,2,3,4),c(1,3,2,4),c(1,4,2,3),c(1,4,3,2),c(1,3,4,2),c(1,2,4,3),c(1,2,2,2),
c(1,3,2,3),c(1,2,3,2),c(1,2,3,3),c(1,3,2,2),c(1,3,3,2),c(1,2,2,3)
)

#---------------------------------------------
#-Exagon B first
E2<-rbind(
c(-1.5, -0.5,  0.0),#        ...    %%'B D C A'     [4 1 3 2]   14
c(-1.5,  0.5,  0.0),#        ...    %%'B C D A'     [4 1 2 3]   15
c(-1.0,  1.0,  0.70710677),# ...    %%'B C A D'     [3 1 2 4]   16
c(-0.5,  0.5,  1.4142135),#  ...    %%'B A C D'     [2 1 3 4]   17
c(-0.5, -0.5,  1.4142135),#  ...    %%'B A D C'     [2 1 4 3]   18
c(-1.0, -1.0,  0.70710677)# ...    %%'B D A C'     [3 1 4 2]   19
)

MB<-apply(E2,2,mean) #center of exagon B  B(ACD)        [2 1 2 2]  20

E2T<-rbind(
c(-0.5000,         0,    1.4142),#; ... %% 'B A {CD}'   [2 1 3 3]   21
c(-1.5000,         0,         0),#;...  %% 'B {CD} A'   [3 1 2 2]   22
c(-1.2500,    0.7500,    0.3536),#;...  %% 'B C {AD}'   [3 1 2 3]   23
c(-0.7500,   -0.7500,    1.0607),#;...  %% 'B {AD} C'   [2 1 3 2]   24
c(-1.2500,   -0.7500,    0.3536),#;...  %% 'B D {AC}'   [3 1 3 2]   25
c(-0.7500,    0.7500,    1.0607)# ;...  %% 'B {AC} D'   [2 1 2 3]   26
)

ranksB<-rbind(
c(4,1,3,2),c(4,1,2,3),c(3,1,2,4),c(2,1,3,4),c(2,1,4,3),c(3,1,4,2),c(2,1,2,2),
c(2,1,3,3),c(3,1,2,2),c(3,1,2,3),c(2,1,3,2),c(3,1,3,2),c(2,1,2,3)
)

#-------------------------------------------------
#exagon C first

E3<-rbind(
c(-1.0,  1.0, -0.70710677),# ...    %%'C B D A'     [4 2 1 3]   27
c(-0.5,  0.5, -1.4142135),#  ...    %%'C D B A'     [4 3 1 2]   28
c(0.5,  0.5, -1.4142135),#   ...    %%'C D A B'     [3 4 1 2]   29
c(1.0,  1.0, -0.70710677),#  ...    %%'C A D B'     [2 4 1 3]   30
c(0.5,  1.5,  0.0),#         ...    %%'C A B D'     [2 3 1 4]   31
c(-0.5,  1.5,  0.0) #        ...    %%'C B A D'     [3 2 1 4]   32
)

MC<-apply(E3,2,mean) #center of exagon C  C(ABD)        [2 2 1 2] 33

E3T<-rbind(
c(0,    0.5000,   -1.4142),      #;...  %% 'C D {AB}'   [3 3 1 2]   34
c(0,    1.5000,         0),      #;...  %% 'C {AB} D'   [2 2 1 3]   35
c(0.7500,    1.2500,   -0.3536), #;...  %% 'C A {BD}'   [2 3 1 3]   36
c(-0.7500,    0.7500,   -1.0607),#;...  %% 'C {BD} A'   [3 2 1 2]   37
c(0.7500,    0.7500,   -1.0607), #;...  %% 'C {AD} B'   [2 3 1 2]   38
c(-0.7500,    1.2500,   -0.3536) #;...  %% 'C B {AD}'   [3 2 1 3]   39
)

ranksC<-rbind(c(4,2,1,3),c(4,3,1,2),c(3,4,1,2),c(2,4,1,3),c(2,3,1,4),c(3,2,1,4),c(2,2,1,2),
c(3,3,1,2),c(2,2,1,3),c(2,3,1,3),c(3,2,1,2),c(2,3,1,2),c(3,2,1,3)
)

#--------------------------------------
#exagon D first

E4<-rbind(
c(-1.0, -1.0, -0.70710677),# ...    %%'D B C A'     [4 2 3 1]   40
c(-0.5, -0.5, -1.4142135),#  ...    %%'D C B A'     [4 3 2 1]   41
c(0.5, -0.5, -1.4142135),#   ...    %%'D C A B'     [3 4 2 1]   42
c(1.0, -1.0, -0.70710677),#  ...    %%'D A C B'     [2 4 3 1]   43
c(0.5, -1.5,  0.0),#         ...    %%'D A B C'     [2 3 4 1]   44
c(-0.5, -1.5,  0.0) #        ...    %%'D B A C'     [3 2 4 1]   45
)

MD<-apply(E4,2,mean) #center of exagon D  D(ABC)        [2 2 2 1]  46

E4T<-rbind(
c(0,   -0.5000,   -1.4142),      #;...  %% 'D C {AB}'   [3 3 2 1]   47
c(0,   -1.5000,         0),      #;...  %% 'D {AB} C'   [2 2 3 1]   48
c(-0.7500,   -1.2500,   -0.3536),#;...  %% 'D B {AC}'   [3 2 3 1]   49
c(0.7500,   -0.7500,   -1.0607), #;...  %% 'D {AC} B'   [2 3 2 1]   50
c(-0.7500,   -0.7500,   -1.0607),#;...  %% 'D {BC} A'   [3 2 2 1]   51
c(0.7500,   -1.2500,   -0.3536)  #;...  %% 'D A {BC}'   [2 3 3 1]   52
)

ranksD<-rbind(c(4,2,3,1),c(4,3,2,1),c(3,4,2,1),c(2,4,3,1),c(2,3,4,1),c(3,2,4,1),c(2,2,2,1),
c(3,3,2,1),c(2,2,3,1),c(3,2,3,1),c(2,3,2,1),c(3,2,2,1),c(2,3,3,1)
)

#squares----------------------------------------------------------
ESQ<-rbind(
c(0,    0.5000,    1.4142), #      ; ... %% '{AB} C D'   [1 1 2 3]   53
c(0,   -0.5000,    1.4142), #      ; ... %% '{AB} D C'   [1 1 3 2]   54
c(-0.5000,         0,   -1.4142), # ;...  %% '{CD} B A'   [3 2 1 1]   55
c(0.5000,         0,   -1.4142), #  ;...  %% '{CD} A B'   [2 3 1 1]   56
c(1.2500,    0.7500,   -0.3536), #  ;...  %% '{AC} D B'   [1 3 1 2]   57
c(0.7500,1.2500,0.3536),       #  ;...  %% '{AC} B D'   [1 2 1 3]   58
c(-1.2500,   0.7500,   -0.3536), #  ;...  %% '{BC} D A'   [3 1 1 2]   59
c(-0.7500,    1.2500,    0.3536), # ;...  %% '{BC} A D'   [2 1 1 3]   60
c(1.2500,   -0.7500,   -0.3536), #  ;...  %% '{AD} C B'   [1 3 2 1]   61
c(0.7500,   -1.2500,    0.3536), #  ;...  %% '{AD} B C'   [1 2 3 1]   62
c(-1.2500,   -0.7500,   -0.3536), # ;...  %% '{BD} C A'   [3 1 2 1]   63
c(-0.7500,   -1.2500,    0.3536) #  ;...  %% '{BD} A C'   [2 1 3 1]   64
)

ranksSQ<-rbind(c(1,1,2,3),c(1,1,3,2),c(3,2,1,1),c(2,3,1,1),c(1,3,1,2),c(1,2,1,3),
c(3,1,1,2),c(2,1,1,3),c(1,3,2,1),c(1,2,3,1),c(3,1,2,1),c(2,1,3,1)
)

#------------------------------------------------------------------------

M_AB_CD<-apply(rbind(c(0,0.5,1.4142),c(-0.5,0,1.4142),c(0,-0.5,1.4142),
c(0.5,0,1.4142)),2,mean) # '{AB}{CD}'   [1 1 2 2]   65

M_AC_BD<-apply(rbind(c(1.25,0.75,0.3536),c(1.25,0.75,-0.3536),c(0.75,1.25,-0.3536),
c(0.75,1.25,0.3536)),2,mean) #'{AC}{BD}'   [1 2 1 2] 66

M_BC_AD<-apply(rbind(c(-0.75,1.25,-0.3536),c(-1.25,0.75,-0.3536),c(-1.25,0.75,0.3536),
c(-0.75,1.25,0.3536)),2,mean) # '{BC}{AD}'   [2 1 1 2] 67

EMID<-rbind(M_AB_CD, M_AC_BD, M_BC_AD, M_AB_CD*-1, M_AC_BD*-1, M_BC_AD*-1,MA*-1,MB*-1,MC*-1,MD*-1)
#M_AB_CD*-1 = '{CD}{AB}'   [2 2 1 1] 68
#M_AC_BD*-1 = '{BD}{AC}'   [2 1 2 1] 69
#M_BC_AD*-1;= '{AD}{BC}'   [1 2 2 1] 70
#MA*-1;=      '{BCD}A'   [2 1 1 1] 71
#MB*-1;=      '{ACD}B'   [1 2 1 1] 72
#MC*-1;=      '{ABD}C'   [1 1 2 1] 73
#MD*-1;=      '{ABC}D'   [1 1 1 2] 74
#last =        {ABCD}    [1 1 1 1] 75

rankres<-rbind(c(1,1,2,2),c(1,2,1,2),c(2,1,1,2),c(2,2,1,1),c(2,1,2,1),
c(1,2,2,1),c(2,1,1,1),c(1,2,1,1),c(1,1,2,1),c(1,1,1,2),c(1,1,1,1)
)

EE<-rbind(E1,MA,E1T,E2,MB,E2T,E3,MC,E3T,E4,MD,E4T,ESQ,EMID)
coord<-rbind(EE,apply(EE,2,mean))
ranks<-rbind(ranksA,ranksB,ranksC,ranksD,ranksSQ,rankres)

if (is(L,"NULL")){
rr<-labelsn(ranks,4,labs=2)
} else {
rr<-labelsn(ranks,4,L,labs=1)
}

plot3d(coord, type = 'p', xlab = '', ylab = '', zlab = '', add = T,
aspect = T, box = F, axes = F, col = 1)

#exagon A first
segments3d(E1[c(1,2),], lwd=1, col = 1)
segments3d(E1[c(2,3),], lwd=1, col = 1)
segments3d(E1[c(3,4),], lwd=1, col = 1)
segments3d(E1[c(4,5),], lwd=1, col = 1)
segments3d(E1[c(5,6),], lwd=1, col = 1)
segments3d(E1[c(1,6),], lwd=1, col = 1)
segments3d(E1T[c(1,2),], lwd=0.5, col = 'gray')
segments3d(E1T[c(3,4),], lwd=0.5, col = 'gray')
segments3d(E1T[c(5,6),], lwd=0.5, col = 'gray')
#exagon B first
segments3d(E2[c(1,2),], lwd=1, col = 1)
segments3d(E2[c(2,3),], lwd=1, col = 1)
segments3d(E2[c(3,4),], lwd=1, col = 1)
segments3d(E2[c(4,5),], lwd=1, col = 1)
segments3d(E2[c(5,6),], lwd=1, col = 1)
segments3d(E2[c(1,6),], lwd=1, col = 1)
segments3d(E2T[c(1,2),], lwd=0.5,col = 'gray')
segments3d(E2T[c(3,4),], lwd=0.5,col = 'gray')
segments3d(E2T[c(5,6),], lwd=0.5,col = 'gray')
#exagon C first
segments3d(E3[c(1,2),], lwd=1, col = 1)
segments3d(E3[c(2,3),], lwd=1, col = 1)
segments3d(E3[c(3,4),], lwd=1, col = 1)
segments3d(E3[c(4,5),], lwd=1, col = 1)
segments3d(E3[c(5,6),], lwd=1, col = 1)
segments3d(E3[c(1,6),], lwd=1, col = 1)
segments3d(E3T[c(1,2),], lwd=0.5,col = 'gray')
segments3d(E3T[c(3,4),], lwd=0.5,col = 'gray')
segments3d(E3T[c(5,6),], lwd=0.5,col = 'gray')
#exagon D first
segments3d(E4[c(1,2),], lwd=1, col = 1)
segments3d(E4[c(2,3),], lwd=1, col = 1)
segments3d(E4[c(3,4),], lwd=1, col = 1)
segments3d(E4[c(4,5),], lwd=1, col = 1)
segments3d(E4[c(5,6),], lwd=1, col = 1)
segments3d(E4[c(1,6),], lwd=1, col = 1)
segments3d(E4T[c(1,2),], lwd=0.5,col = 'gray')
segments3d(E4T[c(3,4),], lwd=0.5,col = 'gray')
segments3d(E4T[c(5,6),], lwd=0.5,col = 'gray')
#squares
segments3d(rbind(E1[1,],E2[4,]), lwd=1, col = 1)
segments3d(rbind(E1[6,],E2[5,]), lwd=1, col = 1)
segments3d(rbind(E3[2,],E4[2,]), lwd=1, col = 1)
segments3d(rbind(E3[3,],E4[3,]), lwd=1, col = 1)
segments3d(rbind(E1[5,],E4[5,]), lwd=1, col = 1)
segments3d(rbind(E1[4,],E4[4,]), lwd=1, col = 1)
segments3d(rbind(E2[1,],E4[1,]), lwd=1, col = 1)
segments3d(rbind(E2[6,],E4[6,]), lwd=1, col = 1)
segments3d(rbind(E1[2,],E3[5,]), lwd=1, col = 1)
segments3d(rbind(E1[3,],E3[4,]), lwd=1, col = 1)
segments3d(rbind(E2[2,],E3[1,]), lwd=1, col = 1)
segments3d(rbind(E2[3,],E3[6,]), lwd=1, col = 1)
#other exagons
segments3d(rbind(ESQ[1,],ESQ[2,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[3,],ESQ[4,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[5,],ESQ[6,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[7,],ESQ[8,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[9,],ESQ[10,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[11,],ESQ[12,]), lwd=0.5, col = 'gray')
segments3d(rbind(E1T[1,],E3T[3,]), lwd=0.5, col = 'gray')
segments3d(rbind(E2T[3,],E3T[6,]), lwd=0.5, col = 'gray')
segments3d(rbind(E1T[3,],E2T[1,]), lwd=0.5, col = 'gray')
segments3d(rbind(E1T[5,],E4T[6,]), lwd=0.5, col = 'gray')
segments3d(rbind(E2T[5,],E4T[3,]), lwd=0.5, col = 'gray')
segments3d(rbind(E3T[1,],E4T[1,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[1,],E3T[2,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[6,],E2T[6,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[8,],E1T[6,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[2,],E4T[2,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[7,],E4T[5,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[5,],E4T[4,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[12,],E1T[2,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[10,],E2T[4,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[4,],E1T[4,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[9,],E3T[5,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[3,],E2T[2,]), lwd=0.5, col = 'gray')
segments3d(rbind(ESQ[11,],E3T[4,]), lwd=0.5, col = 'gray')
#-----------------------------

if (is(X,"NULL")){
indplot<-matrix(1:75,ncol=1)
} else {

#ranksinplot=ranks[apply(o, 2, any),]

o2 <- outer(seq_len(nrow(ranks)), seq_len(nrow(X)), Vectorize(
function(i, j) which(all(ranks[i,]==X[j,]))
))

indexing<-o2==1
#print(indexing)
indexing[indexing==TRUE]<-1
indexing[is.na(indexing)]<-0
indplot<-which(rowSums(indexing)==1)
#print(indplot)
#       ranksinplot=ranks[indplot,]
#
#       o = outer(seq_len(nrow(X)), seq_len(nrow(ranksinplot)), Vectorize(
#         function(i, j) all(X[i,]==ranksinplot[j,])
#       ))
#
#
#
#       indexlabs=o==1
#       #print(indexing)
#       indexlabs[indexlabs==TRUE]=1
#       indexlabs[is.na(indexlabs)]=0
#       indlab=matrix(nrow=ncol(indexlabs),ncol=1)
#       for (j in 1:nrow(indlab)){
#         indlab[j,1]=which(indexlabs[j,]==1)
#       }

}
#points(coord[indplot,1],coord[indplot,2],pch=16)
#points3d(coord[indplot,],col="blue",cex=sqrt(100*((Wk/sum(Wk))/pi)))

if (is(Wk,"NULL")){

spheres3d(coord[indplot,],col="blue",radius=0.02)

} else {
idwk<-matrix(0,nrow(X),1)
counter<-0
for (i in 1:75){
for (j in 1:nrow(X)){
check<-sum(pos=X[j,]==ranks[i,])
if (check==4){
counter<-counter+1
idwk[counter]<-j
break}
}
}

spheres3d(coord[indplot,],col="blue",radius=sqrt(((Wk[idwk]/sum(Wk))/(25*pi))))

}
#text(tcoord[indplot,],rr[indplot,])
text3d(coord[indplot,1]+0.1, coord[indplot,2]+0.1,
coord[indplot,3]+0.1,rr[indplot,],col=1,cex=0.7)
}
}

#--------------------------------------------------------------

labelsn <- function(x, m, label = 1:m, labs ){

## Place labels in a data matrix X of rankings (N judges by M objects)
#m is the number of objects
#label (optional) is the vector of the objects names
#labs = 1 or 2
#source('reordering.r')
# if the class of the object is different from 'matrix' transform it in 'matrix'
if(!is(x,"matrix")){
obs <- length(x)
XX <- matrix(x, ncol = obs)
} else {
XX <- x
}

nj <- nrow(XX)
nob <- ncol(XX)

## if length of the object is higher than m, last number is the penalty
#if(nob > m){
## if the number of rows is 1 is a vector
#  if(nj == 1){
#    pens = x[m+1]
#    X = matrix(reordering(XX[1:m]), m, ncol = m)
#    } else {
#    pens = x[,m+1]
#    X = t(apply(x, 1, function(g) reordering(g, m)))
#    }
#} else {
X <- XX
#}
if(labs ==1){
let <- label
} else if(labs == 2){
let <- LETTERS[label]
}

out <- rep(0, nj)
for(i in 1:nj){

ord <- rank(X[i,])
orders <- tapply(let, ord, sort)

names1 <- NULL
for(j in 1:length(orders)){
if(length(orders[[j]]) > 1){
nams <- paste('(', paste(orders[[j]], sep = '', collapse = ' '), ')', sep = '', collapse='')
} else {
nams <- paste(orders[[j]], collapse = ' ')
}
names1 <- c(names1, nams)
}
out[i] <- paste(names1, collapse = ' ' )
}
out <- matrix(out, nrow = nj)

#if(nob > m){
#dat = data.frame(data = out, pens = pens)
#} else {
dat <- out
#}

return(dat)
}
```

## Try the ConsRank package in your browser

Any scripts or data that you put into this service are public.

ConsRank documentation built on Sept. 28, 2021, 5:07 p.m.