## ----setup, include=FALSE-----------------------------------------------------

knitr::opts_chunk$set(tidy      = "styler",
                      fig.align = "center",
                      comment   = NA,
                      warning   = FALSE,
                      error     = FALSE,
                      message   = FALSE,
                      collapse  = FALSE,
                      out.width = "100%",
                      dev = "ragg_png", #<- prevent default Windows device to
                      # render plots
                      dpi       = 132,
                      echo      = FALSE)

old_options <- options(scipen = 999, digits = 2)
on.exit(options(old_options))

olds <- options(rmarkdown.html_vignette.check_title = FALSE)
on.exit(options(olds))

library(Dyn4cast)
library(tidyverse, quietly = T)


## ----github, echo = TRUE, eval = FALSE----------------------------------------
# 
# # install.packages("devtools")
# devtools::install_github("JobNmadu/Dyn4cast")

## ----universe, echo = TRUE, eval = FALSE--------------------------------------
# 
# install.packages("Dyn4cast", repos = c("https://jobnmadu.r-universe.dev", "https://cloud.r-project.org"))

## ----echo = TRUE, eval = FALSE------------------------------------------------
# data0 <- Transform %>%
# pivot_longer(!X, names_to = "Factors", values_to = "Data")
# 
# ggplot(data = data0, aes(x = X, y = Data, fill = Factors, color = Factors)) +
#   geom_line() +
#   scale_fill_brewer(palette = "Set1") +
#   scale_color_brewer(palette = "Set1") +
#   labs(y = "Data", x = "Series", color = "Factors") +
#   theme_bw(base_size = 12)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# data1 <- data_transform(Transform[, -1], 1)
# data1 <- cbind(Transform[, 1], data1)
# data1 <- data1 %>%
#   pivot_longer(!X, names_to = "Factors", values_to = "Data")
# 
# ggplot(data = data1, aes(x = X, y = Data, fill = Factors, color = Factors)) +
#   geom_line() +
#   scale_fill_brewer(palette = "Set1") +
#   scale_color_brewer(palette = "Set1") +
#   labs(y = "Data", x = "Series", color = "Factors") +
#   theme_bw(base_size = 12)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# data2 <- data_transform(Transform[, -1], 2)
# data2 <- cbind(Transform[, 1], data2)
# data2 <- data2 %>%
#   pivot_longer(!X, names_to = "Factors", values_to = "Data")
# 
# ggplot(data = data2, aes(x = X, y = Data, fill = Factors, color = Factors)) +
#   geom_line() +
#   scale_fill_brewer(palette = "Set1") +
#   scale_color_brewer(palette = "Set1") +
#   labs(y = "Data", x = "Series", color = "Factors") +
#   theme_bw(base_size = 12)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# data3 <- data_transform(Transform[, -1], 3)
# data3 <- cbind(Transform[, 1], data3)
# data3 <- data3 %>%
#   pivot_longer(!X, names_to = "Factors", values_to = "Data")
# 
# ggplot(data = data3, aes(x = X, y = Data, fill = Factors, color = Factors)) +
#   geom_line() +
#   scale_fill_brewer(palette = "Set1") +
#   scale_color_brewer(palette = "Set1") +
#   labs(y = "Data", x = "Series", color = "Factors") +
#   theme_bw(base_size = 12)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(forecast)
# library(readr)
# COVID19$Date <- zoo::as.Date(COVID19$Date, format = '%m/%d/%Y')
# 
# LEN <- length(COVID19$Case)
# Dss <- seq(COVID19$Date[1], by = "day", length.out = LEN)
# ORIGIN = "2020-02-29"
# lastdayfo21 <- Dss[length(Dss)]
# gggg <- COVID19[COVID19$Date <= lastdayfo21 - 28, ]
# BREAKS <- c(70, 131, 173, 228, 274)
# dyrima <- auto.arima(gggg$Case)
# 
# DynamicForecast(date = gggg$Date, series = gggg$Case, dyrima = dyrima,
#                 BREAKS = BREAKS, MaximumDate = "2021-02-10",
#                 Trend = "Day", Length = 0, Type = "Integer")

## ----echo = TRUE, eval = FALSE------------------------------------------------
# lastdayfo21 <- Dss[length(Dss)]
# ddy <- COVID19[COVID19$Date <= lastdayfo21 - 14, ]
# BREAKS = c(70, 131, 173, 228, 274)
# dyrima <- auto.arima(ddy$Case)
# 
# suppressWarnings(DynamicForecast(date = ddy$Date, series = ddy$Case,
#                                  dyrima = dyrima, BREAKS = BREAKS ,
#                 MaximumDate = "2021-02-10", Trend = "Day", Length = 0,
#                 Type = "Integer"))

