Creating a random play function in R - r

I want to create a gambling game that does the following:
It is a lottery, which asks for 5 numbers comprised between 01 and 43 and an additional number comprised between 01 and 16; the idea is that I give my 6 numbers and it tells me if I won or not.
To do so, use this code
Lotery = function(a,b,c,d,e,f){
NumeroAleatorio <- matrix(1:6, ncol = 6)
NumeroAleatorio[1] <- sample (1:43, 1, replace= FALSE)
for (i in 2:6) {
if(i!=6){
NumeroAleatorio[i] <- sample (1:43, 1, replace= FALSE)
if(i == 2){
while(NumeroAleatorio[i] == NumeroAleatorio[1] ){
NumeroAleatorio[i] <- sample (1:43, 1, replace= FALSE)
}
}else{
if(i == 3 ){
while(NumeroAleatorio[i] == NumeroAleatorio[1] || NumeroAleatorio[i] == NumeroAleatorio[2]){
NumeroAleatorio[i] <- sample (1:43, 1, replace= FALSE)
}
}else{
if(i == 4 ){
while(NumeroAleatorio[i] == NumeroAleatorio[1] || NumeroAleatorio[i] == NumeroAleatorio[2] || NumeroAleatorio[i] == NumeroAleatorio[3]){
NumeroAleatorio[i] <- sample (1:43, 1, replace= FALSE)
}
}else{
if(i == 5 ){
while(NumeroAleatorio[i] == NumeroAleatorio[1] || NumeroAleatorio[i] == NumeroAleatorio[2] || NumeroAleatorio[i] == NumeroAleatorio[3] || NumeroAleatorio[i] == NumeroAleatorio[4] ){
NumeroAleatorio[i] <- sample (1:43, 1, replace= FALSE)
}
}
}
}
}
}else{
NumeroAleatorio[6] <- sample (1:16, 1, replace= FALSE)
}
}
ContA<-0
ContB<-0
ContC<-0
ContD<-0
ContE<-0
ContF<-0
for(p in 1:6){
if(NumeroAleatorio[p] == a){
ContA<-ContA+1
}
if(NumeroAleatorio[p] == b){
ContB<-ContB+1
}
if(NumeroAleatorio[p] == c){
ContC<-ContC+1
}
if(NumeroAleatorio[p] == d){
ContD<-ContD+1
}
if(NumeroAleatorio[p] == e){
ContE<-ContE+1
}
if(NumeroAleatorio[p] == f){
ContF<-ContF+1
}
}
if(ContA==0 || ContB==0 || ContC==0 || ContD==0 || ContE==0 || ContF==0){
return(data.frame("Resultado", NumeroAleatorio, "Numero escogido", a, b, c, d, e, f, "No Ganaste"))
}else{
return(data.frame("Resultado", NumeroAleatorio, "Numero escogido", a, b, c, d, e, f, "Ganaste"))
}
}
Lotery(20,15,3,45,9,8)
It seems to work, but I want to know if I can make things simpler because I think the code is too long.

I may not be following your code, but it looks like you randomly select 6 numbers and compare them to the numbers submitted. None of the first 5 should match, but the 6th can match one of the first 5. If that is correct then this will generate the random 6 numbers:
NumeroAleatorio <- c(sample.int(43, 5, replace=FALSE), sample.int(16, 1))
To compare this to the submitted values, just use
NumeroAleatorio == comp
All FALSE indicates no matches. Any TRUE values indicate a match at that position.

Related

working with nested for loop with if statment

