Skip to content

Commit

Permalink
update tecananalyze
Browse files Browse the repository at this point in the history
  • Loading branch information
@kdm9
kdm9 committed Aug 18, 2023
1 parent b9d5a40 commit 340bb10
Showing 1 changed file with 102 additions and 53 deletions.
155 changes: 102 additions & 53 deletions platemate/tecanalyze/app.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,29 +9,31 @@ ui <- fluidPage(

fluidRow(wellPanel(
numericInput("nplates", "How many plates:", 1),
checkboxInput("intercept", "Use an intercept in linear prediction model?", FALSE),
checkboxInput("intercept", "Use an intercept in linear prediction model?", TRUE),
checkboxInput("includestds", "Include standards in output table?", FALSE),
checkboxInput("stdperplate", "Use standards only from each plate to quantify each plate", TRUE),
splitLayout(
numericInput("concA", "[Std A]:", 40, width="100px"),
numericInput("concB", "[Std B]:", 32, width="100px"),
numericInput("concC", "[Std C]:", 24, width="100px"),
numericInput("concD", "[Std D]:", 20, width="100px"),
numericInput("concE", "[Std E]:", 16, width="100px"),
numericInput("concF", "[Std F]:", 8, width="100px"),
numericInput("concG", "[Std G]:", 4, width="100px"),
numericInput("concH", "[Std H]:", 0, width="100px"),
numericInput("concA", "[Std A]:", 0, width="100px"),
numericInput("concB", "[Std B]:", 4, width="100px"),
numericInput("concC", "[Std C]:", 8, width="100px"),
numericInput("concD", "[Std D]:", 16, width="100px"),
numericInput("concE", "[Std E]:", 20, width="100px"),
numericInput("concF", "[Std F]:", 24, width="100px"),
numericInput("concG", "[Std G]:", 32, width="100px"),
numericInput("concH", "[Std H]:", 40, width="100px"),
actionButton("reverse", "Reverse Standards"),
)
)),
uiOutput("plates"),
fluidRow(wellPanel(
actionButton(inputId="enter",label="Convert"),
downloadButton("dlBtn"),
tableOutput("outtbl"),
plotOutput("standardsPlot"),
verbatimTextOutput("stdmdltxt")
))
)


