maximize the value of a function using a for loop - r

I'm a bit new to R and I'm trying to maximize a simple value function, for a given parameter space.
The idea is to solve for c given different values of a.
The function is
2*(c^2)-(7.8*c)-(4*c*a)+(5*a)+(a^2)+6=0
And I would like to solve for the different values of c, given values of a from 0 to 100.
Is there any way to do this simply using a for loop?
Thanks a lot!

The equation can be solved analytically for c (since it's a simple degree 2 polynomial equation). Using e.g. Wolfram Alpha gives the two solutions
We can roll this up into a function to calculate c for different a
func_c <- function(a) a + 1/20 * (39 + c(-1, 1) * sqrt(200 * a^2 + 560 * a + 321))
sapply(0:10, func_c)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
#[1,] 1.054176 1.306072 1.58304 1.867387 2.154937 2.44417 2.734398 3.025264 3.316562 3.608168 3.9
#[2,] 2.845824 4.593928 6.31696 8.032613 9.745063 11.45583 13.165602 14.874736 16.583438 18.291832 20.0
If you must use a numerical root finder (and I don't recommend doing this here since this has a simple closed-form analytical solution) you can use polyroot. The coefficients can be read off from the equation you give
pol_coef <- function(a) c(5 * a + a^2 + 6, 7.8 + 4 * a, 2)
sapply(0:10, \(x) abs(polyroot(pol_coef(x))))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
#[1,] 1.054176 1.306072 1.58304 1.867387 2.154937 2.44417 2.734398 3.025264 3.316562 3.608168 3.9
#[2,] 2.845824 4.593928 6.31696 8.032613 9.745063 11.45583 13.165602 14.874736 16.583438 18.291832 20.0
Solutions from both approaches are identical.

Related

how to apply fisher exact test on matrices

I want to perform the fisher exact test between these two matrices, I want to compare the columns of one matrix with the columns of other matrix
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
A 0.1200480 0.07189073 0.0000000 0.1016260 0.1128205 0.10200927 0.2961319 0.3020383 0.02524866 0.0000000
C 0.0300120 0.19769950 0.2012802 0.2815041 0.2358974 0.48686244 0.4724160 0.3749228 0.65340474 0.3294118
G 0.6302521 0.52120776 0.6273115 0.4085366 0.4179487 0.35548686 0.1122384 0.1247684 0.29609793 0.6705882
T 0.2196879 0.20920201 0.1714083 0.2083333 0.2333333 0.05564142 0.1192137 0.1982705 0.02524866 0.0000000
here is the other matrix
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
A 0.3143147 0.79432422 0.03440895 0.07098851 0.0004179104 0.0002388202 0.9988065402 0.69191708 0.181764 0.00000000
C 0.1690764 0.02235194 0.89570290 0.92901149 0.0000000000 0.0004179354 0.0007757489 0.01218711 0.000000 0.48599247
G 0.3406620 0.14882308 0.06988816 0.00000000 0.9992835821 0.9993432444 0.0004177109 0.00000000 0.818236 0.02478944
T 0.1759469 0.03450076 0.00000000 0.00000000 0.0002985075 0.0000000000 0.0000000000 0.29589581 0.000000 0.48921809
How can I do this.
I tried this
Ref <- read.table("Ref_PPM.txt", sep=" ", header=T, stringsAsFactors=F)
Pred <- read.table("Pre_PPM.txt", sep=" ", header=T, stringsAsFactors=F)
output_df_forward <- data.frame()
for(i in 1:ncol(Ref)) {
Ref_vec <- as.numeric(unlist(as.data.frame(Ref[,1:i])))
Pred_vec <- as.numeric(unlist(as.data.frame(Pred[,(ncol(Pred)-i+1):ncol(Pred)])))
res <- Fisher.test(Pred_vec, Ref_vec)
output <- as.data.frame(cbind(as.numeric(res$p.value), as.numeric(res$estimate)))
ifelse(i == 1, output_df_forward <- output, output_df_forward <- rbind(output_df_forward, output))
}
But this loop does not work I want to apply this fisher test through above mention loop.
I also try this
FP<-table(Pre_PPM)
FR<-table(Ref_PPM)
fisher.test(FP, FR)
Error in fisher.test(FP, FR) : 'x' and 'y' must have the same length
Kindly guide how can I do this. Thanks for your time in advance.
Considering your second example, I believe your matrices do not have the same size in terms of rows and columns. Here is an example of Fisher test:
a <- data.frame(foo=c(1,2), bar=c(3, 4), spam=c(5, 6))
b <- data.frame(eggs=c(7,10), ham=c(15, 30), spar=c(35, 40))
Which works perfectly fine:
fisher.test(a, b)
The output is:
Consider checking the matrices sizes.

How to fix? 'It is recommended to have a covariance matrix with a determinant bigger than 1/ ((2*PI)^k) .' when using RcppHMM package in R

I am using a RcppHMM package to make a GHMM(Multivariate gaussian mixture HMM model) with continuous observation.
I want to learn an EM algorithm using continuous observations with different sequence lengths.
To be specific, each observation has a different sequence length from 3 to 6.
I tried to fit the model using the whole observation dataset at once (I made the dataset with ncol=6(maximum sequence length) and filled the empty part with all zero), but it didn't work
so I separated observations as groups with the same lengths [O3, O4, O5, O6]
and updated the model by each group.
Each observation group looks like this
O3
[,1] [,2] [,3]
[1,] 0.8550940 0.3231340 0.8639223
[2,] 0.4453262 0.5840305 0.4356958
[3,] 0.4344789 -1.2234760 0.4344789
[4,] -0.5003085 3.0322560 -0.5003085
[5,] -0.1459598 -0.4661041 -0.1459598
[6,] -0.1977263 -0.6352724 -0.1977263
O4
[,1] [,2] [,3] [,4]
[1,] 0.8965332 0.3338220 0.7270241 0.8824540
[2,] 0.4033438 0.4131293 0.1593136 0.4187023
[3,] -0.7329015 -1.6828296 -0.1550487 -0.1550487
[4,] -0.3213490 7.3449076 -0.2787857 -0.2787857
[5,] -0.2868067 -0.3743332 -0.1340566 -0.1340566
[6,] 2.6832742 -0.5844305 0.2320774 0.2320774
O5
[,1] [,2] [,3] [,4] [,5]
[1,] 0.83401341 0.2492370 0.47493190 0.6440035 0.84985396
[2,] 0.37988234 0.2335883 0.17043570 0.2116066 0.36260248
[3,] -0.05240445 -0.3034002 -0.05240445 -0.3034002 -0.05240445
[4,] -0.37240867 1.1500528 -0.37240867 1.1500528 -0.37240867
[5,] -0.02056839 0.9343497 -0.02056839 0.9343497 -0.02056839
[6,] -0.27586584 -0.4406833 -0.27586584 -0.4406833 -0.27586584
O6
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.9287066 0.35065802 0.4493442 0.6142040 0.7423286 0.9217381
[2,] 0.3852644 0.09612516 0.1623447 0.1320334 0.1875127 0.3928661
[3,] 0.1436024 -0.08326038 0.7800491 0.1436024 0.1926751 0.1436024
[4,] -0.4284304 -0.27916609 -0.5224586 -0.4284304 0.1267840 -0.4284304
[5,] -0.8846364 -0.81131525 -0.1781479 -0.8846364 -0.1266250 -0.8846364
[6,] -0.2141231 -0.78377461 -0.4440142 -0.2141231 -0.7888260 -0.2141231
nrow is the number of dimension of observation, and ncol is lengths of sequences.
When I updated the model with the first group that has sequence length 3, it operated.
But when I tried to re-update model with second group that has sequence length 4, the warning message came out as below,
In learnEM(newModel, O4[, 1:4, ], iter = 20, delta = 1e-05, print = TRUE) :
It is recommended to have a covariance matrix with a determinant bigger than 1/ ((2*PI)^k) .
Does anyone know how to fix this warning message?
And is there any proper way to learn a EM algorithm with observations that have different sequence lengths using this package?

A for loop with rowSums function

I am a beginner in R and I have written a double-for loop for calculating chi2 values for selecting features among 6610 terms and 10 classes.
Here is my for loops:
library(raster)
#for x^2 [n,r] = term n, class r. n starts from col #7 and r starts from col #6617
chi2vals <- matrix(0:0,6610,10)
chi2avgs <- vector("numeric",6610L)
for(r in 1:10){
for(n in 1:6610){
A = sum(data1.sub.added[,6+n]==1 & data1.sub.added[,6616+r]==1)
M = sum(data1.sub.added[,6+n]==1)
P = sum(data1.sub.added[,6616+r]==1)
N = nrow(data1.sub.added)
E = ((A*N)-(M*P))**2
F = (N-P)*(N-M)
chi2vals[n,r] = (N/(P*M))*(E/F) # for term n
}
Prcj = sum(data1.sub.added[,6616+r]==1)/sum(data1.sub.added[,6616:6626]==1) #probability of class c_r
pchi <- Prcj * chi2vals
chi2avgs[n] = rowSums(pchi)[n]
}
The code correctly calculates everything up to the line pchi <- Prcj * chi2vals. The result is a nice matrix of p*chi2 values:
> head(pchi)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 128.36551442 0.239308113 0.683517530 1.5038665 0.6145058 3.656857e-01 1.3311564 2.6977448 0.410702803
[2,] 0.06632758 0.067970859 0.019178551 0.2900692 1.5300639 4.430705e-08 0.2599859 0.6362953 0.098745147
[3,] 1.85641330 1.411925435 3.590747764 7.3018416 38.8044465 4.102248e-01 6.4118078 13.0164994 1.709506238
[4,] 0.11063892 0.005039029 0.244964758 0.1622654 0.1156411 8.274468e+00 0.2564959 0.0577651 0.242946022
[5,] 0.04788648 0.049072885 0.001420669 0.2094211 1.7200152 2.045923e-01 0.1877019 0.1468187 0.005493183
[6,] 5.39946188 6.899336618 60.735646913 7.4351538 10.7005784 9.946261e+00 35.8868899 178.7112406 11.382740754
[,10]
[1,] 0.26436516
[2,] 0.14414444
[3,] 0.90292073
[4,] 0.01168997
[5,] 0.06641298
[6,] 19.68599142
But the final chi2avgs values mostly turn out to be zeros:
> head(chi2avgs)
[1] 0.000000 0.000000 0.000000 0.000000 2.638835 0.000000
However, when aside from the loop I replace n with any number, the last line works well:
chi2avgs[1] = rowSums(pchi)[1]
chi2avgs[2] = rowSums(pchi)[2]
chi2avgs[3] = rowSums(pchi)[3]
chi2avgs[4] = rowSums(pchi)[4]
chi2avgs[5] = rowSums(pchi)[5]
> head(chi2avgs)
[1] 136.476367 3.112781 75.416334 9.481914 2.638835 0.000000
I wonder what causes this problem. Do you have an idea how I can fix it?
You can try directly rowsums without [n]
chi2avgs = rowSums(pchi)

Missing argument in a function

I have an ODE function LVM() which takes the arguments time,population, carry capacity and growth rate. I need to compute its stability by finding the Jacobian using 'pracma' R package or 'rootSolve' package but i get an error
Error in fun(x, ...) : argument "r" is missing, with no default
my function is;
LVM <- function(t,pop,int_mat,str_mat,carry_cap,r){
dN=r*pop*((carry_cap-(int_mat*str_mat)%*%pop)/carry_cap)
return(dN)
}
When i compute the Jacobian as below;
jacobian(LVM,c(0.287778,0.2553485,0.147619,0.3661074,0.4390739,0.1270218,0.4533318,0.2236241,0.3555208,0.2102366))
where the numerical values are population densities i get an error
Error in fun(x, ...) : argument "r" is missing, with no default
Your input will be highly appreciated.
With a modified function LVM_V2 which takes a vector of parameters instead
of 6 parameters, I get the following output. Is this the expected output
Mapping of parameters:
#r=>x[6]
#pop => x[2]
#carry_cap => x[5]
#int_mat => x[3]
#str_mat => x[4]
LVM_V2 <- function(x){
dN=x[6]*x[2]*((x[5]-(x[3]*x[4])%*%x[2])/x[5])
return(dN)
}
pracma::jacobian(LVM_V2,c(0.287778,0.2553485,0.147619,0.3661074,0.4390739,0.1270218,0.4533318,0.2236241,0.3555208,0.2102366))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#[1,] 0 0.1190372 -0.006905828 -0.002784515 0.002321776 0.2473229 0 0 0 0
Note that the parameter t remains unused in your function

Replicate each time with different standard deviation

I have a vector of standard deviations:
sd_vec<-runif(10,0,20) with 10 values between 0 and 20.
[1] 11.658106 9.693493 12.695608 4.091922 5.761061 18.410951 14.710990 12.095944 18.023123
[10] 13.294963
I would like to replicate the following process:
a<-rnorm(10,0,30)
[1] -21.265083 85.557147 23.958170 -32.843328 6.629831 -23.745339 46.094324 51.020059
[9] 1.041724 13.757235
n_columns=50
replicate(n_columns, a+rnorm(length(a), mean=0,sd=sd_vec))
The result should be 10 columns each of which are:
column 1: a + rnorm(length(a),0,11.658106)
column 2: a + rnorm(length(a),0,9.693493)
column 3: a + rnorm(length(a),0,12.695608)
.
.
.
column 10:a + rnorm(length(a),0,13.294963)
Will this use different values of sd_vec for each replication or will it use it for each random number generation?
According to your edit, then you may want to try
a+sapply(sd_vec, rnorm, n=100, mean=0)
# example
> set.seed(1)
> sd_vec <-runif(10,0,20)
> set.seed(1)
> a<-rnorm(100,0,30)
> n_columns=10
> head(a+sapply(sd_vec, rnorm, n=100, mean=0))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] -22.087869 -15.746650 -8.554735 0.7226986 -18.481801 -24.921835 -32.16206 -33.158153 -38.187974
[2,] 5.732942 18.078702 -6.489666 39.9422684 4.311839 32.504554 42.75921 -18.624133 7.954302
[3,] -29.906010 -13.260709 -2.483113 -36.0217953 -29.841630 -15.576334 -26.76925 -11.915258 -21.741820
[4,] 48.697584 45.395650 43.463125 40.7586401 47.903975 57.600406 47.59359 47.701659 33.782184
[5,] 6.409275 -7.122582 28.836887 2.3249113 13.884993 7.429514 -11.34081 1.960571 18.075706
[6,] -15.229450 -6.025260 -7.288529 -31.4375515 -18.184563 -45.038651 -50.00938 -26.965804 -37.610292
[,10]
[1,] -17.391109
[2,] 6.883342
[3,] -26.144900
[4,] 48.118830
[5,] 9.970987
[6,] -26.668629
Your current solution will replicate sd_vec for each replication, not using each sd for each replication.
If you want to have columns for each sd then you may work on matrices. Create matrix of rnorm with desire sd by:
X <- rnorm(length(a)*n_columns, mean=0, sd=sd_vec)
X <- matrix(X, nrow=length(a), ncol=n_columns, byrow=TRUE)
Then add it to a converted to matrix:
matrix(a, nrow=length(a), ncol=n_columns) + X

Resources