Nothing
# TODO: Add comment
#
# Author: Martin Rittner <kmr@thegeologician.net>
# (c) Martin Rittner 2008-2014
###############################################################################
relativeAtomicMass<-function(element="",A=getMassNumber(element)){
s<-getSymbol(element)
headers<-paste(s,A,sep="")
ret=rep(NA,length(headers))
names(ret)<-headers
ret[element==""]<-NA
ret[s==""]<-NA
ret[A==""]<-NA
ics<-getICS()
isos<-headers[headers%in%paste(ics$atomic_symbol,ics$mass_number,sep="")]
ram<-subset(ics,subset=paste(atomic_symbol,mass_number,sep="")%in%isos,
select=c("atomic_symbol","mass_number","relative_atomic_mass"))
if(length(ram)<1)return(NA)
for(i in c(1:length(ram[[1]]))){
ret[paste(ram$atomic_symbol[i],ram$mass_number[i],sep="")]<-ram$relative_atomic_mass[i]
}
return(ret)
}
isotopicAbundance<-function(element="",A=getMassNumber(element)){
s<-getSymbol(element)
headers<-paste(s,A,sep="")
ret=rep(NA,length(headers))
names(ret)<-headers
ret[element==""]<-NA
ret[s==""]<-NA
ret[A==""]<-NA
ics<-getICS()
isos<-headers[headers%in%paste(ics$atomic_symbol,ics$mass_number,sep="")]
ab<-subset(ics,subset=(paste(atomic_symbol,mass_number,sep="")%in%isos),
select=c("atomic_symbol","mass_number","isotopic_composition"))
if(length(ab)<1)return(NA)
for(i in c(1:length(ab[[1]]))){
ret[paste(ab$atomic_symbol[i],ab$mass_number[i],sep="")]<-ab$isotopic_composition[i]
}
return(ret)
}
standardAtomicWeight<-function(element=""){
s<-getSymbol(element)
headers<-s
ret=rep(NA,length(headers))
names(ret)<-headers
ret[element==""]<-NULL
ics<-getICS()
actuals<-headers[headers%in%ics$atomic_symbol]
wts<-subset(ics,subset=atomic_symbol%in%s,select=c("atomic_symbol","standard_atomic_weight"))
for(i in c(1:length(ret))){
if(headers[i]%in%actuals)ret[i]<-wts$standard_atomic_weight[wts$atomic_symbol==headers[i]][1]
}
return(ret)
}
getSymbol<-function(isotope){
idx<-regexpr("[[:alpha:]]+",isotope)
s<-substr(isotope,idx,idx+attr(idx,"match.length")-1)
return(s)
}
getMassNumber<-function(isotope){
idx<-regexpr("[[:digit:]]+",isotope)
a<-substr(isotope,idx,(idx+(attr(idx,"match.length")-1)))
# return(as.integer(a))
return(a)
}
getICS<-function(){
fn<-system.file("extdata/const_isotopic_composition.csv",package="GeoConst")
ics<-read.table(file=fn,header=TRUE,sep=",",
colClasses=c("integer","character","integer","numeric","numeric","numeric","NULL",
"logical","logical","logical","logical","logical","logical","logical","logical","logical","logical","logical"),
blank.lines.skip=FALSE)
return(ics)
}
getNIST612<-function(){
fn<-system.file("extdata/NIST_SRM612_GeoREM.csv",package="GeoConst")
nist612<-read.table(file=fn,header=TRUE,sep=",",
colClasses=c("character","numeric","numeric","character","character"),
blank.lines.skip=FALSE)
return(nist612)
}
get612conc<-function(element){
s<-getSymbol(element)
headers<-s
ret=rep(NA,length(headers))
names(ret)<-headers
ret[s==""]<-NA
n612<-getNIST612()
actuals<-headers[headers%in%n612$Item]
conc<-subset(n612,subset=Item%in%s,select=c("Item","Value"))
# print(sprintf("requested: %s, returned: %s, %f",element,conc$Item,conc$Value))
for(i in c(1:length(ret))){
if(headers[i]%in%actuals)ret[i]<-conc$Value[conc$Item==headers[i]]
}
return(ret)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.