I have a data frame of two columns first is the longitude and second is the latitude. I want to find the coordinates of the center cell.
e.g. the range is lat[31 31.5], lon[33 33.5] if the first values of two columns fulfill this condition then create the third column and put the value 31.25 and create the fourth column and put in it the value 33.25
I have tried nested for loop but it does not work
# my dataframe is cycle8 contain 166 rows and two columns
latitude<- seq(31,37,by=0.5)
longitude<- seq(33,37,by=0.5)
cycle8$latcenter<- 0
cycle8$loncenter<-0
for (m in 1:nrow(cycle8))
{
for(j in seq_along(latitude))
{
for(k in seq_along(longitude))
{
if (cycle8$lat[m]>=j && cycle8$lat[m]<=j+0.5 && cycle8$lon[m]>=k &&
cycle8$lon[m]<=k+0.5)
{
cycle8$latcenter[m]<- j+0.25
cycle8$loncenter[m]<- k+0.25
}
}
}
}
the following code will work and deliver the desired result but it is so long and requires a lot of statement typing
cycle8$latcenter<- 0
for (m in 1:nrow(cycle8))
{
if (cycle8$lat[m]>=31 && cycle8$lat[m]<=31.5 )
{
cycle8$latcenter[m]<- 31+0.25
}
else if
(cycle8$lat[m]>=31.5 && cycle8$lat[m]<=32 ){
cycle8$latcenter[m]<- 31.5+0.25
}
else if
(cycle8$lat[m]>=32 && cycle8$lat[m]<=32.5 ){
cycle8$latcenter[m]<- 32+0.25
}
else if
(cycle8$lat[m]>=32.5 && cycle8$lat[m]<=33 ){
cycle8$latcenter[m]<- 32.5+0.25
}
else if
(cycle8$lat[m]>=33 && cycle8$lat[m]<=33.5 ){
cycle8$latcenter[m]<- 33+0.25
}
else if
(cycle8$lat[m]>=33.5 && cycle8$lat[m]<=34 ){
cycle8$latcenter[m]<- 33.5+0.25
}
else if
(cycle8$lat[m]>=34 && cycle8$lat[m]<=34.5 ){
cycle8$latcenter[m]<- 34+0.25
}
else if
(cycle8$lat[m]>=34.5 && cycle8$lat[m]<=35 ){
cycle8$latcenter[m]<- 34.5+0.25
}
else if
(cycle8$lat[m]>=35 && cycle8$lat[m]<=35.5 ){
cycle8$latcenter[m]<- 35+0.25
}
else if
(cycle8$lat[m]>=35.5 && cycle8$lat[m]<=36 ){
cycle8$latcenter[m]<- 35.5+0.25
}
else if
(cycle8$lat[m]>=36 && cycle8$lat[m]<=36.5 ){
cycle8$latcenter[m]<- 36+0.25
}
else if
(cycle8$lat[m]>=36.5 && cycle8$lat[m]<=37 ){
cycle8$latcenter[m]<- 36.5+0.25
}
}
My solution avoids for-loops, sapply or other similiar functions. The logic behind the code is as follows: Since the ranges have decimals .50 or .00, the centered values will always be .25 or .75. This means that we simply need to replace the decimals; all decimals between .00 and.50 become.25, while the other ones become .75.
Here the code for this
# generate data
latitude <- seq(30, 32, .1)
longitude <- seq(30, 32, .1)
cycle8 <- data.frame(latitude, longitude)
# make a function that replaces decimals as explained above
lat_lon <- function(vec){
decimals <- as.character(format(vec, nsmall= 1))
decimals <- as.numeric(gsub("^.*\\.", "", decimals))
decimals <- ifelse(decimals < 5, .25, .75)
values <- as.numeric(gsub("\\..*","",vec)) + as.numeric(decimals)
return(values)
}
# apply function
cycle8$lat_center <- lat_lon(latitude)
cycle8$lon_center <- lat_lon(longitude)
# see results
cycle8
EDIT
Because you want 30.00 to be 29.75 and 30.50 to be 30.25, here is an edit. But the logic remains the same.
latitude <- seq(30, 32, .1)
longitude <- seq(30, 32, .1)
cycle8 <- data.frame(latitude, longitude)
lat_lon <- function(vec){
decimals <- as.character(format(vec, nsmall= 1))
decimals <- as.numeric(gsub("^.*\\.", "", decimals))
decimals_new <- ifelse(decimals > 5 | decimals == 0, .75, .25)
values <- as.numeric(gsub("\\..*","",vec)) + as.numeric(decimals_new)
values[decimals == 0] <- values[decimals == 0] - 1
return(values)
}
cycle8$lat_center <- lat_lon(latitude)
cycle8$lon_center <- lat_lon(longitude)
cycle8
# The other way of solving this question is
mydata<- c(35.666,35.4578,35.0, 33.50,32.10)
centered_value <- function(val){
a<- trunc(val)
b<- val %% 1
c<- ifelse(b/0.5 > 1, a +0.75 , ifelse(b/0.5> 1, a+0.25, ifelse(b/0.5 ==0, a-
0.25,a+0.25)))
}
d<- centered_value(mydata)
d

