R Notebook

Write a function to solve a 2x2 system using Cramer’s rule.

solver2by2 <- function(A,b){
  A_inv <- (1/(A[1,1]*A[2,2]-A[2,1]*A[1,2]))* matrix(c(A[2,2],-A[1,2],-A[2,1],A[1,1]), byrow= TRUE, nrow=2)
  sol <- A_inv %*%  b
  cat("x=",sol[1],"\ny=",sol[2])
}
A <- matrix(c(2,3,4,-1), byrow=TRUE, nrow=2)
b<- matrix(c(8,6), nrow=2)
solver2by2(A,b)

x= 1.857143 
y= 1.428571

# built in
solve(A,b)

         [,1]
[1,] 1.857143
[2,] 1.428571

Write a function to find the determinant of a 2x2 matrix.

det2by2 <- function(A){
  detA22<- (A[1,1]*A[2,2]-A[2,1]*A[1,2])
  cat("Determinant=",detA22)
  return(detA22)
}
det2by2(A)

Determinant= -14[1] -14

# built in
det(A)

[1] -14

determinant of a 3x3 matrix

det3by3 <- function(A){
  detA33 <- A[1,1]*(A[2,2]*A[3,3]-A[2,3]*A[3,2])-A[2,1]*(A[1,2]*A[3,3]-A[1,3]*A[3,2])+A[3,1]*(A[1,2]*A[2,3]-A[1,3]*A[2,2])
  cat("Determinant=",detA33)
}
B <- rbind(cbind(A,b),c(b,1))
det3by3(B)

Determinant= 314

Write a function to check if a 2x2 matrix is invertible.

inv_checker <- function(A){
  if (det2by2(A)==0){
    print("Inverse Not Possible.")
  } else{
    print("Inverse Possible.")
  }
}
inv_checker(A)

Determinant= -14[1] "Inverse Possible."

Write a function to form an augmented matrix from coefficient matrix A and vector b.

cbind(A,b)

     [,1] [,2] [,3]
[1,]    2    3    8
[2,]    4   -1    6

aug_mat <- function(A,b){
  aug <- cbind(A,b)
  cat("Augmented Matrix:\n")
  return(aug)
}
aug_A<-aug_mat(A,b)

Augmented Matrix:

print(aug_A)

     [,1] [,2] [,3]
[1,]    2    3    8
[2,]    4   -1    6

Write a function to perform row swapping in an augmented matrix.

swap_rows <- function(A, i, j) {
  temp <- A[i, ]
  A[i, ] <- A[j, ]
  A[j, ] <- temp
  print(A)
  return(A)
}
# Swap rows 1 and 2
A_swapped <- swap_rows(A, 1, 2)

     [,1] [,2]
[1,]    4   -1
[2,]    2    3

Write a function to scale a row in a matrix by a constant.

row_scaler <- function(A,i,c){
  A[i]<-A[i]*c
  print(A)
}
row_scaler(A,1,5)

     [,1] [,2]
[1,]   10    3
[2,]    4   -1

Write a function to add a multiple of one row to another row.

row_operation <- function(A,row1,row2,c){
  A[row1,]<-A[row1]+A[row2,]*c
  print(A)
}

row_operation(A,1,2,4)

     [,1] [,2]
[1,]   18   -2
[2,]    4   -1

Write a function to convert a 3x3 augmented matrix to upper triangular form.

to_upper_tri <- function(A) {
  # Forward elimination
  # Step 1: Eliminate x from row 2
  if (A[1,1] != 0) {
    factor <- A[2,1] / A[1,1]
    A[2,] <- A[2,] - factor * A[1,]
  }
  
  # Step 2: Eliminate x from row 3
  if (A[1,1] != 0) {
    factor <- A[3,1] / A[1,1]
    A[3,] <- A[3,] - factor * A[1,]
  }
  
  # Step 3: Eliminate y from row 3
  if (A[2,2] != 0) {
    factor <- A[3,2] / A[2,2]
    A[3,] <- A[3,] - factor * A[2,]
  }
  
  return(A)
}

B <- matrix(c(
  2,  1, -1,  8,  # 2x + y - z = 8
  4, -2,  1,  1,  # 4x - 2y + z = 1
 -2,  1,  2,  5   # -2x + y + 2z = 5
), nrow = 3, byrow = TRUE)



C <- to_upper_tri(B)
print(C)

     [,1] [,2] [,3]  [,4]
[1,]    2    1 -1.0   8.0
[2,]    0   -4  3.0 -15.0
[3,]    0    0  2.5   5.5

Write a function to perform back substitution on an upper triangular system.