## ----echo = TRUE, eval = FALSE------------------------------------------------
# DD <- rnorm(100000)
# formattedcut(DD, 12, FALSE)
# DD1 <- cut(DD, 12)
# formattedcut(DD1, 12, TRUE)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(readr)
# garrett_data <- data.frame(garrett_data)
# ranking <- c("Serious constraint", "Constraint",
# "Not certain it is a constraint", "Not a constraint",
# "Not a serious constraint")
# 
# garrett_ranking(garrett_data, 5, ranking)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# garrett_ranking(garrett_data, 5)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# garrett_ranking(garrett_data, 8)
# 
# garrett_ranking(garrett_data, 4)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# df <- data.frame(Age = c(49, 30, 44, 37, 29, 56, 28, 26, 33, 45, 45, 19,
#                          32, 22, 19, 28, 28, 36, 56, 34),
# Sex = c("male", "female", "female", "male", "male", "male", "female",
#         "female", "Prefer not to say", "male", "male", "female", "female",
#         "male", "Non-binary/third gender", "male", "female", "female", "male",
#         "male"))
# gender(df)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# y <- linearsystems$MKTcost
# x <- select(linearsystems, -MKTcost)
# Linearsystems(y, x, 6, 15)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# x <- sampling[, -1]
# y <- sampling$qOutput
# limit <- 20
# mod <-3
# Test <- NA
# Linearsystems(y, x, 3, 15)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# x <- sampling[, -1]
# y <- sampling$qOutput
# mod <- 1
# Linearsystems(y, x, 1, 15)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# x <- sampling[, -1]
# y <- sampling$qOutput
# mod <- 2
# Linearsystems(y, x, 2, 15)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# x <- sampling[, -1]
# y <- sampling$qOutput
# ddc <- cbind(y, x)
# sampling <- sample(1 : nrow(ddc), 0.8 * nrow(ddc))
# train <- ddc[sampling, ]
# Test  <- ddc[-sampling, ]
# y <- train$y
# x <- train[, -1]
# mod <- 4
# Linearsystems(y, x, 4, 15, Test)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(tidyverse)
# library(ggtext)
# 
# y <- linearsystems$MKTcost
# x <- select(linearsystems, -MKTcost)
# Linearsystems(y, x, 5, 15)

## ----echo = TRUE, eval = FALSE------------------------------------------------
#  data <- mdpi1 # data from `MPI` package
#  data1 <- mdpi2 #from `mpitbR` package
# 
# dm <- list(d1 = c("Child.Mortality", "Access.to.health.care"),
#              d2 = c("Years.of.education", "School.attendance", "School.lag"),
#              d3 = c("Cooking.Fuel", "Access.to.clean.source.of.water",
#                     "Access.to.an.improve.sanatation", "Electricity",
#                     "Housing.Materials", "Asset.ownership"))
#   mdi(data, dm, plots = "t", Factor = "Region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# mdi(data, dm, plots = "t")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# dm <- list(d1 = c("Child.Mortality", "Access.to.health.care"),
#              d2 = c("Years.of.education", "School.attendance", "School.lag"),
#              d3 = c("Cooking.Fuel", "Electricity", "Housing.Materials",
#                     "Asset.ownership"),
#              d4 = c("Access.to.clean.source.of.water",
#                     "Access.to.an.improve.sanatation"))
# 
#   mdi(data, dm, id_add = c("Water and Sanitation"),
#                 plots = "t", Factor = "Region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# dm <- list(d1 = c("d_cm"),
#              d2 = c("d_satt","d_educ"),
#              d3 = c("d_elct", "d_hsg","d_ckfl","d_asst"),
#              d4 = c("d_sani","d_wtr"),
#              d5 = c("d_nutr"))
# 
#   mdi(data1, dm, id_add = "Water and Sanitation", id_add1 = "Nutrition",
#        plots = "t", Factor = "region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# mdi(data1, dm, id_add = "Water and Sanitation", id_add1 = "Nutrition",
#        Factor = "region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# mdi(data1, dm, id_add = "Water and Sanitation", id_add1 = "Nutrition")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# dm <- list(d1 = c("d_cm"),
#              d2 = c("d_satt","d_educ"),
#              d3 = c("d_elct", "d_ckfl"),
#              d4 = c("d_sani","d_wtr"),
#              d5 = c("d_nutr"),
#              d6 = c("d_hsg","d_asst"))
# 
#   mdi(data1, dm, id_add = "Water and Sanitation", id_add1 = "Nutrition",
#                 id_addn = "Housing and Assets", plots = "t", Factor = "region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# dm <- list(d1 = c("d_cm"),
#              d2 = c("d_satt","d_educ"),
#              d3 = c("d_elct", "d_ckfl"),
#              d4 = c("d_sani","d_wtr"),
#              d5 = c("d_nutr"),
#              d6 = c("d_hsg"),
#              d7 = c("d_asst"))
# 
#   mdi(data1, dm, id_add = "Water and Sanitation",
#                 id_add1 = "Nutrition", id_addn = c("Housing", "Assets"),
#                 plots = "t", Factor = "region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
# dm <- list(d1 = c("d_cm"),
#              d2 = c("d_satt","d_educ"),
#              d3 = c("d_elct", "d_ckfl"),
#              d4 = c("d_sani"),
#              d5 = c("d_nutr"),
#              d6 = c("d_hsg"),
#              d7 = c("d_asst"),
#              d8 = c("d_wtr"))
# 
#   mdi(data1, dm, id_add = "Sanitation",
#                  id_add1 = "Nutrition",
#                  id_addn = c("Housing", "Assets", "Water"),
#                  plots = "t", Factor = "region")

