AULA DE REVISÃO

1. SISTEMAS NÃO LINEARES

3. Considere o sistema não linear abaixo:

Faça um gráfico para observar as raízes.

Calcule aproximações pelo método de Newton.
Solução

f<-function(x){x^2+5*x+3}
plot(f,-20,20,xlab=expression('x'[1]),
ylab=expression('x'[2]),
lwd=3,col="blue")

abline(h=0,v=0,lwd=3)

g<-function(x){-x^2-5*x+200}
plot(g,-20,20,add=T,col="red",lwd=3)
# Carregando o pacote
require(nleqslv)

# Definindo o sistema
sistema <- function(x) {
y <- numeric(2)
y[1] <- x[1]^2+5*x[1]+3-x[2]
y[2] <- -x[1]^2-5*x[1]+200-x[2]
y
}

# Primeira raiz
#Definindo a aproximação inicial
xstart <- c(10,100)
points(10,100,pch=20,lwd=3,col="black")
# Resolvendo
nleqslv(xstart,sistema,method =
c("Newton"),control=list(xtol=0.000001))

$x
[1] 7.734745 101.500000

$fvec
[1] 5.684342e-14 -5.684342e-14

$iter
[1] 4
# Plotando a solução encontrada
points(7.734745,101.500000,pch=20,lwd=3,col="green")
# Segunda raiz
#Definindo a aproximação inicial
xstart <- c(-10,100)
points(-10,100,pch=20,lwd=3,col="black")
# Resolvendo
nleqslv(xstart,sistema,method =
c("Newton"),control=list(xtol=0.000001))

$x
[1] -12.73474 101.50000

$fvec
[1] 4.187939e-11 -4.187939e-11

$iter
[1] 4
# Plotando a solução encontrada
points(-12.73474,101.500000,pch=20,lwd=3,col="green")
2. INTERPOLAÇÃO

# Inserindo o conjunto de pontos

x<-c(1,3,4,5)
y<-c(0,6,24,60)

# Fazendo o gráfico
plot(x,y,pch=20,lwd=4,col="red")

# Determinando o polinômio interpolador

require(polynom)
poly.calc(x,y)
2*x - 3*x^2 + x^3
# Inserindo o polinômio no gráfico
f<-function(x){2*x - 3*x^2 + x^3}
curve(f,1,5,add=T,lwd=3)
 Calcule a área da região destacada em vermelho. Descreva o
procedimento utilizado.

# Carregue o pacote digitize

require(digitize)

# Inserindo a figura
cal <- ReadAndCal('figura.jpg')

# A Figura será aberta em uma janela.

# Precisamos clicar, na sequência em x1, x2, y1 e y2.
# Vou considerar x1 = 0, x2 = 50, y1 = 0 e y2 = 50

#Agora devemos clicar nos pontos da função superior

# Clicar com o botão direito do mouse e selecionar "parar".
f1 <- DigitData(col = 'blue')

#Calibrando os pontos clicados com os pontos x1,x2,y1 e y2.

data1 <- Calibrate(f1,cal,0,50,0,50)
# Visualizando as coordenadas
x1<-data1[,1]
x1
[1] 1.494565 4.347826 10.054348 15.081522 22.010870 28.396739 35.733696
[8] 39.945652 43.070652 47.282609

y1<-data1[,2]
y1
[1] 9.234828 12.664908 19.129288 24.670185 31.926121 37.335092 40.765172
[8] 41.820580 42.612137 43.271768

#Agora devemos clicar nos pontos da função inferior

# Clicar com o botão direito do mouse e selecionar "parar".
f2 <- DigitData(col = 'blue')

#Calibrando os pontos clicados com os pontos x1,x2,y1 e y2.

data2 <- Calibrate(f2,cal,0,50,0,50)

# Visualizando as coordenadas
x2<-data2[,1]
x2
[1] 2.581522 7.336957 11.956522 17.255435 23.233696 29.891304 36.005435
[8] 40.217391 44.565217 47.282609
y2<-data2[,2]
y2
[1] 1.846966 4.485488 7.124011 10.158311 13.720317 17.810026 22.295515
[8] 27.440633 36.015831 43.139842

# Dividindo os pontos da função superior

# em 4 grupos
a1<-x1[1:3]
b1<-y1[1:3]

a2<-x1[3:5]
b2<-y1[3:5]

a3<-x1[5:7]
b3<-y1[5:7]

a4<-x1[7:10]
b4<-y1[7:10]

plot(x1,y1,xlim=c(0,60),ylim=c(0,60),pch=20,lwd=3)
abline(h=0,v=0,lwd=3)

# Determinando o polinômio interpolador

require(polynom)

poly.calc(a1,b1)
pol1<-function(x){7.38547 + 1.249499*x - 0.008102478*x^2}
plot(pol1,0,10.054348,lwd=3,col="blue",add=T)
poly.calc(a2,b2)
pol2<-function(x){7.349237 + 1.217936*x - 0.004604851*x^2}
plot(pol2,10.05435,22.01087,lwd=3,col="blue",add=T)
poly.calc(a3,b3)
pol3<-function(x){-4.003417 + 2.241081*x - 0.02765573*x^2}
plot(pol3,22.01087,35.73370,lwd=3,col="blue",add=T)