back_substitution <- function(U) {
  n <- nrow(U)
  x <- numeric(n)
  
  for (i in n:1) {
    # Sum of (coefficient × already-solved-variable)
    sum_coeff_times_known <- 0
    if (i < n) {
      sum_coeff_times_known <- sum(U[i, (i+1):n] * x[(i+1):n])
    }
    x[i] <- (U[i, n+1] - sum_coeff_times_known) / U[i, i]
  }
  
  return(x)
}

D<-back_substitution(C)
print(D)

[1] 2.4 5.4 2.2

Write a function to solve a 3x3 system using Gaussian elimination.

solve_3x3 <- function(A, b) {
  # Create augmented matrix
  aug <- cbind(A, b)
  
  # Forward elimination
  # Step 1: Eliminate x1 from rows 2 and 3
  if (aug[1,1] != 0) {
    # Row 2
    factor <- aug[2,1] / aug[1,1]
    aug[2,] <- aug[2,] - factor * aug[1,]
    
    # Row 3
    factor <- aug[3,1] / aug[1,1]
    aug[3,] <- aug[3,] - factor * aug[1,]
  }
  
  # Step 2: Eliminate x2 from row 3
  if (aug[2,2] != 0) {
    factor <- aug[3,2] / aug[2,2]
    aug[3,] <- aug[3,] - factor * aug[2,]
  }
  
  # Back substitution
  x <- numeric(3)
  x[3] <- aug[3,4] / aug[3,3]
  x[2] <- (aug[2,4] - aug[2,3] * x[3]) / aug[2,2]
  x[1] <- (aug[1,4] - aug[1,2] * x[2] - aug[1,3] * x[3]) / aug[1,1]
  
  return(x)
}

A <- matrix(c(2, 1, -1,
              0, 3, 1,
              0, 0, 4), nrow = 3, byrow = TRUE)
b <- c(3, 9, 12)

solution <- solve_3x3(A, b)
print(solution)  # Output: 2 2 3

[1] 2 2 3

Write a function to check if a 2x2 system has a unique solution.

unique_sol_checker<- function(A){
  D <- A[1,1]*A[2,2]-A[2,1]*A[1,2]
  if (D!=0){
    print("Unique Solution")
  }
  else{
    print("Not unique solution")
  }
}

A <- matrix(c(2,3,4,-1), byrow=TRUE, nrow=2)
unique_sol_checker(A)

[1] "Unique Solution"

Write a function to check if a 3x3 system is inconsistent using row echelon form.

is_inconsistent <- function(A, b) {
  aug <- cbind(A, b)
  
  # Forward elimination to row echelon form
  for (col in 1:3) {
    # Find non-zero pivot
    pivot_row <- which(aug[col:3, col] != 0)[1]
    if (!is.na(pivot_row)) {
      pivot_row <- pivot_row + col - 1
      if (pivot_row != col) {
        # Swap rows
        aug[c(col, pivot_row),] <- aug[c(pivot_row, col),]
      }
      
      # Eliminate below
      if (col < 3) {
        for (row in (col+1):3) {
          factor <- aug[row, col] / aug[col, col]
          aug[row,] <- aug[row,] - factor * aug[col,]
        }
      }
    }
  }
  
  # Check for inconsistency: row of zeros in A with non-zero in b
  for (row in 1:3) {
    if (all(aug[row, 1:3] == 0) && aug[row, 4] != 0) {
      return(TRUE)  # Inconsistent system
    }
  }
  
  return(FALSE)  # Consistent system
}


# Consistent system
A1 <- matrix(c(1, 2, 3,
               0, 1, 2,
               0, 0, 1), nrow = 3, byrow = TRUE)
b1 <- c(14, 8, 3)
print(is_inconsistent(A1, b1))  # FALSE

[1] FALSE

# Inconsistent system: 0x + 0y + 0z = 5
A2 <- matrix(c(1, 2, 3,
               0, 0, 0,
               0, 0, 1), nrow = 3, byrow = TRUE)
b2 <- c(14, 5, 3)
print(is_inconsistent(A2, b2))  # TRUE

[1] TRUE

# Another inconsistent example
A3 <- matrix(c(1, 1, 1,
               2, 2, 2,
               1, 0, 1), nrow = 3, byrow = TRUE)
b3 <- c(3, 7, 2)
print(is_inconsistent(A3, b3))  # TRUE (rows 1 and 2 are multiples but give different b)

[1] TRUE

Write a function to find the inverse of a 2x2 matrix.

