Clamix / Food

Cars

Food SR25 2012

The food data ara available at 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 paper (2002).

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 )

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 )