I'm implementing GA algorithm. The chromosomes have a combination of -1,0,1 values. In the mutation part, I want to change -1 to 1 with prob(-1 to 1) and change 1 to -1 with prob(1 to -1).
I don't know if there is any function in R which would make it easy for me. Would any one tell me if there is a function which helps me replace the values according to their probability?
You could throw a dice and if 1 comes up, you change the original value to another value. You could add if statements for all of your transitions. If you mean to mutate the whole string in one step, this can be better optimized.
from <- c(1,-1,1,0,-1)
probToMutate <- function(x) {
if (x == 1) {
dice <- rbinom(1, size = 1, prob = 0.1)
if (dice == 1) {
x <- -1
} else {
x <- 1
}
} else {
x
}
}
sapply(from, FUN = probToMutate)
Related
I've just started getting back into coding, and I'm trying to write a few different functions to simulate betting strategies. The first I'm trying to simulate is the martingale strategy, a strategy where you place a roulette bet that has ~ 50% odds (black/red or even/odd) and each time you lose the bet, you double the bet until you won (or pass the max wager).
This is my current function which does not appear to be working. I'm not sure if the logic is sound (too many nested loops become confusing quickly). If anyone could point me in the right direction, that would be awesome.
possible_nums <- floor(runif(5, min=0, max=35)) # generate sequence of random numbers
wager = 5
tot_money <- 10000
wins <- 0
simulations <- 1:500
Martingale <- function(wager, tot_money) {
for(i in simulations) {
while(tot_money >= 5 & wager <= 500 ) { # stop betting if lose by running out of money or surpassing max wager
roll <- sample(possible_nums, 1) # roll number 1-35
if (roll %% 2 == 0) { # we will be betting even/odd (as opposed to black/red) for simulation
wins = wins + 1 # if even, we win
tot_money = tot_money + 5 # add 5 dollars to total money/balance if win
} else {
wager*2 # if roll was odd, double wager
}
}
}
}
print(wins)
print(tot_money)
}
Martingale(5, 1000) # run function
The function isn't even giving me an output when I run it. R seems very picky with the spacing of the brackets. I tried correcting them to not avail. If I get the function working, then I can correct the logic.
Thanks for any help!
You have one closing bracket too much, which closes the function before you print the results:
Martingale <- function(wager, tot_money) {
for(i in simulations) {
while(tot_money >= 5 & wager <= 500 ) { # stop betting if lose by running out of money or surpassing max wager
roll <- sample(possible_nums, 1) # roll number 1-35
if (roll %% 2 == 0) { # we will be betting even/odd (as opposed to black/red) for simulation
wins = wins + 1 # if even, we win
tot_money = tot_money + 5 # add 5 dollars to total money/balance if win
} else {
wager*2 # if roll was odd, double wager
}
}
}
} # <-- this one is too much,
print(wins)
print(tot_money)
}
Also note that your code will NOT terminate: you only increase tot_money, and do not modify the value of wager.
Let me note that you do not simulate a 50% chance: you choose at the beginning 5 random integers below 35 and take samples from those; if you want to simulate an odd/even change, you are better off with rbinom(1, 1, .5).
You might want to swap the way this is simulated and run the simulation-loop outside the Martingale function, and return the values and store them in a array:
Martingale2 <- function(wager, tot_money) {
while(tot_money >= 5 & wager <= 500 ) {
roll <- rbinom(1, 1, .5)
if (roll == 0) {
wins <- wins + 1
tot_money <- tot_money + 5
} else {
tot_money <- tot_money - wager
wager <- wager*2
}
}
list(wins = wins, tot_money = tot_money)
}
simulations <- 500
simulation_results <- t(replicate(simulations, Martingale2(5, 1000)))
I am working on a project in which I am simulating 8 classroom social networks over 6 weeks, so 30 iterations. Students will nominate each other based on a number of factors, and I plan to simulate a number of conditions in which I remove or add some of these factors to the simulation. In other words, I'm going to be repeating a lot of code, so I'd rather use functions rather than cutting and pasting where ever possible.
Right now, I'm trying to create a function that adjusts the probability of one student selecting another based on the similarity of their emotions. When I include it in a set of nested for for loops, this works just fine:
num_students <- 5
names_students <- letters[1:num_students]
student_emotion <- sample(round(runif(5, min = -5, max = 5), digits = 1))
student_emotion_df <- cbind.data.frame(names_students, student_emotion)
probs <- rep(1/num_students, 5)
row_prob <- vector(length = 5)
for(i in 1:num_students){
for(q in 1:num_students){
if(abs(student_emotion[i]-student_emotion[q]) >= 0 &
abs(student_emotion[i]-student_emotion[q]) <= .5){
row_prob[q] <- 1*probs[q]
} else if(abs(student_emotion[i]-student_emotion[q]) > .5 &
abs(student_emotion[i]-student_emotion[q]) <= 1) {
row_prob[q] <- .75 * probs[q]
}
else {
row_prob[q] <- .5 * probs[q]
}
}
}
The row_prob object is a vector of probabilities a student i, in the column, will select student q, in the rows.
I've created a user-defined function based on the same code, and that works:
emotion_difference_fun <- function(probs){
for(q in 1:num_students){
if(abs(student_emotion[i]-student_emotion[q]) >= 0 &
abs(student_emotion[i]-student_emotion[q]) <= .5){
row_prob[q] <- 1*probs[q]
} else if(abs(student_emotion[i]-student_emotion[q]) > .5 &
abs(student_emotion[i]-student_emotion[q]) <= 1) {
row_prob[q] <- .75 * probs[q]
}
else {
row_prob[q] <- .5 * probs[q]
}
}
return(row_prob)
}
emotion_difference_fun(probs)
But when I try to embed that function within the for loop iterating through the columns, row_prob returns as an empty vector:
for(i in 1:num_students){
emotion_difference_fun(probs)
}
Any thoughts on how I can get this to work?
Thanks for any help you're able to offer.
If I understood your question properly, then you need to assign the results in your last 'for' loop:
for(i in 1:num_students){
if(i == 1) out <- NULL
out <- c(out, emotion_difference_fun(probs))
}
out
Is that what you are looking for?
What I am unclear about though, is why in your second code section you are not looking for a 5*5 matrix. Eventually, when running that code, it doesn't matter that you did it for i = 5 students, because it will only save in row_prob your last iteration (student = 5).
You can use replicate to repeat the function emotion_difference_fun for num_students.
result <- replicate(num_students, emotion_difference_fun(probs))
You can also set simplify = FALSE to get output as list.
result <- replicate(num_students, emotion_difference_fun(probs),simplify = FALSE)
I've encountered a simple question but failed to write the code. Grateful if you can help me.
The question: Create a function that will return the sum of 2 integers.
My code:
q1 <- function(a, b) {
if (a == as.integer(a)) {
if (b == as.integer(b)) {
result1 <- a + b
}
}
} else {
result1 <- NA
result1
}
q1(3,6) - suppose it returns 9
q1(3.1,6) - suppose it returns NA
BTW, why can I not write the syntax in this way?
if(is.integer(a) = TRUE){
This uses a function (testInteger) in this answer, slightly edited. It checks if a value is TRUE with the now recommended isTRUE().
testInteger <- function(x){
test <- all.equal(x, as.integer(x), check.attributes = FALSE)
isTRUE(test)
}
q1 <- function(a, b) {
if (testInteger(a) && testInteger(b)) {
a + b
} else {
NA
}
}
q1(3, 6) # returns 9
q1(3.1, 6) # returns NA
Depends on what you decide to be integer. Usually you don't need your integers to be stored as an objects of class integer:
Integer vectors exist so that data can be passed to C or Fortran code which expects them, and so that (small) integer data can be represented exactly and compactly.
So, 3 is integer which is represented in R as numeric (try class(3) to see that). So I think, we don't need to check class of the values passed to your function, but rather check if those numbers are whole numbers with some level of tolerance.
sum_int <- function(..., tol = .Machine$double.eps^.5){
if(any(abs(round(c(...)) - c(...)) > tol)){
return(NA)
}
return(sum(round(c(...))))
}
sum_int(1, 2, 3 + 1e-7)
#NA
sum_int(1, 2, 3 + 1e-15)
#6
sum_int(1, 2, 3 + 1e-15, tol = 0)
#NA
sum_int(1, 2, 3.1, tol = .02)
#NA
sum_int(1, 2, 3.1, tol = .2)
#6
At the first step we grab the list of all arguments passed into the sum_int(). To find if those values are integers we use predefined or defined by user tolerance level (tol is defined the same way as it shown in ?is.integer examples). After that we round our numeric values, to make them whole numbers, and to find fractional parts of those values, as absolute difference between whole parts of the arguments, and arguments themselves. If any of the fractional parts exceed the tolerance level - we return NA. Otherwise we return sum of whole parts of those values.
You had missplaced some brackets and you were not returning anything, check this:
q1 <- function(a,b){
if (a == as.integer(a)){
if (b == as.integer(b)){
result1 <- a + b
}
}
else {
result1 <- NA
}
return(result1);
}
If you want your function to only sum() integers, as in the R object.
Intsum <- function(a,b){
if(is.integer(a) & is.integer(b) == TRUE){
return(sum(a,b))
}
else {
return(NA)
}
}
s <- seq(-10, 6, by = 0.1)
my.fun = function(s)
{
n = length(s)
s = 0
for(i in 1:n)
{
s = ((s[i]*s[i]*s[i]*s[i])*sin(1/s[i]) +(s[i]*s[i]))/(1+abs((s[i]*s[i]*s[i])))
}
s
}
This is my function. I am attempting to compute a sequence of numbers and then use that sequence within the equation. However, It isnt saving the new variable S and the function wont print anything out either.
Two reasons:
You're setting s to zero in your function
The main guts of your function contains 1/s[i], so s shouldn't contain any zeroes.
Try
s <- seq(-10, 6, by = 0.1)
s = s[which(s != 0)] # to drop the zero from the vector
my.fun = function(s)
{
n = length(s)
for(i in 1:n) {
s[i] = ((s[i]*s[i]*s[i]*s[i])*sin(1/s[i]) + s[i]*s[i]))/(1+abs((s[i]*s[i]*s[i])))
}
s
}
my.fun(s)
You cant return an output in the definition of a function itself.
Do my.fun(s) to return the output for s.
Also make sure to not have 0s while initializing values for s. Since you are doing 1/s at one point, you will return only NaNs.
I tried to implement a simple 2D single layer perceptron and ended up with this solution:
perceptron <- function(featureVec, classVec, wStart=matrix(c(0,0,0)), eta=1, limit = 50) {
plot(x=featureVec[,1],y=featureVec[,2])
# Extending dimensions
dimension <- dim(featureVec)[1]
featureVec <- cbind(featureVec,rep(1,dimension))
# Inverting 2. class
index <- classVec == -1
featureVec[index,] <- apply(matrix(featureVec[index]),1,prod,-1)
wTemp <- wStart
y <- featureVec %*% wTemp
iteration = 0
while (T) {
y <- featureVec %*% wTemp
delta <- as.matrix(featureVec[y <= 0,])
for(i in 1:nrow(delta)) {
wTemp <- wTemp + eta*delta[i,]
}
result <- featureVec %*% wTemp
if (sum(result <= 0) == 0) {
break
}
if (iteration >= limit) {
stop("Maximum count of interations reached!")
}
iteration = iteration + 1
}
if(wTemp[2] != 0) {
abline(-wTemp[3]/wTemp[2],-wTemp[1]/wTemp[2])
} else if(wTemp[2] == 0) {
abline(v=wTemp[1])
} else if(wTemp[1] == 0) {
abline(h=wTemp[2])
}
return(wTemp)
}
The feature vector works row-wise, the class vector needs values of 1 and -1 col-wise.
For most of my tests it works correct, but when I have samples like (0,0) (0,1) with classes (1,-1) I get no result. That happens with some of my examples with two points lying on a straight line (horizontal to a coordinate axis). When I try to choose different start vectors it sometimes works correctly (I have no deterministic behaviour here right now I guess). Is that a correct behaviour or is my implementation wrong?
Thanks for your help, Meiner.
EDIT: Some changes of the inital post.
Bad Dataset:
featureTest <- matrix(c(0,0,0,1),byrow=T,nrow=2)
classTest <- matrix(c(1,-1),nrow=2)
perceptron(featureTest,classTest)
featureTest <- matrix(c(0,1,0,2),byrow=T,nrow=2)
classTest <- matrix(c(1,-1),nrow=2)
perceptron(featureTest,classTest)
Good Dataset:
featureTest <- matrix(c(0,0,0,2),byrow=T,nrow=2)
classTest <- matrix(c(1,-1),nrow=2)
perceptron(featureTest,classTest)