poly.calc(a4,b4)
pol4<-function(x){104.4707 - 5.276429*x + 0.1396928*x^2 - 0.001173235*x^3}
plot(pol4,35.73370,47.28261,lwd=3,col="blue",add=T)

# Integrais
I1<-integrate(pol1,0,10.054348)
I2<-integrate(pol2,10.054348,22.01087)
I3<-integrate(pol3,22.01087,35.73370)
I4<-integrate(pol4,35.73370,47.28261)

# Área superior
A1<-I1$value+I2$value+I3$value+I4$value
A1
[1] 1438.788

# Dividindo os pontos da função inferior

# em 5 grupos
a5<-x2[1:3]
b5<-y2[1:3]

a6<-x2[3:5]
b6<-y2[3:5]

a7<-x2[5:7]
b7<-y2[5:7]

a8<-x2[7:10]
b8<-y2[7:10]

points(x2,y2,xlim=c(0,60),ylim=c(0,60),pch=20,lwd=3,add=T)

poly.calc(a5,b5)
pol5<-function(x){0.4475944 + 0.5375786*x + 0.001740686*x^2}
plot(pol5,0,11.956522,lwd=3,col="blue",add=T)

poly.calc(a6,b6)
pol6<-function(x){0.7018127 + 0.5125324*x + 0.002057192*x^2}
plot(pol6,11.95652,23.23370,lwd=3,col="blue",add=T)

poly.calc(a7,b7)
pol7<-function(x){5.937134 + 0.1179066*x + 0.009343708*x^2}
plot(pol7,23.23370,36.00543,lwd=3,col="blue",add=T)

poly.calc(a8,b8)
pol8<-function(x){81.27793 - 3.658986*x + 0.04271425*x^2 +
0.0003724855*x^3}
plot(pol8,36.00543,47.28261,lwd=3,col="blue",add=T)
# Integrais
I5<-integrate(pol5,0,11.956522)
I6<-integrate(pol6,11.956522,23.23370)
I7<-integrate(pol7,23.23370,36.00543)
I8<-integrate(pol8,36.00543,47.28261)

# Área superior
A2<-I5$value+I6$value+I7$value+I8$value
A2
[1] 736.1875

# Área final
A = A1-A2
A
[1] 702.600
3. APROXIMAÇÃO POLINOMIAL

Um estudo foi conduzido para determinar a relação entre os gastos semanais com
publicidade e as vendas.

Tabela 1: Gastos com publicidade.

Gastos com publicidade ($) Vendas ($)
40 385
20 400
25 395
20 365
30 475
50 440
40 490
20 420
50 560
40 525
25 480
50 510

Faça um diagrama de dispersão.

x<-c(40,20,25,20,30,50,40,20,50,40,25,50)
y<-c(385,400,395,365,475,440,490,420,560,525,480,510)
plot(x,y,xlim=c(0,55),ylim=c(0,600),lwd=5,pch=20)

Determine a equação da reta de regressão para prever as vendas semanais com

base nos gastos com publicidade.
reta<-lm(y~x)
reta
Call:
lm(formula = y ~ x)

Coefficients:
(Intercept) x
343.706 3.221

f<-function(x){343.706+3.221*x}
curve(f,0,55,add=T,col="red")

Estime as vendas semanais quando os gastos de publicidade são de $ 35.

f(35)
[1] 456.441
Caso não linear (exponencial)

Considere os dados para gastos de propaganda e receita de vendas.

Gasto de propaganda Receita de vendas

(X) (US$ 100) (Y) (US$ 1000)
1 1
2 1
3 2
4 2
5 4
a) Construa um diagrama de dispersão
b) Ajuste uma exponencial

x<-c(1,2,3,4,5)

y<-c(1,1,2,2,4)

plot(x,y,pch=20,lwd=6,xlim=c(0,6),ylim=c(0,6))
y<-log(y)
y
[1] 0.0000000 0.0000000 0.6931472 0.6931472 1.3862944

reta<-lm(y~x)
reta

Call:
lm(formula = y ~ x)

Coefficients:
(Intercept) x
-0.4852 0.3466
f<-function(x){exp(-0.4852)*exp(0.3466*x)}
curve(f, 1,6,add=T,col="red", pch=8)
4. DIFERENCIAÇÃO NUMÉRICA

Exercícios: Utilize a fórmula dos três pontos mais precisa para calcular
cada um dos dados de entrada nas tabelas

x f(x) f’(x)
1,1 9,025013
1,2 11,02318
1,3 13,46374
1,4 16,44465

Cálculo para x=1,1

i) Utilizando ( ) [ ( ) ( ) ( )]

(1/(2*0.1))*(-3*(9.025013)+4*(11.02318)-(13.46374))
17.76971

Cálculo para x=1,2

ii) Utilizando ( ) [( ) ( )]

{
(1/(2*0.1))*(( 13.46374)-( 9.025013))
[1] 22.19364

Cálculo para x=1,3

(igual o anterior)

Cálculo para x=1,4

iii) Utilizando ( ) [( ) ( ) ( )]

