Week 11 Homework Assignment

Section 12.5

Page 566 #1

Use Euler’s method to solve the first-order system subject to the specified initial condition. Use the given step size \(\Delta t\) and calculate the first three approximations \((x_1,y_1)\), \((x_2,y_2)\), and \((x_3,y_3)\). Then repeat your calculations for \(\frac{\Delta t}{2}\). Compare your approximations with the values of the given analytical solution.


Given:

\[\frac{dx}{dt}=2x+3y\]
\[\frac{dy}{dt}=3x+2y\]
\[x(0)=1,y(0)=1,\Delta t = \frac{1}{4}\]

\[x(t)=\frac{1}{2}e^{-t}+\frac{1}{2}e^{5t}\] \[~y(t)=\frac{1}{2}e^{-t}+\frac{1}{2}e^{5t}\]

Set up:

x0 <- 1 
y0 <- 1
dt <- 0.25
half <- dt/2
t0 = 0

dxdt

dxdt <- function(x,y) 2*x + 3*y

dydt

dydt <- function(x,y) 3*x + 2*y

Soultion for x

xs <- function(t){
  0.5 * exp(-t) + 0.5*exp(5*t)
}

Solution for y

ys <- function(t){
  0.5 * exp(-t) + 0.5*exp(5*t)
}

Euler’s Method \[x_i=x_{i-1}+f(t_{i-1},x_{i-1},y_{i-1})\Delta t\]

\[y_i=y_{i-1}+g(t_{i-1},x_{i-1},y_{i-1})\Delta t\]

Generate three approximations using step size \(\frac{1}{4}\)

# x1,y1 
x1 <- x0 + dxdt(x0,x0)*dt  
y1 <- y0 + dydt(x0,y0)*dt
# x2, y2
x2 <- x1 + dxdt(x1,x1)*dt  
y2 <- y1 + dydt(x1,y1)*dt
# x3, y3
x3 <- x2 + dxdt(x2,x2)*dt  
y3 <- y2 + dydt(x2,y2)*dt

Approximations to Vector

first_approx <- c(paste0("(",round(x1,4),",",round(y1,4),")"),
             paste0("(",round(x2,4),",",round(y2,4),")"),
             paste0("(",round(x3,4),",",round(y3,4),")"))
# x1, y1
x1_actual <- xs(t0 + dt)
y1_actual<- ys(t0 + dt)
# x2, y2
x2_actual <- xs(t0 + dt*2)
y2_actual <- ys(t0 + dt*2)
# x3, y3  
x3_actual <- xs(t0 + dt*3)
y3_actual <- ys(t0 + dt*3)

Actual Results to Vector

result <- c(paste0("(",round(x1_actual,4),",",round(y1_actual,4),")"),
            paste0("(",round(x2_actual,4),",",round(y2_actual,4),")"),
            paste0("(",round(x3_actual,4),",",round(y3_actual,4),")"))
t <- c(0.25,0.50,0.75)
df <- data.frame(t = t, Approximation=first_approx, Actual=result)
knitr::kable(df, align="rrr")
t Approximation Actual
0.25 (2.25,2.25) (2.1346,2.1346)
0.50 (5.0625,5.0625) (6.3945,6.3945)
0.75 (11.3906,11.3906) (21.4967,21.4967)


Generate three approximations using step size \(\frac{1}{8}\).

# x1,y1 
x1_half <- x0 + dxdt(x0,x0)*half  
y1_half <- y0 + dydt(x0,y0)*half
# x2, y2
x2_half <- x1_half + dxdt(x1_half,x1_half)*half  
y2_half <- y1_half + dydt(x1_half,y1_half)*half
# x3, y3
x3_half <- x2_half + dxdt(x2_half,x2_half)*half  
y3_half <- y2_half + dydt(x2_half,y2_half)*half
approx_df_2 <- c(paste0("(",round(x1_half,4),",",round(y1_half,4),")"),
             paste0("(",round(x2_half,4),",",round(y2_half,4),")"),
             paste0("(",round(x3_half,4),",",round(y3_half,4),")"))

Final Results

# x1, y1
x1_actual_half <- xs(t0 + half)
y1_actual_half <- ys(t0 + half)
# x2, y2
x2_actual_half <- xs(t0 + half*2)
y2_actual_half <- ys(t0 + half*2)
# x3, y3
x3_actual_half <- xs(t0 + half*3)
y3_actual_half <- ys(t0 + half*3)

Saave all result to Vector

actual_half <- c(paste0("(",round(x1_actual_half,4),",",round(y1_actual_half,4),")"),
            paste0("(",round(x2_actual_half,4),",",round(y2_actual_half,4),")"),
            paste0("(",round(x3_actual_half,4),",",round(y3_actual_half,4),")"))

First Three Time Periods

t <- c(1/8,2/8,3/8)
df <- data.frame(t = t, Approximation=approx_df_2, Actual=actual_half)
knitr::kable(df, align="rrr")
t Approximation Actual
0.125 (1.625,1.625) (1.3754,1.3754)
0.250 (2.6406,2.6406) (2.1346,2.1346)
0.375 (4.291,4.291) (3.6041,3.6041)