Error running identical function when comparing two vectors

I have a vector (length 8) and change one element randomly in the vector each time the for loop run. I want to check my new generated vector with a fixed vector (Destination) and save the valid case in a counting variable (Time_to_Destination). However, when I use identical() function, there was no saved recorded in Time_to_Destination. Is there anything wrong with my code?
I tried identical(), all.equal()
If I commented out if(identical()), the variable Time_to_Destination was counted
rm(list = ls())
library(igraph)
#Plot the graph
graph_MC <- graph(edge = c(1,2,1,3,2,3,2,4,3,4), n = 4, directed = F)
plot(graph_MC)
#Initial position
X_0 <- c(1,2,3,1)
Destination <- c(3,1,2,3)
X <- X_0
Time_to_destination <- 0
#I would like to see how many time I arrive to the Destination, which have a valid set of color
for(i in 1:10000){
#Generate a random node
a <- as.integer(runif(1,1,4))
#Generate a random color of the node
q <- as.integer(runif(1,1,3))
test_vector <- X
test_vector[a] = q
#Check if the new set of color is valid
if (a == 1) {
if ((q != test_vector[2]) & (q != test_vector[3])) {
X = test_vector
if (identical(X, Destination)){
Time_to_destination = Time_to_destination + 1
}
}
}
if (a == 2) {
if ((q != test_vector[1]) & (q != test_vector[3]) & (q != test_vector[4])) {
X = test_vector
if (identical(X, Destination)){
Time_to_destination = Time_to_destination + 1
}
}
}
if (a == 3) {
if ((q != test_vector[1]) & (q != test_vector[2]) & (q != test_vector[4])) {
X = test_vector
if (identical(X, Destination)){
Time_to_destination = Time_to_destination + 1
}
}
}
if (a == 4) {
if ((q != test_vector[3]) & (q != test_vector[2])) {
X = test_vector
if (identical(X, Destination)){
Time_to_destination = Time_to_destination + 1
}
}
}
}
Time_to_destination

My yathzee function stucks in the if statement

