====== Clamix / Food ======
[[notes:da:data:cars|Cars]]
[[notes:da:data:sr25|Food SR25]] 2012
===== Encoding =====
The food data ara available at [[http://www.ars.usda.gov/Main/site_main.htm?modecode=12-35-45-00|USDA's National Nutrient Database for Standard Reference]]. The last (2012) version is SR25.
Here is partial encoding rule file for SR22 based on the rules for SR14 used in the [[http://vlado.fmf.uni-lj.si/pub/preprint/imfm0800.pdf|paper]] (2002).
{{:notes:zip:sr22.zip}}
encWater <- list(
"[0]" = function(x) x<=0,
"(0,5.65]" = function(x) x<=5.65,
"(5.65,29.5]" = function(x) x<=29.5,
"(29.5,53.9)" = function(x) x< 53.9,
"[53.9,62.4)" = function(x) x< 62.4,
"[62.4,70.75)" = function(x) x< 70.75,
"[70.75,78.05]" = function(x) x<=78.05,
"(78.05,88)" = function(x) x< 88,
"[88,100]" = function(x) x<=100,
"NA" = function(x) TRUE )
encEnergKC <- list(
"[0]" = function(x) x<=0,
"(0,50]" = function(x) x<=50,
"(50,104]" = function(x) x<=104,
"(104,160]" = function(x) x<=160,
"(160,232]" = function(x) x<=232,
"(232,312]" = function(x) x<=312,
"(312,386]" = function(x) x<=386,
"(386,800)" = function(x) x< 800,
"[800,905]" = function(x) x<=905,
"NA" = function(x) TRUE )
encProtein <- list(
"[0]" = function(x) x<=0,
"(0,1.5]" = function(x) x<=1.5,
"(1.5,4.1]" = function(x) x<=4.1,
"(4.1,8.4)" = function(x) x< 8.4,
"[8.4,16]" = function(x) x<=16,
"(16,23.05)" = function(x) x< 23.05,
"[23.05,37]" = function(x) x<=37,
"(37,75)" = function(x) x< 75,
"[75,90]" = function(x) x<=90,
"NA" = function(x) TRUE )
encTotLipi <- list(
"[0]" = function(x) x<=0,
"(0,0.3]" = function(x) x<=0.3,
"(0.3,1.3)" = function(x) x< 1.3,
"[1.3,3.8)" = function(x) x< 3.8,
"[3.8,8)" = function(x) x< 8,
"[8,13.7)" = function(x) x< 13.7,
"[13.7,23.5)" = function(x) x< 23.5,
"[23.5,85)" = function(x) x< 85,
"[85,100]" = function(x) x<=100,
"NA" = function(x) TRUE )
encCarbohyd <- list(
"[0]" = function(x) x<=0,
"(0,3.5]" = function(x) x<=3.5,
"(3.5,6.85]" = function(x) x<=6.85,
"(6.85,11.35]" = function(x) x<=11.35,
"(11.35,18.1)" = function(x) x< 18.1,
"[18.1,27.8]" = function(x) x<=27.8,
"(27.8,55.1]" = function(x) x<=55.1,
"(55.1,73]" = function(x) x<=73,
"(73,100]" = function(x) x<=100,
"NA" = function(x) TRUE )
encFiberTd <- list(
"[0]" = function(x) x<=0,
"(0,0.8]" = function(x) x<=0.8,
"(0.8,1.5]" = function(x) x<=1.5,
"(1.5,2.1]" = function(x) x<=2.1,
"(2.1,3.1]" = function(x) x<=3.1,
"(3.1,5.6]" = function(x) x<=5.6,
"(5.6,35]" = function(x) x<=35,
"(35,60]" = function(x) x<=60,
"(60,90]" = function(x) x<=90,
"NA" = function(x) TRUE )
encAsh <- list(
"[0]" = function(x) x<=0,
"(0,0.7)" = function(x) x< 0.7,
"[0.7,1)" = function(x) x< 1,
"[1,1.24)" = function(x) x< 1.24,
"[1.24,1.75)" = function(x) x< 1.75,
"[1.75,3)" = function(x) x< 3,
"[3,45)" = function(x) x< 45,
"[45,95)" = function(x) x< 95,
"[95,100]" = function(x) x<=100,
"NA" = function(x) TRUE )
encCalcium <- list(
"[0]" = function(x) x<=0,
"(0,7]" = function(x) x<=7,
"(7,12]" = function(x) x<=12,
"(12,20]" = function(x) x<=20,
"(20,34]" = function(x) x<=34,
"(34,69]" = function(x) x<=69,
"(69,159]" = function(x) x<=159,
"(159,3000]" = function(x) x<=3000,
"(3000,7400]" = function(x) x<=7400,
"NA" = function(x) TRUE )
encPhosphor <- list(
"[0]" = function(x) x<=0,
"(0,25)" = function(x) x< 25,
"[25,60)" = function(x) x< 60,
"[60,112)" = function(x) x< 112,
"[112,172)" = function(x) x< 172,
"[172,208)" = function(x) x< 208,
"[208,268)" = function(x) x< 268,
"[268,6000)" = function(x) x< 6000,
"[6000,10000]" = function(x) x<=10000,
"NA" = function(x) TRUE )
encIron <- list(
"[0]" = function(x) x<=0,
"(0,0.35]" = function(x) x<=0.35,
"(0.35,0.75]" = function(x) x<=0.75,
"(0.75,1.2]" = function(x) x<=1.2,
"(1.2,1.8]" = function(x) x<=1.8,
"(1.8,2.5]" = function(x) x<=2.5,
"(2.5,3.85]" = function(x) x<=3.85,
"(3.85,80]" = function(x) x<=80,
"(80,125]" = function(x) x<=125,
"NA" = function(x) TRUE )
encSodium <- list(
"[0]" = function(x) x<=0,
"(0,10)" = function(x) x< 10,
"[10,50)" = function(x) x< 50,
"[50,66)" = function(x) x< 66,
"[66,121)" = function(x) x< 121,
"[121,351)" = function(x) x< 351,
"[351,655)" = function(x) x< 655,
"[655,15000)" = function(x) x< 15000,
"[15000,30000]" = function(x) x<=30000,
"NA" = function(x) TRUE )
encPotassium <- list(
"[0]" = function(x) x<=0,
"(0,90)" = function(x) x< 90,
"[90,147)" = function(x) x< 147,
"[147,211)" = function(x) x< 211,
"[211,281)" = function(x) x< 281,
"[281,340)" = function(x) x< 340,
"[340,426)" = function(x) x< 426,
"[426,6000)" = function(x) x< 6000,
"[6000,17000]" = function(x) x<=17000,
"NA" = function(x) TRUE )
encMagnesiu <- list(
"[0]" = function(x) x<=0,
"(0,9)" = function(x) x< 9,
"[9,16)" = function(x) x< 16,
"[16,21)" = function(x) x< 21,
"[21,25)" = function(x) x< 25,
"[25,32)" = function(x) x< 32,
"[32,65)" = function(x) x< 65,
"[65,600)" = function(x) x< 600,
"[600,900]" = function(x) x<=900,
"NA" = function(x) TRUE )
encZinc <- list(
"[0]" = function(x) x<=0,
"(0,0.23)" = function(x) x< 0.23,
"[0.23,0.53)" = function(x) x< 0.53,
"[0.53,1.06)" = function(x) x< 1.06,
"[1.06,2.23)" = function(x) x< 2.23,
"[2.23,4.12)" = function(x) x< 4.12,
"[4.12,20)" = function(x) x< 20,
"[20,150)" = function(x) x< 150,
"[150,200]" = function(x) x<=200,
"NA" = function(x) TRUE )
encCopper <- list(
"[0]" = function(x) x<=0,
"(0,0.045)" = function(x) x< 0.045,
"[0.045,0.071)" = function(x) x< 0.071,
"[0.071,0.1)" = function(x) x< 0.1,
"[0.1,0.135)" = function(x) x< 0.135,
"[0.135,0.23)" = function(x) x< 0.23,
"[0.23,0.95)" = function(x) x< 0.95,
"[0.95,6.5)" = function(x) x< 6.5,
"[6.5,10]" = function(x) x<=10,
"NA" = function(x) TRUE )
encManganes <- list(
"[0]" = function(x) x<=0,
"(0,0.016)" = function(x) x< 0.016,
"[0.016,0.028)" = function(x) x< 0.028,
"[0.028,0.118)" = function(x) x< 0.118,
"[0.118,0.27)" = function(x) x< 0.27,
"[0.27,0.71)" = function(x) x< 0.71,
"[0.71,10)" = function(x) x< 10,
"[10,70)" = function(x) x< 70,
"[70,80]" = function(x) x<=80,
"NA" = function(x) TRUE )
encSelenium <- list(
"[0]" = function(x) x<=0,
"(0,0.8)" = function(x) x< 0.8,
"[0.8,3)" = function(x) x< 3,
"[3,11]" = function(x) x<=11,
"(11,20)" = function(x) x< 20,
"[20,28.5)" = function(x) x< 28.5,
"[28.5,160)" = function(x) x< 160,
"[160,1500)" = function(x) x< 1500,
"[1500,3000]" = function(x) x<=3000,
"NA" = function(x) TRUE )
encVitA <- list(
"[0]" = function(x) x<=0,
"(0,15]" = function(x) x<=15,
"(15,52]" = function(x) x<=52,
"(52,118]" = function(x) x<=118,
"(118,230]" = function(x) x<=230,
"(230,560]" = function(x) x<=560,
"(560,1800]" = function(x) x<=1800,
"(1800,50000]" = function(x) x<=50000,
"(50000,100000]"= function(x) x<=100000,
"NA" = function(x) TRUE )
encVitE <- list(
"[0]" = function(x) x<=0,
"(0,0.13)" = function(x) x< 0.13,
"[0.13,0.2]" = function(x) x<=0.2,
"(0.2,0.3]" = function(x) x<=0.3,
"(0.3,0.63]" = function(x) x<=0.63,
"(0.63,1.5]" = function(x) x<=1.5,
"(1.5,20)" = function(x) x< 20,
"[20,190]" = function(x) x<=190,
"(190,195]" = function(x) x<=195,
"NA" = function(x) TRUE )
encThiamin <- list(
"[0]" = function(x) x<=0,
"(0,0.025]" = function(x) x<=0.025,
"(0.025,0.05]" = function(x) x<=0.05,
"(0.05,0.08)" = function(x) x<=0.08,
"[0.08,0.105]" = function(x) x<=0.105,
"(0.105,0.19)" = function(x) x< 0.19,
"[0.19,0.42)" = function(x) x< 0.42,
"[0.42,8)" = function(x) x< 8,
"[8,15]" = function(x) x<=15,
"NA" = function(x) TRUE )
encRibolfla <- list(
"[0]" = function(x) x<=0,
"(0,0.036]" = function(x) x<=0.036,
"(0.036,0.076]" = function(x) x<=0.076,
"(0.076,0.14)" = function(x) x< 0.14,
"[0.14,0.192)" = function(x) x< 0.192,
"[0.192,0.25]" = function(x) x<=0.25,
"(0.25,0.36]" = function(x) x<=0.36,
"(0.36,5]" = function(x) x<=5,
"(5,7]" = function(x) x<=7,
"NA" = function(x) TRUE )
encNiacin <- list(
"[0]" = function(x) x<=0,
"(0,0.35]" = function(x) x<=0.35,
"(0.35,0.93)" = function(x) x< 0.93,
"[0.93,2.26)" = function(x) x< 2.26,
"[2.26,3.75]" = function(x) x<=3.75,
"(3.75,5.41]" = function(x) x<=5.41,
"(5.41,25]" = function(x) x<=25,
"(25,60)" = function(x) x< 60,
"[60,80]" = function(x) x<=80,
"NA" = function(x) TRUE )
encPantoAc <- list(
"[0]" = function(x) x<=0,
"(0,0.125)" = function(x) x< 0.125,
"[0.125,0.27)" = function(x) x< 0.27,
"[0.27,0.36]" = function(x) x<=0.36,
"(0.36,0.53]" = function(x) x<=0.53,
"(0.53,0.83)" = function(x) x< 0.83,
"[0.83,15)" = function(x) x< 15,
"[15,30)" = function(x) x< 30,
"[30,40]" = function(x) x<=40,
"NA" = function(x) TRUE )
encVitB6 <- list(
"[0]" = function(x) x<=0,
"(0,0.037]" = function(x) x<=0.037,
"(0.037,0.07]" = function(x) x<=0.07,
"(0.07,0.12]" = function(x) x<=0.12,
"(0.12,0.215]" = function(x) x<=0.215,
"(0.215,0.33]" = function(x) x<=0.33,
"(0.33,0.43]" = function(x) x<=0.43,
"(0.43,5)" = function(x) x< 5,
"[5,8]" = function(x) x<=8,
"NA" = function(x) TRUE )
encFolate <- list(
"[0]" = function(x) x<=0,
"(0,5)" = function(x) x< 5,
"[5,8)" = function(x) x< 8,
"[8,12)" = function(x) x< 12,
"[12,23)" = function(x) x< 23,
"[23,48)" = function(x) x< 48,
"[48,115)" = function(x) x< 115,
"[115,1000)" = function(x) x< 1000,
"[1000,2350]" = function(x) x<=2350,
"NA" = function(x) TRUE )
encVitB12 <- list(
"[0]" = function(x) x<=0,
"(0,0.12]" = function(x) x<=0.12,
"(0.12,0.3]" = function(x) x<=0.3,
"(0.3,0.6]" = function(x) x<=0.6,
"(0.6,1.4]" = function(x) x<=1.4,
"(1.4,2.47]" = function(x) x<=2.47,
"(2.47,3)" = function(x) x< 3,
"[3,60)" = function(x) x< 60,
"[60,120]" = function(x) x<=120,
"NA" = function(x) TRUE )
encVitC <- list(
"[0]" = function(x) x<=0,
"(0,0.5)" = function(x) x< 0.5,
"[0.5,1]" = function(x) x<=1,
"(1,2.5)" = function(x) x< 2.5,
"[2.5,6)" = function(x) x< 6,
"[6,13.5)" = function(x) x< 13.5,
"[13.5,34)" = function(x) x< 34,
"[34,1500)" = function(x) x< 1500,
"[1500,2400]" = function(x) x<=2400,
"NA" = function(x) TRUE )
encFaSat <- list(
"[0]" = function(x) x<=0,
"(0,0.054)" = function(x) x< 0.054,
"[0.054,0.29)" = function(x) x< 0.29,
"[0.29,1.08)" = function(x) x< 1.08,
"[1.08,2.4)" = function(x) x< 2.4,
"[2.4,4.3]" = function(x) x<=4.3,
"(4.3,7.9]" = function(x) x<=7.9,
"(7.9,80)" = function(x) x< 80,
"[80,100]" = function(x) x<=100,
"NA" = function(x) TRUE )
encFaMono <- list(
"[0]" = function(x) x<=0,
"(0,0.035]" = function(x) x<=0.035,
"(0.035,0.3]" = function(x) x<=0.3,
"(0.3,1.25)" = function(x) x< 1.25,
"[1.25,3]" = function(x) x<=3,
"(3,5.6)" = function(x) x< 5.6,
"[5.6,9.5)" = function(x) x< 9.5,
"[9.5,65)" = function(x) x< 65,
"[65,85]" = function(x) x<=85,
"NA" = function(x) TRUE )
encFaPoly <- list(
"[0]" = function(x) x<=0,
"(0,0.115]" = function(x) x<=0.115,
"(0.115,0.335]" = function(x) x<=0.335,
"(0.335,0.685]" = function(x) x<=0.685,
"(0.685,1.23)" = function(x) x< 1.23,
"[1.23,2.73)" = function(x) x< 2.73,
"[2.73,40)" = function(x) x< 40,
"[40,60)" = function(x) x< 60,
"[60,75]" = function(x) x<=75,
"NA" = function(x) TRUE )
encCholestr <- list(
"[0]" = function(x) x<=0,
"(0,12]" = function(x) x<=12,
"(12,45]" = function(x) x<=45,
"(45,66]" = function(x) x<=66,
"(66,80]" = function(x) x<=80,
"(80,94]" = function(x) x<=94,
"(94,550]" = function(x) x<=550,
"(550,1900]" = function(x) x<=1900,
"(1900,3100]" = function(x) x<=3100,
"NA" = function(x) TRUE )
===== Automatic generation of rules =====
The function ''makeEnc'' prints the definition of encoding function. We copy it and
paste to R or to the encoding rules file:
makeEnc <- function(var,name,k){
n <- length(var)
v <- sort(var)
steps <- seq.int(0,n,n %/% (k-1))
cuts <- c(0,v[steps[1:(k-1)]],max(v))
cat("enc",name," <- list(\n",sep="")
cat(' "[0]" = function(x) x<=0,\n')
for(j in 2:k) cat(' "(',cuts[j-1],',',cuts[j],']" = function(x) x<=',cuts[j],',\n',sep='')
cat(' "NA" = function(x) TRUE )\n')
}
> makeEnc(water,"Water",8)
encWater <- list(
"[0]" = function(x) x<=0,
"(0,6.43]" = function(x) x<=6.43,
"(6.43,43.05]" = function(x) x<=43.05,
"(43.05,59.79]" = function(x) x<=59.79,
"(59.79,68.81]" = function(x) x<=68.81,
"(68.81,77.08]" = function(x) x<=77.08,
"(77.08,87.3]" = function(x) x<=87.3,
"(87.3,100]" = function(x) x<=100,
"NA" = function(x) TRUE )