inverse_2x2 <- function(A) {
  det_A <- A[1,1] * A[2,2] - A[1,2] * A[2,1]
  
  if (abs(det_A) < 1e-10) {
    return(NULL)  # or return(matrix(NA, nrow=2, ncol=2))
  }
  
  inv <- matrix(c(A[2,2], -A[2,1], -A[1,2], A[1,1]), nrow=2, byrow=TRUE) / det_A
  return(inv)
}

A <- matrix(c(4, 7, 2, 6), nrow=2)
inv_A <- inverse_2x2(A)
print(inv_A)

     [,1] [,2]
[1,]  0.6 -0.7
[2,] -0.2  0.4

Write a function to multiply a matrix by a vector (Ax).

matxvec<- function(A,b){
  return(A%*%b)
}

A1 <- matrix(c(1, 2, 3,
               0, 1, 2,
               0, 0, 1), nrow = 3, byrow = TRUE)
b1 <- c(14, 8, 3)
matxvec(A1,b1)

     [,1]
[1,]   39
[2,]   14
[3,]    3

Write a function to verify a solution x satisfies Ax = b for given A and b.

sol_checker <- function(A,b,x){
  if (all(abs(A %*% x - b) < 1e-10)){
    print("Yes")
  } else{
    print("Wrong")
  }
}


A <- matrix(c(2, 1, -1,
              0, 3, 1,
              0, 0, 4), nrow = 3, byrow = TRUE)
b <- c(3, 9, 12)
x <- c(2, 2, 3)  # Correct solution
sol_checker(A,b,x)

[1] "Yes"

Write a function to find the trace of a square matrix.

trace <- function(A){
  val = 0
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if (i==j){
        val = val + A[i,i]
      }
    }
  }
  return(val)
}

ans <- trace(A)
print(ans)

[1] 9

Write a function to extract the diagonal from a square matrix.

diago <- function(A){
  v<- c()
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if (i==j){
        v <- append(v,A[i,i])
      }
    }
  }
  print(v)
}
diago(A)

[1] 2 3 4

Write a function to create a diagonal matrix from a vector.

vec_diag_mat <- function(b){
  n<-length(b)
  A <- matrix(0, nrow=n, ncol=n)
  for (i in 1:n){
    A[i,i]<-b[i]
  }
  print(A)
}

vec_diag_mat(b)

     [,1] [,2] [,3]
[1,]    3    0    0
[2,]    0    9    0
[3,]    0    0   12

Write a function to create an identity matrix of size n.

In <- function(n){
  A<-matrix(0,nrow=n,ncol=n)
  for (i in 1:n){
    A[i,i]<-1
  }
  return(A)
}
A<-In(5)
A

     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1

Write a function to compute the sum of each column in a matrix.

col_sum <- function(A){
  colsum<-c()
  for (i in 1:ncol(A)){
    colsum<-append(colsum,sum(A[,i]))
  }
  colsum
}
col_sum(A)

[1] 1 1 1 1 1

Write a function to compute the mean of each row in a matrix.

rowmean <- function(A){
  x<-c()
  for (i in 1:nrow(A)){
    x<-append(x,mean(A[i,]))
  }
  return(x)
}

x<-rowmean(A)
print(x)

[1] 0.2 0.2 0.2 0.2 0.2

Write a function to check if two matrices are equal.

equal_check <- function(A,B){
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if (A[i,j]!=B[i,j]){
        return (FALSE)
      }
    }
  }
  return (TRUE)
}
A<-matrix(c(1,2,3,4), nrow=2)
B<-matrix(c(1,2,3,4.000000001), nrow=2)
equal_check(A,B)

[1] FALSE

Write a function to find the transpose of a matrix.

trans<-function(A){
  B<-matrix(NA,nrow=nrow(A),ncol=ncol(A))
  for (i in 1:nrow(A)){
    for (j in 1:ncol(B)){
      B[j,i]<-A[i,j]
      }
  }
  return(B)
}

ans<-trans(A)
print(ans)

     [,1] [,2]
[1,]    1    2
[2,]    3    4

A

     [,1] [,2]
[1,]    1    3
[2,]    2    4

A

     [,1] [,2]
[1,]    1    3
[2,]    2    4

solve(A)

     [,1] [,2]
[1,]   -2  1.5
[2,]    1 -0.5

Write a function to multiply two 2x2 matrices.

mul2by2 <- function(A,B){
  C <- matrix(NA, nrow=2, ncol=2)
  
  C[1,1] <- A[1,1]*B[1,1] + A[1,2]*B[2,1]
  C[1,2] <- A[1,1]*B[1,2] + A[1,2]*B[2,2]
  C[2,1] <- A[2,1]*B[1,1] + A[2,2]*B[2,1]
  C[2,2] <- A[2,1]*B[1,2] + A[2,2]*B[2,2]
  
  return(C)
}
A<-matrix(c(1,2,7,4),nrow=2)
B<-matrix(c(2,3,4,10),nrow=2)
mul2by2(A,B)

     [,1] [,2]
