library(data.tree)
tennis=read.csv(file="../data/04PlayTennis.csv")

Early optimization is the root of all evil

Donald E. Knuth

Problema

Dado un conjunto de datos (playtennis) con un numero de terminado de atributos (Outlook,Temp.,Humidity,Windy), se debe calcular cada uno de los valores posibles de cada atributo, el numero de veces que dicho valor esta asociado a cada valor posible de la clase (Play)

Para esto existen muchas maneras, se presentan algunas con distintos niveles de complejidad y eficiencia (desde el punto de vista del codigo)

1. Iterando sobre los atributos y los valores y contabilizando.

Para cada uno de los atributos feature se obtiene el conjunto de valores posibles unique(tennis[,feature]) y se calcula los casos donde ese valor estaba asociado a la clase con valor Yes y No. Para esto usamos dos funciones de R: which() y length(). La primera nos permite explicitar la condicion de busqueda y la segunda contabiliza los resultados.

features<-names(tennis)[-5]
for (feature in features){
  print("           Play")
  print(paste(feature,"Yes","No"))
  for (value in unique(tennis[,feature])){
    countyes<-length(which(tennis[,feature]==value & tennis[,"Play"]=="Yes"))
    countno<-length(which(tennis[,feature]==value & tennis[,"Play"]=="No"))
    print(paste(value,countyes,countno))
  }
}
[1] "           Play"
[1] "Outlook Yes No"
[1] "Sunny 2 3"
[1] "Overcast 4 0"
[1] "Rainy 3 2"
[1] "           Play"
[1] "Temp. Yes No"
[1] "Hot 2 2"
[1] "Mild 4 2"
[1] "Cool 3 1"
[1] "           Play"
[1] "Humidity Yes No"
[1] "High 3 4"
[1] "Normal 6 1"
[1] "           Play"
[1] "Windy Yes No"
[1] "False 6 2"
[1] "True 3 3"

2. Iterando sobre los attributos y usando la funcion table().

La funcion de R table() permita construir Tablas de contingencias donde se contabiliza las ocurrencias de cada combinacion de los elementos incluidos en dicha tabla.

En este caso, se recorre cada unos de los attributos del conjunto playtennis y se crea una tabla con solamente 2 columans:

  1. La columna asociada al attributo seleccionado
  2. La columna asociada a la clase

La funcion table() se encarga de contabiliza de cada uno de las posibilidades.

for (attr in features) 
  print(table(tennis[,c(attr,"Play")]))
          Play
Outlook    No Yes
  Overcast  0   4
  Rainy     2   3
  Sunny     3   2
      Play
Temp.  No Yes
  Cool  1   3
  Hot   2   2
  Mild  2   4
        Play
Humidity No Yes
  High    4   3
  Normal  1   6
       Play
Windy   No Yes
  False  2   6
  True   3   3

3. Iterando sobre los attributos y usando los pipes dplyr (parte del tidyverse).

El secuencia de comandos (pipeline) es la siguiente:

  1. se toma como entrada el dataset tennis

  2. se agroupa por el attributo que corresponda y la classe Play

  3. Se contabiliza y se crea un nuevo atributo de nombre total

  4. Del nuevo dataframe se redistribuyen los valores de la columna Play como nuevas columnas (yes,no) y se coloca el valor de total