server <- function(input, output, session) {
observeEvent(input$reverse, {
for (i in 1:4) {
Expand All @@ -48,13 +50,21 @@ server <- function(input, output, session) {
output$plates = renderUI(lapply(seq_len(input$nplates), function(i) {
ti = textInput(sprintf("plate%d_name", i), "Plate Name", "")
ht = rHandsontableOutput(sprintf("plate%d_hot", i))
msg=tags$p("In the bottom status row, write EXACTLY 'STD' to mark a column as the standard column, or the name of another plate to mark that this is the standard column from that plate")
cb = checkboxGroupInput(sprintf("plate%d_stds", i), "Standard column(s)", choices=as.character(1:12), inline=T)
fluidRow(wellPanel(ti, ht,cb))
col1s = fluidRow(wellPanel(
tags$p("If this is a 'column 1s' plate, which plate name does each column belong to?"),
splitLayout(
textInput("col1of1", "1", ""), textInput("col1of2", "2", ""), textInput("col1of3", "3", ""), textInput("col1of4", "4", ""),
textInput("col1of5", "5", ""), textInput("col1of6", "6", ""), textInput("col1of7", "7", ""), textInput("col1of8", "8", ""),
textInput("col1of9", "9", ""), textInput("col1of10", "10", ""), textInput("col1of11", "11", ""), textInput("col1of12", "12", ""),
), width="800px"))
fluidRow(wellPanel(ti, ht, msg))#,cb, col1s))
}))
for(i in seq_len(input$nplates)) { local({
DF=as.data.frame(matrix("", nrow=8, ncol=12))
DF=as.data.frame(matrix("", nrow=9, ncol=12))
colnames(DF) = as.character(1:12)
rownames(DF) = LETTERS[1:8]
rownames(DF) = c(LETTERS[1:8], "STATUS")
intbl=renderRHandsontable(rhandsontable(DF, readOnly=F))
output[[sprintf("plate%d_hot", i)]] <- intbl
})}
Expand All @@ -64,54 +74,93 @@ server <- function(input, output, session) {
data = do.call("bind_rows", lapply(seq_len(input$nplates), function(i){
local({
pname = input[[sprintf("plate%d_name", i)]]
d = hot_to_r(input[[sprintf("plate%d_hot", i)]]) %>%
mutate(row=LETTERS[1:8]) %>%
pivot_longer(!c("row")) %>%
transmute(plate_name=pname, well=sprintf("%s%02d", row, as.integer(name)), value, col=name, row)
d
d = hot_to_r(input[[sprintf("plate%d_hot", i)]])
rownames(d) = c(LETTERS[1:8], "status")
pl = d %>%
t() %>%
as.data.frame() %>%
rownames_to_column("col") %>%
pivot_longer(LETTERS[1:8]) %>%
transmute(plate_name=pname, col=as.integer(col), row=name, well=sprintf("%s%02d", name, col), value,
status=sub("^\\s+|\\s+$", "", status, perl=T))
pl
})
}))
stds = do.call("bind_rows", lapply(seq_len(input$nplates), function(i){
local({
if (length(input[[sprintf("plate%d_stds", i)]]) > 0) {
return(data.frame(plate_name=input[[sprintf("plate%d_name", i)]],
std_cols=input[[sprintf("plate%d_stds", i)]]))
}
})}))

std_concs = do.call("bind_rows", lapply(LETTERS[1:8], function(w) {
local({
data.frame(well=w, conc=input[[sprintf("conc%s", w)]])
})
}))
data = mutate(data, value=as.numeric(value))

std = left_join(stds, data, by=c("plate_name", "std_cols"="col")) %>%
left_join(std_concs, by=c("row"="well")) %>%
mutate(conc=as.numeric(conc), value=as.numeric(value))


if (input$intercept) {
m = lm(conc ~ value, data=std)

if (input$stdperplate) {
data$std_group=data$plate_name
} else {
m = lm(conc ~ 0 + value, data=std)
data$std_group="everything"
}


stdconc = local({
x = data.frame(row=LETTERS[1:8])
x$conc = sapply(x$row, function(l) as.numeric(input[[sprintf("conc%s", l)]]))
x
})

data2 = data %>%
transmute(plate_name, well, rfu=value, conc=predict(m, data)) %>%
filter(!is.na(rfu)) %>%
mutate(conc = ifelse(conc < 0, 0, conc))
mutate(value=as.numeric(value)) %>%
group_by(std_group) %>%
group_modify(
function(df, key) {
stds = df %>%
filter(status=="STD") %>%
left_join(stdconc, by="row")
if (input$intercept) {
m = lm(conc ~ value, data=stds)
} else {
m = lm(conc ~ 0 + value, data=stds)
}
print(summary(m))
res = df %>%
mutate(
conc=pmax(predict(m, df), 0),
r2=summary(m)$adj.r.squared,
)
return(res)
}) %>%
ungroup()

nonstd = data2 %>%
filter(is.na(status) | status == "")
stds = data2 %>%
filter(status=="STD") %>%
group_by(plate_name, status) %>%
summarise(col=unique(col))
colstds = data2 %>%
filter(status %in% data2$plate_name)

corrected_stdcols = colstds %>%
group_by(plate_name, status) %>%
summarise(src_col=unique(col)) %>%
ungroup() %>%
rename(src_plate=plate_name) %>%
left_join(stds, ., by=c("plate_name"="status")) %>%
filter(!is.na(src_plate)) %>%
left_join(colstds, by=c("src_plate"="plate_name", "src_col"="col")) %>%
mutate(well=sprintf("%s%02d", row, col))

output$standardsPlot = renderPlot(
ggplot(std, aes(conc, value)) +
geom_point(data=std) +
geom_point(aes(conc, rfu), colour="red", data=data2) +
labs(x="Conc (ng/uL)", y="RFU", title="Standard Curve") +
theme_classic()
if (input$includestds) {
stds_fortbl = data2 %>%
filter(status=="STD") %>%
group_by(plate_name) %>%
mutate(col=NA, well=sprintf("std_%s_%i", row, stdconc[match(row, stdconc$row),"conc"]))
data3 = bind_rows(nonstd, corrected_stdcols, stds_fortbl)
} else {
data3 = bind_rows(nonstd, corrected_stdcols)
}
data3 = data3 %>%
select(plate_name, row, col, well, value, conc, r2) %>%
filter(!is.na(value)) %>%
arrange(plate_name, col, row) %>%
select(-row, -col)

output$dlBtn <- downloadHandler(
filename = function(){"plates.csv"},
content = function(fname){ write_csv(data3, fname, na="") }
)
output$stdmdltxt = renderPrint(summary(m))
output$outtbl=renderTable(data2)
output$outtbl=renderTable(data3)
})
}

Expand Down

0 comments on commit 340bb10

Please sign in to comment.