-Dracarys.Rhistory

View(beta_spread_all)
View(top_topic_document)
View(top_terms_assignments)
View(top_terms)
View(top_document_topic)
word_counts %>% group_by(title) %>% count(word)
?summarise
word_counts %>% group_by(title) %>% summarize(word)
word_counts %>% group_by(title) %>% summarize(a = n(word))
word_counts %>% group_by(title) %>% summarize(word = n())
x <- word_counts %>% group_by(title) %>% summarize(word = n())
View(x)
doc_length <- word_counts %>% group_by(title) %>% summarize(word = n())
rm(x)
View(word_counts)
View(word_counts)
x <- word_counts %>% summarize(word = n())
x
View(x)
View(doc_length)
term.frequency <- word_counts %>% group_by(word) %>% summarize(word = n())
term.frequency <- word_counts %>% group_by(word) %>% summarize( n())
View(term.frequency)
term.frequency <- word_counts %>% group_by(word) %>% summarize(n())
phi <- beta_spread_all[ , 2:28] %>% as.matrix
theta <- gamma_df %>% as.matrix
vocab <- beta_spread_all[ , 1]
doc_length <- word_counts %>% group_by(title) %>% summarize(word = n())
term.frequency <- word_counts %>% group_by(word) %>% summarize(n())
createJSON(phi, theta, doc.length, vocab, term.frequency))
createJSON(phi, theta, doc.length, vocab, term.frequency)
doc.length <- word_counts %>% group_by(title) %>% summarize(word = n())
createJSON(phi, theta, doc.length, vocab, term.frequency)
library(topicmodels)
library(tidyverse)
library(topicmodels)
library(tidyverse)
library(tidytext)
library(readr)
library(lubridate)
library(LDAvis)
install.packages("LDAvis")
library(LDAvis)
library(corrplot)
install.packages("corrplot")
library(corrplot)
llis_df <- read_csv("~/OneDrive/GitHub/RCodeShare/data/llis.csv",
col_types = cols(LessonDate = col_date(format = "%m/%d/%y")))
llis_df <- read_csv("data/llis.csv",
col_types = cols(LessonDate = col_date(format = "%m/%d/%y")))
by_lesson <- llis_df %>%
transmute(lessonID = LessonId, title = Title, lesson = Lesson)
by_lesson_word <- by_lesson %>%
unnest_tokens(word, lesson)
word_counts <- by_lesson_word %>%
anti_join(stop_words) %>%
count(title, word, sort = TRUE) %>%
ungroup()
word_counts <- word_counts %>% arrange(word) %>% slice(-1:-1187)
View(word_counts)
lesson_dtm <- word_counts %>%
cast_dtm(title, word, n)
lesson_dtm
system.time(lesson_lda <- LDA(lesson_dtm, k = 27, control = list(seed = 0622)))
lesson_lda
lesson_topics <- tidy(lesson_lda, matrix = "beta")
lesson_topics
top_terms <- lesson_topics %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta)
top_terms
top_terms %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()
topic22_terms <- lesson_topics %>%
filter(topic == 22) %>%
arrange(topic, -beta) %>%
top_n(40, beta)
topic22_terms
llis_stop_words <- topic22_terms[1:27, 2]
llis_stop_words <- llis_stop_words %>%
rename(word = term) %>%
mutate(lexicon = rep("custom", 27))
my_stop_words <- bind_rows(stop_words, llis_stop_words)
tail(my_stop_words, 27)
word_counts <- word_counts %>%
anti_join(my_stop_words) %>%
count(title, word, sort = TRUE) %>%
ungroup()
lesson_dtm <- word_counts %>%
cast_dtm(title, word, n)
word_counts <- word_counts %>%
anti_join(my_stop_words) %>%
count(title, word, sort = TRUE) %>%
ungroup()
lesson_dtm <- word_counts %>%
cast_dtm(title, word, n)
lesson_dtm
system.time(lesson_lda <- LDA(lesson_dtm, k = 27, control = list(seed = 0622)))
lesson_lda
lesson_topics <- tidy(lesson_lda, matrix = "beta")
lesson_topics
top_terms <- lesson_topics %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta)
top_terms
top_terms %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()
lesson_gamma <- tidy(lesson_lda, matrix = "gamma")
lesson_gamma
top_document_topic <- lesson_gamma %>%
group_by(topic) %>%
top_n(5, gamma) %>%
ungroup() %>%
arrange(topic, -gamma)
top_document_topic
top_topic_document <- lesson_gamma %>%
group_by(document) %>%
top_n(1, gamma) %>%
ungroup() %>%
arrange(document, -topic)
top_topic_document
gamma_df <- tidy(posterior(lesson_lda)$topics)
lesson_assignments <- augment(lesson_lda, data = lesson_dtm)
lesson_assignments
top_terms_assignments <- lesson_assignments %>%
group_by(document) %>%
top_n(1, count) %>%
ungroup() %>%
arrange(.topic, -count)
top_terms_assignments
top_terms_assignments2 <- lesson_assignments %>%
group_by(term) %>%
top_n(1, count) %>%
ungroup() %>%
arrange(.topic, -count)
beta_spread_all <- lesson_topics %>%
#mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(`2` > .001 | `7` > .001) %>%
mutate(log_ratio = log2(`7`/`2`))
beta_spread_cor <- cor(beta_spread_all[2:28])
corrplot::corrplot(beta_spread_cor)
beta_spread2_7 <- lesson_topics %>%
filter(topic == 2 | topic == 7) %>%
mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(topic2 > .001 | topic7 > .001) %>%
mutate(log_ratio = log2(topic7/topic2))
beta_spread2_7
source('~/OneDrive/GitHub/NASAdatanauts/R/llis_topicModel.R', echo=TRUE)
library(topicmodels)
library(tidyverse)
library(tidytext)
library(readr)
library(lubridate)
library(LDAvis)
library(corrplot)
llis_df <- read_csv("~/OneDrive/GitHub/RCodeShare/data/llis.csv",
col_types = cols(LessonDate = col_date(format = "%m/%d/%y")))
#windows
llis_df <- read_csv("data/llis.csv",
col_types = cols(LessonDate = col_date(format = "%m/%d/%y")))
by_lesson <- llis_df %>%
transmute(lessonID = LessonId, title = Title, lesson = Lesson)
# split into words
by_lesson_word <- by_lesson %>%
unnest_tokens(word, lesson)
# find document-word counts and remove stop words
word_counts <- by_lesson_word %>%
anti_join(stop_words) %>%
count(title, word, sort = TRUE) %>%
ungroup()
word_counts <- word_counts %>% arrange(word) %>% slice(-1:-1187)
#########################################
# Do this after my_stop_words is created (see below)
word_counts <- word_counts %>%
anti_join(my_stop_words) %>%
count(title, word, sort = TRUE) %>%
ungroup()
######################################
lesson_dtm <- word_counts %>%
cast_dtm(title, word, n)
lesson_dtm
system.time(lesson_lda <- LDA(lesson_dtm, k = 27, control = list(seed = 0622)))
# user  system elapsed
# 74.078   0.408  75.550
lesson_lda
# we can examine per-topic-per-word probabilities (beta)
# For each combination, the model computes the probability of that term being
# generated from that topic.
lesson_topics <- tidy(lesson_lda, matrix = "beta")
lesson_topics
#We could use dplyr’s top_n() to find the top 5 terms within each topic.
top_terms <- lesson_topics %>%
group_by(topic) %>%
top_n(5, beta) %>%
ungroup() %>%
arrange(topic, -beta)
top_terms
top_terms %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()
#### Before we go further lets explore the terms
#### Create my_stop_words
# Thus, we may want to know which topics are associated with each document.
# We can find this by examining the per-document-per-topic probabilities, “gamma”.
lesson_gamma <- tidy(lesson_lda, matrix = "gamma")
lesson_gamma
# Each of these values is an estimated proportion of words from that document that
# are generated from that topic. For example, the model estimates that that each
# the first lesson has only a .0000612% probability of coming from topic 1
# top 5 documents in each topic
top_document_topic <- lesson_gamma %>%
group_by(topic) %>%
top_n(5, gamma) %>%
ungroup() %>%
arrange(topic, -gamma)
top_document_topic
# Gets the top topic for each document
top_topic_document <- lesson_gamma %>%
group_by(document) %>%
top_n(1, gamma) %>%
ungroup() %>%
arrange(document, -topic)
top_topic_document
##############################
lesson_gamma %>%
mutate(title = reorder(document, gamma * topic)) %>%
ggplot(aes(factor(topic), gamma)) +
geom_boxplot() +
facet_wrap(~ title)
###############################
# Creates a dataframe of the per-document-per-topic probabilities, “gamma”, of
# each topic for each document
gamma_df <- tidy(posterior(lesson_lda)$topics)
# One step of the LDA algorithm is assigning each word in each document to a topic.
# The more words in a document are assigned to that topic, generally, the more
# weight (gamma) will go on that document-topic classification.
#
# We may want to take the original document-word pairs and find which words in
# each document were assigned to which topic. This is the job of the augment()
# function, which also originated in the broom package as a way of tidying model
# output. While tidy() retrieves the statistical components of the model,
# augment() uses a model to add information to each observation in the original data.
lesson_assignments <- augment(lesson_lda, data = lesson_dtm)
lesson_assignments
top_terms_assignments <- lesson_assignments %>%
group_by(document) %>%
top_n(1, count) %>%
ungroup() %>%
arrange(.topic, -count)
top_terms_assignments
top_terms_assignments2 <- lesson_assignments %>%
group_by(term) %>%
top_n(1, count) %>%
ungroup() %>%
arrange(.topic, -count)
## To Do
## compare terms bewtwee the topics containing project as a top term
beta_spread_all <- lesson_topics %>%
#mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(`2` > .001 | `7` > .001) %>%
mutate(log_ratio = log2(`7`/`2`))
beta_spread_cor <- cor(beta_spread_all[2:28])
corrplot::corrplot(beta_spread_cor)
beta_spread2_7 <- lesson_topics %>%
filter(topic == 2 | topic == 7) %>%
mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(topic2 > .001 | topic7 > .001) %>%
mutate(log_ratio = log2(topic7/topic2))
beta_spread2_7
#beta_spread2_7 %>% select(term, topic2, topic7, log_ratio)
beta_spread2_7 %>%
group_by(direction = log_ratio > 0,
absratio = abs(log_ratio)) %>%
top_n(10, absratio) %>%
mutate(term = reorder(term, log_ratio)) %>%
ggplot(aes(term, log_ratio)) +
geom_col() +
labs(y = "Log2 ratio of beta in topic 7 / topic 2") +
coord_flip()
install.packages("sem")
install.packages("lavaan")
install.packages("lavaan.shiny")
install.packages("lavaan.survey")
install.packages("lavaanPlot")
install.packages("qgraph")
library(qgraph)
require("lavaan")
model <- '
# latent variable definitions
ind60 =~ x1 + x2 + x3
dem60 =~ y1 + y2 + y3 + y4
dem65 =~ y5 + equal("dem60=~y2")*y6
+ equal("dem60=~y3")*y7
+ equal("dem60=~y4")*y8
# regressions
dem60 ~ ind60
dem65 ~ ind60 + dem60
# residual correlations
y1 ~~ y5
y2 ~~ y4 + y6
y3 ~~ y7
y4 ~~ y8
y6 ~~ y8
'
fit <- sem(model, data=PoliticalDemocracy)
qgraph.lavaan(fit,layout="tree",vsize.man=5,vsize.lat=10,
filetype="",include=4,curve=-0.4,edge.label.cex=0.6)
qgraph.lavaan(fit,layout="tree",vsize.man=5,vsize.lat=10,
filetype="",include=8,curve=-0.4,edge.label.cex=0.6)
detach("package:qgraph", unload=TRUE)
library("sem", lib.loc="~/Library/R/3.4/library")
library("semPlot", lib.loc="~/Library/R/3.4/library")
install.packages("OpenMx")
library("semPlot", lib.loc="~/Library/R/3.4/library")
source('http://openmx.psyc.virginia.edu/getOpenMx.R')
library("sem", lib.loc="~/Library/R/3.4/library")
library("semPlot", lib.loc="~/Library/R/3.4/library")
X <- rnorm(100)y
X <- rnorm(100)
Y <- rnorm(100)
Z <- rnorm(1) * X + rnorm(1) * Y + rnorm(1) * X * Y
DF <- data.frame(X, Y, Z)
res <- lm(Z ~ X * Y, data = DF)
semPaths(res)
library("lavaan")
Data <- read.table("http://www.statmodel.com/usersguide/chap5/ex5.8.dat")
names(Data) <- c(paste("y", 1:6, sep = ""), paste("x", 1:3, sep = ""))
model.Lavaan <- "f1 =~ y1 + y2 + y3\nf2 =~ y4 + y5 + y6\nf1 + f2 ~ x1 + x2 + x3 "
library("lavaan")
fit <- lavaan:::cfa(model.Lavaan, data = Data, std.lv = TRUE)
semPaths(fit, title = FALSE, curvePivot = TRUE)
semPaths(fit, "std", edge.label.cex = 0.5, curvePivot = TRUE)
download.file("http://www.statmodel.com/usersguide/chap5/ex5.8.out", outfile <- tempfile(fileext = ".out"))
semPaths(outfile, intercepts = FALSE)
install.packages("MplusAutomation")
semPaths(outfile, intercepts = FALSE)
library("OpenMx")
data(demoOneFactor)  # load the demoOneFactor dataframe
manifests <- names(demoOneFactor)  # set the manifest to the 5 demo variables
library("OpenMx")
data()
setwd("E:/Users/David/OneDrive/GitHub/NASADatanauts/jamovi")
setwd("E:/Users/David/OneDrive/GitHub/NASADatanauts/jamovi/SEM")
jmvtools::create('SEM')
setwd("E:/Users/David/OneDrive/GitHub/NASADatanauts/jamovi")
jmvtools::create('SEM')
jmvtools::check(home="C:\\Program Files\\jamovi 0.7.5.2\\bin")
options(jamovi_home="C:\\Program Files\\jamovi 0.7.5.2\\bin")
jmvtools::create('SEM')
install.packages("semPlot")
setwd("E:/Users/David/OneDrive/GitHub/NASADatanauts/jamovi/SEM")
greet <- function(name) {}
rm(greet)
sample(5)
?quo
??quo
install.packages(c("git2r", "igraph", "OpenMx"))
quo(g1)
install.packages("dplyr", lib="/Library/Frameworks/R.framework/Versions/3.4/Resources/library")
library(rlang)
quo(g1)
df <- tibble(
g1 = c(1, 1, 2, 2, 2),
g2 = c(1, 2, 1, 2, 1),
a = sample(5),
b = sample(5)
)
library(tidyverse)
quo(g1)
df <- tibble(
g1 = c(1, 1, 2, 2, 2),
g2 = c(1, 2, 1, 2, 1),
a = sample(5),
b = sample(5)
)
my_summarise <- function(df, group_by) {
group_by <- enquo(group_by)
print(group_by)
df %>%
group_by(!!group_by) %>%
summarise(a = mean(a))
}
my_summarise(df, g1)
library(lavaan)
HS.model <- ' visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9 '
HS.model <- ' visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9 '
fit <- cfa(HS.model, data = HolzingerSwineford1939)
summary(fit, fit.measures = TRUE)
NHtemp <- read_csv("~/OneDrive/GitHub/NASADatanauts/data/NHtemp.csv",
na = "empty", comment = "*")
library(tidyverse)
library(readr)
NHtemp <- read_csv("~/OneDrive/GitHub/NASADatanauts/data/NHtemp.csv",
na = "empty", comment = "*")
NHtemp <- read_csv("/data/NHtemp.csv",
na = "empty", comment = "*")
NHtemp <- read_csv("/data/NHtemp.csv",
na = "empty", comment = "*")
NHtemp <- read_csv("data/NHtemp.csv",
na = "empty", comment = "*")
NHyearlyTemp <- NHtemp %>%
select(Year:Dec) %>%
filter(Year != 2017) %>%
gather(Months, MeanTemp, -Year) %>%
arrange(Year)
NHsummerTemp <- NHtemp %>%
select(Year, Jun:Aug) %>%
filter(Year != 2017) %>%
gather(Months, MeanTemp, -Year) %>%
arrange(Year)
library(data.table)
NHsummerTemp <- data.table(NHsummerTemp)
NHsummerTemp[, Group := ifelse(Year %in% c(1951:1980), "Group1",
ifelse(Year %in% c(1983:1993), "Group2",
ifelse(Year %in% c(1994:2004), "Group3",
ifelse(Year %in% c(2005:2015), "Group4", "Base"))))]
View(NHsummerTemp)
NHsummerTemp, between(Year, 1951, 2015)
filter(NHsummerTemp, between(Year, 1951, 2015))
p <- ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = "light gray", color = "black") +
xlim(-1,1)
gganimate::gganimate(p)
install.packages("cowplot")
devtools::install_github("dgrtwo/gganimate")
install.packages("curl")
devtools::install_github("dgrtwo/gganimate")
library(gganimate)
gganimate(p)
gganimate(p)
library(tidyverse)
library(readr)
NHtemp <- read_csv("data/NHtemp.csv",
na = "empty", comment = "*")
NHyearlyTemp <- NHtemp %>%
select(Year:Dec) %>%
filter(Year != 2017) %>%
gather(Months, MeanTemp, -Year) %>%
arrange(Year)
NHsummerTemp <- NHtemp %>%
select(Year, Jun:Aug) %>%
filter(Year != 2017) %>%
gather(Months, MeanTemp, -Year) %>%
arrange(Year)
library(data.table)
NHsummerTemp <- data.table(NHsummerTemp)
NHsummerTemp[, Group := ifelse(Year %in% c(1951:1980), "Group1",
ifelse(Year %in% c(1983:1993), "Group2",
ifelse(Year %in% c(1994:2004), "Group3",
ifelse(Year %in% c(2005:2015), "Group4", "Base"))))]
library(gganimate)
p <- ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = "light gray", color = "black") +
xlim(-1,1)
p
gganimate(p)
gganimate(p)
ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = Group, color = "black") +
xlim(-1,1)
ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(data = filter(NHsummerTemp, between(Year, 1951, 2015)),binwidth = 0.04, fill = Group, color = "black") +
xlim(-1,1)
ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = "Group", color = "black") +
xlim(-1,1)
ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = "blue", color = "black") +
xlim(-1,1)
theme_set(theme_bw())
ggplot(data = filter(NHsummerTemp, between(Year, 1951, 2015)), mapping = aes(MeanTemp, frame = Group))  +
geom_histogram(binwidth = 0.04, fill = "blue", color = "black") +
xlim(-1,1)
install.packages(c("car", "dplyr", "git2r", "haven", "htmlwidgets", "httpuv", "igraph", "mgcv", "modelr", "OpenMx", "pbapply", "plotly", "Rcpp", "readr", "rgdal", "RMySQL", "sandwich", "shinydashboard", "stringdist", "tibble", "tidytext", "TTR", "visNetwork", "XML", "xts"))
library(plotly)
df <- data.frame(
x = c(1,2,3,4),
y = c(1,2,3,4),
f = c(1,2,3,4)
)
p <- ggplot(df, aes(x, y)) +
geom_point(aes(frame = f))
p <- ggplotly(p)
library(gapminder)
p <- ggplot(gapminder, aes(gdpPercap, lifeExp, color = continent)) +
geom_point(aes(size = pop, frame = year, ids = country)) +
scale_x_log10()
p <- ggplotly(p)
devtools::install_github('hadley/ggplot2')