(1/(2*0.1))*((11.02318)-4*(13.46374)+3*(16.44465))
[1] 32.51085
5. INTEGRAÇÃO NUMÉRICA

Connsidere a integral abaixo:

∫ ( )

a) Esboce a área a ser calculada, a área aproximada pela regra

do trapézio e calcule o erro absoluto quando esta
aproximação é realizada.

b) Calcule uma aproximação pela regra dos trapézios repetidos

com 1000 subintervalos.

c) Calcule uma aproximação utilizando a regra 1/3 de Simpson

e calcule o erro absoluto.

# Definindo a função
f<-function(x){exp(3*x)*sin(2*x)}

# Gráfico da função
plot(f,0,0.7,lwd=6,col="blue",ylim=c(0,8),
xlim=c(0,1))
abline(h=0,v=0,lwd=6)
# Trapézio
segments(0,0,0,f(0),col="red",lwd=3,lty=2)
segments(0.7,0,0.7,f(0.7),col="red",lwd=3,lty=2)
segments(0,f(0),0.7,f(0.7),col="red",lwd=3,lty=2)

# Área aproximada
A=((f(0)+f(0.7))*(0.7-0))/2
A
[1] 2.816572

# Área real
integrate(f,0,0.7)
1.797391 with absolute error < 2e-14

# Erro absoluto
abs(1.797391-2.816572)
[1] 1.019181
# b)
# Carregando o pacote caTools
require(caTools)

# Criando uma sequência com x0= 0, xn= 0.7 e h = 0,0007

x<-seq(0,0.7,0.0007)

# Calculando o valor de f(x) para cada ponto acima.

y<-f(x)

# Regra dos trapézios repetidos

trapz(x,y)
[1] 1.79739

# Calculando a área
a=0
b = 0.7
h=(b-a)/2
x0=a
x1=x0+h
x2=x1+h

# Área
A=(h/3)*(f(x0)+4*f(x1)+f(x2))
A
[1] 1.79797
6. PROBLEMA DE VALOR INICIAL - PVI

Considere o seguinte PVI

{
( )

Esboce a solução exata ( ) ( ) no intervalo [ ]

f<-function(x){(x+1)^2 -0.5*exp(x)}
curve(f,0,2,col="blue",ylim=c(0,6),lwd=2)
abline(h=0,v=0,lwd=2)

Utilizando o método de Euler, calcule aproximações para a solução

considerando h=0,05, apresente as respostas e marque-as no gráfico
considerando pch= “+”.

#carregando o pacote
require(pracma)
f <- function(x, y){y-(x^2)+1}
a <-0
b <-2
y0<-0.5
n=40

euler<-euler_heun(f,a,b,y0,n, improved = FALSE)

euler
$t
[1] 0.00 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70
[16] 0.75 0.80 0.85 0.90 0.95 1.00 1.05 1.10 1.15 1.20 1.25 1.30 1.35 1.40 1.45
[31] 1.50 1.55 1.60 1.65 1.70 1.75 1.80 1.85 1.90 1.95 2.00

$y
[1] 0.5000000 0.5750000 0.6536250 0.7358062 0.8214716 0.9105451 1.0029474
[8] 1.0985948 1.1973995 1.2992695 1.4041080 1.5118134 1.6222790 1.7353930
[15] 1.8510376 1.9690895 2.0894190 2.2118899 2.3363594 2.4626774 2.5906863
[22] 2.7202206 2.8511066 2.9831619 3.1161950 3.2500048 3.3843800 3.5190990
[29] 3.6539290 3.7886254 3.9229317 4.0565783 4.1892822 4.3207463 4.4506586
[36] 4.5786915 4.7045011 4.8277262 4.9479875 5.0648869 5.1780062

points(euler$t,euler$y,col="red",pch="+")
Utilizando o método de Euler Aperfeiçoado, calcule aproximações para a
solução considerando h=0,05, apresente as respostas e marque-as no
gráfico considerando pch= “*”.

euler_a<-euler_heun(f,a,b,y0,n, improved = TRUE)

euler_a

$t
[1] 0.00 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70
[16] 0.75 0.80 0.85 0.90 0.95 1.00 1.05 1.10 1.15 1.20 1.25 1.30 1.35 1.40 1.45
[31] 1.50 1.55 1.60 1.65 1.70 1.75 1.80 1.85 1.90 1.95 2.00

$y
[1] 0.5000000 0.5768125 0.6573085 0.7414206 0.8290778 0.9202055 1.0147254
[8] 1.1125551 1.2136079 1.3177928 1.4250141 1.5351710 1.6481579 1.7638635
[15] 1.8821709 2.0029572 2.1260931 2.2514428 2.3788637 2.5082054 2.6393103
[22] 2.7720125 2.9061375 3.0415021 3.1779134 3.3151690 3.4530558 3.5913499
[29] 3.7298159 3.8682065 4.0062614 4.1437073 4.2802567 4.4156074 4.5494416
[36] 4.6814255 4.8112079 4.9384199 5.0626732 5.1835602 5.3006521
points(euler_a$t,euler_a$y,col="green",pch="*")