Referring to other cells in R without using a for loop - r

I am new to R and one thing I have been told again and again is that there really is no need for for loops. I have had some success with apply but could not figure out how to use it in this instance.
Here is the data I am working with:
Bid Ask Exp Strike Price V6
51 4.95 5.15 NOV1 13 335 5.050 3.08
52 3.40 3.50 NOV1 13 340 3.450 NA
53 2.28 2.42 NOV1 13 345 2.350 NA
54 1.51 1.57 NOV1 13 350 1.540 NA
55 0.99 1.07 NOV1 13 355 1.030 NA
56 0.66 0.71 NOV1 13 360 0.685 NA
57 0.46 0.51 NOV1 13 365 0.485 NA
58 0.33 0.37 NOV1 13 370 0.350 NA
59 0.25 0.28 NOV1 13 375 0.265 NA
60 0.18 0.24 NOV1 13 380 0.210 NA
61 0.11 0.20 NOV1 13 385 0.155 NA
62 0.05 0.17 NOV1 13 390 0.110 NA
63 0.05 0.16 NOV1 13 395 0.105 NA
64 0.07 0.13 NOV1 13 400 0.100 NA
In column 6 (called V6), I want the values to be twice the value in the price column in the cell that is 3 below the current row. For example, Row 1 in Col 6 is 3.08 which is 2*1.54 which is in column 5, row 4. I would like to do this for every cell in row 6 until it runs out in row 12. NA is fine in column 6 after this row.
Here is how I accomplished this:
for (i in 1:11){
data[i,6] <- 2*data[i+3,5]}
Is there a faster/easier/ more appropriate way to do this?
Here is the final data as I want it.
Bid Ask Exp Strike Price V6
51 4.95 5.15 NOV1 13 335 5.050 3.08
52 3.40 3.50 NOV1 13 340 3.450 2.06
53 2.28 2.42 NOV1 13 345 2.350 1.37
54 1.51 1.57 NOV1 13 350 1.540 0.97
55 0.99 1.07 NOV1 13 355 1.030 0.70
56 0.66 0.71 NOV1 13 360 0.685 0.53
57 0.46 0.51 NOV1 13 365 0.485 0.42
58 0.33 0.37 NOV1 13 370 0.350 0.31
59 0.25 0.28 NOV1 13 375 0.265 0.22
60 0.18 0.24 NOV1 13 380 0.210 0.21
61 0.11 0.20 NOV1 13 385 0.155 0.20
62 0.05 0.17 NOV1 13 390 0.110 NA
63 0.05 0.16 NOV1 13 395 0.105 NA
64 0.07 0.13 NOV1 13 400 0.100 NA
Thank you.

use mydata$V6 <- 2 * c(mydata$Price[-(1:3)], rep(NA, 3))

df1 is your data. I used sapply here which should be faster than for loop
df1$V6<-sapply(1:nrow(df1),function(x) 2*df1[x+3,5])

Related

How to change loadings.label in PCA plot using ggplot2?

