Fixes for 1.0 release

jassler · Jun 11, 2023 · 8e90959 · 8e90959
1 parent b9cee4f
commit 8e90959
Show file tree

Hide file tree

Showing 6 changed files with 260 additions and 14 deletions.
diff --git a/.gitignore b/.gitignore
@@ -9,3 +9,4 @@ inst/doc
 /Meta/
 cran-comments.md
 docs
+CRAN-SUBMISSION
diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# socialranking 1.0.0
+# socialranking 1.0.0 (2023-03-13)
 
 This major update brings a lot of breaking changes that are hopefully justified.
 

diff --git a/R/generator.R b/R/generator.R
@@ -118,7 +118,14 @@ powerRelationGenerator <- function(coalitions, startWithLinearOrder = FALSE) {
   partCum <- c(0, cumsum(part))
   permsI <- 0
 
+  done <- FALSE
+
   nextPartition <- function() {
+    if(compI >= ncol(compositions)) {
+      done <<- TRUE
+      return()
+    }
+
     compI <<- compI + 1
     part <<- Filter(function(x) x != 0, compositions[,compI])
     perms <<- partitions::multinomial(part)
@@ -129,11 +136,11 @@ powerRelationGenerator <- function(coalitions, startWithLinearOrder = FALSE) {
 
   function() {
     if(permsI >= ncol(perms)) {
-      if(compI >= ncol(compositions))
-        return(NULL)
-
       nextPartition()
     }
+    if(done) {
+      return(NULL)
+    }
 
     permsI <<- permsI + 1
 
@@ -161,7 +168,7 @@ powerRelationGenerator <- function(coalitions, startWithLinearOrder = FALSE) {
       eqs,
       elements = elements,
       coalitionLookup = function(v) coalitionLookup[[toKey(v)]],
-      elementLookup = function(e) elementLookup[[paste(e)]]
+      elementLookup = function(e) stop('not implemented')# elementLookup[[paste(e)]]
     )
   }
 }

diff --git a/ignored/felixRanking.R b/ignored/felixRanking.R
@@ -32,17 +32,23 @@ rankL1 <- function(powerRelation) {
 }
 
 
-library(sets)
-makePrFelixMinimal <- function(powerRelation) {
-  eqs <- list()
-  current <- list()
-  for(eq in powerRelation$equivalenceClasses) {
-    current <- append(current, eq)
-    current <- Filter(function(x) !set_is_proper_subset(current, x), current)
-    eqs <- append(eqs, list(current))
+makeStefanoMatrix <- function(pr) {
+  l <- lapply(pr$elements, function(x) matrix(0, nrow = length(pr$elements), length(pr$eqs)))
+  names(l) <- pr$elements
+
+  for(x in seq_along(pr$eqs)) {
+    for(coalition in pr$eqs[[x]]) {
+      if(any(sapply(pr$eqs[[x]], function(otherCoal) all(otherCoal %in% coalition) && length(setdiff(coalition, otherCoal)) > 0)))
+        next
+
+      y <- length(coalition)
+      for(i in coalition) {
+        l[[i]][y,x] <- l[[i]][y,x] + 1
+      }
+    }
   }
 
-  eqs
+  structure(l, class = 'L1Scores')
 }
 
 
diff --git a/ignored/recMonotone.R b/ignored/recMonotone.R
@@ -0,0 +1,228 @@
+library(socialranking)
+library(sets)
+
+# makeStefanoMatrix <- function(pr) {
+#   l <- lapply(pr$elements, function(x) matrix(0, nrow = length(pr$elements), length(pr$eqs)))
+#   names(l) <- pr$elements
+#
+#   for(x in seq_along(pr$eqs)) {
+#     for(coalition in pr$eqs[[x]]) {
+#       if(any(sapply(pr$eqs[[x]], function(otherCoal) all(otherCoal %in% coalition) && length(setdiff(coalition, otherCoal)) > 0)))
+#         next
+#
+#       y <- length(coalition)
+#       for(i in coalition) {
+#         l[[i]][y,x] <- l[[i]][y,x] + 1
+#       }
+#     }
+#   }
+#
+#   structure(l, class = 'L1Scores')
+# }
+#
+# s <- (function(elements) {
+#   l <- list()
+#   gen <- powerRelationGenerator(createPowerset(elements, includeEmptySet = FALSE))
+#   print('doing permutations')
+#   while(!is.null(pr <- gen())) {
+#     if(coalitionLookup(pr, elements) > 1)
+#       gen <- generateNextPartition(gen)
+#     else
+#       l[[length(l)+1]] <- capture.output(makePowerRelationMonotonic(pr))
+#   }
+#
+#   print('doing sets')
+#   as.set(l)
+# })(c('a','b','c'))
+#
+# (function(elements) {
+#   superset <- if(TRUE) {
+#     createPowerset(elements, includeEmptySet = FALSE)
+#   } else {
+#     supersettmp <- createPowerset(elements, includeEmptySet = FALSE)
+#     superset <- list()
+#     for(i in seq_along(elements)) {
+#       superset <- append(superset, supersettmp[which(sapply(supersettmp, length) == i)])
+#     }
+#     superset
+#   }
+#
+#   m <- matrix(nrow = 0, ncol = length(superset), dimnames = list(c(), sapply(superset, paste0, collapse='')))
+#   s <- lapply(colnames(m), function(x) as.set(strsplit(x, '')[[1]]))
+#   for(coal in s) {
+#     r <- sapply(s, set_is_subset, x=coal)
+#     m <- rbind(m, sapply(r, function(v) if(v) '.' else ''))
+#   }
+#   rownames(m) <- rep('', nrow(m))
+#
+#   s <- paste(colnames(m),collapse=';')
+#   s <- paste0(s,'\n')
+#   s <- paste0(s,paste(
+#     apply(m, 1, paste, collapse=';'),
+#     collapse='\n'
+#   ))
+#   clipr::write_clip(s)
+#   #m
+# })(letters[1:7])
+#
+# (function() {
+#   coals <- createPowerset(1:9, includeEmptySet = FALSE)
+#   s <- length(coals)-1
+#   count <- 0
+#
+#   while(TRUE) {
+#     pr <- as.PowerRelation(
+#       sample(coals),
+#       sample(c('>','~'),length(coals)-1,replace=TRUE)
+#     )
+#     pr <- makePowerRelationMonotonic(pr)
+#     rank <- L1Ranking(pr)
+#     if(!(rank == lexcelRanking(pr))) {
+#       print('AAAAAAAAAAAAAA')
+#       print(pr)
+#       print('AAAAAAAAAAAAAA')
+#     }
+#     count <- count + 1
+#     if(count %% 100 == 0) {
+#       print(paste(count, ':', capture.output(pr)))
+#     }
+#   }
+# })()
+#
+# (function(prs) {
+#   ks <- 0
+#   cop <- 0
+#   for(pr in prs) {
+#     s1 <- kramerSimpsonRanking(pr); s2 <- copelandRanking(pr);
+#     s1 <- s1[[length(s1)]]; s2 <- s2[[length(s2)]];
+#     if((length(s1) <= length(s2) && all(s1 %in% s2))) {
+#       ks <- ks + 1
+#       print('ks')
+#     } else if(all(s2 %in% s1)) {
+#       cop <- cop + 1
+#       print('cop')
+#       print(pr)
+#     }
+#   }
+#
+#   print(paste('ks =', ks, '| cop =', cop))
+# })(s)
+
+nextCoal <- function(counter, prevs) {
+  coals <- which(counter == 0)
+
+  s <- 0
+
+  if(length(coals) == 0) {
+    s <- 1
+    print(paste(prevs, collapse = ' > '))
+
+  } else for(i in seq_along(coals)) {
+    coal <- coals[i]
+    counter[coal] <- -1
+
+    s <- s + nextCoal(chooseCoal(counter, coal), c(prevs, names(coal)))
+
+    counter[coal] <- 0
+  }
+
+  return(s)
+}
+
+
+
+
+
+
+
+
+
+
+
+
+toCoalition <- function(coalitions) {
+  sapply(coalitions, function(coalition)
+    paste(which(intToBits(coalition) == 1), collapse = '')
+  )
+}
+
+
+
+# 123, 12, 13, 23, 1, 2, 3, {}
+
+
+
+
+
+chooseCoal <- function(counter, coal) {
+  i <- 0
+  p <- 1
+  while(p < coal) {
+    if(bitwAnd((coal-1), p) != 0) {
+      i <- bitwXor((coal-1), p) + 1
+      counter[i] <- counter[i] - 1
+    }
+    p <- bitwShiftL(p, 1)
+  }
+
+  counter
+}
+
+nextCoalWo <- function(counter) {
+  coals <- which(counter == 0)
+
+  s <- 0
+
+  if(length(coals) == 0) {
+    s <- 1
+
+  } else for(i in seq_along(coals)) {
+    coal <- coals[i]
+    counter[coal] <- -1
+
+    s <- s + nextCoalWo(chooseCoal(counter, coal))
+
+    counter[coal] <- 0
+  }
+
+  return(s)
+}
+
+generatePrs <- function(amount) {
+  pascalRow <- numbers::pascal_triangle(amount)[amount+1,]
+
+  # counter <- lapply(seq_along(pascalRow), function(i) {
+  #   rep(amount - i + 1, pascalRow[i])
+  # }) |> unlist()
+
+  nms <- toCoalition(0:(2^amount-1))
+  counter <- structure(
+    sapply(nms, function(nm) amount - nchar(nm)),
+    names = nms
+  )
+
+  counter[(length(counter)-2):length(counter)] <- -1
+  counter <- chooseCoal(counter, length(counter))
+  counter <- chooseCoal(counter, length(counter)-1)
+  counter <- chooseCoal(counter, length(counter)-2)
+
+  #nextCoal(counter, c())
+  #nextCoal(counter, names(counter)[length(counter):(length(counter)-1)])# list('1234', '123'))
+  nextCoalWo(counter)
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/vignettes/socialranking.Rmd b/vignettes/socialranking.Rmd
@@ -511,6 +511,10 @@ preorderNum <- function(x) sapply(0:x, function(k) factorial(k) * stirlingSecond
 | 10              | 115.975         | 102.247.563          |
 | 11              | 678.570         | 1.622.632.573        |
 | 12              | 4.213.597       | 28.091.567.595       |
+| 13              | 27.644.437      | 526.858.348.381      |
+| 14              | 190.899.322     | 10.641.342.970.441   |
+| ($2^4-1$) 15    | 1.382.958.545   | 230.283.190.977.959  |
+| 16              | 10.480.142.147  | 5.315.654.681.940.580|
 
 # `SocialRanking` Objects