Ver video desde 13:02
setwd("~/clase_28_mayo_2020")
library(tidyverse)
library(GGally)
library(ggsci)
library(ggplot2)
library(gridExtra)
library(autoplotly)
library(ggmuller)
library(gapminder)
library(gganimate)
library(gifski)
library(av)
data('psychademic')
data('diamonds')
data('iris')
sets.de.datos <- list()
sets.de.datos[['sicoacademico']] <- psychademic
sets.de.datos[['diamantes']] <- diamonds
sets.de.datos[['flores']] <- iris
sets.de.datos$sicoacademico %>% head()
sets.de.datos$diamantes %>% head()
sets.de.datos$flores %>% head()
mi.set = sets.de.datos$sicoacademico
mi.set %>% class()
## [1] "data.frame"
mi.set %>% dim()
## [1] 600 8
mi.set %>% length()
## [1] 8
mi.set %>% head()
#mi.set %>% as.matrix()
mi.set %>% names()
## [1] "locus_of_control" "self_concept" "motivation" "read"
## [5] "write" "math" "science" "sex"
mi.set %>% rownames()
## [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"
## [13] "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24"
## [25] "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36"
## [37] "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48"
## [49] "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72"
## [73] "73" "74" "75" "76" "77" "78" "79" "80" "81" "82" "83" "84"
## [85] "85" "86" "87" "88" "89" "90" "91" "92" "93" "94" "95" "96"
## [97] "97" "98" "99" "100" "101" "102" "103" "104" "105" "106" "107" "108"
## [109] "109" "110" "111" "112" "113" "114" "115" "116" "117" "118" "119" "120"
## [121] "121" "122" "123" "124" "125" "126" "127" "128" "129" "130" "131" "132"
## [133] "133" "134" "135" "136" "137" "138" "139" "140" "141" "142" "143" "144"
## [145] "145" "146" "147" "148" "149" "150" "151" "152" "153" "154" "155" "156"
## [157] "157" "158" "159" "160" "161" "162" "163" "164" "165" "166" "167" "168"
## [169] "169" "170" "171" "172" "173" "174" "175" "176" "177" "178" "179" "180"
## [181] "181" "182" "183" "184" "185" "186" "187" "188" "189" "190" "191" "192"
## [193] "193" "194" "195" "196" "197" "198" "199" "200" "201" "202" "203" "204"
## [205] "205" "206" "207" "208" "209" "210" "211" "212" "213" "214" "215" "216"
## [217] "217" "218" "219" "220" "221" "222" "223" "224" "225" "226" "227" "228"
## [229] "229" "230" "231" "232" "233" "234" "235" "236" "237" "238" "239" "240"
## [241] "241" "242" "243" "244" "245" "246" "247" "248" "249" "250" "251" "252"
## [253] "253" "254" "255" "256" "257" "258" "259" "260" "261" "262" "263" "264"
## [265] "265" "266" "267" "268" "269" "270" "271" "272" "273" "274" "275" "276"
## [277] "277" "278" "279" "280" "281" "282" "283" "284" "285" "286" "287" "288"
## [289] "289" "290" "291" "292" "293" "294" "295" "296" "297" "298" "299" "300"
## [301] "301" "302" "303" "304" "305" "306" "307" "308" "309" "310" "311" "312"
## [313] "313" "314" "315" "316" "317" "318" "319" "320" "321" "322" "323" "324"
## [325] "325" "326" "327" "328" "329" "330" "331" "332" "333" "334" "335" "336"
## [337] "337" "338" "339" "340" "341" "342" "343" "344" "345" "346" "347" "348"
## [349] "349" "350" "351" "352" "353" "354" "355" "356" "357" "358" "359" "360"
## [361] "361" "362" "363" "364" "365" "366" "367" "368" "369" "370" "371" "372"
## [373] "373" "374" "375" "376" "377" "378" "379" "380" "381" "382" "383" "384"
## [385] "385" "386" "387" "388" "389" "390" "391" "392" "393" "394" "395" "396"
## [397] "397" "398" "399" "400" "401" "402" "403" "404" "405" "406" "407" "408"
## [409] "409" "410" "411" "412" "413" "414" "415" "416" "417" "418" "419" "420"
## [421] "421" "422" "423" "424" "425" "426" "427" "428" "429" "430" "431" "432"
## [433] "433" "434" "435" "436" "437" "438" "439" "440" "441" "442" "443" "444"
## [445] "445" "446" "447" "448" "449" "450" "451" "452" "453" "454" "455" "456"
## [457] "457" "458" "459" "460" "461" "462" "463" "464" "465" "466" "467" "468"
## [469] "469" "470" "471" "472" "473" "474" "475" "476" "477" "478" "479" "480"
## [481] "481" "482" "483" "484" "485" "486" "487" "488" "489" "490" "491" "492"
## [493] "493" "494" "495" "496" "497" "498" "499" "500" "501" "502" "503" "504"
## [505] "505" "506" "507" "508" "509" "510" "511" "512" "513" "514" "515" "516"
## [517] "517" "518" "519" "520" "521" "522" "523" "524" "525" "526" "527" "528"
## [529] "529" "530" "531" "532" "533" "534" "535" "536" "537" "538" "539" "540"
## [541] "541" "542" "543" "544" "545" "546" "547" "548" "549" "550" "551" "552"
## [553] "553" "554" "555" "556" "557" "558" "559" "560" "561" "562" "563" "564"
## [565] "565" "566" "567" "568" "569" "570" "571" "572" "573" "574" "575" "576"
## [577] "577" "578" "579" "580" "581" "582" "583" "584" "585" "586" "587" "588"
## [589] "589" "590" "591" "592" "593" "594" "595" "596" "597" "598" "599" "600"
mi.set %>% colnames()
## [1] "locus_of_control" "self_concept" "motivation" "read"
## [5] "write" "math" "science" "sex"
mi.set %>% attributes()
## $names
## [1] "locus_of_control" "self_concept" "motivation" "read"
## [5] "write" "math" "science" "sex"
##
## $row.names
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
## [91] 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
## [271] 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
## [289] 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306
## [307] 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
## [325] 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
## [343] 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
## [361] 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
## [379] 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
## [397] 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
## [415] 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432
## [433] 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
## [451] 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
## [469] 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
## [487] 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
## [505] 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
## [523] 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
## [541] 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
## [559] 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
## [577] 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594
## [595] 595 596 597 598 599 600
##
## $academic
## [1] "read" "write" "math" "science" "sex"
##
## $psychology
## [1] "locus_of_control" "self_concept" "motivation"
##
## $class
## [1] "data.frame"
mi.set %>% str()
## 'data.frame': 600 obs. of 8 variables:
## $ locus_of_control: num -0.84 -0.38 0.89 0.71 -0.64 1.11 0.06 -0.91 0.45 0 ...
## $ self_concept : num -0.24 -0.47 0.59 0.28 0.03 0.9 0.03 -0.59 0.03 0.03 ...
## $ motivation : chr "4" "3" "3" "3" ...
## $ read : num 54.8 62.7 60.6 62.7 41.6 62.7 41.6 44.2 62.7 62.7 ...
## $ write : num 64.5 43.7 56.7 56.7 46.3 64.5 39.1 39.1 51.5 64.5 ...
## $ math : num 44.5 44.7 70.5 54.7 38.4 61.4 56.3 46.3 54.4 38.3 ...
## $ science : num 52.6 52.6 58 58 36.3 58 45 36.3 49.8 55.8 ...
## $ sex : chr "female" "female" "male" "male" ...
## - attr(*, "academic")= chr "read" "write" "math" "science" ...
## - attr(*, "psychology")= chr "locus_of_control" "self_concept" "motivation"
mi.set %>% glimpse()
## Rows: 600
## Columns: 8
## $ locus_of_control <dbl> -0.84, -0.38, 0.89, 0.71, -0.64, 1.11, 0.06, -0.91, …
## $ self_concept <dbl> -0.24, -0.47, 0.59, 0.28, 0.03, 0.90, 0.03, -0.59, 0…
## $ motivation <chr> "4", "3", "3", "3", "4", "2", "3", "3", "4", "3", "2…
## $ read <dbl> 54.8, 62.7, 60.6, 62.7, 41.6, 62.7, 41.6, 44.2, 62.7…
## $ write <dbl> 64.5, 43.7, 56.7, 56.7, 46.3, 64.5, 39.1, 39.1, 51.5…
## $ math <dbl> 44.5, 44.7, 70.5, 54.7, 38.4, 61.4, 56.3, 46.3, 54.4…
## $ science <dbl> 52.6, 52.6, 58.0, 58.0, 36.3, 58.0, 45.0, 36.3, 49.8…
## $ sex <chr> "female", "female", "male", "male", "female", "femal…
mi.set %>% colnames() %>% class()
## [1] "character"
nombres.filas <- mi.set %>% rownames()
mi.set %>% colnames() -> nombres.columnas
nombres.columnas %>% str_replace_all('_',' ')
## [1] "locus of control" "self concept" "motivation" "read"
## [5] "write" "math" "science" "sex"
nombres.columnas %>%
str_replace_all(c("locus_of_control" = "control", "self_concept" = "consciencia", 'motivation'='motivación',
'read'='lectura','write'='escritura','math'='matemáticas', 'science'='ciencias', 'sex'='sexo')) -> nuevas.cols
colnames(mi.set) <- nuevas.cols
attr(mi.set, "psychology") <- nuevas.cols[c(1,2,3)]
attr(mi.set, "academic") <- nuevas.cols[c(4,5,6,7,8)]
attributes(mi.set)
## $names
## [1] "control" "consciencia" "motivación" "lectura" "escritura"
## [6] "matemáticas" "ciencias" "sexo"
##
## $row.names
## [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
## [19] 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
## [37] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
## [55] 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## [73] 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
## [91] 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
## [109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
## [127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
## [145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
## [163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
## [181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
## [199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
## [217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
## [235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
## [253] 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270
## [271] 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
## [289] 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306
## [307] 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
## [325] 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
## [343] 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
## [361] 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
## [379] 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
## [397] 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
## [415] 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432
## [433] 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
## [451] 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
## [469] 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
## [487] 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
## [505] 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
## [523] 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540
## [541] 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
## [559] 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
## [577] 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594
## [595] 595 596 597 598 599 600
##
## $academic
## [1] "lectura" "escritura" "matemáticas" "ciencias" "sexo"
##
## $psychology
## [1] "control" "consciencia" "motivación"
##
## $class
## [1] "data.frame"
mi.set$motivación <- as.factor(mi.set$motivación)
dp <- ggplot(mi.set, aes(x=motivación, y=matemáticas, fill=motivación)) +
geom_violin(trim=FALSE)+
geom_boxplot(width=0.1, fill="white")+
labs(title="Plot of length by dose",x="motivación", y = "ciencias")
dp + scale_fill_brewer(palette="Blues") + theme_classic()
psych_variables <- attr(mi.set, "psychology")
academic_variables <- attr(mi.set, "academic")
ggpairs(mi.set, academic_variables, title = "Within Academic Variables")
mi.set2 = sets.de.datos$diamantes
p1 <- ggplot(
subset(mi.set2, carat >= 2.2),
aes(x = table, y = price, colour = cut)
) +
geom_point(alpha = 0.7) +
geom_smooth(method = "loess", alpha = 0.05, size = 1, span = 1) +
theme_bw()
p2 <- ggplot(
subset(mi.set2, carat > 2.2 & depth > 55 & depth < 70),
aes(x = depth, fill = cut)
) +
geom_histogram(colour = "black", binwidth = 1, position = "dodge") +
theme_bw()
p1_lancet <- p1 + scale_color_lancet()
p2_lancet <- p2 + scale_fill_lancet()
grid.arrange(p1_lancet, p2_lancet, ncol = 2)
# Automatically generate interactive plot for results produced by `stats::prcomp`
p <- autoplotly(prcomp(iris[c(1, 2, 3, 4)]), data = iris,
colour = 'Species', label = TRUE, label.size = 3, frame = TRUE)
# You can apply additional ggplot2 elements to the generated interactive plot
p +
ggplot2::ggtitle("Principal Components Analysis") +
ggplot2::labs(y = "Second Principal Components", x = "First Principal Components")
# Or apply additional plotly elements to the generated interactive plot
p %>% plotly::layout(annotations = list(
text = "Example Text",
font = list(
family = "Courier New, monospace",
size = 18,
color = "black"),
x = 0,
y = 0,
showarrow = TRUE))
edges3 <- data.frame(Parent = paste0("clone_",
LETTERS[c(rep(1:3, each = 2), 2, 5)]),
Identity = paste0("clone_", LETTERS[2:9]))
# a function for generating exponential growth curves:
pop_seq <- function(gens, lambda, start_gen) c(rep(0, start_gen),
exp(lambda * gens[0:(length(gens) - start_gen)]))
lambda <- 0.1 # baseline fitness
gens <- 0:150 # time points
fitnesses <- c(1, 2, 2.2, 2.5, 3, 3.2, 3.5, 3.5, 3.8) # relative fitnesses of genotypes
pop3 <- data.frame(Generation = rep(gens, 9),
Identity = paste0("clone_", LETTERS[rep(1:9, each = length(gens))]),
Population = c(1E2 * pop_seq(gens, fitnesses[1]*lambda, 0),
pop_seq(gens, fitnesses[2]*lambda, 0),
pop_seq(gens, fitnesses[3]*lambda, 10),
pop_seq(gens, fitnesses[4]*lambda, 20),
pop_seq(gens, fitnesses[5]*lambda, 30),
pop_seq(gens, fitnesses[6]*lambda, 40),
pop_seq(gens, fitnesses[7]*lambda, 50),
pop_seq(gens, fitnesses[8]*lambda, 50),
pop_seq(gens, fitnesses[9]*lambda, 60)),
Fitness = rep(fitnesses, each = length(gens)))
Muller_df3 <- get_Muller_df(edges3, pop3)
Muller_plot(Muller_df3, add_legend = TRUE, xlab = "Time", ylab = "Proportion")
Muller_plot(Muller_df3, colour_by = "Fitness", add_legend = TRUE)
p <- ggplot(Muller_df3, aes(Generation,Population, size = Frequency , colour = Identity)) +
geom_point(alpha = 0.7, show.legend = T) +
scale_size(range = c(2, 12)) +
scale_y_log10() +
labs(title = 'Generation: {frame_time}', x = 'Generation', y = 'Population') +
transition_time(Generation) +
ease_aes('linear')
p
# Render and show the video
#q <- 2
#df <- animate(p, renderer = av_renderer('animation.mp4'), width = 720*q, height = 480*q, res = 72*q, fps = 25)
#utils::browseURL('animation.mp4')