I am plotting a PCA analysis in ggplot2 and loadings.label overlap with the arrows. I want to move the labels a little to make more accessible the reading of the plot, but I can't find a way to do it. I am attaching the plot below.
here is part of the data:
Linfoprolif CORT Testo FDL Ac.GRO ifn.g il.4 Profile
1 23.76 0.27 0.96 2.41 6 307 69 1
2 NA 2.59 0.07 0.39 4 117 58
3 25.53 0.16 0.71 2.17 5 273 54 1
4 31.67 0.88 0.07 0.55 5 211 48 1
5 6.15 0.24 0.23 1.07 5 224 48 1
6 26.19 0.74 0.04 0.60 4 308 59 1
7 10.31 0.34 0.75 2.29 7 295 49 1
8 22.30 0.42 0.07 0.63 5 271 52 1
9 24.74 0.29 1.18 2.91 4 236 56 1
10 9.51 2.19 0.07 0.40 5 54 62 2
11 22.59 0.19 0.40 3.28 4 272 58 1
12 22.01 0.28 0.04 0.54 4 67 64 1
13 39.21 0.21 0.82 1.91 4 235 56 1
14 42.07 0.32 0.16 0.70 5 362 54 3
15 13.45 0.30 0.24 2.21 6 146 68 1
16 15.08 2.19 0.08 0.34 5 58 63 2
17 20.48 0.38 1.27 2.40 4 278 52 1
18 12.10 0.83 0.11 0.53 2 146 41 1
19 61.56 0.07 0.09 1.09 9 305 52 3
20 35.06 0.59 0.05 0.67 4 220 54 1
21 33.48 0.68 0.99 1.24 3 102 58 1
22 20.56 0.94 0.06 1.71 3 58 45 2
23 26.46 0.12 0.29 1.60 3 210 55 1
24 24.91 0.56 0.11 0.55 5 108 56 1
25 29.22 0.42 2.60 1.55 3 84 69 1
26 19.30 1.63 0.02 0.78 3 62 69 2
27 14.45 0.22 0.79 1.89 4 245 59 1
28 20.89 0.72 0.04 0.57 4 85 53 1
29 26.70 0.36 1.02 2.05 3 309 45 1
30 27.83 2.66 0.04 0.54 3 52 65 2
31 34.70 0.46 0.83 1.39 5 120 65 1
and the code
library(ggfortify)
p_pca<-d_e_b[c(1,2,3,4,5,6,7)]
p_pca<-na.omit(p_pca)
pca_res <- prcomp(p_pca, scale. = TRUE)
pca_b<-autoplot(pca_res, data = d_e_b, colour = "Profile",
loadings = TRUE, loadings.colour = 'gray30',loadings.size = 5,
loadings.label = TRUE, loadings.label.color='black',
loadings.label.size = 4) + theme_classic()+
scale_colour_discrete("Profile")+
theme(text = element_text(size = 20 ),
axis.line.x = element_line(color="black", size = 1),
axis.line.y = element_line(color="black", size = 1),
axis.text.x=element_text(colour="black",angle = 360,vjust = 0.6),
axis.text.y=element_text(colour="black"))
pca_b
Any ideas on how to solve it?
You can add loadings.label.repel = T inside autoplot() to offset the labels a bit.

Problems with partimat plot in R

I am trying to plot an LDA analysis using partimat function from klaRpackage in R and I am getting this warning message Error in partimat.default(x, grouping, ...) : at least two classes required I am pasting here part of the data to make a reproducible example:
abrev Linfoprolif CORT Testo FDL Ac.GRO ifn.g il.4
1 A 2.00 0.53 1.54 1.65 8 192 68
2 A 13.91 0.65 1.34 2.27 6 195 58
3 A 15.65 0.50 0.07 0.97 5 280 67
4 A 4.96 1.51 1.45 2.54 3 30 48
5 A 0.00 3.18 0.01 0.95 3 60 71
6 A 36.23 0.28 0.88 3.63 7 320 50
7 A 9.15 1.20 0.16 1.32 1 52 74
8 A 17.63 1.68 1.29 1.86 1 47 53
9 A 6.52 2.36 0.03 0.92 4 51 75
113 B 20.48 0.38 1.27 2.40 4 278 52
114 B 12.10 0.83 0.11 0.53 2 146 41
115 B 61.56 0.07 0.09 1.09 9 305 52
116 B 35.06 0.59 0.05 0.67 4 220 54
117 B 33.48 0.68 0.99 1.24 3 102 58
118 B 20.56 0.94 0.06 1.71 3 58 45
119 B 26.46 0.12 0.29 1.60 3 210 55
120 B 24.91 0.56 0.11 0.55 5 108 56
121 B 29.22 0.42 2.60 1.55 3 84 69
122 B 19.30 1.63 0.02 0.78 3 62 69
123 B 14.45 0.22 0.79 1.89 4 245 59
373 D 27.13 0.23 1.03 4.23 6 261 100
374 D 0.00 0.43 0.08 15.34 1 58 69
375 D 17.42 0.27 2.07 7.09 5 184 80
376 D 37.34 0.91 0.08 6.18 6 210 81
377 D 28.19 0.20 3.34 6.82 6 269 105
378 D 8.53 0.61 0.05 5.31 4 98 115
I followed the code posted here like this:
partimat(abrev ~ Linfoprolif + CORT + Testo + FDL+Ac.GRO,+ ifn.g + ifn.g, data=d_e_disc, method="lda")
I can't find my error. Any help is wecome
Your response variable abrev must be factor , so you have to make it of class factor
d_e_disc $abrev <- as.factor(d_e_disc $abrev)
# then apply your code above
#Mohamed Desouky found your problem, abrev should be a factor! Also, there is a small typo in your formula (","), So here you can see a reproducible example to make sure you can reproduce your problem:
library(klaR)
partimat(factor(abrev) ~ Linfoprolif + CORT + Testo + FDL+Ac.GRO + ifn.g + ifn.g, data=d_e_disc, method="lda")
Created on 2022-07-11 by the reprex package (v2.0.1)

