Can somebody help me understand a CS problem.
The problem is the New York Time Rollercoaster problem.
I have a queue:
queue <- seq(from = 1, to = 5)
1 2 3 4 5
A person can bribe another person who is ahead of them in the queue but by only a maximum of 2 times. Thus a queue sequence might look like:
Ride: 1, 2, 3, 4, 5 # Original queue
Ride: 1, 2, 3, 5, 4 # 5 bribes number 4
Ride: 1, 2, 5, 3, 4 # 5 bribes number 3 and thus runs out of bribes and cannot move further (it does not state in the problem if 3 can "re-bribe" 5 so I assume they cannot).
Ride: 2, 1, 5, 3, 4 # 2 bribes number 1
So given the input c(1, 2, 3, 4, 5) what are the minimum number of swaps it would take to get to the final output which would be c(2, 1, 5, 3, 4).
Python code from here:
def minimumBribes(q):
moves = 0
for pos, val in enumerate(q):
if (val-1) - pos > 2:
return "Too chaotic"
for j in xrange(max(0,val-2), pos):
if q[j] > val:
moves+=1
return moves
I am trying to re-create this in R and understand the solution.
Here's a way I think -
minimumBribes <- function(final_q) {
change <- final_q - seq_along(final_q)
if(any(change > 2)) return("Too chaotic!")
sum(change[change > 0])
}
minimumBribes(q = c(2, 1, 5, 3, 4))
[1] 3
Explanation -
initial_q <- 1:5
final_q <- c(2, 1, 5, 3, 4)
# calculate change in position; +ve is gain and -ve is loss
change <- final_q - initial_q
[1] 1 -1 2 -1 -1
# it is clear that if some gained x posn combined then other(s) lost x posn combined
# i.e. sum of posn gains and losses will always be 0
# therefore, to get min total swaps, simply add either gains or losses
# which in a way implies the most direct path from initial_q to final_q
sum(change[change > 0])
[1] 3
Related
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 have a vector created simulating a continious time Markov Chain. The vector represents the path the chain may describe. Simulating 20 steps we could have:
Xt <- c(5, 5, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 2, 2, 2, 1, 1, 1, 0 ,0)
Further, the vector can jump 1 by 1 or jump from any state (5,4,3,2,1) to 0. So other simulation could be:
Xt <- c(5, 5, 5, 5, 5, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
I want to count the number of times the simulated chain jumps to other state (when the vector changes of number) within a determined interval. For example:
The number of jumps for the first vector I wrote for the first 10 elements is 2 (Jumps from 5 to 4 and 4 to 0). The number of jumps for the second vector I wrote for the last 10 elements is 0 (The last 10 elements are all 0)
So I would like to count the number of jumps (the number of times the pattern changes). I tried using toString(Xt)and then trying to match some regex but nothing worked. Any ideas?
You can use diff for this which counts the difference between adjacent numbers in a vector. Sum all instances not equal to zero to get total times the pattern changes.
First 10:
sum(diff(Xt[1:10])!=0)
[1] 2
Last 10:
sum(diff(Xt[(length(Xt)-10):length(Xt)])!=0)
[1] 0
Seems like just count the number of times the difference was not zero would deliver the desired result:
Xt <- c(5, 5, 5, 5, 5, 4, 4, 4, 4, 3, 3, 3, 2, 2, 2, 1, 1, 1, 0 ,0)
sum(diff(Xt) != 0)
If the goal was to write a function that takes a string and a starting positon it could be done thusly:
jump_in_next_10 <- function(string, start){
sum( diff(string[start:(start+9)]) != 0 )}
jump_in_next_10(Xt, 3)
#[1] 2
I have a vector:
as <- c(1,2,3,4,5,9)
I need to extract the first continunous sequence in the vector, starting at index 1, such that the output is the following:
1 2 3 4 5
Is there a smart function for doing this, or do I have to do something not so elegant like this:
a <- c(1,2,3,4,5,9)
is_continunous <- c()
for (i in 1:length(a)) {
if(a[i+1] - a[i] == 1) {
is_continunous <- c(is_continunous, i)
} else {
break
}
}
continunous_numbers <- c()
if(is_continunous[1] == 1) {
is_continunous <- c(is_continunous, length(is_continunous)+1)
continunous_numbers <- a[is_continunous]
}
It does the trick, but I would expect that there is a function that can already do this.
It isn't clear what you need if the index of the continuous sequence only if it starts at index one or the first sequence, whatever the beginning index is.
In both case, you need to start by checking the difference between adjacent elements:
d_as <- diff(as)
If you need the first sequence only if it starts at index 1:
if(d_as[1]==1) 1:(rle(d_as)$lengths[1]+1) else NULL
# [1] 1 2 3 4 5
rle permits to know lengths and values for each consecutive sequence of same value.
If you need the first continuous sequence, whatever the starting index is:
rle_d_as <- rle(d_as)
which(d_as==1)[1]+(0:(rle_d_as$lengths[rle_d_as$values==1][1]))
Examples (for the second option):
as <- c(1,2,3,4,5,9)
d_as <- diff(as)
rle_d_as <- rle(d_as)
which(d_as==1)[1]+(0:(rle_d_as$lengths[rle_d_as$values==1][1]))
#[1] 1 2 3 4 5
as <- c(4,3,1,2,3,4,5,9)
d_as <- diff(as)
rle_d_as <- rle(d_as)
which(d_as==1)[1]+(0:(rle_d_as$lengths[rle_d_as$values==1][1]))
# [1] 3 4 5 6 7
as <- c(1, 2, 3, 6, 7, 8)
d_as <- diff(as)
rle_d_as <- rle(d_as)
which(d_as==1)[1]+(0:(rle_d_as$lengths[rle_d_as$values==1][1]))
# [1] 1 2 3
A simple way to catch the sequence would be to find the diff of your vector and grab all elements with diff == 1 plus the very next element, i.e.
d1<- which(diff(as) == 1)
as[c(d1, d1[length(d1)]+1)]
NOTE
This will only work If you only have one sequence in your vector. However If we want to make it more general, then I 'd suggest creating a function as so,
get_seq <- function(vec){
d1 <- which(diff(as) == 1)
if(all(diff(d1) == 1)){
return(c(d1, d1[length(d1)]+1))
}else{
d2 <- split(d1, cumsum(c(1, diff(d1) != 1)))[[1]]
return(c(d2, d2[length(d2)]+1))
}
}
#testing it
as <- c(3, 5, 1, 2, 3, 4, 9, 7, 5, 4, 5, 6, 7, 8)
get_seq(as)
#[1] 3 4 5 6
as <- c(8, 9, 10, 11, 1, 2, 3, 4, 7, 8, 9, 10)
get_seq(as)
#[1] 1 2 3 4
as <- c(1, 2, 3, 4, 5, 6, 11)
get_seq(as)
#[1] 1 2 3 4 5 6
The code is to be used to decide who shall be the first player in the game Wazabi (a popular game developed by Gigamic). So you understand the gist of what I'm trying to do, the following procedure decides who goes first:
Each player rolls a 4, six-sided dice consisting of three outcomes (three faces have 'W', two faces have 'C' and the remaining face has 'G', so there is a 3/6 probability you'd roll a W for example).
The player who rolls the most Ws wins.
In the event of more than one player rolling the highest number of Ws, the players who rolled the highest number re-roll the 4 dice, and then the player with the highest W becomes first (this may happen recursively).
I've designed the below code (albeit messily) in r to try and decide who this player should be, but after a few hours of attempts and a tired brain for company I'm hoping one of you will be able to help me out. Here's the output in R console from my code:
who_first <- function(){
dummylist <- c()
playersdummy <- 1:number_of_players
first_rolling <- function(players_left=number_of_players){
for(i in 1:players_left){
# Random variable where 1, 2 & 3 represents Ws, Cs and Gs respectively.
die_poss <- c(1, 1, 1, 2, 2, 3)
die_result <- sample(die_poss, 4, replace=T)
dummy2 <- 0
for(j in 1:4){
if(die_result[j]==1){
dummy2 <- dummy2 + 1
}
}
dummy3 <- append(dummylist, dummy2, after=i)
# dummylist stores the number of Ws rolled by each respective player,
# i.e. first element says how many Ws 1st player still left in rolled.
dummylist <<- dummy3
}
dummy4 <- 0
for(k in 1:players_left){
if(dummylist[k]==max(dummylist)){
# dummy4 represents the number of players who rolled the highest number of Ws that roll.
dummy4 <<- dummy4 + 1
}
}
return(dummy4)
}
while(dummy4 >= 1){
if(dummy4==1){
playersdummy <<- playersdummy[(which(dummylist==max(dummylist))==TRUE)]
return(playersdummy)
}
else if(dummy4 > 1){
dummy5 <- c()
for(l in 1:length(playersdummy)){
if(any((playersdummy[l]==which(dummylist==max(dummylist)))==TRUE)){
dummy6 <- append(dummy5, playersdummy[l], after=l)
dummy5 <<- dummy6
}
}
# playersdummy becomes the vector containing which players are left in the game, i.e. 2 represents player 2.
playersdummy <<- dummy5
dummylist <<- c()
first_rolling(length(playersdummy))
}
}
}
who_first()
[1] 1 2 3 4 5 6 7
Warning message:
In max(dummylist) : no non-missing arguments to max; returning -Inf*
number_of_players is globally defined in another function simply as the number of players in the game. It is equal to 7 in this test.
Clearly I should return a vector of length 1 with the player number for whichever player rolled the most Ws after however many rolls and rerolls. Also, as I'm quite new to R, I'm not exactly sure as to what the warning message is getting at, if someone could explain that'd be helpful.
Here's a code that apparently follows your algorithm but is much simpler than your attempt.
The idea is simple: Since there's no difference between the C and G outcomes, you can just make them the same, valued 0. Make the W outcome 1, and sum the number of times it's been rolled. Then check if there's a winner, if not, keep only the highest ties and repeat.
It does seem that it would be much simpler to just roll the dice once and, in case of a tie, keep those and roll again. But maybe there's more to it.
who_first <- function(n) {
players <- seq_len(n)
found_winner <- FALSE
die_poss <- c(rep(c(0, 1), each = 3))
while (!found_winner) {
cat("Rolling for players", paste(players, collapse = ", "), "\n")
results <- replicate(length(players), sum(sample(die_poss, 4, replace=T)))
cat("Players rolled", paste(results, collapse = ", "), "points\n")
if (sum(max(results) == results) == 1) {
found_winner <- TRUE
winner <- players[which.max(results)]
cat("Winner is player", winner, "\n")
} else {
players <- players[max(results) == results]
}
}
invisible(winner)
}
Some runs:
> set.seed(10)
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 2, 0, 3, 1, 1, 3, 2 points
Rolling for players 3, 6
Players rolled 2, 2 points
Rolling for players 3, 6
Players rolled 4, 1 points
Winner is player 3
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 0, 2, 1, 1, 0, 3, 1 points
Winner is player 6
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 3, 1, 2, 1, 1, 3, 2 points
Rolling for players 1, 6
Players rolled 0, 3 points
Winner is player 6
I have the following matrix
m <- matrix(c(2, 4, 3, 5, 1, 5, 7, 9, 3, 7), nrow=5, ncol=2,)
colnames(x) = c("Y","Z")
m <-data.frame(m)
I am trying to create a random number in each row where the upper limit is a number based on a variable value (in this case 1*Y based on each row's value for for Z)
I currently have:
samp<-function(x){
sample(0:1,1,replace = TRUE)}
x$randoms <- apply(m,1,samp)
which work works well applying the sample function independently to each row, but I always get an error when I try to alter the x in sample. I thought I could do something like this:
samp<-function(x){
sample(0:m$Z,1,replace = TRUE)}
x$randoms <- apply(m,1,samp)
but I guess that was wishful thinking.
Ultimately I want the result:
Y Z randoms
2 5 4
4 7 7
3 9 3
5 3 1
1 7 6
Any ideas?
The following will sample from 0 to x$Y for each row, and store the result in randoms:
x$randoms <- sapply(x$Y + 1, sample, 1) - 1
Explanation:
The sapply takes each value in x$Y separately (let's call this y), and calls sample(y + 1, 1) on it.
Note that (e.g.) sample(y+1, 1) will sample 1 random integer from the range 1:(y+1). Since you want a number from 0 to y rather than 1 to y + 1, we subtract 1 at the end.
Also, just pointing out - no need for replace=T here because you are only sampling one value anyway, so it doesn't matter whether it gets replaced or not.
Based on #mathematical.coffee suggestion and my edited example this is the slick final result:
m <- matrix(c(2, 4, 3, 5, 1, 5, 7, 9, 3, 7), nrow=5, ncol=2,)
colnames(m) = c("Y","Z")
m <-data.frame(m)
samp<-function(x){
sample(Z + 1, 1)}
m$randoms <- sapply(m$Z + 1, sample, 1) - 1