In JARS3N/shinyStar: shinyStar

========================================================
MF batch: XBATCHX

library(knitr)
library(ggplot2)
library(gridExtra)
library(ggthemes)

data<-read.csv('data.csv',stringsAsFactors = F)
models<-lapply(split(data,data$dye),
               function(x){nls(counts ~ SSfpl(pH, Bottom, Top, pKa, Slope), x)})

model_names<-split(names(models),names(models))

pHvals <- seq(min(data$pH), max(data$pH), length.out=150)

linedata<- lapply(model_names,function(u){
  predict(models[[u]],data.frame(pH=pHvals))[1:150]})

titrlines <- do.call('rbind',
                     lapply(model_names,
                            function(u) {
                              data.frame(val = linedata[[u]], dye = u, pH = pHvals)
                            }))

cols <- c("CL" = "cornflowerblue","PR" = "red")

titrPlot<-ggplot(data,aes(x=pH,y=counts,colour=dye,fill=dye))+
  geom_jitter(aes(fill=dye),size=2,shape=16,alpha=.7)+
  geom_line(data=titrlines,aes(x=pH,y=val,colour=dye))+
  theme_few()+ggtitle('Titration Curve')+
  guides(colour = FALSE,fill=FALSE) +
  scale_colour_manual(values = cols)


## lines for effective range
min10<-function(z){min(z) + ((max(z) - min(z))/10)}
max10<-function(z){max(z) - ((max(z) - min(z))/10)}
LowLine<-function(u){b<-min10(u);which(abs(u - b) == min(abs(u - b)))}
HighLine<-function(u){b<-max10(u);which(abs(u - b) == min(abs(u - b)))}
#
pH.index<- do.call('rbind',c(lapply(linedata,LowLine),lapply(linedata,HighLine)))

EfRange<-data.frame(vline=pHvals[pH.index],dye=factor(c('CL','PR')))

gainData<-do.call('rbind',lapply(model_names,function(j){
  data.frame(gain=diff(linedata[[j]][1:150])/diff(pHvals)/1000,pH=pHvals[-1],dye=j)
})
)
gainData$dye<-factor(gainData$dye)


gain_plot<-ggplot(gainData,aes(x=pH,y=gain,colour=dye)) + geom_line(size=2) +
  theme_few() +
  ggtitle('Gain Curve') +
  geom_vline(data=EfRange,aes(xintercept=vline,colour=dye),linetype = 'dotted')+
  scale_colour_manual(values = cols)

grid.arrange(titrPlot,gain_plot, nrow=1, ncol=2,top='pKA')

Effective range

EfRange$stat<-c(rep('Low.pH',2),rep('High.pH',2))
fix<-c('CL'='Clear','PR'='Phenol Red')
EfRange$dye<-fix[EfRange$dye]

r kable(t(xtabs(vline~.,data=EfRange)),format='markdown')

Clear pKa information

Clear.V50<-cbind(signif(summary(models[['CL']])$parameters,digits=5),
                 signif(confint(models[['CL']]),digits=4))

r kable(Clear.V50,format='markdown')

Phenol Red pKa information

Phenol.Red.V50<-cbind(signif(summary(models[['PR']])$parameters,digits=5),
                      signif(confint(models[['PR']]),digits=4))

r kable(Phenol.Red.V50,format='markdown')

JARS3N/shinyStar documentation built on Dec. 22, 2024, 4:54 a.m.