Recreating the diag() function - r

I am currently trying to duplicate the diag() function in R to get a better understanding. Unfortunately, my solution is only useful for symmetric matrices.
diagnew <- function(x){
k <- c()
for(i in 1:nrow(x)){
k[i] <- x[i,i]
}
return(k)
}
I would be grateful for any tips that allow me to generalize my function.

The error comes from looping pass min(nrow, ncol).
diagnew <- function(x){
n <- min(nrow(x), ncol(x))
k <- vector(class(x[1,1]), n)
for(i in seq.int(n)){
k[i] <- x[i,i]
}
k
}
mat <- matrix(1:10, 5)
diag(mat)
diagnew(mat)
identical(diag(mat), diagnew(mat))
#[1] TRUE

Related

Benchmarking matrices functions and calculations in R

I have managed to program several functions to perform matrices calculations in R such as:
Determinants Calculation:
Det_fn <- function(x){
if(nrow(x)!=ncol(x)) {
print("Undefined")
} else
if(nrow(x)==1 && ncol(x)==1) {
DET <- x[1,1]; DET
} else
if(nrow(x)==2 && ncol(x)==2) {
DET <- x[1,1]*x[2,2]-x[1,2]*x[2,1]; DET
} else
for(j in 1:ncol(x)){
DET[j] <- (((-1)^(1+j))*x[1,j]*Det_fn(x[-1,-j]))
}
DET
sum(DET)
}
Cofactor signs matrix:
Cof_fn <- function(x){
COF <- matrix(rep(0,ncol(x)), nrow(x), ncol(x)); COF
for(i in 1:nrow(x)) {
for(j in 1:ncol(x)) {
COF[i,j] <- ((-1)^(i+j))
}
}
COF
}
Adjoint Matrix:
Adj_fn <- function(x){
ADJ <- matrix(rep(0,ncol(x)), nrow(x), ncol(x))
for(i in 1:nrow(x)){
for(j in 1:ncol(x)){
ADJ[i,j] <- Det_fn(x[-j,-i])
}
}
ADJ
}
Inverse:
Inv_fn <- function(x){
ifelse(Det_fn(x)!=0, INV <- (((Adj_fn(x)/Det_fn(x))*Cof_fn(x))), print("Undefined, matrix is singular."))
INV
}
I know that there are inbuilt functions in R to do this such as: det() and solve() but I just wanted to learn a little bit about matrices and some functions programming in R. Now my question:
How do I perform a benchmarking test on my functions and see how they perform compared to the inbuilt matrices functions in R?
Very pedestrian but it did the job as I expected... Using Sys.time()
# Benchmarking tests
V1 <- rnorm(100, mean=1.3, sd=0.6)
X <- matrix(V1, 10, 10)
Start1 <- Sys.time()
Det_fn(X)
Inv_fn(X)
End1 <- Sys.time()
End1-Start1
Start2 <- Sys.time()
det(X)
solve(X)
End2 <- Sys.time()
End2-Start2
abs(det(X)-Det_fn(X))
solve(X)-Inv_fn(X)
max(abs(solve(X)-Inv_fn(X)))
I just wanted to see how my functions Det_fn() and Inv_fn() compared to the inbuilt functions det() and solve() and the code I just posted did it for me. The results are:
My Det_fn() and Inv_fn() took 2.536057 mins while det() and solve() took 0.003991842 secs.
The resulting determinants by using both methods are vistually the same with an error of 2.842171e-14. The maximum absolute error in the inverse was 1.221245e-15
How can I optimize my determinant calculation? I must study that...

how can i get list of all partition with K dimension R

i'm using this code:
library("partitions")
x <- c(2,4,6)
parts <- listParts(length(x))
out <- rapply(parts, function(ii) x[ii], how="replace")
to calculate list vector of all partition, but i would be like list of partition with k dimension, for example:
k=2
{(2),(4,6)}{(4),(2,6)}{(6),(2,4)}
Maybe there are better ways of doing this but the following does what you want.
library(partitions)
funParts <- function(x, k){
parts <- listParts(length(x))
res <- lapply(parts, function(inx) sapply(inx, function(i) x[i]))
res <- unlist(res, recursive = FALSE)
res <- res[sapply(res, length) <= k]
unique(res)
}
x <- c(2,4,6)
k <- 2
funParts(x, 2)
funParts(x, 1)
funParts(4:10, 3)

R for-loop vector 1,2,2,3,3,3,4,4,4,4,..,10,