Why is t() returning a 'vector'?

Just trying to some basic matrix algebra in R and I'm getting some weird results that I don't completely understand.
So, my data looks like this:
Wt LvrWt Dose Y
1 176 6.5 0.88 0.42
2 176 9.5 0.88 0.25
3 190 9.0 1.00 0.56
4 176 8.9 0.88 0.23
5 200 7.2 1.00 0.23
6 167 8.9 0.83 0.32
7 188 8.0 0.94 0.37
8 195 10.0 0.98 0.41
9 176 8.0 0.88 0.33
10 165 7.9 0.84 0.38
11 158 6.9 0.80 0.27
12 148 7.3 0.74 0.36
13 149 5.2 0.75 0.21
14 163 8.4 0.81 0.28
15 170 7.2 0.85 0.34
16 186 6.8 0.94 0.28
17 146 7.3 0.73 0.30
18 181 9.0 0.90 0.37
19 149 6.4 0.75 0.46
And here is the code I'm using:
# Creating the X matrix
Xmatrix <- subset(questionOneA, select = -c(Y))
Xmatrix <- matrix(Xmatrix)
Xmatrix <- sapply(Xmatrix, as.numeric)
is.numeric(Xmatrix)
# Transposing the x matrix
Xtranspose <- t(Xmatrix)
Xtranspose <- matrix(Xtranspose)
is.numeric(Xtranspose)
The output of Xmatrix seems correct:
V1 V2 V3
1 176 6.5 0.88
2 176 9.5 0.88
3 190 9.0 1.00
4 176 8.9 0.88
5 200 7.2 1.00
6 167 8.9 0.83
7 188 8.0 0.94
8 195 10.0 0.98
9 176 8.0 0.88
10 165 7.9 0.84
11 158 6.9 0.80
12 148 7.3 0.74
13 149 5.2 0.75
14 163 8.4 0.81
15 170 7.2 0.85
16 186 6.8 0.94
17 146 7.3 0.73
18 181 9.0 0.90
19 149 6.4 0.75
However, the output of Xtranspose seems strange to me:
V1
1 176.00
2 6.50
3 0.88
4 176.00
5 9.50
6 0.88
7 190.00
8 9.00
9 1.00
10 176.00
11 8.90
12 0.88
13 200.00
14 7.20
15 1.00
16 167.00
17 8.90
18 0.83
19 188.00
20 8.00
21 0.94
22 195.00
23 10.00
24 0.98
25 176.00
26 8.00
27 0.88
28 165.00
29 7.90
30 0.84
31 158.00
32 6.90
33 0.80
34 148.00
35 7.30
36 0.74
37 149.00
38 5.20
39 0.75
40 163.00
41 8.40
42 0.81
43 170.00
44 7.20
45 0.85
46 186.00
47 6.80
48 0.94
49 146.00
50 7.30
51 0.73
52 181.00
53 9.00
54 0.90
55 149.00
56 6.40
57 0.75
I was expecting an output with 3 rows and 19 columns. What's happened here that I'm not understanding?
Any help would be appreciated!
You should use as.matrix instead of matrix to convert to matrix, also this can be done in fewer steps.
Xmatrix <- subset(questionOneA, select = -Y)
Xmatrix <- as.matrix(Xmatrix)
Xtranspose <- t(Xmatrix)
Xmatrix
# Wt LvrWt Dose
#1 176 6.5 0.88
#2 176 9.5 0.88
#3 190 9.0 1.00
#4 176 8.9 0.88
#5 200 7.2 1.00
#6 167 8.9 0.83
#7 188 8.0 0.94
#8 195 10.0 0.98
#9 176 8.0 0.88
#10 165 7.9 0.84
#11 158 6.9 0.80
#12 148 7.3 0.74
#13 149 5.2 0.75
#14 163 8.4 0.81
#15 170 7.2 0.85
#16 186 6.8 0.94
#17 146 7.3 0.73
#18 181 9.0 0.90
#19 149 6.4 0.75
Xtranspose
# 1 2 3 4 5 6 7 8
#Wt 176.00 176.00 190 176.00 200.0 167.00 188.00 195.00
#LvrWt 6.50 9.50 9 8.90 7.2 8.90 8.00 10.00
#Dose 0.88 0.88 1 0.88 1.0 0.83 0.94 0.98
# 9 10 11 12 13 14 15 16
#Wt 176.00 165.00 158.0 148.00 149.00 163.00 170.00 186.00
#LvrWt 8.00 7.90 6.9 7.30 5.20 8.40 7.20 6.80
#Dose 0.88 0.84 0.8 0.74 0.75 0.81 0.85 0.94
# 17 18 19
#Wt 146.00 181.0 149.00
#LvrWt 7.30 9.0 6.40
#Dose 0.73 0.9 0.75
See what matrix(Xmatrix) returns :
matrix(Xmatrix)
# [,1]
#[1,] Integer,19
#[2,] Numeric,19
#[3,] Numeric,19
Just check the output from each of your steps, and you will see the matrix becomes a "one column" matrix after this step:
Xtranspose <- matrix(Xtranspose)
This function creates a matrix. If you see the manual of the matrix function you will see that it defaults to nrow=1 and ncol=1.
Your matrix obviously has more elements than would fit in a 1x1 matrix, but creating a matrix isn't really what you would want to do at this point, you would just make sure that the 2-dimensional structure you have, is a matrix, for which as.matrix is better. (But unecessary, it already is a matrix.)
Though I will say, the manual does not explain this specific happening well enough. It does not clearly say what happens if you give matrix() a matrix as input data that has more elements than would fit in the given number of rows and columns you want.
Though it does say this, which is probably applicable to your case:
When coercing a vector, it produces a one-column matrix, and promotes the names (if any) of the vector to the rownames of the matrix.
This is also what you see.

