I have a custom class object (list of tuples). I have defined <.myclass
>.myclass
and ==.myclass
on it as well.
Now I have a
a <- obj1 # of myclass b <- obj2 # of myclass c <- obj3 # of myclass L <- list(list(a,12,1),list(b,215,23),list(c,21,9))
I want to sort L, on index 1. i.e. I have b < c < a
then, I want sorted L in this form list(list(b,215,23),list(c,21,9),list(a,12,1))
How do I achieve this?
In my searches, I found how to sort on particular index, and using that I wrote the following function
magic_sort <- function(lst, sortind, dec = T) { return(lst[order(sapply(lst,'[[',sortind), decreasing = dec)]) }
But when I give index 1 to it, to sort on obj1, it fails with
> magic_sort(L,1) Error in order(sapply(lst, "[[", sortind), decreasing = dec) : unimplemented type 'list' in 'orderVector1'
Is there any fix for this? In general, can I have functions like sort, minimum and so on, based on custom definition of comparison operators?
Edit: Following perhaps will help understand the structure better: http://pastebin.com/0M7JRLTu
Edit 2:
library("sets") a <- list() class(a) <- "dfsc" a[[1]] <- tuple(1L, 2L, "C", "a", "B") b <- list() class(b) <- "dfsc" b[[1]] <- tuple(1L, 2L, "A", "b", "B") c <- list() class(c) <- "dfsc" c[[1]] <- tuple(1L, 2L, "A", "a", "B") L <- list() L[[1]] <- list(a, 12, 132) L[[2]] <- list(b, 21, 21) L[[3]] <- list(c, 32, 123) `<.dfsc` <- function(c1, c2) { return(lt_list(toList(c1),toList(c2))) } `==.dfsc` <- function(c1, c2) { return(toString(c1) == toString(c2)) } `>.dfsc` <- function(c1, c2) { return(!((c1 < c2) || (c1 == c2))) } lt_list <- function(l1, l2) { n1 <- length(l1) n2 <- length(l2) j = 1 while(j <= n1 && j <= n2) { if (l1[[j]] != l2[[j]]) { return (l1[[j]] < l2[[j]]) } j = j + 1 } return(n1 < n2) } toString.dfsc <- function(x) { code_string <- "" #for(ii in x[[1]]) { for(ii in x) { code_string <- paste(code_string,"(",ii[[1]],",",ii[[2]],",",ii[[3]],",",ii[[4]],",",ii[[5]],")", sep = "") } return(code_string) }
Now I want the L
desired to be list(list(c,_,_),list(b,_,_),list(a,_,_))
This answer from Aaron demonstrates, exactly, what is needed to apply a customized sort
on a class
ed object. As Roland notes, you -actually- need to sort
"L" and, thus, that is where the focus on custom sort
should be. To provide flexibility specifying on which index of "L" 's elements to sort
, a way would be to store an extra attr
on "L":
Turn "L" to an appropriate object:
class(L) = "myclass" attr(L, "sort_ind") = 1L
Ops
methods need to be defined (extract the relevant element of your data):
"<.myclass" = function(x, y) { i = attr(x, "sort_ind") ## also check if 'x' and 'y' have the same 'attr(, "sort_ind")' x[[1]][[i]] < y[[1]][[i]] } "==.myclass" = function(x, y) { i = attr(x, "sort_ind") x[[1]][[i]] == y[[1]][[i]] } ">.myclass" = function(x, y) { i = attr(x, "sort_ind") x[[1]][[i]] > y[[1]][[i]] }
And a subset method:
"[.myclass" = function(x, i) { y = .subset(x, i) attributes(y) = attributes(x) return(y) }
The above methods are necessary (perhaps, except "<"
) to be defined since a call to sort
/order
will end up calling rank
which needs .gt
in order to subset accordingly each element and compare. Finally, a get/set function for sauce:
sort_ind = function(x) attr(x, "sort_ind") "sort_ind<-" = function(x, value) { attr(x, "sort_ind") = value return(x) }
And:
order(L) #[1] 3 2 1 sort_ind(L) = 3 order(L) #[1] 2 3 1
A method for sort
can be, also, created to wrap all the above:
sort.myclass = function(x, sort_ind = attr(x, "sort_ind"), ...) { sort_ind(x) = sort_ind NextMethod() } sort(L) sort(L, sort_ind = 1)
(I assumed that your toList
function would look like something toList = function(x) x[[1L]]
)
I wanted to make use of internal and supposedly more efficient sort, but doesn't seem like this sort has facility to take custom comparison operator. So I ended up using implementation of quicksort to sort lists of lists at arbitrary index, assuming comparison exists between the elements at that index.
part_qsort <- function(l, idx, low, high) { lst <- l pivot <- lst[[high]][[idx]] i <- low - 1 for(j in low:(high-1)) { if ((lst[[j]][[idx]] < pivot) || (lst[[j]][[idx]] == pivot)) { i <- i + 1 swap(lst[[i]],lst[[j]]) } } swap(lst[[(i+1)]],lst[[high]]) eval.parent(substitute(l <- lst)) return(i+1) } # recursive calls to quicksort qsort <- function(l,idx,low,high) { if (low < high) { lst <- l pi <- part_qsort(lst,idx,low,high) qsort(lst, idx, low, pi-1) qsort(lst, idx, pi+1, high) eval.parent(substitute(l <- lst)) } }
Another thing to look into can be library("rlist")
which seems to have a bunch of functions implemented on lists.