I have been trying to make vector 1,2,2,3,3,3,4,4,4,4,...,10 in R with a for-loop. But my code doesn't seem to work...
vector <- c()
vector[1]<-1
k <- 1
for (i in 1:10){
for (j in 1:10)
if (j<=i){
vector[j+1] = vector[i]+k
}
k <- k+1 }
Could someone help me out? Thanks in advance!
This is best done without any loops: rep(1:10, 1:10)
But if you really must do it with nested loops, this would work:
vector = c()
for(i in 1:10) {
for(j in 1:i) {
vector = c(vector, i)
}
}
How about this:
vector=rep(1:10,1:10)

General code for a summation in R

I'm writing some code in R and I came across following problem:
Basically, I want to calculate a variable X[k], where X takes on values for each k, like this:
where A is a known variable which takes on different values for each index.
For the moment, I have something like this:
k <- NULL
X <- NULL
z<- 1: n
for (k in seq(along =z)){
for (j in seq (along = 1:k)){
X[k] = 1/k*sum(A[n-k]/A[n-j+1])
}
}
which can't be right. Any idea on how to fix this one?
As always, any help would be dearly appreciated.
Try this
# define A
A <- c(1,2,3,4)
n <- length(A)
z <- 1:n
#predefine X (don't worry, all values will be overwritten, but it will have the same length as A
X <- A
for(k in z){
for(j in 1:k){
X[k] = 1/k*sum(A[n-k]/A[n-j+1])
}
}
You don't need to define z, it is only used inside the for. In this case, do for(k in 1:n){
As
You can do the following
set.seed(42)
A <- rnorm(10)
k <- sample(length(A), 4)
calc_x <- function(A, k){
n <- length(A)
c_sum <- cumsum(1/rev(A)[1:max(k)])
A[n-k]/k * c_sum[k]
}
calc_x(A,k)
what returns:
[1] 0.07775603 2.35789999 -0.45393983 0.13323284

-- How to start a loop with a first guess?

This is comp sci 101 stuff, but I couldn't find an answer applicable to R (or matlab).
I have a for loop that I want to initialize with a first guess (all zeros here, but maybe something else later), but I want to keep updating with each iteration. What I have below works, but it kind of clunky and embarrassing.
I would like to avoid the one iteration before the for loop. I could do it with an ifelse inside the loop, but that seems inefficient. Thanks!
alpha <- 0.3
beta <- 0.6
m <- 5 # elements in k
n <- 10 # iterations
k.prime <- v <- matrix(0, n, m)
k <- seq(from=0.04, to=0.2, length.out=m) # poss values for k
colnames(v) <- colnames(k.prime) <- round(k, digits=2)
# first loop for taking the first guess for v()
i <- 1
for (j in 1:m) {
temp.v <- log(k[j]^alpha - k) + beta*rep(0, times=m)
v[i, j] <- max(temp.v)
k.prime[i, j] <- k[which.max(temp.v)]
}
# remaining loops
for (i in 2:n) {
for (j in 1:m) {
temp.v <- log(k[j]^alpha - k) + beta*v[i-1, ]
v[i, j] <- max(temp.v)
k.prime[i, j] <- k[which.max(temp.v)]
}
}
v
k.prime
Init v[1,] with zeroes, delete the first loop and fix i index to i+1 elsewhere.
This should then look like this:
alpha<-0.3
beta<-0.6
m<-5 #elements in k
n<-10 #iterations
k.prime<-matrix(0,n,m);
v<-matrix(0,n+1,m);
k<-seq(from=0.04,to=0.2,length.out=m) #poss values for k
colnames(v)<-colnames(k.prime)<-round(k,digits=2)
v[1,]<-rep(0,m);
# remaining loops
for(i in 1:n){
for(j in 1:m){
temp.v<-log(k[j]^alpha-k)+beta*v[i,]
v[i+1,j]<- max(temp.v)
k.prime[i,j]<-k[which.max(temp.v)]
}
}
v[-1,]->v; #Cleanup of 0-row
v
k.prime
Just do :
for (i in 1:n) {
for (j in 1:m) {
if (i == 1)
temp.v <- log(k[j]^alpha - k) + beta*rep(0, times=m)
else
temp.v <- log(k[j]^alpha - k) + beta*v[i-1, ]
v[i, j] <- max(temp.v)
k.prime[i, j] <- k[which.max(temp.v)]
}
}

Resources