Week 12 Homework Assignment

Section 13.1

Page 585 # 2

Find the local minimum value of the function

\[f(x,y)=3x^2+6xy+7y^2-2x+4y\]

Solution

First Partial Derivatives

\[\frac{\partial f}{\partial x}=6x+6y-2\]

\[\frac{\partial f}{\partial y}=6x+14y+4\]

Set:

\(\frac{\partial f}{\partial x}=0\):

\[6x+6y-2=0\]

\[6x = 2-6y\]
\[x=\frac{1}{3}-y\]

Set: \(\frac{\partial f}{\partial y}=0\):

\[6x+14y+4=0\]

Substitution:

\[6(\frac{1}{3}-y)+14y+4=0\]
\[8y=-6\]
\[y=-\frac{3}{4}\]

Solve for x:

\[x = \frac{1}{3} +\frac{3}{4}\]

\[=\frac{13}{12}\]

Second Partial Derivatives

\[f_{xx}=\frac{\partial^2 f}{\partial x^2}=6\]

\[f_{yy}=\frac{\partial^2 f}{\partial y^2}=14\]

\[f_{xy}=\frac{\partial^2f }{\partial y \partial x}=1\]

Let:

\(D=f_{xx}(a,b)f_{yy}(a,b)-\big[f_{xy}(a,b) \big]^2\)

If \(D > 0\),

Then \(c\) has a Relative Minimum at Critical Point \((a,b)\).

\[D = 6 \times 14 - 1^2 = 84\]

\(D\) is greater than zero.

Therefore, the function \(f(x,y)\) has a relative minimum at the Critical Points:

\((\frac{13}{12},-\frac{3}{4})\).

Critial Point:

\[f\Big(\frac{13}{12},-\frac{3}{4}\Big)=3\Big(\frac{13}{12}\Big)^2+6 \Big(\frac{13}{12}\Big) \Big(-\frac{3}{4}\Big)+7 \cdot \Big(-\frac{3}{4}\Big)^2-2\Big(\frac{13}{12}\Big)+4\Big(-\frac{3}{4}\Big)\]
\[=\frac{507-702+567-312-432}{144}\]
\[=-\frac{31}{12}\]

Gradient Descent Check

series <- function(x,y) 3*x^2 + 6*x*y+7*y^2-2*x+4*y
partial_derivitive <- function(x,y, series, dvar) eval(D(body(series),dvar))
gradient_decent<- function(series, x0, y0, lambda, steps) {
    
    x1 = x0
    y1 = y0

    for (i in 1:steps){
         x1 <- x1 - lambda * partial_derivitive(x1,y1,series,'x')
         y1 <- y1 - lambda * partial_derivitive(x1,y1,series,'y')
    }
    
    list(x=x1,y=y1,min_val=series(x1,y1))
    
}
gradient_decent(series,0.01,0.01,1/16,100)
## $x
## [1] 1.083333
## 
## $y
## [1] -0.75
## 
## $min_val
## [1] -2.583333

Graph of Function

f <- function(x,y) 3*x^2 + 6*x*y+7*y^2-2*x+4*y

Lattice Plot

t <- seq(-3, 3, 0.3)
d <- expand.grid(t, t)
d$z <- f(d[,1],d[,2])
names(d) <- c('x','y','z')
wireframe(z ~ x * y, d,
          scales = list( arrows = FALSE),
          col.regions=rainbow(100),
          aspect = c(1, 1),
          drape = TRUE,
          main = "Plot of f(x,y)",
          par.settings = list(axis.line = list(col = "transparent"))
          )

Section 13.4

Page 599 # 1

Assume that the environmental carrying capacity \(N_u\) is determined principally by the availability of food. Argue that under such an assumption, as \(N\) approaches \(N_u\) the physical condition of the average fish deteriorates as competition for the food supply becomes more severe. What does this suggest about the survival of the species when natural disasters such as storms, severe winters, and similar circumstances further restrict the food supply? Where should conservationists attempt to maintain the population level?


Solution

Let \(N(t)\) denote the size of the fish population at any time.

Let \(g(N)\) represent the rate of growth of the function \(N(t)\).

Let \(N_u\) be the maximum population level that is supported by the availability of food.

\(N_b\) is the polulation level at which the growth rate is maximum.

As \(N\) approaches \(N_u\) the population level of the fish increases and simultaneously the demand for the food increases. The fish will start to starve for the food and since there will no be enough food for the fish and their health will start to decline. In this situation, the fish will increase to the maximum population \(N_u\) but the health condition of the fish will be bad.

However, if natural distasters such as nor’easter or blizzard occurs, this will affect the fish species then the health condition of the fish will not be able to withstand there natural diasters. The availability of food will also be problematic during these events, worsen the overall health of the fish.

Therefore, the result is a new environment with a carrying capacity of \(N_k\) less than \(N_u\) will be formed.

The \(N_k\) may be above or below the \(N_b\), depending upon how bad the natural diaster was and the health conditions of the fish. Nevertheless, the entire system will be altered and, \(N\) will approach to \(N_k\) as time continues.

To maintain the population level, conservationists can see to it that the species have the adequate amount of their food supply after a natural disaster.