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:
- La columna asociada al attributo seleccionado
- 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:
se toma como entrada el dataset tennis
se agroupa por el attributo que corresponda y la classe Play
Se contabiliza y se crea un nuevo atributo de nombre total
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=