I just started to learn R and I am asked to write a function for a simplified Yahtzee game. The objective of the game is to score points by rolling five dice to make certain combinations.
There are 6 different categories:
If all five dice the same, the player gets 50 points (Yahtzee).
Five sequential dices (i.e, all unique dices) yields 40 points (Straight)
Three of one number and two of another yields 25 points.
If four dices are the same, it gives a score of the sum of all dices.
If three dices are the same, it gives a score of the sum of all dices.
Any remaining condition gives a score of the sum of all dices.
Here is how I have tried (Although I think that the last three categories can be condensed into the same logical test):
yahtzee <- function(){
dices <- sample(1:6,5,TRUE)
t <- table(dices)
t.x <- unname(t)
if(length(unique(dices) == 1)){
print("Yahtzee")
score <- 50
}
else if(dices == c(1,2,3,4,5) | dices == c(2,3,4,5,6)){
print("Straight")
score <- 40
}
else if(t.x[1] == 3 & t.x[2] == 2 | t.x[1] == 2 & t.x[2] == 3){
print("Full House")
score <- 25
}
else if(t.x[1] == 4 & t.x[2] == 1 | t.x[1] == 1 & t.x[2] == 4){
print("Four Of A Kind")
score <- sum(dices)
}
else if(t.x[1] == 3 & t.x[2] == 1 & t.x[3] == 1 | t.x[1] == 1 & t.x[2] == 3 & t.x[3] == 1 | t.x[1] == 1 & t.x[2] == 1 & t.x[3] == 3){
print("Three Of A Kind")
score <- sum(dices)
}
else{
print("Chance")
score <- sum(dices)
}
print(dices)
print(score)
}
When I run the function, I always earn 50 points and 'Yahtzee' occurs no matter what the dice combination is. My code does not go over the remaining else if statements or somehow stucks in the first line. How can I fix it?
You basically just had a couple parens mismatched. I don't think you need t.x and can just leverage properties of t combined with the any function. Here's how I'd rewrite your function:
yahtzee <- function(){
dices <- sample(1:6,5,TRUE)
t <- table(dices)
if(length(unique(dices)) == 1){
print("Yahtzee")
score <- 50
}
else if(length(unique(dices)) == 5){
print("Straight")
score <- 40
}
else if(any(t == 3) * any(t == 2)){
print("Full House")
score <- 25
}
else if(any(t == 4)){
print("Four Of A Kind")
score <- sum(dices)
}
else if(any(t == 3)){
print("Three Of A Kind")
score <- sum(dices)
}
else{
print("Chance")
score <- sum(dices)
}
print(dices)
print(score)
}
yahtzee()
yahtzee <- function () {
dices <- sample(1:6, 5, TRUE)
if( length(unique(dices)) == 1 ) {
print("Yahtzee")
score <- 50
} else if ( length(unique(dices)) == 5 ) {
print("Straight")
score <- 40
} else if ( length(unique(dices)) == 2 && length(which(dices ==
unique(dices)[1])) == 2 ||
length(which(dices == unique(dices)[2])) == 2 ) {
print("Full House")
score <- 25
} else if ( length(unique(dices)) == 2 && length(which(dices ==
unique(dices)[1])) == 1 ||
length(which(dices == unique(dices)[2])) == 1 ) {
print("Four Of A Kind")
score <- sum(dices)
} else if ( length(unique(dices)) == 3 && length(which(dices ==
unique(dices)[1])) == 3 ||
length(which(dices == unique(dices)[2])) == 3 ||
length(which(dices == unique(dices)[3])) == 3 ) {
print("Three Of A Kind")
score <- sum(dices)
} else {
print("Chance")
score <- sum(dices)
}
print(dices)
print(score)
}

R - Error executing user-defined function