library(dplyr)
for (attr in features){ 
  t<-tennis %>% group_by_(attr,"Play") %>% summarise(total=n())  %>% spread_("Play","total",fill=0)
  print(t,zero.print=".")
}
LS0tCnRpdGxlOiAiSUQzIChiYXNlZCBvbiBEYXRhLnRyZWUgdmlnbmV0dGUpIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCmBgYHtyfQpsaWJyYXJ5KGRhdGEudHJlZSkKdGVubmlzPXJlYWQuY3N2KGZpbGU9Ii4uL2RhdGEvMDRQbGF5VGVubmlzLmNzdiIpCmBgYAoKRWFybHkgb3B0aW1pemF0aW9uIGlzIHRoZSByb290IG9mIGFsbCBldmlsCgotLSA8Y2l0ZT5Eb25hbGQgRS4gS251dGg8L2NpdGU+CgojIyBQcm9ibGVtYQpEYWRvIHVuIGNvbmp1bnRvIGRlIGRhdG9zIChwbGF5dGVubmlzKSBjb24gdW4gbnVtZXJvIGRlIHRlcm1pbmFkbyBkZSBhdHJpYnV0b3MgKE91dGxvb2ssVGVtcC4sSHVtaWRpdHksV2luZHkpLCBzZSBkZWJlIGNhbGN1bGFyIGNhZGEgdW5vIGRlIGxvcyB2YWxvcmVzIHBvc2libGVzIGRlIGNhZGEgYXRyaWJ1dG8sICBlbCBudW1lcm8gZGUgdmVjZXMgcXVlIGRpY2hvIHZhbG9yIGVzdGEgYXNvY2lhZG8gYSBjYWRhIHZhbG9yIHBvc2libGUgZGUgbGEgY2xhc2UgKFBsYXkpIAoKUGFyYSBlc3RvIGV4aXN0ZW4gbXVjaGFzIG1hbmVyYXMsIHNlIHByZXNlbnRhbiBhbGd1bmFzIGNvbiBkaXN0aW50b3Mgbml2ZWxlcyBkZSBjb21wbGVqaWRhZCB5IGVmaWNpZW5jaWEgKGRlc2RlIGVsIHB1bnRvIGRlIHZpc3RhIGRlbCBjb2RpZ28pCgojIyMgMS4gSXRlcmFuZG8gc29icmUgbG9zIGF0cmlidXRvcyB5IGxvcyB2YWxvcmVzIHkgY29udGFiaWxpemFuZG8uCgpQYXJhIGNhZGEgdW5vIGRlIGxvcyBhdHJpYnV0b3MgKipmZWF0dXJlKiogc2Ugb2J0aWVuZSBlbCBjb25qdW50byBkZSB2YWxvcmVzIHBvc2libGVzICoqdW5pcXVlKHRlbm5pc1ssZmVhdHVyZV0pKiogeSBzZSBjYWxjdWxhIGxvcyBjYXNvcyBkb25kZSBlc2UgdmFsb3IgZXN0YWJhIGFzb2NpYWRvIGEgbGEgY2xhc2UgY29uIHZhbG9yICoqWWVzKiogeSAqKk5vKiouIFBhcmEgZXN0byB1c2Ftb3MgZG9zIGZ1bmNpb25lcyBkZSBSOiAqd2hpY2goKSogeSAqbGVuZ3RoKCkqLiBMYSBwcmltZXJhIG5vcyBwZXJtaXRlIGV4cGxpY2l0YXIgbGEgY29uZGljaW9uIGRlIGJ1c3F1ZWRhIHkgbGEgc2VndW5kYSBjb250YWJpbGl6YSBsb3MgcmVzdWx0YWRvcy4KCmBgYHtyfQpmZWF0dXJlczwtbmFtZXModGVubmlzKVstNV0KCmZvciAoZmVhdHVyZSBpbiBmZWF0dXJlcyl7CiAgcHJpbnQoIiAgICAgICAgICAgUGxheSIpCiAgcHJpbnQocGFzdGUoZmVhdHVyZSwiWWVzIiwiTm8iKSkKICBmb3IgKHZhbHVlIGluIHVuaXF1ZSh0ZW5uaXNbLGZlYXR1cmVdKSl7CiAgICBjb3VudHllczwtbGVuZ3RoKHdoaWNoKHRlbm5pc1ssZmVhdHVyZV09PXZhbHVlICYgdGVubmlzWywiUGxheSJdPT0iWWVzIikpCiAgICBjb3VudG5vPC1sZW5ndGgod2hpY2godGVubmlzWyxmZWF0dXJlXT09dmFsdWUgJiB0ZW5uaXNbLCJQbGF5Il09PSJObyIpKQogICAgcHJpbnQocGFzdGUodmFsdWUsY291bnR5ZXMsY291bnRubykpCiAgfQp9CmBgYAoKIyMjIDIuIEl0ZXJhbmRvIHNvYnJlIGxvcyBhdHRyaWJ1dG9zIHkgdXNhbmRvIGxhIGZ1bmNpb24gdGFibGUoKS4KCkxhIGZ1bmNpb24gZGUgUiAqdGFibGUoKSogcGVybWl0YSBjb25zdHJ1aXIgKipUYWJsYXMgZGUgY29udGluZ2VuY2lhcyoqIGRvbmRlIHNlIGNvbnRhYmlsaXphIGxhcyBvY3VycmVuY2lhcyBkZSBjYWRhIGNvbWJpbmFjaW9uIGRlIGxvcyBlbGVtZW50b3MgaW5jbHVpZG9zIGVuIGRpY2hhIHRhYmxhLgoKRW4gZXN0ZSBjYXNvLCBzZSByZWNvcnJlIGNhZGEgdW5vcyBkZSBsb3MgYXR0cmlidXRvcyBkZWwgY29uanVudG8gKipwbGF5dGVubmlzKiogeSBzZSBjcmVhIHVuYSB0YWJsYSBjb24gc29sYW1lbnRlIDIgY29sdW1hbnM6IAoKMS4gTGEgY29sdW1uYSBhc29jaWFkYSBhbCBhdHRyaWJ1dG8gc2VsZWNjaW9uYWRvCjIuIExhIGNvbHVtbmEgYXNvY2lhZGEgYSBsYSBjbGFzZQoKTGEgZnVuY2lvbiAqdGFibGUoKSogc2UgZW5jYXJnYSBkZSBjb250YWJpbGl6YSBkZSBjYWRhIHVubyBkZSBsYXMgcG9zaWJpbGlkYWRlcy4KCmBgYHtyfQpmb3IgKGZlYXR1cmUgaW4gZmVhdHVyZXMpIAogIHByaW50KHRhYmxlKHRlbm5pc1ssYyhmZWF0dXJlLCJQbGF5IildKSkKYGBgCgojIyMgMy4gSXRlcmFuZG8gc29icmUgbG9zIGF0dHJpYnV0b3MgeSB1c2FuZG8gbG9zIHBpcGVzIGRwbHlyIChwYXJ0ZSBkZWwgdGlkeXZlcnNlKS4KRWwgc2VjdWVuY2lhIGRlIGNvbWFuZG9zIChwaXBlbGluZSkgZXMgbGEgc2lndWllbnRlOgoKMS4gc2UgdG9tYSBjb21vIGVudHJhZGEgZWwgZGF0YXNldCAqKnRlbm5pcyoqCgoyLiBzZSBhZ3JvdXBhIHBvciBlbCBhdHRyaWJ1dG8gcXVlIGNvcnJlc3BvbmRhIHkgbGEgY2xhc3NlICoqUGxheSoqCgozLiBTZSBjb250YWJpbGl6YSB5IHNlIGNyZWEgdW4gbnVldm8gYXRyaWJ1dG8gZGUgbm9tYnJlICoqdG90YWwqKgoKNC4gRGVsIG51ZXZvIGRhdGFmcmFtZSBzZSByZWRpc3RyaWJ1eWVuIGxvcyB2YWxvcmVzIGRlIGxhIGNvbHVtbmEgKipQbGF5KiogY29tbyBudWV2YXMgY29sdW1uYXMgKHllcyxubykgeSBzZSBjb2xvY2EgZWwgdmFsb3IgZGUgKip0b3RhbCoqCgpgYGB7ciBkcGx5ciwgcmVzdWx0cz0idGV4dCJ9CmxpYnJhcnkoZHBseXIpCmZvciAoZmVhdHVyZSBpbiBmZWF0dXJlcyl7IAogIHQ8LXRlbm5pcyAlPiUgZ3JvdXBfYnlfKGZlYXR1cmUsIlBsYXkiKSAlPiUgc3VtbWFyaXNlKHRvdGFsPW4oKSkgICU+JSBzcHJlYWRfKCJQbGF5IiwidG90YWwiLGZpbGw9MCkKICBwcmludCh0KQp9CmBgYAoKCmBgYHtyIGlzcHVyZSwgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KSXNQdXJlIDwtIGZ1bmN0aW9uKGRhdGEpIHsKICBsZW5ndGgodW5pcXVlKGRhdGFbLG5jb2woZGF0YSldKSkgPT0gMQp9CmBgYAoKYGBge3IgZW50cm9weSwgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KRW50cm9weSA8LSBmdW5jdGlvbiggdmxzICkgewogIHJlcyA8LSB2bHMvc3VtKHZscykgKiBsb2cyKHZscy9zdW0odmxzKSkKICByZXNbdmxzID09IDBdIDwtIDAKICAtc3VtKHJlcykKfQpgYGAKCmBgYHtyLCBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQpFbnRyb3B5KGMoMTAsMCkpCmBgYAoKCgpgYGB7ciwgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KSW5mb3JtYXRpb25HYWluIDwtIGZ1bmN0aW9uKCB0YmxlICkgewogIHRibGUgPC0gYXMuZGF0YS5mcmFtZS5tYXRyaXgodGJsZSkKICBlbnRyb3B5QmVmb3JlIDwtIEVudHJvcHkoY29sU3Vtcyh0YmxlKSkKICBzIDwtIHJvd1N1bXModGJsZSkKICBlbnRyb3B5QWZ0ZXIgPC0gc3VtIChzIC8gc3VtKHMpICogYXBwbHkodGJsZSwgTUFSR0lOID0gMSwgRlVOID0gRW50cm9weSApKQogIGluZm9ybWF0aW9uR2FpbiA8LSBlbnRyb3B5QmVmb3JlIC0gZW50cm9weUFmdGVyCiAgcmV0dXJuIChpbmZvcm1hdGlvbkdhaW4pCn0KYGBgCgoKYGBge3IsIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CmRhdGEoIm11c2hyb29tIikKYGBgCgpgYGB7ciB0cmFpbklEMywgZXZhbD1GQUxTRSwgaW5jbHVkZT1GQUxTRX0KVHJhaW5JRDMgPC0gZnVuY3Rpb24obm9kZSwgZGF0YSkgewogICAgCiAgbm9kZSRvYnNDb3VudCA8LSBucm93KGRhdGEpCiAgCiAgI2lmIHRoZSBkYXRhLXNldCBpcyBwdXJlIChlLmcuIGFsbCB0b3hpYyksIHRoZW4KICBpZiAoSXNQdXJlKGRhdGEpKSB7CiAgICAjY29uc3RydWN0IGEgbGVhZiBoYXZpbmcgdGhlIG5hbWUgb2YgdGhlIHB1cmUgZmVhdHVyZSAoZS5nLiAndG94aWMnKQogICAgY2hpbGQgPC0gbm9kZSRBZGRDaGlsZCh1bmlxdWUoZGF0YVssbmNvbChkYXRhKV0pKQogICAgbm9kZSRmZWF0dXJlIDwtIHRhaWwobmFtZXMoZGF0YSksIDEpCiAgICBjaGlsZCRvYnNDb3VudCA8LSBucm93KGRhdGEpCiAgICBjaGlsZCRmZWF0dXJlIDwtICcnCiAgfSBlbHNlIHsKICAgICNjaG9zZSB0aGUgZmVhdHVyZSB3aXRoIHRoZSBoaWdoZXN0IGluZm9ybWF0aW9uIGdhaW4gKGUuZy4gJ2NvbG9yJykKICAgIGlnIDwtIHNhcHBseShjb2xuYW1lcyhkYXRhKVstbmNvbChkYXRhKV0sIAogICAgICAgICAgICBmdW5jdGlvbih4KSBJbmZvcm1hdGlvbkdhaW4oCiAgICAgICAgICAgICAgdGFibGUoZGF0YVsseF0sIGRhdGFbLG5jb2woZGF0YSldKQogICAgICAgICAgICAgICkKICAgICAgICAgICAgKQogICAgZmVhdHVyZSA8LSBuYW1lcyhpZylbaWcgPT0gbWF4KGlnKV1bMV0KICAgIAogICAgbm9kZSRmZWF0dXJlIDwtIGZlYXR1cmUKICAgIAogICAgI3Rha2UgdGhlIHN1YnNldCBvZiB0aGUgZGF0YS1zZXQgaGF2aW5nIHRoYXQgZmVhdHVyZSB2YWx1ZQogICAgY2hpbGRPYnMgPC0gc3BsaXQoZGF0YVssIShuYW1lcyhkYXRhKSAlaW4lIGZlYXR1cmUpXSwgZGF0YVssZmVhdHVyZV0sIGRyb3AgPSBUUlVFKQogICAgCiAgICBmb3IoaSBpbiAxOmxlbmd0aChjaGlsZE9icykpIHsKICAgICAgI2NvbnN0cnVjdCBhIGNoaWxkIGhhdmluZyB0aGUgbmFtZSBvZiB0aGF0IGZlYXR1cmUgdmFsdWUgKGUuZy4gJ3JlZCcpCiAgICAgIGNoaWxkIDwtIG5vZGUkQWRkQ2hpbGQobmFtZXMoY2hpbGRPYnMpW2ldKQogICAgICAKICAgICAgI2NhbGwgdGhlIGFsZ29yaXRobSByZWN1cnNpdmVseSBvbiB0aGUgY2hpbGQgYW5kIHRoZSBzdWJzZXQgICAgICAKICAgICAgVHJhaW5JRDMoY2hpbGQsIGNoaWxkT2JzW1tpXV0pCiAgICB9CiAgICAKICB9Cn0KYGBgCgpgYGB7ciBwcmVkaWN0SUQzLCBldmFsPUZBTFNFLCBpbmNsdWRlPUZBTFNFfQpQcmVkaWN0IDwtIGZ1bmN0aW9uKHRyZWUsIGZlYXR1cmVzKSB7CiAgaWYgKHRyZWUkY2hpbGRyZW5bWzFdXSRpc0xlYWYpIHJldHVybiAodHJlZSRjaGlsZHJlbltbMV1dJG5hbWUpCiAgY2hpbGQgPC0gdHJlZSRjaGlsZHJlbltbZmVhdHVyZXNbW3RyZWUkZmVhdHVyZV1dXV0KICByZXR1cm4gKCBQcmVkaWN0KGNoaWxkLCBmZWF0dXJlcykpCn0KYGBgCgo=