Skip to content

Commit

Permalink
Merge pull request #30 from jtlandis/master
Browse files Browse the repository at this point in the history
Vignette development
  • Loading branch information
ahwbest authored Oct 12, 2017
2 parents c270e75 + 5f462d1 commit 56c4052
Show file tree
Hide file tree
Showing 4 changed files with 285 additions and 158 deletions.
77 changes: 39 additions & 38 deletions inst/doc/usageExamples.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,17 @@
## ----setup, include=FALSE------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE, fig.width = 7)

## ------------------------------------------------------------------------
library(dr4pl)
library(ggplot2)
library(drc)

## ------------------------------------------------------------------------
ggplot(drc_error_1, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_1")

## ------------------------------------------------------------------------
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_1, fct = LL.4())
Expand Down Expand Up @@ -33,6 +39,12 @@ error = function(err) {
})
plot(a, text.title = "Error plot #1", indices.outlier = c(102))

## ------------------------------------------------------------------------
ggplot(drc_error_2, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_2")

## ------------------------------------------------------------------------
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_2, fct = LL.4())
Expand Down Expand Up @@ -61,6 +73,12 @@ error = function(err) {
b <- plot(a, breaks.x = c(0.00135, 0.0135, 0.135, 1.35, 13.5), text.title = "Error plot #2", indices.outlier = c(2,8) )
b

## ------------------------------------------------------------------------
ggplot(drc_error_3, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_3")

## ------------------------------------------------------------------------
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_3, fct = LL.4())
Expand Down Expand Up @@ -89,6 +107,12 @@ error = function(err) {
})
plot(a, indices.outlier = c(90, 101), text.title = "Error plot #3")

## ------------------------------------------------------------------------
ggplot(drc_error_4, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_4")

## ------------------------------------------------------------------------
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_4, fct = LL.4())
Expand All @@ -107,54 +131,31 @@ a<-dr4pl(Response~Dose, data = drc_error_4)
plot(a$robust.plot)

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_1, method.init = "Mead")
plot(a, text.title = "Sample plot #1")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_2, method.init = "Mead")
plot(a, text.title = "Sample plot #2")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_3, method.init = "Mead")
plot(a, text.title = "Sample plot #3")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_4, method.init = "Mead")
plot(a, text.title = "Sample plot #4")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_5, method.init = "Mead")
plot(a, text.title = "Sample plot #5")
a <- dr4pl(Response~Dose, data = sample_data_6)
plot(a, text.title = "Default Sample data #6")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead")
plot(a, text.title = "Sample plot #6")
plot(a, text.title = "Mead's Method")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_7, method.init = "Mead")
plot(a, text.title = "Sample plot #7")
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead", method.robust = "absolute")
plot(a, text.title = "Mead's method & absolute")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_8, method.init = "Mead")
plot(a, text.title = "Sample plot #8")
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead", method.robust = "Tukey")
plot(a, text.title = "Mead's method & Tukey's biweight")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_9, method.init = "Mead")
plot(a, text.title = "Sample plot #9")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_10, method.init = "Mead")
plot(a, text.title = "Sample plot #10")

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_11, method.init = "Mead")
plot(a, text.title = "Sample plot #11")
a <- dr4pl(Response~Dose, data = sample_data_3, method.init = "Mead")
b <- plot(a, text.title = "Sample data #3")
b

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_12, method.init = "Mead")
plot(a, text.title = "Sample plot #12")
b <- summary(a)
b$coefficients

## ------------------------------------------------------------------------
a <- dr4pl(Response~Dose, data = sample_data_13)
plot(a, text.title = "Sample plot #13")
values <- IC(a, c(10, 30, 50, 70, 90))
values

123 changes: 84 additions & 39 deletions inst/doc/usageExamples.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ vignette: >
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE, fig.width = 7)
```

#packages
Expand All @@ -19,6 +19,21 @@ library(drc)
```

#error cases