[1,]   23   74
[2,]   16   48

Write a function to multiply two matrices of compatible dimensions.

#2*3
#3*2

matrix_multiply <- function(A, B) {
  if (ncol(A) != nrow(B)) {
    stop("Incompatible dimensions: ncol(A) must equal nrow(B)")
  }
  result <- matrix(0, nrow = nrow(A), ncol = ncol(B))
  
  for (i in 1:nrow(A)) {
    for (j in 1:ncol(B)) {
      result[i, j] <- sum(A[i, ] * B[, j])
    }
  }
  
  result
}

ans=matrix_multiply(A,B)
print(ans)

     [,1] [,2]
[1,]   23   74
[2,]   16   48

Write a function to replace a row in a matrix with a vector.

row_replace <- function(A,r,vect){
  A[r,]<-vect
  return(A)
  }
ans<-row_replace(A,2,c(0,0))
print(ans)

     [,1] [,2]
[1,]    1    7
[2,]    0    0

Write a function to find the maximum element in a matrix.

max_ele<- function(A){
  maxi<-A[1,1]
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if (A[i,j]>maxi){
        maxi<-A[i,j]
      }
    }
  }
  return(maxi)
}
ans<-max_ele(A)
print(ans)

[1] 7

Write a function to compute row sums of a matrix.

A

     [,1] [,2]
[1,]    1    7
[2,]    2    4

row_sums<-function(A){
  result<-numeric(nrow(A))
  for (i in 1:nrow(A)){
    result[i]<-sum(A[i,])
  }
  return(result)
}

ans<-row_sums(A)
print(ans)

[1] 8 6

Write a function to check if a matrix is upper triangular.

uptrian <- function(A){
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if (i>j){
        A[i,j]!=0
        return(FALSE)
      }
    }
  }
  return(TRUE)
}
ans<-uptrian(A)
print(ans)

[1] FALSE

A<-c()
A<-append(A,2)
A<-append(A,4)
class(A)

[1] "numeric"

Write a function to check if a matrix is scalar (multiple of identity).

scaler_check <- function(A){
  for (i in 1:nrow(A)){
    for (j in 1:ncol(A)){
      if(i != j & A[i,j]!=0){
        return(FALSE)
      } 
      else if(i==j & A[i,j]!=A[1,1]){
        return(FALSE)
      }
    }
  }
  return(TRUE)
  }

A<-matrix(c(1,2,7,4),nrow=2)
B<-matrix(c(1,0,0,1), nrow=2)
scaler_check(B)

[1] TRUE

Write a function to compute the row-wise maximum of a matrix.

rowmax<-function(A){
  maxs<-numeric(nrow(A))
  for (i in 1:nrow(A)){
    max=A[i,1]
    for (j in 1:ncol(A)){
      if (A[i,j]>max){
        max<-A[i,j]
      }
    }
    maxs[i]<-max 
  }
  return(maxs)
}
print(rowmax(A))

[1] 7 4

A

     [,1] [,2]
[1,]    1    7
[2,]    2    4

Write a function to compute cumulative sum of each row.

cumsumrow <- function(A){
  mat<-matrix(NA,nrow=nrow(A),ncol=ncol(A))
  for (i in 1:nrow(A)){
    cumsum<-numeric(ncol(A))
    cumsum[1]<-A[i,1]
    for (j in 2:ncol(A)){
      cumsum[j]<-A[i,j]+cumsum[j-1]
    }
    mat[i,]<-cumsum
  }
  return(mat)
}

print(cumsumrow(A))

     [,1] [,2]
[1,]    1    8
[2,]    2    6

A

     [,1] [,2]
[1,]    1    7
[2,]    2    4

25. Cumulative product

cumprod_vec <- function(a) { result <- numeric(length(a)) result[1] <- a[1] for (i in 2:length(a)) { result[i] <- result[i-1] * a[i] } result }

vecx<-c(10,20,188,348)
sum(vecx^2)

[1] 156948

A<-c(1,2,3,4)
B<-c(2,4,6,8)
all(A/B==A[1]/B[1])

[1] TRUE

# 21. Bubble sort
bubble_sort <- function(a) {
  n <- length(a)
  for (i in 1:(n-1)) {
    for (j in 1:(n-i)) {
      if (a[j] > a[j+1]) {
        temp <- a[j]
        a[j] <- a[j+1]
        a[j+1] <- temp
      }
    }
  }
  a

View(solve)