I'd like to do a list iteration in Rcpp, but this code crashes R:
Rcpp::cppFunction('List foo(List bc) {
for (List::iterator i = bc.begin(); i != bc.end(); ++i) i[0] = i[1];
return(bc);
}'
)
If we take the following foo(list(a = c(1, 2, 3, 4), b = c(4, 3, 2, 1))), R will crash. The example above is just a dummy one - replace first element with second in every sublist (e.g. we should get c(2, 2, 3, 4) for a and for b c(3, 3, 2, 1)).
Could anyone help? I'm really new to both R and Rcpp and just going through the literature but have no idea about why the iterator doesn't work.
The problem is with i[0] and i[1]. Iterators are kinda-sorta-like pointers, you need to instantiate them first. Here is a variant of your code that works:
Code
#include <Rcpp.h>
// [[Rcpp::export]]
Rcpp::List foo(Rcpp::List bc) {
for (Rcpp::List::iterator i = bc.begin(); i != bc.end(); ++i) {
SEXP a = *i;
Rcpp::print(a);
}
return(bc);
}
/*** R
ll <- list(a = c(1, 2, 3, 4), b = c(4, 3, 2, 1))
foo(ll)
*/
Output
edd#rob:~/git/stackoverflow/60291024(master)$ Rscript -e 'Rcpp::sourceCpp("question.cpp")'
R> ll <- list(a = c(1, 2, 3, 4), b = c(4, 3, 2, 1))
R> foo(ll)
[1] 1 2 3 4
[1] 4 3 2 1
$a
[1] 1 2 3 4
$b
[1] 4 3 2 1
edd#rob:~/git/stackoverflow/60291024(master)$
Related
Thanks to lots of help, I've got an expression that substitutes the value from a rbinom into a vector, when certain conditions are met. My problem is that it always substitutes the same value, i.e. does not do a new evaluation for each instance of the conditions being met. I think I just need to wrap it in a sapply statement but haven't got the syntax correct. MWE:
arr1 <- c(8, 2, 5, 2, 3, 2, 2, 2, 8, 2, 4)
arr2 <- c(0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0)
arr1
arr1[Reduce("&", list(arr1 == 2, arr2 ==1))] <- rbinom(1,1,0.5) * 2
arr1
arr1
[1] 8 2 5 0 3 0 0 0 8 0 4
I would have hoped that it changed some of the values but not others, so evaluated the result again for each instance. Is this a good application of purrr::modify2 ? Thx. J
Probably, you mean to use :
inds <- arr1 == 2 & arr2 == 1
arr1[inds] <- rbinom(sum(inds), 1, 0.5) * 2
I have two vectors:
vec1 <- c(0, 1, 2, 3, 4, 5, 6, 7, 9)
vec2 <- c(1, 2, 7, 5, 3, 6, 80, 4, 8)
I would like to set the same order in vec1 as it is in vec2. For example, in vec2 the highest number (position 9) is in position 7, so I would like to put the highest number in vec1 (position 9, number 9) to position 7.
Expected output:
vec1 <- c(0, 1, 6, 4, 2, 5, 9, 3, 7)
I don't have any duplicated values in any vector.
I'm primarily interested in efficient Rcpp solutions but also anything in R is welcome.
Another baseR option is match
vec1[match(vec2, sort(vec2))]
# [1] 0 1 6 4 2 5 9 3 7
edit
Including a benchmark with larger sample size
set.seed(42)
n <- 1e6
vec1 <- seq_len(n)
vec2 <- sample(1:1e7, size = n)
benchmarks <- bench::mark(match = vec1[match(vec2, sort(vec2))],
rank = vec1[rank(vec2)],
frank = vec1[data.table::frank(vec2)],
order_order = vec1[order(order(vec2))],
rcpp_order_order = foo(vec1, vec2),
iterations = 25)
benchmarks[ , 1:3]
Result
# A tibble: 5 x 3
# expression min median
# <bch:expr> <bch:tm> <bch:tm>
#1 match 259.8ms 322ms
#2 rank 825.9ms 876ms
#3 frank 88.6ms 134ms
#4 order_order 110.6ms 139ms
#5 rcpp_order_order 793.5ms 893ms
We can adapt the Rcpp version of order() from this answer (to account for the fact that you do not want to check for duplicates and adding a function to order by an order of an ordering) to make the following Rcpp solution:
#include <Rcpp.h>
Rcpp::IntegerVector order(const Rcpp::NumericVector& x) {
return Rcpp::match(Rcpp::clone(x).sort(), x);
}
Rcpp::IntegerVector order(const Rcpp::IntegerVector& x) {
return Rcpp::match(Rcpp::clone(x).sort(), x);
}
// [[Rcpp::export]]
Rcpp::NumericVector foo(const Rcpp::NumericVector x,
const Rcpp::NumericVector y) {
return x[order(order(y))-1];
}
Then we get the expected results:
library(Rcpp)
sourceCpp("foo.cpp")
vec1 <- c(0, 1, 2, 3, 4, 5, 6, 7, 9)
vec2 <- c(1, 2, 7, 5, 3, 6, 80, 4, 8)
foo(vec1, vec2)
# [1] 0 1 6 4 2 5 9 3 7
with decent performance (comparisons are to the R solutions presented by other answers):
benchmarks <- bench::mark(match = vec1[match(vec2, sort(vec2))],
rank = vec1[rank(vec2)],
order_order = vec1[order(order(vec2))],
rcpp_order_order = foo(vec1, vec2),
iterations = 10000)
benchmarks[ , 1:3]
# # A tibble: 4 x 3
# expression min median
# <bch:expr> <bch:tm> <bch:tm>
# 1 match 28.4µs 31.72µs
# 2 rank 7.99µs 9.84µs
# 3 order_order 26.27µs 30.61µs
# 4 rcpp_order_order 2.51µs 3.23µs
Note that this solution only works if there are no duplicates. (If you might run into duplicates, adding a check is demonstrated in the linked-to answer). Also note that these benchmarks were just done on this data; I don't know for sure how they change at scale.
We could use rank
vec1[rank(vec2)]
#[1] 0 1 6 4 2 5 9 3 7
Or with order
vec1[order(order(vec2))]
#[1] 0 1 6 4 2 5 9 3 7
Or as #markus suggested an option with frank from data.table
library(data.table)
vec1[frank(vec2)]
If I understand you correctly, you want vec1 to follow the same order of vec1. That is, is vec2 is increasing, so should the values of vec1; if vec2 is decreasing, so should vec1 and so on.
sort(vec1)[order(vec2)]
How do I add a vector to another while keeping for the first vector constant? For example if I had c(1, 2, 3) + 1. I would get 2, 3, 4. If I wanted to scale this up to say + 1, and + 2, what could I do to get
2, 3, 4, 3, 4, 5
Intuitively I wanted to c(1, 2, 3) + c(1, 2) but this does not work.
Turning the comments into an answer we can use outer as #jogo showed
c(outer(1:3, 1:2, FUN='+'))
# [1] 2 3 4 3 4 5
Another option is rep
f <- function(x, y) {
x + rep(y, each = length(x))
}
f(1:3, 1:2)
# [1] 2 3 4 3 4 5
I would like to create an array that goes like this
[1, 2, 1, 3, 2, 1, 4, 3, 2, 1]
I use the following code, that should be right, but I am not getting the result I would like.
x = 0
for i in 1:4
for z in i:1
x = x + 1
index[x] = z
end
end
Thank you for your time.
I would use the following one-liner:
index = [ n for m in 1:4 for n in m:-1:1 ]
If you actually need to pre-allocate index for some reason, you can also write the loop out more verbosely like so:
m = 4
index = ones(Int, sum(1:m))
c = 1
for m in 1:4
for n in m:-1:1
index[c] = n
c += 1
end
end
I am building a custom GUI in R for work, and I need to have a part that can select a subset of a dataframe based on variable values (i.e. select all females that are above 50 etc.). I am building the GUI with gwidgets, but I am stuck with regards to how this filter can be implemented. Specifically how to create a widget that allows the user to select one or more filters and then return the filtered data frame.
Here is a small sample from the data I am working with:
structure(list(kunde = c(3, 3, 3, 3, 3, 3, 3, 1, 3, 3),
bank = c(7,98, 3, 3, 98, 2, 2, 1, 7, 2)),
.Names = c("kunde", "bank"), row.names = c(NA, 10L), class = "data.frame")
Any help is greatly appreciated!!
There are some examples of similar things in the ProgGUIinR package. Here is one of them:
library(gWidgets)
options(guiToolkit="RGtk2")
options(repos="http://streaming.stat.iastate.edu/CRAN")
d <- available.packages() # pick a cran site
w <- gwindow("test of filter")
g <- ggroup(cont=w, horizontal=FALSE)
ed <- gedit("", cont=g)
tbl <- gtable(d, cont=g, filter.FUN="manual", expand=TRUE)
ourMatch <- function(curVal, vals) {
grepl(curVal, vals)
}
id <- addHandlerKeystroke(ed, handler=function(h, ...) {
vals <- tbl[, 1, drop=TRUE]
curVal <- svalue(h$obj)
vis <- ourMatch(curVal, vals)
visible(tbl) <- vis
})
For your purpose, you might want to use gcheckboxgroup or gcombobox to select factor levels or a level and filter by that. The key is the visible<- method of the gtable object is used to filter the displayed items.
If you are game, you can try the gfilter widget in gWidgets2 which as of know is just on my github site (use install_packages("gWidgets2", "jverzani") from devtools, also gWidgets2RGtk2). This may be just what you are trying to do.
With your data object and testing one of the variables, this is a simplified version of subset.data.frame:
tmp <-
structure(list(kunde = c(3, 3, 3, 3, 3, 3, 3, 1, 3, 3), bank = c(7,
98, 3, 3, 98, 2, 2, 1, 7, 2)), .Names = c("kunde", "bank"), row.names = c(NA,
10L), class = "data.frame")
getsub <- function(obj, logexpr) if (missing(logexpr)) {return(obj)
} else {e <- substitute(logexpr)
r <- eval(e, obj, parent.frame())
if (!is.logical(r))
stop("'subset' must evaluate to logical")
r <- r & !is.na(r)
obj[r, ] }
getsub(tmp, bank <50)
#--------------
kunde bank
1 3 7
3 3 3
4 3 3
6 3 2
7 3 2
8 1 1
9 3 7
10 3 2