# Decomposição QR
QRGram<-function(A){
n=length(A[1,])
m=length(A[,1])
V=A
Q=0*A
R=matrix(0,n,n)
for (i in 1:n){
R[i,i]=sqrt(V[,i]%*%V[,i])
Q[,i]=V[,i]/R[i,i]
for (j in (i+1):n){
if (j!=(n+1)){
R[i,j]=Q[,i]%*%V[,j]
V[,j]=V[,j]-R[i,j]*Q[,i]
}
}}
return(list(Q=Q,R=R))
}
#-------------------------------------------------------
# Resolução de sistema triangular superior
TSup<-function(R,v){ # Retorna u tal que Ru=v
n=length(v);u=0*v
u[n]=v[n]/R[n,n]
for ( i in (n-1):1){
p=v[i]
for (j in (i+1):n){
p=p-u[j]*R[i,j]
}
u[i]=p/R[i,i]
}
u
}
#---------------------------------------------------------------------------
# Problema de interpolação polinomial
n=41
a=-5;b=5;x=0*1:n
for ( k in 1:n){ # Nós de Chebyshev reescalados.
x[k]=(a+b)/2+(b-a)*cos((2*k-1)/(2*n)*pi )/2}
y=1/(1+x^2)
n=length(x)
plot(x,y,col="red")
n=length(x)
A=matrix(0,n,n);
for ( j in 1:n){A[,j]=x^(j-1)}
B=QRGram(A)
Q=B$Q;Q
R=B$R; R
v=t(Q)%*%y; v
u=TSup(R,v); u
print("Teste de erro"); A%*%u-y
poli<-function(s){
p=u[1]
for ( i in 2:n){p=p+u[i]*(s)^(i-1)}
return(p)
}
curve(poli,-5,5,col="blue",ylim=c(0,1))
points(x,y,col="red") # Teste de ajuste.
Erro<-function(s){1/(1+s^2)-poli(s)}
curve(Erro,-5,5)
To embed this project on your website, copy the following code and paste it into your website's HTML: