library(dplyr)

#descripcion Generar una mano de poker y determinar cuantas veces se repite una mano

deck = c(14,14,14,14,13,13,13,13,12,12,12,12,11,11,11,11,10,10,10,10,9,9,9,9,8,8,8,8,7,7,7,7,6,6,6,6,5,5,5,5,4,4,4,4,3,3,3,3,2,2,2,2)

Determinamos la mano del poker

mano <- sample(deck,5,F)
mano
[1] 10  9 14  4  7

volvemos funcion el deck

hand_function <- function(startingdeck=8)
{
  grupo<-sample(deck[deck>=startingdeck],5,F)
  grupo_df<- tibble (index=1:5,grupo)
  return(grupo_df)
}

hand_function(8)

crearmos nuestro vector de manos

typehand<-function (x,indexnum,starting=8)
{
  
  
  grupo_df<- hand_function(starting)
  grupo_df%>% 
  group_by(grupo) %>% 
  summarise(n=n()) %>% 
  arrange(desc(n)) %>% 
  filter (n==indexnum) %>% 
  nrow() %>% return()
  
}

verificamos cuantas veces esta la mano

typehand(1,2,8)
[1] 2
prob_pares <- function(x,typeindex){
  out <- sapply(1:1000, typehand,indexnum=typeindex,starting=x)
  out<- sum(out>0)/1000
  return (out)
}
prob_pares(1,2)
[1] 0.484

#Pares empezando el deck desde 1 hasta 8

prob_vec<-lapply(1:8, prob_pares,typeindex=2)

plot(1:8, prob_vec, type='l')

#Trios

prob_vec<-lapply(1:8, prob_pares,typeindex=3)

plot(1:8, prob_vec, type='l')

#Poker

prob_vec<-lapply(1:10, prob_pares,typeindex=4)

plot(1:10, prob_vec, type='l')

Conclusion la probabilidad de sacar una mano se incrementa conforme el deck se hace mas pequeño, pero para el caso de poque y trio siempre es dificil y sus probabilidades son bajisimas

LS0tDQp0aXRsZTogIlIgUG9rZXIgaGFuZCBzaW11bGF0b3IiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KYGBge3J9DQpsaWJyYXJ5KGRwbHlyKQ0KYGBgDQojZGVzY3JpcGNpb24NCkdlbmVyYXIgdW5hIG1hbm8gZGUgcG9rZXIgeSBkZXRlcm1pbmFyIGN1YW50YXMgdmVjZXMgc2UgcmVwaXRlIHVuYSBtYW5vDQoNCmBgYHtyfQ0KZGVjayA9IGMoMTQsMTQsMTQsMTQsMTMsMTMsMTMsMTMsMTIsMTIsMTIsMTIsMTEsMTEsMTEsMTEsMTAsMTAsMTAsMTAsOSw5LDksOSw4LDgsOCw4LDcsNyw3LDcsNiw2LDYsNiw1LDUsNSw1LDQsNCw0LDQsMywzLDMsMywyLDIsMiwyKQ0KYGBgDQpEZXRlcm1pbmFtb3MgbGEgbWFubyBkZWwgcG9rZXINCg0KYGBge3J9DQptYW5vIDwtIHNhbXBsZShkZWNrLDUsRikNCm1hbm8NCmBgYA0KDQp2b2x2ZW1vcyBmdW5jaW9uIGVsIGRlY2sgIA0KYGBge3J9DQpoYW5kX2Z1bmN0aW9uIDwtIGZ1bmN0aW9uKHN0YXJ0aW5nZGVjaz04KQ0Kew0KICBncnVwbzwtc2FtcGxlKGRlY2tbZGVjaz49c3RhcnRpbmdkZWNrXSw1LEYpDQogIGdydXBvX2RmPC0gdGliYmxlIChpbmRleD0xOjUsZ3J1cG8pDQogIHJldHVybihncnVwb19kZikNCn0NCg0KaGFuZF9mdW5jdGlvbig4KQ0KYGBgDQpjcmVhcm1vcyBudWVzdHJvIHZlY3RvciBkZSBtYW5vcyANCg0KYGBge3J9DQp0eXBlaGFuZDwtZnVuY3Rpb24gKHgsaW5kZXhudW0sc3RhcnRpbmc9OCkNCnsNCiAgDQogIA0KICBncnVwb19kZjwtIGhhbmRfZnVuY3Rpb24oc3RhcnRpbmcpDQogIGdydXBvX2RmJT4lIA0KICBncm91cF9ieShncnVwbykgJT4lIA0KICBzdW1tYXJpc2Uobj1uKCkpICU+JSANCiAgYXJyYW5nZShkZXNjKG4pKSAlPiUgDQogIGZpbHRlciAobj09aW5kZXhudW0pICU+JSANCiAgbnJvdygpICU+JSByZXR1cm4oKQ0KICANCn0NCmBgYA0KDQp2ZXJpZmljYW1vcyBjdWFudGFzIHZlY2VzIGVzdGEgbGEgbWFubw0KDQpgYGB7cn0NCnR5cGVoYW5kKDEsMiw4KQ0KDQoNCmBgYA0KDQoNCmBgYHtyfQ0KcHJvYl9wYXJlcyA8LSBmdW5jdGlvbih4LHR5cGVpbmRleCl7DQogIG91dCA8LSBzYXBwbHkoMToxMDAwLCB0eXBlaGFuZCxpbmRleG51bT10eXBlaW5kZXgsc3RhcnRpbmc9eCkNCiAgb3V0PC0gc3VtKG91dD4wKS8xMDAwDQogIHJldHVybiAob3V0KQ0KfQ0KcHJvYl9wYXJlcygxLDIpDQoNCmBgYA0KI1BhcmVzIGVtcGV6YW5kbyBlbCBkZWNrIGRlc2RlIDEgaGFzdGEgOCAgDQpgYGB7cn0NCnByb2JfdmVjPC1sYXBwbHkoMTo4LCBwcm9iX3BhcmVzLHR5cGVpbmRleD0yKQ0KDQpwbG90KDE6OCwgcHJvYl92ZWMsIHR5cGU9J2wnKQ0KYGBgDQojVHJpb3MNCg0KYGBge3J9DQpwcm9iX3ZlYzwtbGFwcGx5KDE6OCwgcHJvYl9wYXJlcyx0eXBlaW5kZXg9MykNCg0KcGxvdCgxOjgsIHByb2JfdmVjLCB0eXBlPSdsJykNCmBgYA0KDQojUG9rZXINCg0KYGBge3J9DQpwcm9iX3ZlYzwtbGFwcGx5KDE6MTAsIHByb2JfcGFyZXMsdHlwZWluZGV4PTQpDQoNCnBsb3QoMToxMCwgcHJvYl92ZWMsIHR5cGU9J2wnKQ0KYGBgDQoNCg0KQ29uY2x1c2lvbiBsYSBwcm9iYWJpbGlkYWQgZGUgc2FjYXIgdW5hIG1hbm8gc2UgaW5jcmVtZW50YSBjb25mb3JtZSBlbCBkZWNrIHNlIGhhY2UgbWFzIHBlcXVlw7FvLCBwZXJvIHBhcmEgZWwgY2FzbyBkZSBwb3F1ZSB5IHRyaW8gc2llbXByZSBlcyBkaWZpY2lsIHkgc3VzIHByb2JhYmlsaWRhZGVzIHNvbiBiYWppc2ltYXMgDQo=