## ----echo = TRUE, warning = FALSE, eval = FALSE-------------------------------
#   dm <- list(d1 = c("d_cm"),
#              d2 = c("d_satt","d_educ"),
#              d3 = c("d_elct", "d_ckfl"),
#              d4 = c("d_sani"),
#              d5 = c("d_nutr"),
#              d6 = c("d_hsg"),
#              d7 = c("d_asst"),
#              d8 = c("d_wtr"),
#              d9 = c("d_elct"))
# 
#   mdi(data1, dm, id_add = "Sanitation",
#                  id_add1 = "Nutrition",
#                  id_addn = c("Housing", "Assets", "Water", "Electricity"),
#                  plots = "t", Factor = "region")

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(splines)
# library(readr)
# Model   <- lm(states ~ bs(sequence, knots = c(30, 115)), data = Data)
# suppressWarnings(MLMetrics(Observed = Data, yvalue = Data$states, modeli = Model, K = 2,
#            Name = "Linear", Form = "LM", kutuf = 0, TTy = "Number"))

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(psych)
# library(readr)
# ddd <- Quicksummary
# GGn <- names(ddd)
# GG <- ncol(ddd)
# GGx <- c(paste0('x0', 1 : 9), paste("x", 10 : ncol(ddd), sep = ""))
# names(ddd) <- GGx
# lll <- fa.parallel(ddd, fm = "minres", fa = "fa")
# dat <- fa(ddd, nfactors = lll[["nfact"]], rotate = "varimax",fm = "minres")
# 
# model_factors(data = dat, DATA = ddd)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# Data <- c(1.2, 0.5, 0.103, 7, 0.1501)
# Percent(Data = Data, Type = "Frame")
# Data <- 1.2
# Percent(Data = Data, Type = "Value")

## ----echo = TRUE, eval = FALSE------------------------------------------------
# df <- data.frame(c(A = 2320, 5760, 4800, 2600, 5700, 7800, 3000, 6300, 2400,
# 10000, 2220, 3740),
# B = c(0, 0, 1620, 3600, 1200, 1200, 1200, 4250, 14000, 10000, 1850, 1850),
# C = c(3000, 3000, 7800, 5400, 3900, 7800, 1950, 2400, 2400, 7000, 1850, 1850),
# D = c(2900, 5760, 3750, 5400, 4095, 3150, 2080, 7800, 1920, 1200, 5000, 1950),
# E = c(2900, 2030, 0, 5400, 5760, 1800, 2000, 1950, 1850, 3600, 5200, 5760),
# F = c(2800, 5760, 1820, 4340, 7500, 2400, 2300, 1680, 1850, 0, 2800, 8000),
# G = c(5760, 4600, 13000, 7800, 6270, 1200, 1440, 8000, 1200, 2025, 4800, 2600),
# H = c(2100, 5760, 8250, 3900, 1800, 1200, 4800, 1800, 7800, 2035, 8000, 3000))
# Percent(Data = df, Type = "Frame")  # Value, Frame

