inst/doc/stress-strain.R In cmstatrExt: More Statistical Methods for Composite Material Data

```## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk\$set(
collapse = TRUE,
comment = "#>",
fig.width = 5,
fig.height = 3
)

## ----setup--------------------------------------------------------------------
knitr::opts_chunk\$set(message = FALSE, warning = FALSE)
library(cmstatrExt)
library(tidyverse)

## -----------------------------------------------------------------------------

## -----------------------------------------------------------------------------
pa12_tension %>%
ggplot(aes(x = Strain, y = Stress, color = Coupon)) +
geom_point()

## -----------------------------------------------------------------------------
pa12_tension, Coupon,
Stress ~ I(Strain) + I(Strain^2) + 0
)

## -----------------------------------------------------------------------------
augment() %>%
ggplot(aes(x = Strain)) +
geom_point(aes(y = Stress, color = Coupon)) +
geom_line(aes(y = .fit))

## -----------------------------------------------------------------------------
curve_cubic <- average_curve_lm(
pa12_tension, Coupon,
Stress ~ I(Strain) + I(Strain^2) + I(Strain^3) + 0
)
summary(curve_cubic)

## -----------------------------------------------------------------------------
curve_cubic %>%
augment() %>%
ggplot(aes(x = Strain)) +
geom_point(aes(y = Stress, color = Coupon)) +
geom_line(aes(y = .fit))

## -----------------------------------------------------------------------------
average_curve_lm(
pa12_tension, Coupon,
Strain ~ I(Stress) + I(Stress^2) + I(Stress^3) + I(Stress^4) + 0
) %>%
augment() %>%
ggplot(aes(y = Stress)) +
geom_point(aes(x = Strain, color = Coupon)) +
geom_line(aes(x = .fit))

## -----------------------------------------------------------------------------
bilinear_fn <- function(strain, par) {
c1 <- par[1]
c2 <- par[2]
e1 <- par[3]
if (strain <= e1) {
return(c1 * strain)
} else {
return(c2 * (strain - e1) + c1 * e1)
}
}

## -----------------------------------------------------------------------------
curve_bilinear <- average_curve_optim(
pa12_tension,
Coupon, Strain, Stress,
bilinear_fn,
c(1, 1, 0.04) # the initial guess
)
curve_bilinear

## -----------------------------------------------------------------------------
curve_bilinear <- average_curve_optim(
pa12_tension,
Coupon, Strain, Stress,
bilinear_fn,
c(1, 1, 0.04),
lower = c(0, 0, 0.025),
upper = c(2000, 2000, 0.100)
)
curve_bilinear

## -----------------------------------------------------------------------------
curve_bilinear %>%
augment() %>%
ggplot(aes(x = Strain)) +
geom_point(aes(y = Stress, color = Coupon)) +
geom_line(aes(y = .fit))

## -----------------------------------------------------------------------------
fff_shear %>%
ggplot(aes(x = Strain, y = Stress, color = Specimen)) +
geom_point()

## -----------------------------------------------------------------------------
fff_shear %>%
filter(Stress > 1000 & Stress < 3000) %>%
group_by(Specimen) %>%
nest() %>%
mutate(lm = map(data, ~lm(Strain ~ Stress, data = .))) %>%
mutate(x_intercept = map(lm, ~predict(.x, data.frame(Stress = 0)))) %>%
select(-c(lm, data)) %>%
unnest(x_intercept)

## -----------------------------------------------------------------------------
fff_shear %>%
filter(Stress > 1000 & Stress < 3000) %>%
group_by(Specimen) %>%
nest() %>%
mutate(lm = map(data, ~lm(Strain ~ Stress, data = .))) %>%
mutate(x_intercept = map(lm, ~predict(.x, data.frame(Stress = 0)))) %>%
select(-c(lm, data)) %>%
unnest(x_intercept) %>%
inner_join(fff_shear, by = "Specimen") %>%

## -----------------------------------------------------------------------------
fff_shear_offset <- fff_shear %>%
filter(Stress > 1000 & Stress < 3000) %>%
group_by(Specimen) %>%
nest() %>%
mutate(lm = map(data, ~lm(Strain ~ Stress, data = .))) %>%
mutate(x_intercept = map(lm, ~predict(.x, data.frame(Stress = 0)))) %>%
select(-c(lm, data)) %>%
unnest(x_intercept) %>%
inner_join(fff_shear, by = "Specimen") %>%
mutate(Strain = Strain - x_intercept) %>%
select(-c(x_intercept))

## -----------------------------------------------------------------------------
fff_shear_offset %>%
ggplot(aes(x = Strain, y = Stress, color = Specimen)) +
geom_point()

## -----------------------------------------------------------------------------
fff_shear_offset %>%
group_by(Specimen) %>%
Remove = Slope < -1e5 | is.na(Slope)) %>%
ggplot(aes(x = Strain, y = Stress, shape = Specimen, color = Remove)) +
geom_point()

## -----------------------------------------------------------------------------
fff_shear_offset %>%
group_by(Specimen) %>%
Remove = Slope < -1e5 | is.na(Slope),
Remove = cumsum(Remove) > 0) %>%
ggplot(aes(x = Strain, y = Stress, shape = Specimen, color = Remove)) +
geom_point()

## -----------------------------------------------------------------------------
fff_shear_truncated <- fff_shear_offset %>%
group_by(Specimen) %>%
Remove = Slope < -1e5 | is.na(Slope),
Remove = cumsum(Remove) > 0) %>%
ungroup() %>%
filter(!Remove) %>%
select(Specimen, Stress, Strain)

## -----------------------------------------------------------------------------
fff_shear_truncated_no_toe <- fff_shear_truncated %>%
filter(Stress > 1000)

## -----------------------------------------------------------------------------
fff_shear_truncated_no_toe %>%
ggplot(aes(x = Strain, y = Stress, color = Specimen)) +
geom_point() +
xlim(c(0, NA)) +
ylim(c(0, NA))

## -----------------------------------------------------------------------------
curve_fff_shear <- fff_shear_truncated_no_toe %>%
average_curve_lm(
Specimen,
Stress ~ I(Strain) + I(Strain^2) + I(Strain^3) + 0
)
curve_fff_shear

## -----------------------------------------------------------------------------
curve_fff_shear %>%
augment(fff_shear) %>%
ggplot(aes(x = Strain)) +
geom_point(aes(y = Stress, color = Specimen)) +
geom_line(aes(y = .fit))

## -----------------------------------------------------------------------------
pa12_tension_conditions <-
bind_rows(
pa12_tension %>%
mutate(Condition = "RTA"),
pa12_tension %>%
mutate(Condition = "Fake ETA",
Stress = 0.50 * Stress,
Strain = 1.25 * Strain)
)

## -----------------------------------------------------------------------------
curve_cubic_rta <- pa12_tension_conditions %>%
filter(Condition == "RTA") %>%
average_curve_lm(
Coupon,
Stress ~ I(Strain) + I(Strain^2) + I(Strain^3) + 0
)
curve_cubic_rta

## -----------------------------------------------------------------------------
curve_cubic_fake_eta <- pa12_tension_conditions %>%
filter(Condition == "Fake ETA") %>%
average_curve_lm(
Coupon,
Stress ~ I(Strain) + I(Strain^2) + I(Strain^3) + 0
)
curve_cubic_fake_eta

## -----------------------------------------------------------------------------
bind_rows(
augment(curve_cubic_rta),
augment(curve_cubic_fake_eta)
) %>%
ggplot(aes(x = Strain, y = .fit, color = Condition)) +
geom_line()

## -----------------------------------------------------------------------------
bind_rows(
augment(curve_cubic_rta),
augment(curve_cubic_fake_eta)
) %>%
group_by(Condition) %>%
ggplot(aes(x = Strain)) +
geom_point(aes(y = Stress, color = Condition)) +
geom_line(aes(y = .fit, group = Condition))

## -----------------------------------------------------------------------------
bind_rows(
augment(curve_cubic_rta),
augment(curve_cubic_fake_eta)
) %>%
ggplot(aes(x = Strain, y = .fit, color = Condition)) +
geom_line() +
scale_y_continuous(
"Stress [MPa]",
sec.axis = sec_axis(~ . * 0.1450377377, name = "Stress [ksi]")
)

## -----------------------------------------------------------------------------
bind_rows(
augment(curve_cubic_rta),
augment(curve_cubic_fake_eta)
) %>%
ggplot(aes(x = Strain, y = .fit, color = Condition)) +
geom_line() +
scale_y_continuous(
"Stress [MPa]",
sec.axis = sec_axis(~ . * 0.1450377377, name = "Stress [ksi]")
) +
theme_bw()
```

Try the cmstatrExt package in your browser

Any scripts or data that you put into this service are public.

cmstatrExt documentation built on June 22, 2024, 12:15 p.m.