Applying a custom function repeatedly to same dataframe using purrr

Suppose I have a dataframe as follows:
df <- data.frame(
alpha = 0:20,
beta = 30:50,
gamma = 100:120
)
I have a custom function that makes new columns. (Note, my actual function is a lot more complex and can't be vectorized without a custom function, so please ignore the substance of the transformation here.) For example:
newfun <- function(var = NULL) {
newname <- paste0(var, "NEW")
df[[newname]] <- df[[var]]/100
return(df)
}
I want to apply this over many columns of the dataset repeatedly and have the dataset "build up." This happens just fine when I do the following:
df <- newfun("alpha")
df <- newfun("beta")
df <- newfun("gamma")
Obviously this is redundant and a case for map. But when I do the following I get back a list of dataframes, which is not what I want:
df <- data.frame(
alpha = 0:20,
beta = 30:50,
gamma = 100:120
)
out <- c("alpha", "beta", "gamma") %>%
map(function(x) newfun(x))
How can I iterate over a vector of column names AND see the changes repeatedly applied to the same dataframe?
Writing the function to reach outside of its scope to find some df is both risky and will bite you, especially when you see something like:
df[['a']] <- 2
# Error in df[["a"]] <- 2 : object of type 'closure' is not subsettable
You will get this error when it doesn't find your variable named df, and instead finds the base function named df. Two morals from this discovery:
While I admit to using df myself, it's generally bad practice to name variables the same as R functions (especially from base); and
Scope-breach is sloppy and renders a workflow unreproducible and often difficult to troubleshoot problems or changes.
To remedy this, and since your function relies on knowing what the old/new variable names are or should be, I think pmap or base R Map may work better. Further, I suggest that you name the new variables outside of the function, making it "data-only".
myfunc <- function(x) x/100
setNames(lapply(dat[,cols], myfunc), paste0("new", cols))
# $newalpha
# [1] 0.00 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 0.10 0.11 0.12 0.13 0.14 0.15 0.16 0.17
# [19] 0.18 0.19 0.20
# $newbeta
# [1] 0.30 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.40 0.41 0.42 0.43 0.44 0.45 0.46 0.47
# [19] 0.48 0.49 0.50
# $newgamma
# [1] 1.00 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 1.10 1.11 1.12 1.13 1.14 1.15 1.16 1.17
# [19] 1.18 1.19 1.20
From here, we just need to column-bind (cbind) it:
cbind(dat, setNames(lapply(dat[,cols], myfunc), paste0("new", cols)))
# alpha beta gamma newalpha newbeta newgamma
# 1 0 30 100 0.00 0.30 1.00
# 2 1 31 101 0.01 0.31 1.01
# 3 2 32 102 0.02 0.32 1.02
# 4 3 33 103 0.03 0.33 1.03
# 5 4 34 104 0.04 0.34 1.04
# ...
Special note: if you plan on doing this iteratively (repeatedly), it is generally bad to iteratively add rows to frames; while I know this is a bad idea for adding rows, I suspect (without proof at the moment) that doing the same with columns is also bad. For that reason, if you do this a lot, consider using do.call(cbind, c(list(dat), ...)) where ... is the list of things to add. This results in a single call to cbind and therefore only a single memory-copy of the original dat. (Contrast that with iteratively calling the *bind functions which make a complete copy with each pass, scaling poorly.)
additions <- lapply(1:3, function(i) setNames(lapply(dat[,cols], myfunc), paste0("new", i, cols)))
str(additions)
# List of 3
# $ :List of 3
# ..$ new1alpha: num [1:21] 0 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 ...
# ..$ new1beta : num [1:21] 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 ...
# ..$ new1gamma: num [1:21] 1 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 ...
# $ :List of 3
# ..$ new2alpha: num [1:21] 0 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 ...
# ..$ new2beta : num [1:21] 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 ...
# ..$ new2gamma: num [1:21] 1 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 ...
# $ :List of 3
# ..$ new3alpha: num [1:21] 0 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 ...
# ..$ new3beta : num [1:21] 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 ...
# ..$ new3gamma: num [1:21] 1 1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 ...
do.call(cbind, c(list(dat), additions))
# alpha beta gamma new1alpha new1beta new1gamma new2alpha new2beta new2gamma new3alpha new3beta new3gamma
# 1 0 30 100 0.00 0.30 1.00 0.00 0.30 1.00 0.00 0.30 1.00
# 2 1 31 101 0.01 0.31 1.01 0.01 0.31 1.01 0.01 0.31 1.01
# 3 2 32 102 0.02 0.32 1.02 0.02 0.32 1.02 0.02 0.32 1.02
# 4 3 33 103 0.03 0.33 1.03 0.03 0.33 1.03 0.03 0.33 1.03
# 5 4 34 104 0.04 0.34 1.04 0.04 0.34 1.04 0.04 0.34 1.04
# 6 5 35 105 0.05 0.35 1.05 0.05 0.35 1.05 0.05 0.35 1.05
# ...
An alternative approach is to change your function to only return a vector:
newfun2 <- function(var = NULL) {
df[[var]] / 100
}
newfun2('alpha')
# [1] 0.00 0.01 0.02 0.03 0.04 0.05 0.06 0.07 0.08 0.09 0.10 0.11 0.12 0.13
#[15] 0.14 0.15 0.16 0.17 0.18 0.19 0.20
Then, using base, you can use lapply() to loop through your list of functions to do:
cols <- c("alpha", "beta", "gamma")
df[, paste0(cols, 'NEW')] <- lapply(cols, newfun2)
#or
#df[, paste0(cols, 'NEW')] <- purrr::map(cols, newfun2)
df
alpha beta gamma alphaNEW betaNEW gammaNEW
1 0 30 100 0.00 0.30 1.00
2 1 31 101 0.01 0.31 1.01
3 2 32 102 0.02 0.32 1.02
4 3 33 103 0.03 0.33 1.03
5 4 34 104 0.04 0.34 1.04
6 5 35 105 0.05 0.35 1.05
7 6 36 106 0.06 0.36 1.06
8 7 37 107 0.07 0.37 1.07
9 8 38 108 0.08 0.38 1.08
10 9 39 109 0.09 0.39 1.09
11 10 40 110 0.10 0.40 1.10
12 11 41 111 0.11 0.41 1.11
13 12 42 112 0.12 0.42 1.12
14 13 43 113 0.13 0.43 1.13
15 14 44 114 0.14 0.44 1.14
16 15 45 115 0.15 0.45 1.15
17 16 46 116 0.16 0.46 1.16
18 17 47 117 0.17 0.47 1.17
19 18 48 118 0.18 0.48 1.18
20 19 49 119 0.19 0.49 1.19
21 20 50 120 0.20 0.50 1.20
Based on the way you wrote your function, a for loop that assign the result of newfun to df repeatedly works pretty well.
vars <- names(df)
for (i in vars){
df <- newfun(i)
}
df
# alpha beta gamma alphaNEW betaNEW gammaNEW
# 1 0 30 100 0.00 0.30 1.00
# 2 1 31 101 0.01 0.31 1.01
# 3 2 32 102 0.02 0.32 1.02
# 4 3 33 103 0.03 0.33 1.03
# 5 4 34 104 0.04 0.34 1.04
# 6 5 35 105 0.05 0.35 1.05
# 7 6 36 106 0.06 0.36 1.06
# 8 7 37 107 0.07 0.37 1.07
# 9 8 38 108 0.08 0.38 1.08
# 10 9 39 109 0.09 0.39 1.09
# 11 10 40 110 0.10 0.40 1.10
# 12 11 41 111 0.11 0.41 1.11
# 13 12 42 112 0.12 0.42 1.12
# 14 13 43 113 0.13 0.43 1.13
# 15 14 44 114 0.14 0.44 1.14
# 16 15 45 115 0.15 0.45 1.15
# 17 16 46 116 0.16 0.46 1.16
# 18 17 47 117 0.17 0.47 1.17
# 19 18 48 118 0.18 0.48 1.18
# 20 19 49 119 0.19 0.49 1.19
# 21 20 50 120 0.20 0.50 1.20

Object not found in for loop

I'm trying to figure out why this doesn't work:
data=read.csv("data_risk.csv")
pa1 = c(data$pa1)
pa2 = c(data$pa2)
pb1 = c(data$pb1)
pb2 = c(data$pb2)
a1 = c(data$a1)
a2= c(data$a2)
b1 = c(data$b1)
b2 = c(data$b2)
yy=c(data$choice)
crra=function(x,r){
u=x^(1-r)/(1-r)
return(u)
}
eua = c(pa1*crra(a1,r)+pa2*crra(a2,r))
eub = c(pb1*crra(b1,r)+pb2*crra(b2,r))
LL_all = c()
R<-seq(0,1,0.01)
for (r in R){
eua = c(pa1*crra(a1,r)+pa2*crra(a2,r))
eub = c(pb1*crra(b1,r)+pb2*crra(b2,r))
probA = eua/(eua+eub)
total = ifelse(yy==1, probA, 1-probA)
LL=log(prod(total))
LL_all=c(LL_all,LL)
}
Right now every time I try and run it it says object r not found or error object R not found it works without the for loop just fine but when I add the for loop it all breaks down.
I'm trying to find the value of r that maximises someones utility given two choices. A decision maker chooses option A over B with probability a EUA/(EUA+EUB). In this example r is the risk aversion coefficient and x is the outcome of the lottery.
pa1 = probability of event a1 happening
pa2 = probability of event a2 happening
pb1 = probability of event b1 happening
pb2 = probability of event b2 happening
a1,a2,b1,b2 = outcomes of events
yy= indicator function that takes the value of 1 if lottery a is chosen and 0 otherwise
dataset:
: task pa1 a1 pa2 a2 pb1 b1 pb2 b2 choice
1 0.34 24 0.66 59 0.42 47 0.58 64 0
2 0.88 79 0.12 82 0.20 57 0.80 94 0
3 0.74 62 0.26 0 0.44 23 0.56 31 1
4 0.05 56 0.95 72 0.95 68 0.05 95 1
5 0.25 84 0.75 43 0.43 7 0.57 97 0
6 0.28 7 0.72 74 0.71 55 0.29 63 0
7 0.09 56 0.91 19 0.76 13 0.24 90 0
8 0.63 41 0.37 18 0.98 56 0.02 8 0
9 0.88 72 0.12 29 0.39 67 0.61 63 1
10 0.61 37 0.39 50 0.60 6 0.40 45 1
11 0.08 54 0.92 31 0.15 44 0.85 29 1
12 0.92 63 0.08 5 0.63 43 0.37 53 1
13 0.78 32 0.22 99 0.32 39 0.68 56 0
14 0.16 66 0.84 23 0.79 15 0.21 29 1
15 0.12 52 0.88 73 0.98 92 0.02 19 0
16 0.29 88 0.71 78 0.29 53 0.71 91 1
17 0.31 39 0.69 51 0.84 16 0.16 91 1
18 0.17 70 0.83 65 0.35 100 0.65 50 0
19 0.91 80 0.09 19 0.64 37 0.36 65 1
20 0.09 83 0.91 67 0.48 77 0.52 6 1
21 0.44 14 0.56 72 0.21 9 0.79 31 1
22 0.68 41 0.32 65 0.85 100 0.15 2 0
23 0.38 40 0.62 55 0.14 26 0.86 96 0
24 0.62 1 0.38 83 0.41 37 0.59 24 1
25 0.49 15 0.51 50 0.94 64 0.06 14 0
26 0.10 40 0.90 32 0.10 77 0.90 2 1
27 0.20 40 0.80 32 0.20 77 0.80 2 1
28 0.30 40 0.70 32 0.30 77 0.70 2 1
29 0.40 40 0.60 32 0.40 77 0.60 2 1
30 0.50 40 0.50 32 0.50 77 0.50 2 0
31 0.60 40 0.40 32 0.60 77 0.40 2 0
32 0.70 40 0.30 32 0.70 77 0.30 2 0
33 0.80 40 0.20 32 0.80 77 0.20 2 0
34 0.90 40 0.10 32 0.90 77 0.10 2 0
35 1.00 40 0.00 32 1.00 77 0.00 2 0
The problem in the peace of code below after your definition of crra function:
eua = c(pa1*crra(a1,r)+pa2*crra(a2,r))
eub = c(pb1*crra(b1,r)+pb2*crra(b2,r))
Basically you are trying to use r variable before it's defined moreover it is a duplicate of the code inside the for-loop. If you comment out these two lines everything goes OK. Please see the code below:
data=read.table(text = " task pa1 a1 pa2 a2 pb1 b1 pb2 b2 choice
1 0.34 24 0.66 59 0.42 47 0.58 64 0
2 0.88 79 0.12 82 0.20 57 0.80 94 0
3 0.74 62 0.26 0 0.44 23 0.56 31 1
4 0.05 56 0.95 72 0.95 68 0.05 95 1
5 0.25 84 0.75 43 0.43 7 0.57 97 0
6 0.28 7 0.72 74 0.71 55 0.29 63 0
7 0.09 56 0.91 19 0.76 13 0.24 90 0
8 0.63 41 0.37 18 0.98 56 0.02 8 0
9 0.88 72 0.12 29 0.39 67 0.61 63 1
10 0.61 37 0.39 50 0.60 6 0.40 45 1
11 0.08 54 0.92 31 0.15 44 0.85 29 1
12 0.92 63 0.08 5 0.63 43 0.37 53 1
13 0.78 32 0.22 99 0.32 39 0.68 56 0
14 0.16 66 0.84 23 0.79 15 0.21 29 1
15 0.12 52 0.88 73 0.98 92 0.02 19 0
16 0.29 88 0.71 78 0.29 53 0.71 91 1
17 0.31 39 0.69 51 0.84 16 0.16 91 1
18 0.17 70 0.83 65 0.35 100 0.65 50 0
19 0.91 80 0.09 19 0.64 37 0.36 65 1
20 0.09 83 0.91 67 0.48 77 0.52 6 1
21 0.44 14 0.56 72 0.21 9 0.79 31 1
22 0.68 41 0.32 65 0.85 100 0.15 2 0
23 0.38 40 0.62 55 0.14 26 0.86 96 0
24 0.62 1 0.38 83 0.41 37 0.59 24 1
25 0.49 15 0.51 50 0.94 64 0.06 14 0
26 0.10 40 0.90 32 0.10 77 0.90 2 1
27 0.20 40 0.80 32 0.20 77 0.80 2 1
28 0.30 40 0.70 32 0.30 77 0.70 2 1
29 0.40 40 0.60 32 0.40 77 0.60 2 1
30 0.50 40 0.50 32 0.50 77 0.50 2 0
31 0.60 40 0.40 32 0.60 77 0.40 2 0
32 0.70 40 0.30 32 0.70 77 0.30 2 0
33 0.80 40 0.20 32 0.80 77 0.20 2 0
34 0.90 40 0.10 32 0.90 77 0.10 2 0
35 1.00 40 0.00 32 1.00 77 0.00 2 0", header = TRUE)
pa1 = c(data$pa1)
pa2 = c(data$pa2)
pb1 = c(data$pb1)
pb2 = c(data$pb2)
a1 = c(data$a1)
a2= c(data$a2)
b1 = c(data$b1)
b2 = c(data$b2)
yy=c(data$choice)
crra=function(x,r){
u=x^(1-r)/(1-r)
return(u)
}
# eua = c(pa1*crra(a1,r)+pa2*crra(a2,r))
# eub = c(pb1*crra(b1,r)+pb2*crra(b2,r))
LL_all = c()
R<-seq(0,1,0.01)
for (r in R){
eua = c(pa1*crra(a1,r)+pa2*crra(a2,r))
eub = c(pb1*crra(b1,r)+pb2*crra(b2,r))
probA = eua/(eua+eub)
total = ifelse(yy==1, probA, 1-probA)
LL=log(prod(total))
LL_all=c(LL_all,LL)
}
head(LL_all)
Output:
[1] -18.93759 -18.97863 -19.02000 -19.06170 -19.10374 -19.14611

Resources