## ----echo = TRUE, eval = FALSE------------------------------------------------
# quicksummary(x = Quicksummary, Type = 2)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# x <- select(linearsystems, 1:6)
# quicksummary(x = x, Type = 1)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(readr)
# Treatment = treatments$treatment
# data = treatments[, c(2:3)]
# treatment_model(Treatment, data)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# 
# library(readr)
# garrett_data <- data.frame(garrett_data)
# index_construction(garrett_data)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# 
# library(readr)
# garrett_data <- data.frame(garrett_data)
# relative_likert(garrett_data, Ranks = 3, Option = "sccore")
# relative_likert(garrett_data, Ranks = 5, Option = "sccore")
# relative_likert(garrett_data, Ranks = 7, Option = "sccore")
# relative_likert(garrett_data, Ranks = 9, Option = "sccore")
# 
# relative_likert(Quicksummary, Ranks = 5, Option = "sccore")
# 
# library(tidyverse)
# data_l <- garrett_data %>%
# pivot_longer(cols = everything()) %>%
#  mutate(value = case_when(value == 5 ~ "Serious constraint",
#                           value == 4 ~ "Constraint",
#                           value == 3 ~ "Not certain it is a constraint",
#                           value == 2 ~ "Not a constraint",
#                           value == 1 ~ "Not a serious constraint",
#                           .default = "None")) %>%
#  group_by(name) %>%
#  mutate(row = row_number()) %>%
#  pivot_wider(names_from = name, values_from = value) %>%
#  select(-row) %>%
#  unnest(cols = everything())
# 
#  ranking <- c("Serious constraint", "Constraint",
# "Not certain it is a constraint", "Not a constraint",
# "Not a serious constraint")
# 
#  relative_likert(data_l, Likert = ranking)

## ----echo = TRUE, eval = FALSE------------------------------------------------
# library(Dyn4cast)
#  library(tidyverse)
# 
#  counts <- c(18,17,15,20,10,20,25,13,12)
#  outcome <- gl(3,1,9)
#  treatment <- gl(3,3)
#  ddc <- data.frame(treatment, outcome, counts) # showing data
#  glm.D93 <- glm(counts ~ ., data = ddc, family = poisson())
#  odds_summary(glm.D93)
# 
#  library(MASS)
#  anorexia
# 
#  anorex.1 <- glm(Postwt ~ Prewt + Treat + offset(Prewt),
#                  family = gaussian, data = anorexia)
#  odds_summary(anorex.1)
# 
#  clotting <- data.frame(
#    u = c(5,10,15,20,30,40,60,80,100),
#    lot1 = c(118,58,42,35,27,25,21,19,18),
#    lot2 = c(69,35,26,21,18,16,13,12,12))
#  lot1 <- glm(lot1 ~ log(u), data = clotting, family = Gamma)
#  odds_summary(lot1)
# 
#  lot2 <- glm(lot2 ~ log(u), data = clotting, family = Gamma)
#  odds_summary(lot2)
# 
#  fS <- glm(lot2 ~ log(u) + log(u^2), data = clotting, family = Gamma)
#  #odds_summary(fS) #error because there is no convergence
# 
#  x <- rnorm(100)
#  y <- rpois(100, exp(1+x))
# 
#  lm2 <- glm(y ~ x, family = quasi(variance = "mu", link = "log"))
#  odds_summary(lm2)
# 
#  lm3 <- glm(y ~ x, family = poisson)
#  odds_summary(lm3)
# 
#  lm4 <- glm(y ~ x, family = quasi(variance = "mu^2", link = "log"))
#  #odds_summary(lm4) #error
# 
#  y <- rbinom(100, 1, plogis(x))
# 
#  lm5 <- glm(y ~ x, family = quasi(variance = "mu(1-mu)", link = "logit"),
#             start = c(0,1))
#  odds_summary(lm5)
# 
#  library(betareg)
# data("GasolineYield")
# gy <- betareg(yield ~ batch + temp, data = GasolineYield)
# odds_summary(gy)
# #'
# library(mvProbit)
# ## generate a simulated data set
# set.seed( 123 )
# # number of observations
# nObs <- 50
# #'
# # generate explanatory variables
# xMat <- cbind(const = rep(1, nObs), x1 = as.numeric(rnorm(nObs) > 0),
# x2 = rnorm(nObs))
# #'
# # model coefficients
# beta <- cbind(c(0.8,  1.2, -0.8), c(-0.6, 1.0, -1.6), c(0.5, -0.6, 1.2))
# #'
# # covariance matrix of error terms
# library(miscTools)
# sigma <- symMatrix(c(1, 0.2, 0.4, 1, -0.1, 1))
# #'
# # generate dependent variables
# yMatLin <- xMat %*% beta
# yMat <- (yMatLin + rmvnorm(nObs, sigma = sigma)) > 0
# colnames(yMat) <- paste("y", 1:3, sep = "")
# #'
# estResultStart <- mvProbit(cbind(y1, y2, y3) ~ x1 + x2, start = c(beta),
# startSigma = sigma, data = as.data.frame(cbind(xMat, yMat)), iterlim = 1,
# nGHK = 50)
# odds_summary(estResultStart)

