Task: QR decomposition

C: #include <stdio.h>
#include <stdlib.h>
#include <math.h>

typedef struct {
	int m, n;
	double ** v;
} mat_t, *mat;

mat matrix_new(int m, int n)
{
	mat x = malloc(sizeof(mat_t));
	x->v = malloc(sizeof(double*) * m);
	x->v[0] = calloc(sizeof(double), m * n);
	for (int i = 0; i < m; i++)
		x->v[i] = x->v[0] + n * i;
	x->m = m;
	x->n = n;
	return x;
}

void matrix_delete(mat m)
{
	free(m->v[0]);
	free(m->v);
	free(m);
}

void matrix_transpose(mat m)
{
	for (int i = 0; i < m->m; i++) {
		for (int j = 0; j < i; j++) {
			double t = m->v[i][j];
			m->v[i][j] = m->v[j][i];
			m->v[j][i] = t;
		}
	}
}

mat matrix_copy(int n, double a[][n], int m)
{
	mat x = matrix_new(m, n);
	for (int i = 0; i < m; i++)
		for (int j = 0; j < n; j++)
			x->v[i][j] = a[i][j];
	return x;
}

mat matrix_mul(mat x, mat y)
{
	if (x->n != y->m) return 0;
	mat r = matrix_new(x->m, y->n);
	for (int i = 0; i < x->m; i++)
		for (int j = 0; j < y->n; j++)
			for (int k = 0; k < x->n; k++)
				r->v[i][j] += x->v[i][k] * y->v[k][j];
	return r;
}

mat matrix_minor(mat x, int d)
{
	mat m = matrix_new(x->m, x->n);
	for (int i = 0; i < d; i++)
		m->v[i][i] = 1;
	for (int i = d; i < x->m; i++)
		for (int j = d; j < x->n; j++)
			m->v[i][j] = x->v[i][j];
	return m;
}


double *vmadd(double a[], double b[], double s, double c[], int n)
{
	for (int i = 0; i < n; i++)
		c[i] = a[i] + s * b[i];
	return c;
}


mat vmul(double v[], int n)
{
	mat x = matrix_new(n, n);
	for (int i = 0; i < n; i++)
		for (int j = 0; j < n; j++)
			x->v[i][j] = -2 *  v[i] * v[j];
	for (int i = 0; i < n; i++)
		x->v[i][i] += 1;

	return x;
}


double vnorm(double x[], int n)
{
	double sum = 0;
	for (int i = 0; i < n; i++) sum += x[i] * x[i];
	return sqrt(sum);
}


double* vdiv(double x[], double d, double y[], int n)
{
	for (int i = 0; i < n; i++) y[i] = x[i] / d;
	return y;
}


double* mcol(mat m, double *v, int c)
{
	for (int i = 0; i < m->m; i++)
		v[i] = m->v[i][c];
	return v;
}

void matrix_show(mat m)
{
	for(int i = 0; i < m->m; i++) {
		for (int j = 0; j < m->n; j++) {
			printf(" %8.3f", m->v[i][j]);
		}
		printf("\n");
	}
	printf("\n");
}

void householder(mat m, mat *R, mat *Q)
{
	mat q[m->m];
	mat z = m, z1;
	for (int k = 0; k < m->n && k < m->m - 1; k++) {
		double e[m->m], x[m->m], a;
		z1 = matrix_minor(z, k);
		if (z != m) matrix_delete(z);
		z = z1;

		mcol(z, x, k);
		a = vnorm(x, m->m);
		if (m->v[k][k] > 0) a = -a;

		for (int i = 0; i < m->m; i++)
			e[i] = (i == k) ? 1 : 0;

		vmadd(x, e, a, e, m->m);
		vdiv(e, vnorm(e, m->m), e, m->m);
		q[k] = vmul(e, m->m);
		z1 = matrix_mul(q[k], z);
		if (z != m) matrix_delete(z);
		z = z1;
	}
	matrix_delete(z);
	*Q = q[0];
	*R = matrix_mul(q[0], m);
	for (int i = 1; i < m->n && i < m->m - 1; i++) {
		z1 = matrix_mul(q[i], *Q);
		if (i > 1) matrix_delete(*Q);
		*Q = z1;
		matrix_delete(q[i]);
	}
	matrix_delete(q[0]);
	z = matrix_mul(*Q, m);
	matrix_delete(*R);
	*R = z;
	matrix_transpose(*Q);
}

