with(LinearAlgebra):

AllocLA := module()
option package;
export getrow_c,setrow_c,getcol_c,setcol_c,vecf,tovecf,veci,matf,mati,allocla,dynla,setvec,dotprod,l2norm,l2nn,l2dist,l2dd,setelems,cholesky_c,cholinv;

    l2norm := proc(x)
        return sqrt(add(x[i]^2,i=1..numelems(x)));
    end proc;

    l2nn := proc(x)
        d := numelems(x);
        return add(x[i]^2,i=1..d);
    end proc;

    l2dd := proc(x,y)
        d := numelems(x);
        return add((x[i]-y[i])^2,i=1..d);
    end proc;

    l2dist := proc(x,y)
        return sqrt(add((x[i]-y[i])^2,i=1..mnumelems(x)));
    end proc;

    dotprod := proc(U,V)
        n := numelems(U);
        return add(U[i]*V[i],i=1..n);
    end proc;

    setelems := proc(V,xx)
        for i from 1 to numelems(xx) do
            V[i] := xx[i];
        end do;
        return;
    end proc;

    setvec := proc(V,xx)
        for i from 1 to numelems(xx) do
            V[i] := xx[i];
        end do;
        return;
    end proc;

    getrow_c := proc(A::Array(datatype=float[8]),i::integer[4],V::Array(datatype=float[8]),n::integer[4])
        for j from 1 to n do
            V[j] := A[i,j];
        end do;
        return;
    end proc;

    getrow_c := Compiler:-Compile(getrow_c);

    setrow_c := proc(A::Array(datatype=float[8]),i::integer[4],V::Array(datatype=float[8]),n::integer[4])
        for j from 1 to n do
            A[i,j] := V[j];
        end do;
        return;
    end proc;

    setrow_c := Compiler:-Compile(setrow_c);

    getcol_c := proc(A::Array(datatype=float[8]),j::integer[4],V::Array(datatype=float[8]),m::integer[4])
        for i from 1 to m do
            V[i] := A[i,j];
        end do;
        return;
    end proc;

    getcol_c := Compiler:-Compile(getcol_c);

    setcol_c := proc(A::Array(datatype=float[8]),j::integer[4],V::Array(datatype=float[8]),m::integer[4])
        for i from 1 to m do
            A[i,j] := V[i];
        end do;
        return;
    end proc;

    setcol_c := Compiler:-Compile(setcol_c);

    allocla := proc()
        if(not type(procname,indexed)) then
            return allocla[float[8]](args);
        end if;
        typ := op(procname);
        ans := [];
        for x in args do
            if(type(x,'integer')) then
                A := Vector(x,datatype=typ);
            elif(type(x,'list')) then
                A := Matrix(op(x),datatype=typ);
            elif(type(x,'Matrix')) then
                A := Matrix(x,datatype=typ);
            elif(type(x,'Vector')) then
                A := Vector(x,datatype=typ);
            else
                error;
            end if;
            ans := [op(ans),A];
        end do;
        return op(ans);
    end proc;

    vecf := proc(xl)
        return Vector(args,datatype=float[8]);
    end proc;

    veci := proc(xl)
        return Vector(args,datatype=integer[4]);
    end proc;

    matf := proc(A)
        return Matrix(args,datatype=float[8]);
    end proc;

    mati := proc(A)
        return Matrix(args,datatype=integer[4]);
    end proc;

    tovecf := proc(V)
        if(type(V,'Vector(float[8])')) then
            return V;
        else
            return vecf(V):
        end if;
    end proc;

    cholesky_c := proc(A::Array(datatype=float[8]),L::Array(datatype=float[8]),L1::Array(datatype=float[8]),A1::Array(datatype=float[8]),n::integer[4])
        for i from 1 to n do
            for j from 1 to i do
                c := 0.0;
                if(j=i) then
                    for k from 1 to j-1 do
                        c := c+L[j,k]^2;
                    end do;
                    L[j,j] := sqrt(A[j,j]-c);
                else
                    for k from 1 to j-1 do
                        c := c+L[i,k]*L[j,k];
                    end do;
                    L[i,j] := (A[i,j]-c)/L[j,j];
                    L1[i,j] := L[i,j];
                    A1[i,j] := A[i,j];
                end if;
            end do;
        end do;
        for i from 1 to n do
            L1[i,i] := 1/L[i,i];
            for j from 1 to i-1 do
                c := 0.0;
                for k from j to i-1 do
                    c := c+L[i,k]*L1[k,j];
                end do;
                L1[i,j] := -c/L[i,i];
            end do;
        end do;
        for i from 1 to n do
            for j from 1 to n do
                c := 0.0;
                for k from 1 to n do
                    c := c+L1[k,i]*L1[k,j];
                end do;
                A1[i,j] := c;
            end do;
        end do;
        return;
    end proc;

    cholesky_c := Compiler:-Compile(cholesky_c);

    cholinv := proc(A,B)
        n := Dimension(A)[1];
        L,L1,A1 := allocla[float[8]]([n,n],[n,n],[n,n]);
        cholesky_c(A,L,L1,A1,n);
        return L,L1,A1;
    end proc;

#collection of vectors, matrices which can be resized
    dynla := proc()
        md := module()
        option object;
        export N,allocif,init,getelts,elts,typs,l;
        local ModulePrint;
            ModulePrint::static := proc()
                return nprintf("dynamic storage. %d objects, size=%d",3,N);
            end proc;
            allocif::static := proc(n)
                if(n<=N) then
                    return false;
                end if;
                N1 := 2^ceil(log(n)/log(2));
                elts1 := [];
                for i from 1 to l do
                    elt := elts[i];
                    typ := typs[i];
                    if(type(elt,'Matrix')) then
                        N0,m := Dimension(elt);
                        elt1 := Matrix(N1,m,datatype=typ);
                        elt1[1..N0,1..m] := elt;
                    elif(type(elt,'Vector')) then
                        N0 := Dimension(elt);
                        elt1 := Vector(N1,datatype=typ);
                        elt1[1..N0] := elt;
                    end if;
                    elts1 := [op(elts1),elt1];
                end do;
                elts := elts1;
                N := N1;
                return true;
            end proc;
            getelts::static := proc()
                return op(elts);
            end proc;
            init::static := proc()
                N := 16;
                elts := [];
                typs := [];
                for x in args do
                    if(type(x,'function')) then
                        typ := op(0,x);
                        m := op(x);
                        elt := Matrix(N,m,datatype=typ);
                    else
                        typ := x;
                        elt := Vector(N,datatype=typ);
                    end if;
                    elts := [op(elts),elt];
                    typs := [op(typs),typ];
                end do;
                l := nops(elts);
            end proc;
        end module;
        md:-init(args);
        return md;
    end proc;

end module;
