16-09-2020ExPedro, R

Language: Layout:

# Ajuste de curvas por mínimos quadrados.

# Dados os vetores x e y, supomos que y_i=f(x_i)+erro_i, como erro_i um erro "pequeno".
x=c(2,5,8,11,14,17,27,31,41,44)
n=length(x)

y=c(94.8,89.7,81.3,74.9,68.7,64.0,49.3,44.0,39.1,31.6)

plot(x,y,col="red")

# Suponha que y=f(x) (aproximado) e que f(s)= a exp(bs). Descobrir aproximações para a e b.
#
# Mudança de variável z=ln(y)=~ ln(f(x) = ln(a)+bx= c+bx. Determinar b e c=ln(a).

# Minimizar |Au-z|^2, em que A matriz, cuja linha i é o vetor c(1,x_i).

# Resolver o sistema linear A^*(Au-z)=A^*Au-A^*z=0 pelo método A=QR.

A=matrix(0,n,2); v=0*x;
for ( i in 1:n){A[i,]=c(1,x[i]);v[i]=log(y[i])}

# Agora é conhecido que o gradiente de g(u) é dado por A^*(Au-v).
#
# Como o problema é linear, vamos resolver pelo Método de decomposição A=QR.
# Isso nos leva a resolver a equação Ru=t(Q)v.

# ---------------Processo de ortogonalização de Gram-Schmdit

pe<-function(u,v){ # Dados os vetores u e v, somo o produto de cada coordenada de u com a respectiva cooordenada de v.
n=length(u)
p=u[1]*v[1]
for ( i in 2:n){p=p+u[i]*v[i]}
p
}

mod<-function(u){sqrt(pe(u,u))}  # módulo de u

proj<-function(u,v){pe(u,v)*v}  # Projeção de u sobre v (ortogonal), com norma de v igual 1

GramS<-function(A){  # Ortogonliza as colunas de A
n=length(A[1,])

Q=0*A

Q[,1]=A[,1]/mod(A[,1])

for (i in 2:n){
p=A[,i]
for (j in 1:(i-1)){
p=p-proj(A[,i],Q[,j])
}
Q[,i]=p/mod(p)
}

Q
}

Q=GramS(A); print("Matriz Q"); Q

t(Q)%*%Q      # Teste de ortogonalização

R=t(Q)%*%A; print("Matriz R"); R

#------ Resolução de sistema triangular Ru=t(Q)v.

TSup<-function(A,b){
p=0*b; n=length(b)
p[n]=b[n]/A[n,n]
for (i in (n-1):1){
q=b[i]
for (j in n:(i+1)){
q=q-A[i,j]*p[j]
}
p[i]=q/A[i,i]
}
p
}

v=t(Q)%*%log(y);v
u=TSup(R,v)
#---------------------------------------------------------------------------------------

print("Soulução") ; u                                # Aproximação para u que minimisa |Au-v|^2.

fapmv<-function(s){exp(u[1])*exp(u[2]*s)}  # Aproximação da função linearizada.

curve(fapmv,2,44)                           # Teste de ajuste
points(x,y,col="red")

[ + ] Show input
Absolute running time: 0.79 sec, cpu time: 0.92 sec, memory peak: 51 Mb, absolute service time: 1 sec