I'm trying to run a function much more complex but equal to:
A <<- 5
B <<- 5
table <- data.frame(A,B)
backup <- table
test <- function(A,B){
while(A > 0){
r <- runif(1,0,1)
if ((r >= 0)&(r <= 0.5)){
A <- A + 1
B <- B - 1
} else if ((r > 0.5)&(r<=1)){
A <- A - 1
B <- B + 1
}
tab <- cbind(A,B)
table <<- rbind(table,tab)
if (nrow(table) == 10) {
break
} else if ((A > 0) & (nrow(table) != 10)) {
next
} else {if ((A == 0) & (nrow(table != 10)) { #pointing to error here?
A <- 5
B <- 5
table <- backup
next
}
}
}
So what I want this function to do is stop when the when number of rows of the table (= the number of times the function ran) is equal to a certain value, in this case 10. But A cannot take a value below 0. If A reaches 0 before the number of rows of the table is 10 the whole process has to start again, with the same inputvalues as before.
However, this function does not work. I think it's because I use multiple next statements, is that correct?
Thanks!
I think you're on the right track... just a few recommendations
I think this accomplishes what you're trying to achieve a little cleaner. I second Carl's suggestion of avoiding the global operator '<<-' when possible and passing the objects through to the function as arguments or parameters. I also second Justin's suggestion of avoiding the break command in favor of placing the return() call smartly. To accomplish this, I put your 10 (stopping criteria) directly into the while loop. I included it as a parameter n so that you can experiment with different stopping criteria. Hope this helps :)
test <- function(A,B,n){
A0 <- A
B0 <- B
tab <- data.frame(A,B)
while(A > 0 & nrow(tab) < n){
r <- runif(1,0,1)
if (r <= 0.5){
A <- A + 1
B <- B - 1
} else {
A <- A - 1
B <- B + 1
}
tab1 <- cbind(A,B)
tab <- rbind(tab,tab1)
if(nrow(tab)<n & A==0){
A<-5
B<-5
tab <- cbind(A0,B0)
names(tab) <- c('A', 'B')
print(paste('found A==0 in less than ', n, ' iterations', sep=''))
}
}
return(tab)
}
Testing function...
## running function
A <- 5
B <- 5
testDF <- test(A,B,10)
> testDF
A B
1 5 5
2 6 4
3 5 5
4 6 4
5 7 3
6 8 2
7 9 1
8 10 0
9 9 1
10 10 0
Related
I just saw a YouTube video from Numberphile on the Yellowstone sequence (A098550). It's base on a sequence starting with 1 and 2, with subsequent terms generated by the rules:
no repeated terms
always pick the lowest integer
gcd(a_n, a_(n-1)) = 1
gcd(a_n, a_(n-2)) > 1
The first 15 terms would be: 1 2 3 4 9 8 15 14 5 6 25 12 35 16 7
A Q&D approach in R could be something like this, but understandably, this becomes very slow at attempts to make longer sequences. It also make some assumptions about the highest number that is possible within the sequence (as info: the sequence of 10,000 items never goes higher than 5000).
What can we do to make this faster?
library(DescTools)
a <- c(1, 2, 3)
p <- length(a)
# all natural numbers
all_ints <- 1:5000
for (n in p:1000) {
# rule 1 - remove all number that are in sequence already
next_a_set <- all_ints[which(!all_ints %in% a)]
# rule 3 - search the remaining set for numbers that have gcd == 1
next_a_option <- next_a_set[which(
sapply(
next_a_set,
function(x) GCD(a[n], x)
) == 1
)]
# rule 4 - search the remaining number for gcd > 1
next_a <- next_a_option[which(
sapply(
next_a_option,
function(x) GCD(a[n - 1], x)
) > 1
)]
# select the lowest
a <- c(a, min(next_a))
n <- n + 1
}
Here's a version that's about 20 times faster than yours, with comments about the changes:
# Set a to the final length from the start.
a <- c(1, 2, 3, rep(NA, 997))
p <- 3
# Define a vectorized gcd() function. We'll be testing
# lots of gcds at once. This uses the Euclidean algorithm.
gcd <- function(x, y) { # vectorized gcd
while (any(y != 0)) {
x1 <- ifelse(y == 0, x, y)
y <- ifelse(y == 0, 0, x %% y)
x <- x1
}
x
}
# Guess at a reasonably large vector to work from,
# but we'll grow it later if not big enough.
allnum <- 1:1000
# Keep a logical record of what has been used
used <- c(rep(TRUE, 3), rep(FALSE, length(allnum) - 3))
for (n in p:1000) {
# rule 1 - remove all number that are in sequence already
# nothing to do -- used already records that.
repeat {
# rule 3 - search the remaining set for numbers that have gcd == 1
keep <- !used & gcd(a[n], allnum) == 1
# rule 4 - search the remaining number for gcd > 1
keep <- keep & gcd(a[n-1], allnum) > 1
# If we found anything, break out of this loop
if (any(keep))
break
# Otherwise, make the set of possible values twice as big,
# and try again
allnum <- seq_len(2*length(allnum))
used <- c(used, rep(FALSE, length(used)))
}
# select the lowest
newval <- which.max(keep)
# Assign into the appropriate place
a[n+1] <- newval
# Record that it has been used
used[newval] <- TRUE
}
If you profile it, you'll see it spends most of its time in the gcd() function. You could probably make that a lot faster by redoing it in C or C++.
The biggest change here is pre-allocation and restricting the search to numbers that have not yet been used.
library(numbers)
N <- 5e3
a <- integer(N)
a[1:3] <- 1:3
b <- logical(N) # which numbers have been used already?
b[1:3] <- TRUE
NN <- 1:N
system.time({
for (n in 4:N) {
a1 <- a[n - 1L]
a2 <- a[n - 2L]
for (k in NN[!b]) {
if (GCD(k, a1) == 1L & GCD(k, a2) > 1L) {
a[n] <- k
b[k] <- TRUE
break
}
}
if (!a[n]) {
a <- a[1:(n - 1L)]
break
}
}
})
#> user system elapsed
#> 1.28 0.00 1.28
length(a)
#> [1] 1137
For a fast C++ algorithm, see here.
Select only unique sets from a dataframe
here one set = one row of data frame.
syntax in r?
I want set concepts
see this example
1 1 2
1 2 1
1 2 3
o/p:
1 1 2
1 2 3
Here row1 and row2 form the sets ={1,2}, so I need only one copy of such rows.
This is my code for apriori algorithm. The function trim(data,r) is what i'hv been trying as a solution,but isn't working out.
uniqueItemSets<-function(data){
#unique items in basket
items <- c()
for(j in c(1:ncol(data))){
items <- c(items,unique(data[,j]))
}
items <- unique(items)
#return(as.list(items))
return(items)
}
F_itemset<-function(data,candidate,sup){
count <- rep(0,nrow(candidate))
for(i in c(1:nrow(data))){ #every transaction
for(j in c(1:nrow(candidate))){ #every dataset
x <- candidate[j,]
#x <- uniqueItemSets(x)
y <- data[i,]
#y <- uniqueItemSets(y)
if(all(x %in% y)){
count[j] <- count[j] + 1
}
}
}
#pruning
pp<-cbind(candidate,count)
pp<-as.data.frame(pp)
pp<-subset(pp,pp$count>=sup)
return(pp)
}
#k-itemset :k-value
makeItemSet<- function(candidate,k){
l<-combn(candidate,k,simplify=FALSE)
return(l)
}
aprio<-function(data,sup,conf,kmax){
C <- uniqueItemSets(data)
C <- as.data.frame(C)
for(k in c(2:kmax))
{
F <- F_itemset(data,C,sup)
F$count <- NULL
if(nrow(F)<k){
break;
}
F<-t(F)
C <- combn(F,k,simplify=FALSE)
C <- as.data.frame(C)
C <- t(C) #transpose
C<-unique(C)
trim(C,1)
}
return(F)
}
**
new <- data.frame()
trim<-function(data,r)
{
x<-as.data.frame(data[r,])
c<-c()
for(j in c(1:ncol(x))){
c<-c(c,x[,j])
}
c<-unique(c)
if(r+1<=nrow(data)){
for(i in c((r+1):nrow(data))){
t<-c()
for(j in c(1:ncol(data))){
t<-c(t,data[i,j])
}
t<-unique(t)
if(all(t %in% c) && all(c %in% t))
{
data[-i,]
}
}
new <- as.data.frame(data)
if(r+1 < nrow(data)){
trim(data[r+1:nrow(data),],r+1)
}
}
}
**
You can use apply with margin = 1 to execute row wise functions. The only thing to be aware of is that you need to transpose the outcome to get the order you need
d <- data.frame(number1 = c(1,1,1),
number2 = c(1,2,2),
number3 = c(2,1,3))
# next two statements can be run in one line of code if you want
d_sort <- t(apply(d, 1, sort))
# get rid of duplicate rows
unique(d_sort)
[,1] [,2] [,3]
[1,] 1 1 2
[2,] 1 2 3
i am writing a merge sort in R. I have 2 functions. The first is mergelist()
mergelist <- function(a, b)
{
al <- length(a$data)
bl <- length(b$data)
r <- numeric(al + bl)
numberOfComparisions <-0
ai <- 1
bi <- 1
j <- 1
while((ai <= al) && (bi <= bl))
{
if(a$data[ai]<b$data[bi])
{
r[j] <- a$data[ai]
ai <- ai + 1
numberOfComparisions = numberOfComparisions + 1
}
else
{
r[j] <- b$data[bi]
bi <- bi + 1
numberOfComparisions = numberOfComparisions + 1
}
j <- j + 1
}
if(ai<=al)
r[j:(al+bl)] <- a$data[ai:al]
else if(bi <= bl)
r[j:(al+bl)] <- b$data[bi:bl]
returnList <- list(number=numberOfComparisions + a$number + b$number , data = r)
return(returnList)
}
This methods takes in 2 sorted lists as parameter a and b and returns a sorted list with the number attribute of the list telling me how many comparisions there have been made.
I also have this method mergesort()
mergesort <- function(x)
{
l <- length(x)
if(l > 1) {
p <- ceiling(1/2)
a <- mergesort(x[1:p])
b <- mergesort(x[(p+1):l])
return(mergelist(a,b))
}
lister <- list(number=0, data = x)
return(lister)
}
Which takes in a vector x and sorts it. It is returning a list just like mergelist() with the number attribute being the same as in mergelist.
Now my problem is that i have following example: mergesort(c(11,10,9,15,6,12,17,8,19,7)) ,
Which should return
$number [1] 22
$data [1] 6 7 8 9 10 11 12 15 17 19
But it returns
$number
[1] 30
$data
[1] 6 7 8 9 10 11 12 15 17 19
So this means it counts a comparision where it shouldn´t. I don´t know where. Can somebody tell me what i am doing wrong?
Shouldn't your code
p <- ceiling(**1**/2)
be like this
p <- ceiling(**l**/2)
So i've written this basic code that sorts a list using the well-known merge-sorting algorithm, i've defined two functions mergelists that compares and merges the elements and mergesort that divides the list into single elements:
mergelists <- function(a,b) {
al <- length(a)
bl <- length(b)
r <- numeric(al+bl)
ai <- 1
bi <- 1
j <- 1
while((ai<=al) && (bi<=bl)) {
if(a[ai]<b[bi]) {
r[j] <- a[ai]
ai <- ai+1
} else {
r[j] <- b[bi]
bi <- bi+1
}
j <- j+1
}
if(ai<=al) r[j:(al+bl)] <- a[ai:al]
else if(bi<=bl) r[j:(al+bl)] <- b[bi:bl]
return(r)
}
mergesort <- function(x) {
l <- length(x)
if(l>1) {
p <- ceiling(l/2)
a <- mergesort(x[1:p])
b <- mergesort(x[(p+1):l])
return(mergelists(a,b))
}
return(x)
}
this seems to work fine for the examples i used so far, for example:
> mergesort(c(11,10,9,15,6,12,17,8,19,7))
[1] 6 7 8 9 10 11 12 15 17 19
now for the sake of some research i'm doing, i want to change this code to work with R-lists and not vectors, the lists are usually defined as following:
> list(number=10,data=c(10,5,8,2))
$number
[1] 10
$data
[1] 10 5 8 2
data represents here the vector and number is the number of comparaisons.
After the change i imagine that the program should give me something like this:
>mergelists(list(number=8,data=c(1,3,5,8,9,10)),list(number=5,data=c(2,4,6,7)))
$number
[1] 20
$data
[1] 1 2 3 4 5 6 7 8 9 10
> mergesort(c(11,10,9,15,6,12,17,8,19,7))
$number
[1] 22
$data
[1] 6 7 8 9 10 11 12 15 17 19
the 20 here is basically 8 + 5 + 7, because 7 comparaisons would be necessary to merge the two sorted lists, but i don't know how to do this because i have a little experience with R-lists. i would appreciate your help. Thanks.
The starting point for any vector vec is list(number = 0, data = vec), where number is 0 because it as taken 0 comparisons to start with an unsorted vector.
You first need to modify mergelists to deal with two lists, simply by adding the indexing and then reforming the list at the end.
mergelists <- function(a,b) {
firstn <- a$number + b$number
a <- a$data
b <- b$data
al <- length(a)
bl <- length(b)
r <- numeric(al+bl)
ai <- 1
bi <- 1
j <- 1
while((ai<=al) && (bi<=bl)) {
if(a[ai]<b[bi]) {
r[j] <- a[ai]
ai <- ai+1
} else {
r[j] <- b[bi]
bi <- bi+1
}
j <- j+1
}
if(ai<=al) r[j:(al+bl)] <- a[ai:al]
else if(bi<=bl) r[j:(al+bl)] <- b[bi:bl]
return(list(number = firstn + j - 1L, data = r))
}
mergelists(list(number=8,data=c(1,3,5,8,9,10)), list(number=5,data=c(2,4,6,7)))
# $number
# [1] 20
# $data
# [1] 1 2 3 4 5 6 7 8 9 10
Now that you have the "base function" defined, you need the calling function to generate the enhanced vector (list) and pass it accordingly. This function can easily be improved for efficiency, but I think its recursive properties are sound.
mergesort <- function(x) {
# this first guarantees that if called with a vector, it is list-ified,
# but if called with a list (i.e., every other time in the recursion),
# the argument is untouched
if (! is.list(x)) x <- list(number = 0, data = x)
l <- length(x$data)
if (l > 1) {
p <- ceiling(l/2)
# the `within(...)` trick is a sneaky trick, can easily be
# handled with pre-assignment/subsetting
a <- mergesort(within(x, { data <- data[1:p]; }))
b <- mergesort(within(x, { data <- data[(p+1):l]; }))
return(mergelists(a,b))
}
return(x)
}
mergesort(c(11,10,9,15,6,12,17,8,19,7))
# $number
# [1] 22
# $data
# [1] 6 7 8 9 10 11 12 15 17 19
Good morning,
I have the following problem.
My Data.frame "data" has the format:
Type amount
1 2
2 0
3 3
I would like to create a vector with the format:
1
1
3
3
3
This means I would like to transform my data.
I created a vector and wrote the following code for my transformation in R:
vector <- numeric(5)
for (i in 1:3){
k <- 1
while (k <= data[i,2]){
vector[k] <- data[i,1]
k <- k+1
}
}
The problem is, I get the following results and I have no Idea at which part I go wrong…
3
3
3
0
0
There might be many different ways in solving this particular problem in R but I am curious why my solution doesn't work. I am thankful for alternatives, but really would like to know what my mistake is.
Thank's for your help!
Try this solution:
df <- data.frame(type = c(1, 2, 3), amount = c(2, 0, 3))
result <- unlist(mapply(function(x, y) rep.int(x, y), df[, "type"], df[, "amount"]))
result
Output is following:
# [1] 1 1 3 3 3
Exaclty your code is buggy. Correct code should looks following:
df <- data.frame(type = c(1, 2, 3), amount = c(2, 0, 3))
vector <- numeric(5)
k <- 1
for (i in 1:3) {
j <- 1
while (j <= df[i, 2]) {
vector[k] <- df[i, 1]
k <- k + 1
j <- j + 1
}
}
vector
# [1] 1 1 3 3 3
Probably the fastest and most elegant way to obtain this result has been posted before in a comment by #akrun:
with(data, rep(Type, amount))
[1] 1 1 3 3 3
However, if you want to do this with for/while loops, it could be helpful to use a list for such cases, where the number of entries is not known at the beginning.
Here is an example with minimal modifications of your code:
my_list <- vector("list", 3)
for (i in 1:3) {
k <- 1
while (k <= data[i,2]){
my_list[[i]][k] <- data[i,1]
k <- k + 1
}
}
vector <- unlist(my_list)
#> vector
#[1] 1 1 3 3 3
The reason why your code didn't work was essentially that you were trying to put too much information into a single variable, k. It cannot serve as both, an index of your output vector, and as a counter for the individual entries in the first column of data; a counter which is reset to 1 each time the while loop has finished.