dr4pl is a four parameter regression tool that was designed to provide a converging function in the pressense of outliers. Consider the next four data sets provided by dr4pl.

Lets first consider the data set drc_error_1.

```{r}
ggplot(drc_error_1, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_1")
```

As you can see, this data set contains an extreme outlier at one of the dosage levels. These outliers may be a common phenomena with measuring mistakes of some lab instruments.
If you were to try and produce a four parameter logistic model with drc, you would recieve the following.

```{r}
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_1, fct = LL.4())
Expand All @@ -33,6 +48,8 @@ error = function(err) {
})
```

Instead of removing the extreme outlier, you may try to use dr4pl instead.

```{r}
a <-tryCatch({
dr4pl(Response~Dose, data = drc_error_1, method.robust = "Tukey")
Expand All @@ -48,6 +65,17 @@ error = function(err) {
plot(a, text.title = "Error plot #1", indices.outlier = c(102))
```

Lets next consider the next data set, drc_error_2.

```{r}
ggplot(drc_error_2, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_2")
```

This data set suffers from a low sample amount. There are also high outliers at two seperate dose levels. Lets try to plot this case with drc.

```{r}
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_2, fct = LL.4())
Expand All @@ -62,6 +90,8 @@ error = function(err) {
})
```

Lets see what we can plot with dr4pl.

```{r}
a <-tryCatch({
dr4pl(Response~Dose, data = drc_error_2, method.init = "Mead", method.robust = "Huber" )
Expand All @@ -78,6 +108,17 @@ b <- plot(a, breaks.x = c(0.00135, 0.0135, 0.135, 1.35, 13.5), text.title = "Err
b
```

Lets next consider the next data set, drc_error_3.

```{r}
ggplot(drc_error_3, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_3")
```

This data set presents multiple outliers at one dosage level. Again these outliers may manifest as measurement issues with lab instruments. Additionally this data set exemplifies the problem we refer to as the *support problem*. The support problem occurs when there is lack of data at either the right or left of the IC50 parameter. Lets try to use drc on this data set.

```{r}
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_3, fct = LL.4())
Expand All @@ -93,6 +134,8 @@ error = function(err) {
```

Now lets use dr4pl.

```{r}
a <-tryCatch({
dr4pl(Response~Dose, data = drc_error_3, method.init = "Mead", method.robust = "absolute" )
Expand All @@ -108,6 +151,17 @@ error = function(err) {
plot(a, indices.outlier = c(90, 101), text.title = "Error plot #3")
```

Lets next consider the next data set, drc_error_4.

```{r}
ggplot(drc_error_4, aes(x = Dose, y = Response)) +
geom_point() +
scale_x_log10() +
ggtitle("drc_error_4")
```

This data set has two outliers in the largest dosage level. This data set also exemplifies the *support problem* as well. Lets try to apply drc to this data set.

```{r}
a <- tryCatch({
drc::drm(Response~Dose, data = drc_error_4, fct = LL.4())
Expand All @@ -122,6 +176,8 @@ error = function(err) {
})
```

Now lets use dr4pl.

```{r}
a <-tryCatch({
dr4pl(Response~Dose, data = drc_error_4, method.init = "Mead", method.robust = "absolute" )
Expand All @@ -137,70 +193,59 @@ error = function(err) {
plot(a, text.title = "Error plot #4", indices.outlier = c(1,100))
```

```{r}
a <- dr4pl(Response~Dose, data = sample_data_1, method.init = "Mead")
plot(a, text.title = "Sample plot #1")
```
The package drc draws errors with each one of these cases. However dr4pl is able generate a curve despite the outliers in each error case. In each case we were able to modify the title and axis names with *text.title*, *text.x*, or *text.y*. We are also able to bring attention to outlier points by passing a vector of the indices to the *indices.outlier* argument. As seen the the second error case, we may change the x-axis' and y-axis' break points by using *breaks.x* and *breaks.y* respectively.