double in[][3] = {
	{ 12, -51,   4},
	{  6, 167, -68},
	{ -4,  24, -41},
	{ -1, 1, 0},
	{ 2, 0, 3},
};

int main()
{
	mat R, Q;
	mat x = matrix_copy(3, in, 5);
	householder(x, &R, &Q);

	puts("Q"); matrix_show(Q);
	puts("R"); matrix_show(R);

	
	mat m = matrix_mul(Q, R);
	puts("Q * R"); matrix_show(m);

	matrix_delete(x);
	matrix_delete(R);
	matrix_delete(Q);
	matrix_delete(m);
	return 0;
}








VB: Option Base 1
Private Function vtranspose(v As Variant) As Variant


    vtranspose = WorksheetFunction.Transpose(v)
End Function
 
Private Function mat_col(a As Variant, col As Integer) As Variant
    Dim res() As Double
    ReDim res(UBound(a))
    For i = col To UBound(a)
        res(i) = a(i, col)
    Next i
    mat_col = res
End Function
 
Private Function mat_norm(a As Variant) As Double
    mat_norm = Sqr(WorksheetFunction.SumProduct(a, a))
End Function
 
Private Function mat_ident(n As Integer) As Variant
    mat_ident = WorksheetFunction.Munit(n)
End Function

Private Function sq_div(a As Variant, p As Double) As Variant
    Dim res() As Variant
    ReDim res(UBound(a))
    For i = 1 To UBound(a)
        res(i) = a(i) / p
    Next i
    sq_div = res
End Function

Private Function sq_mul(p As Double, a As Variant) As Variant
    Dim res() As Variant
    ReDim res(UBound(a), UBound(a, 2))
    For i = 1 To UBound(a)
        For j = 1 To UBound(a, 2)
            res(i, j) = p * a(i, j)
        Next j
    Next i
    sq_mul = res
End Function

Private Function sq_sub(x As Variant, y As Variant) As Variant
    Dim res() As Variant
    ReDim res(UBound(x), UBound(x, 2))
    For i = 1 To UBound(x)
        For j = 1 To UBound(x, 2)
            res(i, j) = x(i, j) - y(i, j)
        Next j
    Next i
    sq_sub = res
End Function

Private Function matrix_mul(x As Variant, y As Variant) As Variant
    matrix_mul = WorksheetFunction.MMult(x, y)
End Function

Private Function QRHouseholder(ByVal a As Variant) As Variant
    Dim columns As Integer: columns = UBound(a, 2)
    Dim rows As Integer: rows = UBound(a)
    Dim m As Integer: m = WorksheetFunction.Max(columns, rows)
    Dim n As Integer: n = WorksheetFunction.Min(rows, columns)
    I_ = mat_ident(m)
    Q_ = I_
    Dim q As Variant
    Dim u As Variant, v As Variant, j As Integer
    For j = 1 To WorksheetFunction.Min(m - 1, n)
        u = mat_col(a, j)
        u(j) = u(j) - mat_norm(u)
        v = sq_div(u, mat_norm(u))
        q = sq_sub(I_, sq_mul(2, matrix_mul(vtranspose(v), v)))
        a = matrix_mul(q, a)
        Q_ = matrix_mul(Q_, q)
    Next j
 
    
    Dim R() As Variant
    ReDim R(m, n)
    For i = 1 To m 
        For j = 1 To n 
            R(i, j) = a(i, j)
        Next j
    Next i
    Dim res(2) As Variant
    res(1) = Q_
    res(2) = R
    QRHouseholder = res
End Function

Private Sub pp(m As Variant)
    For i = 1 To UBound(m)
        For j = 1 To UBound(m, 2)
            Debug.Print Format(m(i, j), "0.#####"),
        Next j
        Debug.Print
    Next i
End Sub
Public Sub main()
    a = [{12, -51,   4; 6, 167, -68; -4,  24, -41;-1,1,0;2,0,3}]
    result = QRHouseholder(a)
    q = result(1)
    r_ = result(2)
    Debug.Print "A"
    pp a
    Debug.Print "Q"
    pp q
    Debug.Print "R"
    pp r_
    Debug.Print "Q * R"
    pp matrix_mul(q, r_)
End Sub