libraries

library(ggplot2)
library(nls2)

## Loading required package: proto

#plotting
library(plyr)
library(tidyr)
library(minpack.lm)

Creating a curve following parameters

Boltzmann function

#fitting data with boltzmann function
Boltz<-function(data=x){
  B<-nls(gxp ~ (1+(max-1)/(1+exp((Tm-T)/a))),data=data, start=list(max=80,Tm=35,a=1.05), trace=TRUE,control=nls.control(warnOnly = TRUE, tol = 1e-05, maxiter=1000))
#summary(B)
  return(summary(B)$parameters)
}

implementing boltzmann function

T<-c(25,28,30,31.5,33,35,36.5,40,41)
length(T)

## [1] 9

gxp<-c(1.139380725,
1.495138067,
1.31816746,
2.39787468,
3.341707929,
6.387151393,
6.266289656,
8.939597512,
11.99697887)
dat<-as.data.frame(cbind(T,gxp));dat

##      T       gxp
## 1 25.0  1.139381
## 2 28.0  1.495138
## 3 30.0  1.318167
## 4 31.5  2.397875
## 5 33.0  3.341708
## 6 35.0  6.387151
## 7 36.5  6.266290
## 8 40.0  8.939598
## 9 41.0 11.996979

Boltz(dat)

## 14189.79 :  80.00 35.00  1.05
## 12.09578 :  10.694469 35.006951  1.165677
## 6.142545 :  10.82713 35.15322  2.07248
## 5.200202 :  11.914517 36.018476  2.533412
## 4.957602 :  12.821975 36.628467  2.745191
## 4.92032 :  13.315714 36.923736  2.849653
## 4.916001 :  13.514195 37.043062  2.891202
## 4.915536 :  13.584047 37.085963  2.906369
## 4.915486 :  13.607168 37.100351  2.911456
## 4.915481 :  13.614700 37.105061  2.913127
## 4.91548 :  13.617134 37.106586  2.913668
## 4.91548 :  13.617921 37.107079  2.913842
## 4.91548 :  13.618174 37.107238  2.913899

##      Estimate Std. Error   t value     Pr(>|t|)
## max 13.618174   3.696489  3.684084 1.028068e-02
## Tm  37.107238   2.236674 16.590365 3.058983e-06
## a    2.913899   1.006508  2.895057 2.751134e-02

plotting

###creates data based off of the parameters of a function
fud<-function(T=seq(25,70,.1),Tm=40,slope=1.8,max=50){
  y<-1+ (max-1)/(1+exp(((Tm-T)/slope)))
  return(y)
  }

#plot
par(mar=c(5,5,5,5))
plot(seq(0,70,.1),fud(T=seq(0,70,.1)),col="blue",type="n",ylim=c(0,80),las=1,xlab="",ylab="",xlim=c(25,50))
mtext("Fold Induction", side=2, line=2.5, cex=2)
mtext("Temperature", side=1, line=2.7, cex=2)
lines(seq(25,70,.1),fud(Tm=37.4,slope=1.76,max=76),lwd=6)
lines(c(37.4,37.4),c(-10,39),lwd=5,lty="dotdash",col="purple")
abline(h=73,lty="dotdash",col="red",lwd=5)
arrows(33,-3,45,113,code=2,lwd=5,lty="dotdash",col="gold4")
#points(FB1$T,FB1$gxp,pch=19,col="blue",cex=3)
#text(c(39,30,36),c(20,76,50),c("Tm","Max","Slope"),font=2,cex=2)
text(c(36),c(50),c("Slope"),font=2,cex=2)
mtext(side=1,at=37.5,text="Tm",font=2,cex=2,line=.75)
mtext(side=2,at=73,text="Max",font=2,cex=2,line=.75,las=1)

Plotting 2 samples with differences in parameters

#hsp70
T<-seq(25,43,.1)

#closed
cu<-fud(T=T,Tm=37,slope=0.33,max=27.3)
cl<-fud(T=T,Tm=35.26,slope=1.28,max=49.5)
#open
u<-fud(T=T,Tm=37.08,slope=1.81,max=77.5)#upper open
l<-fud(T=T,Tm=38.17,slope=0.94,max=47.3)#lower open

plot(T,fud(T=T,Tm=36.16,slope=0.84,max=38.9),las=1,ylab="Fold Induction",xlab="Temperature",type='n',ylim=c(0,80),xlim=c(30,43),cex.lab=2)

polygon(c(T,rev(T)),c(cl,rev(cu)),col=rgb(0,0,0.5,.5),border=FALSE)


#lines(T,fud(T=T,Tm=35.26,slope=1.28,max=49.5),lwd=5,col="blue",lty="dotdash")# lower
#lines(T,fud(T=T,Tm=37,slope=0.33,max=27.3),lwd=5,col="blue",lty="dotdash")#upper
polygon(c(T,rev(T)),c(l,rev(u)),col=rgb(.5,0,0,.5),border=FALSE)
lines(T,fud(T=T,Tm=37.63,slope=1.38,max=62.74),lwd=5,col="red")
lines(T,fud(T=T,Tm=36.16,slope=0.84,max=38.9),lwd=5,col="blue")

sessionInfo()

## R version 3.3.1 (2016-06-21)
## Platform: x86_64-apple-darwin13.4.0 (64-bit)
## Running under: OS X 10.12.2 (Sierra)
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] minpack.lm_1.2-0 tidyr_0.6.0      plyr_1.8.4       nls2_0.2        
## [5] proto_0.3-10     ggplot2_2.1.0   
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.7      knitr_1.14       magrittr_1.5     munsell_0.4.3   
##  [5] colorspace_1.2-6 stringr_1.1.0    tools_3.3.1      grid_3.3.1      
##  [9] gtable_0.2.0     htmltools_0.3.5  yaml_2.1.13      rprojroot_1.2   
## [13] digest_0.6.10    assertthat_0.1   tibble_1.2       prettydoc_0.2.0 
## [17] evaluate_0.9     rmarkdown_1.3    stringi_1.1.2    scales_0.4.0    
## [21] backports_1.0.5