R/accessConst.R

Defines functions relativeAtomicMass isotopicAbundance standardAtomicWeight getSymbol getMassNumber getICS getNIST612 get612conc

Documented in get612conc getICS getMassNumber getNIST612 getSymbol isotopicAbundance relativeAtomicMass standardAtomicWeight

# 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)
}

Try the GeoConst package in your browser

Any scripts or data that you put into this service are public.

GeoConst documentation built on May 2, 2019, 5:57 p.m.