---
title: "MACSQuantifyR - Automatic pipeline"
author:
- name: Raphaël Bonnet, Jean-François Peyron 
  email: raphael.bonnet@unice.fr
  affiliation: Université Côte d’Azur, Inserm, C3M, France 
date: "`r Sys.Date()`"
output:
    prettydoc::html_pretty:
        theme: cayman
        toc: true
        css: MACSQuantifyR.css
vignette: >
    %\VignetteIndexEntry{MACSQuantifyR_simple_pipeline}
    %\VignetteEngine{knitr::rmarkdown}
    %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
    fig.width = 8,
    fig.height = 8
)
```

```{r, echo = FALSE,fig.asp=0.6}
library(png)
library(grid)
path_intro <- system.file("extdata", "auto.png", package = "MACSQuantifyR")
intro <- readPNG(path_intro)
grid.raster(intro)
```

# Requirements

1. Four columns MACSQuantify miltenyi Excel output file 
with P1 and P1//P2 gates namely

- `Full path`

- `WID`

- `%-#`

- `Count/mL`

2. Up to date version of R is recommended

# Running the pipeline() function 

---

---

This function will sequentially:

1. Load the Excel file from the provided path
2. Display a graphical interface on which the user can 
easily select his replicates
3. Compute basic statistics on the replicates
4. Generate graphical representations
5. Save all intermediate files in the default output folder
6. Generate a Word report for the user 

---

---

## Load the packages to make the function available

```{r load}
library(MACSQuantifyR)
library(knitr)
library(grid)
library(gridExtra)
library(png)
suppressMessages(library(R.utils))
```

This is an example file loaded with the package:

```{r load_file, include = TRUE}
file <- system.file("extdata", "drugs.xlsx",
    package = "MACSQuantifyR")
```

```{r echo=FALSE}
print(basename(file))
```

This is what the beginning of the file looks like:

```{r,echo=FALSE,include=FALSE}
MACSQuant <- load_MACSQuant(file)
my_data <- slot(MACSQuant, "my_data")
```
```{r,echo=FALSE}
kable(head(my_data), digits = 4)
```

## Run the function

---

---

This line will generate a plot on which the user 
**has to manually select the replicates**. 

Once the replicates of all 
conditions have been identified by the user, the on_plate_selection 
function will automatically reorder the data and process them. 

---

---

In the following example, the user is screening for the effect 
of two drugs on human cell lines at different concentrations. 

Each of the 8 conditions contain 3 replicates.
(`number_of_replicates = 3`, `number_of_conditions = 8`)

(i.e: Drug1_c1 is the concentration for drug1 at concentration c1 and 
the replicates are B2, C2 ,D2).

One can specify `control=T` if a control condition needs to be processed.

```{r eval=FALSE}
MACSQuant <- pipeline(filepath = file,
    sheet_name = NULL, # optional
    number_of_replicates = 3,
    number_of_conditions = 8,
    control = T)
```


```{r, echo = FALSE}

example_path <- system.file("extdata/",
    "plate_template_pipeline.png",
    package = "MACSQuantifyR")
example_image <- readPNG(example_path)
grid.raster(example_image)
```

The user is notified as the function goes along its tasks.

```{r echo = FALSE}
printf(paste("...To quit press ESC...\n",
    "...You can now select your conditions",
    "replicates (without control condition replicates)...\n",
    "    --> 18 conditions:...1...2...3...4...5...6...7...8...OK\n",
    "    --> Done: replicates identified\n",
    "    --> Done: statistics on each condition replicates\n",
    "...You can now select your control replicates...\n",
    "    --> 1 control: ...OK...\n",
    "    --> Done: statistics on each control replicates\n",
    "--> Done: replicates stored in variable my_replicates_sorted\n",
    sep = " "))
```

The user may encounter warnings:

```{r echo = FALSE}
warning(paste("In order_data(sorted_matrix_final, my_data, save.files =",
    "save.files) : \n !!! A2 not selected and will be ignored",
    sep = " "))
```

This warning tells the user that there were some conditions that were 
not selected. Here A2 stands for the calibration well and should not 
be used in this analysis. 

## Access the results

The function will create a folder called outputMQ 
in your current directory and save: 

* The well plate template image (plate_template.png)
* The sorted_replicates data table (sorted_table.txt)
* The statistic table (statistics.txt) 

**Be careful to avoid overriding data, content of 
existing outputMQ folder could be erased.** 

The results presented below can be found 
in the generated report file (results.docx)

* You can find an example of the report generated by the function pipeline() 
at this address: https://github.com/Peyronlab/MACSQuantifyR


### Statistics

---

---

During the process of sorting replicates basic statistical analysis 
for each condition is done (mean and standard deviation of replicates).
A statistic table will be generated. 

---

---

This is the statistic table for this example:

```{r, echo=FALSE}

drugs_R_image <- system.file("extdata",
    "drugs.RDS",
    package = "MACSQuantifyR")
MACSQuant <- readRDS(drugs_R_image)
kable(slot(MACSQuant, "statistics"), digits = 4)
```

In this table the user will find for each conditions:

* the name (full path) and the WID of the first replicate
* the mean of percentage over replicates of cells that incorporated the 
fluorochrome: Fluo.percent.plus and Fluo.percent.minus 
(here mortality experiment with DAPI gates)
* the standard variation for the aforementioned percentages over replicates
* the mean of cell counts over replicates 
* the standard deviation of cell count over replicates

### Graphical representations

---

---

After computing the statistics table, the function 
starts to generate graphical representations and provides 
the user with two plots

---

---

```{r, echo = FALSE, fig.width=20, fig.height=20,fig.asp=0.5}
example_res1 <- system.file("extdata/",
    "barplot_counts_pipeline.png",
    package = "MACSQuantifyR")
example_res2 <- system.file("extdata/",
    "barplot_percent_pipeline.png",
    package = "MACSQuantifyR")
img4 <-  rasterGrob(as.raster(readPNG(example_res1)), interpolate = FALSE)
img5 <-  rasterGrob(as.raster(readPNG(example_res2)), interpolate = FALSE)
grid.arrange(img4, img5, ncol = 2)
```

# Define output and experimental parameters (optional)

In order to define more parameters and to have more exhaustive 
graphical representations such as:

* experiment name 
* condition names
* custom colors
* names label
* doses labels
* ...

please have a look to the step-by-step analysis 
[vignette](MACSQuantifyR_combo.html)

# Links

* A version of this package is available as an Excel macro at this address: 
https://github.com/Peyronlab/MACSQuantifyXL