```{r}
a <- dr4pl(Response~Dose, data = sample_data_2, method.init = "Mead")
plot(a, text.title = "Sample plot #2")
```
#General Usage

```{r}
a <- dr4pl(Response~Dose, data = sample_data_3, method.init = "Mead")
plot(a, text.title = "Sample plot #3")
```
dr4pl provides several methods and loss functions for the user to obtain the best fit possible. Lets explore some of the possibities.

Consider you want to plot the dr4pl data set sample_data_6. Lets try and apply the default parameters.
```{r}
a <- dr4pl(Response~Dose, data = sample_data_4, method.init = "Mead")
plot(a, text.title = "Sample plot #4")
a <- dr4pl(Response~Dose, data = sample_data_6)
plot(a, text.title = "Default Sample data #6")
```

```{r}
a <- dr4pl(Response~Dose, data = sample_data_5, method.init = "Mead")
plot(a, text.title = "Sample plot #5")
```
After producing a plot with the default parameters, you may be confident in producing a better fit with other parameters. This is where the arguments *method.init* and *method.robust* come into play, which you may have noticed that these arguments where used in the error case examples. The default paramter to *method.init* is "Logistic". This uses the logistic method when approximating the theta parameters. The alternative to using the Logistic method is "Mead", which uses a non-logistic method to approximate the theta parameters. Lets see how our plot will change when we use Mead's method.

```{r}
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead")
plot(a, text.title = "Sample plot #6")
plot(a, text.title = "Mead's Method")
```

```{r}
a <- dr4pl(Response~Dose, data = sample_data_7, method.init = "Mead")
plot(a, text.title = "Sample plot #7")
```
Mead's method seems to generate tighter fit with this data set. Now lets talk about *method.robust*. *method.robust* allows the user to choose the loss function used during optimization. The default loss function used is the squared loss function. The user has three other loss functions to select from: "absolute", "Huber", and "Tukey". Lets see how this plot will change when using "absolute" versus "Tukey".

```{r}
a <- dr4pl(Response~Dose, data = sample_data_8, method.init = "Mead")
plot(a, text.title = "Sample plot #8")
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead", method.robust = "absolute")
plot(a, text.title = "Mead's method & absolute")
```

```{r}
a <- dr4pl(Response~Dose, data = sample_data_9, method.init = "Mead")
plot(a, text.title = "Sample plot #9")
a <- dr4pl(Response~Dose, data = sample_data_6, method.init = "Mead", method.robust = "Tukey")
plot(a, text.title = "Mead's method & Tukey's biweight")
```

```{r}
a <- dr4pl(Response~Dose, data = sample_data_10, method.init = "Mead")
plot(a, text.title = "Sample plot #10")
```
Both "absolute" and "Tukey" are less weighted by the largest dosage level which produces a response of zero. However you may notice that Tukey's biweight is far less weighted than the absolute loss function.

Lets look at other uses for this code.
```{r}
a <- dr4pl(Response~Dose, data = sample_data_11, method.init = "Mead")
plot(a, text.title = "Sample plot #11")
a <- dr4pl(Response~Dose, data = sample_data_3, method.init = "Mead")
b <- plot(a, text.title = "Sample data #3")
b
```
Once you produce a curve you feel is representative of your data, you may get the parameters of the curve by using the summary function on the dr4pl variable.

```{r}
a <- dr4pl(Response~Dose, data = sample_data_12, method.init = "Mead")
plot(a, text.title = "Sample plot #12")
b <- summary(a)
b$coefficients
```

It is possible that you are interested in more than just the IC50 variable. Use the IC() function to produce the respective Dose values.

```{r}
a <- dr4pl(Response~Dose, data = sample_data_13)
plot(a, text.title = "Sample plot #13")
values <- IC(a, c(10, 30, 50, 70, 90))
values
```

You may then easily edit your plot further with basic ggplot2 additional controls.



Loading

0 comments on commit 56c4052

Please sign in to comment.