set.seed(650)
library(maxLik)
y = c(rnorm(15,1,1), rnorm(15,3,1))
dat = data.frame(y)
B = 3 # number bootstrap sample
n = length(dat$y)
n1 = 15
boot.samples = matrix(sample(dat$y, size = B * n, replace = TRUE), n, B)
ml = list()
boot.l = 0
va.l = NULL
for (j in 1:B) {
boot.l = boot.samples[, j]
for (i in 1:n) {
LLl <- function(param) {
mul <- param[1]
sigmal <- param[2]
sum(log(dnorm(dat[1:i, ], mul, sigmal)))
}
ml[[i]] = coef(maxLik(logLik = LLl, start = c(mul = 1, sigmal = 1)))
}
va.l = matrix(unlist(ml), n-1, B*2, byrow = TRUE)
}
va.l
The following are my output
However, when I print the list I have the following output.
My question is how can I have mul estimates for j=1 in the 1st column, sigmal estimates for j = 1 in the second column and mul estimates for j=2 in the 3rd column, sigmal estimates for j = 2 in the 4th column and so on?
Are there any other way do this? Thank you for your help.
Related
I am trying to calculate a value and insert the result into a results list. Next, I'd like to use the previous result as an input, run calculation using previous result, and insert into new result into the results list.
x = seq(1,10, by = 1)
y = list()
i = 2
j = 1
for(i in 1:10){
y[i] = (x[i] - y[[j]])/2
i = i +1
j = j + 1
}
Do you mean this ? :
x = seq(1, 10, by = 1)
y = list()
i = 2
j = 1
for(i in 1:10){
y[[i]] = (x[i] - y[[j]])/2
# i = i+1 unnecesary
j = j + 1
}
As others advised this led to error due to uninitialized list.
Now works, but is kinda strange:
x = seq(1, 10, by = 1)
y = list()
i = 2
j = 1
# initialize y with random stuff
for(i in 1:10){
y[[i]] = rnorm(5) # fill with 5 random values
}
for(i in 1:10){
y[[i]] = (x[i] - y[[j]])/2
# i = i+1 unnecesary
j = j + 1
}
Please note that i = 2 is meaningless since its value is overriden by both loop indexes, which are named the same.
I have a matrix of dimension n*k and I am trying to calculate another matrix which has all the pairs which will have n(n-1)/2 rows and k columns
New columns are element-wise multiplication of two different individual rows.
Below is the code,how i am calculating it currently:
mat = matrix(rnorm(10000,mean = 0,sd = 1), nrow = 100, ncol = 100) # n = 100, k = 100
mat2 = matrix(data = NA, nrow = nrow(mat)*(nrow(mat)-1)/2, ncol = ncol(mat))
counter = 0
for(i in seq(nrow(mat))){
# print(paste('i', i))
for(j in seq(nrow(mat))){
# print(paste('j', j))
if((i!= j)&(i<j)){
x = mat[i,]*mat[j,]
# print(x)
mat2 = rbind(mat2, x)
counter = counter + 1
print(paste('Counter - ', counter,' : Pair(', i,',', j, ')', sep = ''))
}
}
}
Its very brute force approach though with O(n^2). Is there a way to do the same computation with less time ?
I am trying to take a derivative of a double sum function. I am running into this error:
Error in deriv.f.1(X = X.data, y = y.vec, alpha = alpha.vector[1, ]) :
object 'L_D_grad' not found
I have tried to move the {} brackets around, double check if I missed a closing/opening bracket, if I have extra opening/closing bracket. However, the error still exists.
# Generate Sample Data
gen.sample <- function(n){
x <- rnorm(n,5,10)
y <- ifelse(x < 2.843,1,-1)
return(data.frame(x,y))
}
##
deriv.f.1 <- function(X,y,alpha){
N <- length(X)
L_D_grad < numeric(N)
xy.alpha.sum <- numeric(N)
for(k in 1:N){
for(l in 1:N){
if(l == k){
xy.alpha.sum[l] = 0}
else{
xy.alpha.sum[l] <- alpha[l]*y[k]*y[l]*X[k]*X[l]}
}
L_D_grad[k] <- 1 - sum(xy.alpha.sum) - alpha[k]*(y[k])^2*(X[k])^2
}
return(L_D_grad)
}
## Illustration
set.seed(4997)
options(digits = 4,scipen = -4)
sample.data <- gen.sample(n=N)
X.data <- sample.data$x
y.vec <- sample.data$y
alpha.vector <- matrix(rep(seq(from=-5,to = 5, length.out = N),N*N),
ncol = N, nrow = N, byrow = TRUE)
alpha_vec <- alpha.vector[1,]
deriv.f.1(X = X.data, y = y.vec, alpha = alpha_vec)
Thanks in advance!
Here is my code:
# Generate Sample Data
gen.sample <- function(n){
x <- rnorm(n,5,10)
y <- ifelse(x < 2.843,1,-1)
return(data.frame(x,y))
}
##
deriv.f.1 <- function(X,y,alpha){
N <- length(X)
L_D_grad <- numeric(N)
xy.alpha.sum <- numeric(N)
for(k in 1:N){
for(l in 1:N){
if(l == k){
xy.alpha.sum[l] = 0}
else{
xy.alpha.sum[l] <- alpha[l]*y[k]*y[l]*X[k]*X[l]}
}
L_D_grad[k] <- 1 - sum(xy.alpha.sum) - alpha[k]*(y[k])^2*(X[k])^2
}
return(L_D_grad)
}
## Illustration
set.seed(4997)
options(digits = 4,scipen = -4)
N=10
sample.data <- gen.sample(n=N)
X.data <- sample.data$x
y.vec <- sample.data$y
alpha.vector <- matrix(rep(seq(from=-5,to = 5, length.out = N),N*N),
ncol = N, nrow = N, byrow = TRUE)
alpha_vec <- alpha.vector[1,]
deriv.f.1(X = X.data, y = y.vec, alpha = alpha_vec)
Where:
#sample.data
#x y
#1 -5.303e+00 1
#2 1.493e+01 -1
#3 9.797e+00 -1
#4 1.991e+01 -1
#5 -1.454e+01 1
#6 1.423e+01 -1
#7 1.025e+01 -1
#8 5.455e+00 -1
#9 3.719e+00 -1
#10 2.021e+01 -1
And deriv.f.1(X = X.data, y = y.vec, alpha = alpha_vec)
# -1.271e+01 -3.759e+01 -2.432e+01 -5.046e+01 -3.659e+01 -3.577e+01 -2.548e+01 -1.310e+01
# -8.612e+00 -5.123e+01
I made two changes:
Assign N a value: N=10
Correct assignment form L_D_grad: L_D_grad <- numeric(N)
I am trying to make a table from a while loop. Basically, I want to make a while loop where the value of r increases by 1 and repeats this until the inequality is met. But in addition to that, I want to combine these values into a table with three columns: the value of r, the value of w, and the value of rhs (rounded to 3 decimal places).
```{r}
al = 0.10; n = 30; a = 3; b = 5; r = 2; int = 8; h = (int/2); msE = 19.19
table = function(MSE, V, H, alpha = al, r = 2){
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
while(w > rhs){
r = r+1
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
}
rbind(g)
}
table(MSE = msE, V = a*b, H = h)
```
I figured it would go something like this, but this only prints out the last value of r before the loop ends (it ends at 26), which results in a "table" that only has one row. I would like a table with 24 rows (since it starts at r = 2).
Any help would be appreciated!
Perhaps this might help:
al = 0.10; n = 30; a = 3; b = 5; r = 2; int = 8; h = (int/2); msE = 19.19
table = function(MSE, V, H, alpha = al, r = 2){
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
gn = data.frame(r, round(w, 3), round(rhs, 3))
while(w > rhs){
r = r+1
rhs = h^2*r/((V-1)*MSE)
w = qf(alpha, V-1, V*(r-1), lower.tail = FALSE)
g = data.frame(r, round(w, 3), round(rhs, 3))
gn <- rbind(gn,g)
}
return(gn)
}
table(MSE = msE, V = a*b, H = h)
A slightly different approach, eliminating the need for an interim data frame and for rbind(). Commented in the code.
# your parameters
al <- 0.10; n <- 30; a <- 3; b <- 5; int <- 8; h <- (int/2); msE <- 19.19
# your function definition (name changed to avoid confusion / conflict with existing R function)
tabula <- function(MSE, V, H, alpha = al, r = 2)
{
g <- data.frame( N = 0, W = 1, RHS = 0 ) # initiate data frame, values set
# so that the while condition is met
# the while function populates the data frame cell by cell,
# eliminating the need for an interim data.frame and rbind()
while( g[ r - 1, "W" ] > g[ r - 1, "RHS" ] ) # check condition in the last data frame row
{ # write values in a new row
g[ r, "N" ] <- r
g[ r, "W" ] <- round( qf( alpha, V - 1, V * ( r - 1 ), lower.tail = FALSE ), 3 )
g[ r, "RHS" ] <- round( h^2 * r / ( ( V - 1 ) * MSE ), 3 )
r <- r + 1 # increment row counter
}
return( g[ -1, ] ) # return the data frame, removing the initial row
}
tabula( MSE = msE, V = a * b, H = h )
I used Rglpk to solve a linear programming problem, but its results seems weird. I changed it to lpSolve, and the two results are different.
Please comment the Rglpk and uncomment lpSolve statements to change the solver to lpSolve.
# Lo, S.-F., & Lu, W.-M. (2009). An integrated performance evaluation of financial holding companies in Taiwan.
# European Journal of Operational Research, 198(1), 341–350. doi:10.1016/j.ejor.2008.09.006
sbm = function(X,Y)
{
# Here X is N * m matrix, Y is N*s matrix.
library(Rglpk)
# require(lpSolve)
N = nrow(X)
m = ncol(X)
s = ncol(Y)
# variables are
# t
# gamma_j,j=1..N
# s_i^(-),i=1..m
# s_r^(+),r=1..s
efficiency = numeric(N)
max_positive_y = apply(Y[,1:s], MARGIN = 2, function(x) max(x[x>0]))
min_positive_y = apply(Y[,1:s], MARGIN = 2, function(x) min(x[x>0]))
dir = rep("==",1+m+s+1)
rhs = c(1,rep(0,m),rep(0,s),0)
for(i in 1:N)
{
x = X[i,]
y = Y[i,]
#variables
coef_t = 1
coef_gamma = rep(0,N)
coef_s_i = -1/(m * x)
coef_s_r = rep(0,s)
obj = c(coef_t,coef_gamma,coef_s_i,coef_s_r)
coef_constraint1_s=y
for(r in 1:s)
{
if(y[r]<0){
coef_constraint1_s[r] =
min_positive_y[r] * (max_positive_y[r] - min_positive_y[r])/
(max_positive_y[r] - y[r])
}
}
constraint1 = c(1, rep(0,N), rep(0,m) , 1/(s*coef_constraint1_s))
constraint2 = cbind(-x, t(X), diag(m), matrix(0,m,s))
constraint3 = cbind(-y, t(Y), matrix(0,s,m), -diag(s))
constraint4 = c(-1, rep(1,N), rep(0,m), rep(0,s))
mat = rbind(constraint1,constraint2,constraint3,constraint4)
results = Rglpk_solve_LP(obj = obj,mat = mat,dir = dir,rhs = rhs,max = FALSE)
efficiency[i] = results$optimum
# results <- lp("min", obj, mat, dir, rhs)
# efficiency[i] = results$objval
}
efficiency
}