I would like to know how to plot 1000 "walkers" that each "walk" 100 steps.
I am not sure how to plot a diagram with more then one walker, let alone 1000 each walking 100 steps.
Below is the code for one "walker" walking 10 steps.
function walk(N, init::Int=0)
trace = Int[init]
for t in 1:N
if randn() > 0
push!(trace, trace[end] + 1)
else
push!(trace, trace[end] - 1)
end
end
trace
end
walk(10)
[0, 1, 0, 1, 0, -1, 0, 1, 2, 3, 2]
There are many ways to do it. I would do it like this (this is not a most efficient way to do it, but I find it easy to write):
using Plots
init = 0
walkers = 1000
walk_length = 100
walks = cumsum(vcat(fill(init, 1, walkers), # initial state
rand([-1, 1], walk_length, walkers)), # vertically append move direction
dims=1) # cumulative sum over the first dimension to get one walk per column
plot(walks, legend=nothing)
In the code walks is a Matrix storing each walk in a column (so in your case it has 101 rows and 1000 columns)
Related
A five card charlie is where you draw five cards and don't go bust, i.e. the points from 5 cards is <= 21. I want to find the probability of a 5 card charlie by brute force - i.e. simulate a large number of "plays" and check if you go bust or not.
by using brute force using R. I'm assuming here that there are 4 decks as is common in Casinos, and I'm sampling 5 cards from these 4 decks, checking if they've won and if so counting it towards the probability. Googling states it should be around 1/50, i.e. 2%:
deck <- c(rep(1:9, 16), rep(10, 64))
n <- 0
size <- 1:10e6
for (i in size){
smpl <- sample(deck,5,replace = F)
if (sum(smpl) <= 21){
n <- n+1
}
}
print(n/max(size) * 100)
[1] 5.98644
Note that "deck" here is the point system, i.e. we have 1:9 points for 4 suits, and 4 deck of cards hence need 1:9 16 times, and similarly Jack Queen King and Ten all count as ten but 4*4*4 possible cards.
Sample 5 cards without replacement, check if the sum is <= 21, and if so count it, then finally do this 10 million times and calculated the probability. However this gives 6% rather than 2%.
I have two questions:
1) How can I modify this so that I can sample 100 million or more plays?
2) Where am I going wrong with the 6% probability?
I think that what is off here is the assumption that it should be 2%.
Your code said about 5%. I've adapted an existing answer and it also says 5%:
deck <- c(rep(1:9, 4), rep(10, 16))
result <- combn(deck, 5, function(x) {sum(x) <= 21})
sum(result)/dim(result)
[1] 0.05385693
For k = 5, 6, 7 - card charlie you could try the following (to compute the probability with simulation) with replicate:
sapply(5:7, function(k) mean(replicate(n=10^6,
sum(sample(c(rep(1:9, 4), rep(10, 16)), k, replace = F)) <= 21)))
#[1] 0.053943 0.008525 0.000890
Here is how the probability decreases with k (for k-card charlie)
library(ggplot2)
ggplot(aes(card, prob),
data=data.frame(card=2:7, prob=sapply(2:7, function(x) mean(replicate(n=10^6, sum(sample(c(rep(1:9, 4), rep(10, 16)),x,replace = F)) <= 21))))) +
geom_point() + geom_line()
I want to solve a linear optimization problem with binary decision variables to be solved in R (currently I am using the Rglkp package). However I am having trouble setting up the constraints.
Suppose a company wants to decide what quarters to sell their product to maximize their profit. But, if they want to sell they must sell in at least 3 quarters in a row. This is an example of what their profits might look like.
profits <- tibble(year = 1,
quarter = 1:4,
profit = c(23, -4, 6, -2))
I could then set up an Rglpk constraint matrix and solve as below.
cons.m <- matrix(c( 2, -1, -1, 0,
-2, 3, -2, -1,
-1, -2, 3, -1,
0, -1, -2, 2),
nrow = 4, byrow = T)
solution <- Rglpk_solve_LP(obj = profits$profit,
mat = cons.m,
dir = rep("<=", 4),
rhs = rep(0, 4),
types = rep("B", 4),
max = T)
solution$solution
[1] 1 1 1 0
Which says I should sell in the first 3 quarters and not sell in Q4. This is clearly the correct solution.
How could I extend this solution to work with 12 periods, where I must sell at least 5 quarters in a row?
profits.new <- tibble(year = rep(1:3, each = 4),
quarter = 1:12,
profit = runif(12, -20, 20))
I realize I can generate all combinations and then select the maximum that meets the requirements, but I want a solution the can generalize to much larger cases where there would be too many combinations.
This can be modeled as:
where n is the minimum length of a production run.
This will only require T=12 constraints.
The total number of possible production runs >= n (with n=5, T=12) is 42.
Of course, this difference will increase (rather dramatically) for longer planning horizons. E.g. for T=24,n=5 we have 24 constraints vs 4316 possible solutions.
An optimal solution can look like:
There is much more to say about constraints like this.
I am writing a simple grid world q-learning program using R. This is my grid world
This simple grid world has 6 states in which state 1 and state 6 are starting and ending state. I avoided adding a fire pit, wall, wind so to keep my grid world as simple as possible. For reward matrix I have starting state value-0.1 and ending state a +1 and rest of the state 0. A -0.1 reward for starting state is to discourage the agent from coming back to the start position.
#Reward and action-value matrix
Row=state(1:6)
Column=actions(1:4)[Left,Right,Down,Up in that order]
I wrote my program in R and its working but with a problem in finding next state when current state is greater than 4th row. The Q matrix doesn't update after 4th row.
#q-learning example
#https://en.wikipedia.org/wiki/Q-learning
# 2x3 grid world
# S for starting grid G for goal/terminal grid
# actions left right down up
# 4 5 6 state
#########
# [0,0,G]
# [S,0,0]
#########
# 1 2 3 state
#setting seed
set.seed(2016)
#number of iterations
N=10
#discount factor
gamma=0.9
#learning rate
alpha=0.1
#target state
tgt.state=6
#reward matrix starting grid has -0.1 and ending grid has 1
R=matrix( c( NA, 0, NA, 0,
-0.1, 0, NA, 0,
0, NA, NA, 1,
NA, 0,-0.1, NA,
0, 1, 0, NA,
0, NA, 0, NA
),
nrow=6,ncol=4,byrow = TRUE)
#initializing Q matrix with zeros
Q=matrix( rep( 0, len=dim(R)[1]*dim(R)[2]), nrow = dim(R)[1],ncol=dim(R)[2])
for (i in 1:N) {
## for each episode, choose an initial state at random
cs <- 1
## iterate until we get to the tgt.state
while (1) {
## choose next state from possible actions at current state
## Note: if only one possible action, then choose it;
## otherwise, choose one at random
next.states <- which(R[cs,] > -1)
if (length(next.states)==1)
ns <- next.states
else
ns <- sample(next.states,1)
## this is the update
Q[cs,ns] <- Q[cs,ns] + alpha*(R[cs,ns] + gamma*max(Q[ns, which(R[ns,] > -1)]) - Q[cs,ns])
## break out of while loop if target state is reached
## otherwise, set next.state as current.state and repeat
if (ns == tgt.state) break
cs <- ns
Sys.sleep(0.5)
print(Q)
}
}
Currently when my algorithm starts the agent always start from the state-1. In the first state(first row of R) there are two actions either Right(R(1,2)) or Up(R(1,4)). If randomly selected an action say Up (R(1,4)) then the agent move to next state as the action Q(4,action).
But now consider state-4(forth row or R) it has two action Right-R(4,2) and Down-R(4,3) this cause problem for my algorithm and if randomly select an action say, Right. Logically it should move to 5th state but my above code
uses the action 2 as the next state. so instead of going to 5th state it goes to 2nd state.
In the end my algorithm will work perfectly if the dimension of state and action matrices are same(m x m) but in my problem my state and action matrices are different (m x n). I tried to find a solution to this problem but failed to find an logical approach to find next state for $max(Q(s',a'))$ currently I am stuck?
(The comments in your code don't correspond to what you are actually doing. Try to avoid this always.)
You are conflating the transition and the reward matrices. For a non-stochastic environment, they should look something like this:
R <- matrix(c(
-1, -1, -1, -1,
-1, -1, -1, -1,
-1, -1, -1, 10,
-1, -1, -1, -1,
-1, 10, -1, -1,
10, 10, -1, -1),
nrow=6, ncol=4, byrow=T)
T <- matrix(c(
1, 2, 1, 4,
1, 3, 2, 5,
2, 3, 3, 6,
4, 5, 1, 4,
4, 6, 2, 5,
6, 6, 3, 5),
nrow=6, ncol=4, byrow=T)
The ε-greedy strategy would be:
greedy <- function(s) which(Q[s,] == max(Q[s,]))
egreedy <- function(s, e) if (runif(1, 0, 1) < e) greedy(s) else sample(1:ncol(Q), 1)
ca <- egreedy(cs, epsilon)
Then choosing the next state is just:
ns <- T[cs, ca]
I am working in R with a classifier that outputs a matrix of real values with one column for each class that I am classifying. I then apply a function to the output matrix and my class label matrix (one column per class) to calculate an error per class (column).
This worked well with small datasets and equal distributions of class and non-class rows but breaks down when I use bigger files with a skewed distribution of class versus non-class. Typically my files contain less than 0.3% class versus 99.7% non-class and in this case my classifier tends to simply output the non-class value (0).
I want to try a different error (cost) function to try to balance this out. I will also try up and down sampling but they have other issues. A possible simple change that I would like to try is to calculate the error for class 1 separately from class 0 and then combine those errors in such a way that the class errors are not buried by the overwhelming non-class errors.
I am including a minimum working example to help demonstrate what I want.
L1 <- runif(13, min=0, max=1)
L2 <- runif(13, min=0, max=1)
predy <- cbind(L1, L2) # simulated output from the classifier
#predy
L1 <- c(0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0)
L2 <- c(0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0)
classy <- cbind(L1, L2) # Simulated class matrix
#classy
# Now compute error showing existing method
mse <- apply((predy - classy)^2, 2, mean)
nrmse <- sqrt(mse / apply(classy, 2, var))
#
#nrmse
# L1 L2
# 1.343796 1.062442
#
# Sort-of-code for what I would like to have
# mse0 <- apply((predy - classy)^2, 2, mean) where x=0
# mse1 <- apply((predy - classy)^2, 2, mean) where x=1
# mse <- (mse0 + mse1) / 2 # or some similar way of combining them of my choice
# nrmse <- sqrt(mse / apply(classy, 2, var))
In addition, my files are large and my classifier model is huge and so doing this in a computationally efficient manner would be very helpful.
I managed to do it using a for loop (below), can anyone help translate this to apply?
mean.ones <- matrix(0, dim(classy)[2])
mean.zeros <- matrix(0, dim(classy)[2])
for (ix in 1:dim(classy)[2]) {
ix.ones <- classy[, ix]==1
mean.ones[ix] <- mean(predy[ix.ones, ix])
mean.zeros[ix] <- mean(predy[!ix.ones, ix])
}
The code above doesn't do the same thing as the original, it just calculates conditional means, however the code flow seems correct.
Here's a solution that takes advantage of (1) lexical scoping so
you don't have to pass the matrices to the summary function passed to the first lapply(), and
(2) that predy and classy have the same dimensions.
Here's the calculation of the conditional means:
# calculation of means
temp <- lapply(seq.int(ncol(predy)),
function(i)tapply(predy[,i],
classy[,i],
mean))
# presumably each column has members of both classes,
# but if not, we'll assure that there are two members
# two each element of the list 'temp', as follows:
temp <- lapply(temp,
function(x)x[match(0:1,names(x))])
# bind the outputs togeather by column.
mean_mx = do.call(cbind,temp)
all(mean_mx[1,]==mean.zeros)
all(mean_mx[2,]==mean.ones)
Here's the calculation of the mean squared errors:
# calculation of MSE
temp <- lapply(seq.int(ncol(predy)),
function(i)tapply((predy[,i] - classy[,i])^2,
classy[,i],
mean))
# presumably each column has members of both classes,
# but if not, we'll assure that there are two members
# two each element of the list 'temp', as follows:
temp <- lapply(temp,
function(x)x[match(0:1,names(x))])
# bind the outputs togeather by column.
mse_mx = do.call(cbind,temp)
mse0 <- mse_mx[1,]
mse1 <- mse_mx[2,]
mse <- (mse0 + mse1) / 2
nrmse <- sqrt(mse / apply(classy, 2, var))
I have a data matrix with 100,000 rows of values corresponding to methylation values across several cell types. I would like to visually display the changes in methylation in a clustered heatmap. To get the data into a more manageable size I was thinking of creating a new data matrix every 10th or so row. Is there any simple way to do this?
Use seq and combinations of arguments. E.g.:
m1 <- matrix(runif(100000*10), ncol = 10)
m2 <- m1[seq(from = 1, to = nrow(m1), by = 10), ]
> dim(m2)
[1] 10000 10
How does this work? Look at what this does:
> sq <- seq(from = 1, to = nrow(m1), by = 10)
> head(sq)
[1] 1 11 21 31 41 51
> tail(sq)
[1] 99941 99951 99961 99971 99981 99991
> nrow(m1)
[1] 100000
We specify to go from the first row to the last incrementing 10 each step. This gives us rows 1, 11, 21, etc. When we get to the end of the sequence, even though we specified nrow(m1) (which is 100000) the last element in our sequence in 99991. This is because 99991 + 10 would take us beyond the from argument limit (beyond 100000) and hence that is not included in the sequence.
Try the following which takes your large matrix m and generates a list of smaller matrices. It generates a sequence of indices that breaks at every chunk.length values and then collects the chunks.
list.of.matrices <- lapply(X=seq.int(1, nrow(m), by=chunk.length)),
FUN=function (k) {
m[k + seq_len(chunk.length) - 1, ])
})
However, if you have 100,000 rows, it will be wasteful for your RAM to save all these chunks separately. Perhaps, you can just do the required computation on the subsets and save only the results. Just a suggestion.