I am trying to build a function that takes 2 arguments and uses those 2 arguments inside a replicate funtion
SPM <- function(bilhetes, N){
total_bilhetes <- 12012000
total_bilhetes_premios <- 3526450
premios <- c(0,5,10,15,20,25,50,100,300,1000,27000,108000,288000)
premios_bilhetes <- c(8485550,1895000,496800*2,88800*3,55200*4,16800*4,7920*6,5030*6,950*5,950,30,10,10)
probs <- premios_bilhetes/total_bilhetes
vector_ganhos <- c()
ganho <- 0
replicate(N, function(bilhetes) {
total_bilhetes1 <- total_bilhetes
premios_bilhetes1 <- premios_bilhetes
probs1 <- probs
for (i in c(1:bilhetes)) {
A <- sample(x = premios,replace = T,size = 1, prob = probs1)
ganho <- ganho - 5 + A
if (A == 0) {
premios_bilhetes1[1] <- premios_bilhetes1[1] - 1
} else if (A == 5) {
premios_bilhetes1[2] <- premios_bilhetes1[2] - 1
} else if (A == 10) {
premios_bilhetes1[3] <- premios_bilhetes1[3] - 1
} else if (A == 15) {
premios_bilhetes1[4] <- premios_bilhetes1[4] - 1
} else if (A == 20) {
premios_bilhetes1[5] <- premios_bilhetes1[5] - 1
} else if (A == 25) {
premios_bilhetes1[6] <- premios_bilhetes1[6] - 1
} else if (A == 50) {
premios_bilhetes1[7] <- premios_bilhetes1[7] - 1
} else if (A == 100) {
premios_bilhetes1[8] <- premios_bilhetes1[8] - 1
} else if (A == 300) {
premios_bilhetes1[9] <- premios_bilhetes1[9] - 1
} else if (A == 1000) {
premios_bilhetes1[10] <- premios_bilhetes1[10] - 1
} else if (A == 27000) {
premios_bilhetes1[11] <- premios_bilhetes1[11] - 1
} else if (A == 108000) {
premios_bilhetes1[12] <- premios_bilhetes1[12] - 1
} else {
premios_bilhetes1[13] <- premios_bilhetes1[13] - 1
}
total_bilhetes1 <- total_bilhetes1 - 1
probs1 <- premios_bilhetes1/(total_bilhetes1)
}
vector_ganhos[length(vector_ganhos)+1] = ganho
})
return(vector_ganhos)
}
when I try to run it, e.g., SPM(bilhetes = 5, N = 100) I get:
Error in SPM(bilhetes = 5, N = 100) : could not find function "SPM"
I looked in another question and someone mentioned "sourcing" the function. I tried it, and this was the output:
> source("SPM")
Error in file(filename, "r", encoding = encoding) :
cannot open the connection
In addition: Warning message:
In file(filename, "r", encoding = encoding) :
I'm rather new to R, so I'm probably making a dumb mistake.
Can someone help?

implement matrix determinant in R

I was asked to implement function that calculates n-dimensional matrix determinant using Laplace expansion. This involves recursion. I developed this:
minor<-function(A,i,j) {
return(A[c(1:(i-1),(i+1):dim(A)[1]),c(1:(j-1),(j+1):dim(A)[2])])
}
determinantRec<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1) return(X[1][1])
else {
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k][i]*(-1)^(k+i)*determinantRec(minor(X,k,i),k)
}
return(s)
}
}
where k in determinantRec(X,k) function indicates which row I want to use Laplace expansion along of.
My problem is when I run determinantRec(matrix(c(1,2,3,4),nrow = 2,ncol = 2),1) this error appears:
C stack usage 7970628 is too close to the limit
What is wrong with my code?
#julia, there is one simple type in your code. Just remove the '*' at the end of the definition of 's'. And don't indent the recursion.
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)
determinantRek(X[-k,-i],k)
}
return(s)
}
I did this way and works just fine, although it is super slow, compared to the det function in base R
laplace_expansion <- function(mat){
det1 <- function(mat){
mat[1]*mat[4]-mat[2]*mat[3]
}
determinant <- 0
for(j in 1:ncol(mat)){
mat1 <- mat[-1,-j]
if(nrow(mat1) == 2){
determinant <- determinant+mat[1,j]*(-1)^(1+j)*det1(mat1)
}else{
val <- mat[1,j]*(-1)^(1+j)
if(val != 0){
determinant <- determinant+val*laplace_expansion(mat1)
}
}
}
return(determinant)
}
This is my approach, I think it's cleaner.
deter <- function(X) {
stopifnot(is.matrix(X))
stopifnot(identical(ncol(X), nrow(X)))
if (all(dim(X) == c(1, 1))) return(as.numeric(X))
i <- 1:nrow(X)
out <- purrr::map_dbl(i, function(i){
X[i, 1] * (-1)^(i + 1) * deter(X[-i, -1, drop = FALSE])
})
return(sum(out))
}
Thank you #ArtemSokolov and #MrFlick for pointing the problem cause, it was it. I also discovered that this code does not calculate properly the determinant of 2x2 matrix. After all it looks like that:
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)*
determinantRek(X[-k,-i],k)
}
return(s)
}
Debuging with browser() was also helpful :)

Resources