Data 609_HW4

EX 1.

x <- c(-0.98, 1, 2.02, 3.03, 4.00)
y <- c(2.44, -1.51, -0.47, 2.54, 7.52)

df <- data.frame(x,y)
df

##       x     y
## 1 -0.98  2.44
## 2  1.00 -1.51
## 3  2.02 -0.47
## 4  3.03  2.54
## 5  4.00  7.52

lm <- lm(y ~., data = df)
lm

## 
## Call:
## lm(formula = y ~ ., data = df)
## 
## Coefficients:
## (Intercept)            x  
##      0.4038       0.9373

EX 2.

x <- c(0.1, 0.5, 1, 1.5, 2, 2.5)
y<- c(0.1, 0.28, 0.4, 0.4, 0.37, 0.32)

# Define the nonlinear model
model <- nls(y ~ (x)/(a+b*x^2), start = list(a=1, b=1))

# print the model summary
summary(model)

## 
## Formula: y ~ (x)/(a + b * x^2)
## 
## Parameters:
##   Estimate Std. Error t value Pr(>|t|)    
## a  1.48544    0.08777   16.92 7.15e-05 ***
## b  1.00212    0.05019   19.96 3.71e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.01739 on 4 degrees of freedom
## 
## Number of iterations to convergence: 5 
## Achieved convergence tolerance: 3.899e-07

#Plot the data and the fitted curve
plot(x,y)
lines(x, predict(model), col="blue")

EX 3.

myfunc <- function(x, a, b) {
  plogis(1/(1 + exp(a + b*x)))
}

x <- c(0.1, 0.5, 1, 1.5, 2.0, 2.5)
y <- c(0, 0, 1, 1, 1, 0)

df <- data.frame(x =x , y = y)
df

##     x y
## 1 0.1 0
## 2 0.5 0
## 3 1.0 1
## 4 1.5 1
## 5 2.0 1
## 6 2.5 0

df$fitted <- myfunc(df$x, a = 1, b = 1)

# Fit a logistic regression model with the custom nonlinear function
model <- glm(y ~ fitted, df, family = binomial(link = "logit"))

# Print the model summary
summary(model)

## 
## Call:
## glm(formula = y ~ fitted, family = binomial(link = "logit"), 
##     data = df)
## 
## Deviance Residuals: 
##       1        2        3        4        5        6  
## -0.5171  -0.7961   1.2122   0.9579   0.8086  -1.7156  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)    30.43      28.84   1.055    0.291
## fitted        -57.60      54.72  -1.053    0.292
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8.3178  on 5  degrees of freedom
## Residual deviance: 6.8852  on 4  degrees of freedom
## AIC: 10.885
## 
## Number of Fisher Scoring iterations: 4

# Plot the data and the fitted curve
plot(x, y, col = ifelse(y == 1, "red", "blue"))