if(onepager == "mountains"){
uoatoplot <- gmba300[which(gmba300$GMBA_V2_ID == uoa),]
}
starcoord <- suppressWarnings(st_coordinates(st_centroid(st_make_valid(uoatoplot))))
pdf(worldmappath, paper = "a4r")
plot(st_geometry(world), col = "light grey", border = "dark grey", lwd = 0.1) # plot surrounding countries
if(onepager == "countries"){
plot(st_geometry(uoatoplot), col = "firebrick", border = NA, add = TRUE) # plot unit of analysis
}
if(!(uoa %in% c("ARG", "AUS", "BRA", "CAN", "CHN", "GRL", "IND", "KAZ", "RUS", "SAU", "USA", # no need for star
"CHL", "COD", "DZA", "IDN", "IRN", "LBY", "MEX", "MLI", "MNG", "SDN", "TCD", "ZAF"))){ # no need for star?
text(starcoord[,1], starcoord[,2], "*", col = "firebrick", cex = 8, srt = 0)
}
dev.off()
image <- magick::image_read_pdf(worldmappath, density = 1200)
# image <- magick::image_crop(image, "6403x2608+4055+3533") # density:1200
image <- magick::image_trim(image)
magick::image_write(image, path = worldmappath, format = "png")
}
}
# produce bivariate maps
bivarmaps <- F
if(bivarmaps == TRUE){
plotcities <- T
# bivmappath <- paste0(datadir,"onepager/materials/biplot/v",version,"/",onepager,"/bivariate_",uoa,".png")
bivmappath <- paste0(datadir,"onepager/test/bivariate_",uoa,".png")
if(file.exists(bivmappath) == FALSE){
if(onepager == "countries"){
uoatoplot <- world[which(world$cc == uoa),]
mountains <- gmbaBasic[which(grepl(uoa, gmbaBasic$CountryISO)),]
if(uoa == "CYP"){ # plus "XAD", "XNC"
mountains <- rbind(mountains, gmbaBasic[which(grepl("XAD", gmbaBasic$CountryISO)),])
mountains <- rbind(mountains, gmbaBasic[which(grepl("XNC", gmbaBasic$CountryISO)),])
mountains <- mountains[-which(duplicated(mountains$GMBA_V2_ID)),]
}
}
if(onepager == "mountains"){
uoatoplot <- gmba300[which(gmba300$GMBA_V2_ID == uoa),]
mountains <- gmbaBasic[which(grepl(uoa, gmbaBasic$Path_ID)),]
}
mountains <- suppressWarnings(st_intersection(st_make_valid(mountains), st_make_valid(uoatoplot)))
cols <- c("#f4e2f5", # rgb 244/226/245
"#f5deb3", "#f5d383", "#f5c74d", "#f5b90f",
"#b1bdb3", "#b1bd83", "#b1bd4d", "#b1b90f",
"#699bb3", "#699b83", "#699b4d", "#699b0f",
"#1874b3", "#187483", "#18744d", "#18740f")
mountains$bicol <- NA
bidata <- gmbaR::gmba_kbapa(fulldata, list(c("UnitOfAnalysis", "Range"),
c("Calculation", "Bivar")
))
for(r in 1:nrow(mountains)){
mountains$bicol[r] <- cols[
bidata$ResultValue[which(bidata$Mountain == as.numeric(mountains$GMBA_V2_ID[r]))]+1
]
}
gmbaBasic$bicol <- NA
for(r in 1:nrow(gmbaBasic)){
gmbaBasic$bicol[r] <- cols[
bidata$ResultValue[which(bidata$Mountain == as.numeric(gmbaBasic$GMBA_V2_ID[r]))]+1
]
}
rm(r)
uoalakes <- suppressWarnings(st_intersects(st_make_valid(lakes), st_make_valid(uoatoplot)))
uoalakes <- lakes[which(uoalakes[] == 1),]
# uoalakesov <- suppressWarnings(st_intersects(st_make_valid(uoalakes), st_make_valid(gmbaBasic)))
# uoalakesov <- gmbaBasic[uoalakesov[[1]][],]
# uoalakes <- st_difference(st_make_valid(uoalakes), st_make_valid(uoalakesov))
gmbabicol <- gmbaBasic$bicol
mntbicol <- gmbaBasic$bicol[match(mountains$GMBA_V2_ID, gmbaBasic$GMBA_V2_ID)]
if(uoa %in% c("RUS", "USA",
as.numeric(11118))){
if(uoa == "RUS"){
subsetcc <- c("AFG", "ALB", "ARE", "ARM", "AUT", "AZE", "BGD", "BGR", "BHR", "BIH",
"BLR", "BTN", "CHE", "CHN", "CYP", "CZE", "DEU", "DNK", "EGY", "EST",
"FIN", "GEO", "GRC", "HKG", "HRV", "HUN", "IND", "IRN", "IRQ", "ISR",
"ITA", "JOR", "JPN", "KAZ", "KGZ", "KOR", "KWT", "LAO", "LBN", "LBY",
"LTU", "LVA", "MDA", "MKD", "MMR", "MNG", "NER", "NOR", "NPL", "PAK",
"POL", "PRK", "QAT", "ROU", "SAU", "SDN", "SJM", "SRB", "SVK", "SVN",
"SWE", "SYR", "TCD", "TJK", "TKM", "TUR", "TWN", "UKR", "USA", "UZB",
"VNM")
}
if(uoa == "USA"){
subsetcc <- c("AIA", "ATG", "BHS", "BLZ", "BRB", "CAN", "COL", "CRI", "CUB", "DMA",
"DOM", "ECU", "GLP", "GRD", "GRL", "GTM", "HND", "HTI", "JAM", "KNA",
"LCA", "MEX", "MSR", "MTQ", "NIC", "PAN", "PRI", "RUS", "SLV", "TCA",
"VCT", "VEN", "VGB", "VIR")
}
if(uoa == 11118){
subsetcc <- c("RUS", "USA")
}
uoatoplot_plot <- st_shift_longitude(uoatoplot)
uoalakes_plot <- st_shift_longitude(uoalakes)
mountains_plot <- st_shift_longitude(mountains)
pdf(bivmappath, paper = "a4r")
plot(st_geometry(uoatoplot_plot), col = "ghostwhite", border = NA) # plot unit of analysis
for(cc in subsetcc){
world_plot <- st_shift_longitude(world[which(world$cc == cc),])
plot(st_geometry(world_plot), col = "ghostwhite", border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding countries
}
plot(st_geometry(uoalakes_plot), col = "cadetblue1", border = "light grey", lwd = 0.1, add = TRUE) # plot lakes
for(cc in subsetcc){
for(mnt in gmbaBasic$GMBA_V2_ID[which(grepl(cc, gmbaBasic$CountryISO))]){
gmbaBasic_plot <- st_shift_longitude(gmbaBasic[which(gmbaBasic$GMBA_V2_ID == mnt),])
plot(st_geometry(gmbaBasic_plot), col = "white", border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding indicator background white
}
}
for(cc in subsetcc){
for(mnt in gmbaBasic$GMBA_V2_ID[which(grepl(cc, gmbaBasic$CountryISO))]){
gmbaBasic_plot <- st_shift_longitude(gmbaBasic[which(gmbaBasic$GMBA_V2_ID == mnt),])
plot(st_geometry(gmbaBasic_plot), col = add_alpha(gmbaBasic$bicol[which(gmbaBasic$GMBA_V2_ID == mnt)], alpha = 0.3), border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding indicator
}
}
plot(st_geometry(mountains_plot), col = mntbicol, border = "dark grey", lwd = 0.1, add = TRUE) # plot indicator
if(onepager == "mountains"){
for(cc in subsetcc){
world_plot <- st_shift_longitude(world[which(world$cc == cc),])
plot(st_geometry(world_plot), col = NA, border = "black", lwd = 0.5, add = TRUE)} # plot country borders
}
suppressMessages(scale <- prettymapr::scalebarparams(plotepsg = 4326)) # for scale-dependency #####
if(scale$widthu > 2000){uoaborder <- 0.5}
if(scale$widthu <= 2000){uoaborder <- 0.6}
if(scale$widthu <= 1000){uoaborder <- 0.8}
if(scale$widthu <= 500){uoaborder <- 1}
if(scale$widthu <= 100){uoaborder <- 1.2}
if(scale$widthu <= 50){uoaborder <- 1.5}
plot(st_geometry(uoatoplot_plot), col = NA, border = "firebrick", lwd = uoaborder, add = TRUE) # plot unit of analysis border
if(onepager == "countries"){if(plotcities == TRUE){
if(!(uoa %in% c("BVT", "HKG", "HMD", "SGS"))){
capital <- cities[which(cities$capital == 1),]
capital <- capital[which(capital$cc == uoa),]
if(nrow(capital) > 1){capital <- capital[which(capital$pop == max(capital$pop)),]}
capital_label <- capital
capital_label$lat[which(capital_label$capital == 1)] <- capital_label$lat[which(capital_label$capital == 1)] + scale$widthu/1140
capital <- get_coordinates(capital)
capital_label <- get_coordinates(capital_label)
if(uoa %in% c("FJI", "USA")){
capital <- st_shift_longitude(capital)
capital_label <- st_shift_longitude(capital_label)}
plot(st_geometry(capital), type = "p", pch = 20, cex = capital$pointcex, col = capital$col, add = TRUE) # plot capital
text(unlist(capital_label$geometry)[2] ~ unlist(capital_label$geometry)[1], labels = capital_label$name, cex = capital_label$labelcex) # plot capital label
}}}
suppressMessages(prettymapr::addscalebar(plotepsg = 4326, pos = "bottomleft", padin = c(0.55, 0.15), htin = 0.05, label.cex = 0.5, style = "ticks"))
dev.off()
}
if(!(uoa %in% c("RUS", "USA",
as.numeric(11118)))){
if(uoa %in% c(as.numeric(19102))){
uoatoplot_plot <- st_transform(uoatoplot, 3995) # crs = "+proj=moll"
world_plot <- st_transform(world, 3995)
uoalakes_plot <- st_transform(uoalakes, 3995)
gmbaBasic_plot <- st_transform(gmbaBasic, 3995)
mountains_plot <- st_transform(mountains, 3995)
} else {
if(uoa %in% c("FJI", "NZL",
as.numeric(11225))){
uoatoplot_plot <- st_shift_longitude(uoatoplot)
world_plot <- st_shift_longitude(world)
uoalakes_plot <- st_shift_longitude(uoalakes)
gmbaBasic_plot <- st_shift_longitude(gmbaBasic)
mountains_plot <- st_shift_longitude(mountains)
} else {
uoatoplot_plot <- uoatoplot
world_plot <- world
uoalakes_plot <- uoalakes
gmbaBasic_plot <- gmbaBasic
mountains_plot <- mountains
}}
pdf(bivmappath, paper = "a4r")
plot(st_geometry(uoatoplot_plot), col = "ghostwhite", border = NA) # plot unit of analysis
plot(st_geometry(world_plot), col = "ghostwhite", border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding countries
plot(st_geometry(uoalakes_plot), col = "cadetblue1", border = "light grey", lwd = 0.1, add = TRUE) # plot lakes
plot(st_geometry(gmbaBasic_plot), col = "white", border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding indicator background white
plot(st_geometry(gmbaBasic_plot), col = add_alpha(gmbabicol, alpha = 0.3), border = "dark grey", lwd = 0.1, add = TRUE) # plot surrounding indicator
plot(st_geometry(mountains_plot), col = mntbicol, border = "dark grey", lwd = 0.1, add = TRUE) # plot indicator
if(onepager == "mountains"){plot(st_geometry(world_plot), col = NA, border = "black", lwd = 0.5, add = TRUE)} # plot country borders
suppressMessages(scale <- prettymapr::scalebarparams(plotepsg = 4326)) # for scale-dependency
if(scale$widthu > 2000){uoaborder <- 0.5}
if(scale$widthu <= 2000){uoaborder <- 0.6}
if(scale$widthu <= 1000){uoaborder <- 0.8}
if(scale$widthu <= 500){uoaborder <- 1}
if(scale$widthu <= 100){uoaborder <- 1.2}
if(scale$widthu <= 50){uoaborder <- 1.5}
plot(st_geometry(uoatoplot_plot), col = NA, border = "firebrick", lwd = uoaborder, add = TRUE) # plot unit of analysis border
if(onepager == "countries"){if(plotcities == TRUE){
if(!(uoa %in% c("BVT", "HKG", "HMD", "SGS"))){
capital <- cities[which(cities$capital == 1),]
capital <- capital[which(capital$cc == uoa),]
if(nrow(capital) > 1){capital <- capital[which(capital$pop == max(capital$pop)),]}
capital_label <- capital
capital_label$lat[which(capital_label$capital == 1)] <- capital_label$lat[which(capital_label$capital == 1)] + scale$widthu/1140
capital <- get_coordinates(capital)
capital_label <- get_coordinates(capital_label)
if(uoa %in% c("FJI", "USA")){
capital <- st_shift_longitude(capital)
capital_label <- st_shift_longitude(capital_label)}
plot(st_geometry(capital), type = "p", pch = 20, cex = capital$pointcex, col = capital$col, add = TRUE) # plot capital
text(unlist(capital_label$geometry)[2] ~ unlist(capital_label$geometry)[1], labels = capital_label$name, cex = capital_label$labelcex) # plot capital label
}}}
suppressMessages(prettymapr::addscalebar(plotepsg = 4326, pos = "bottomleft", padin = c(0.55, 0.15), htin = 0.05, label.cex = 0.5, style = "ticks"))
if(uoa %in% c(as.numeric(19102))){
northpole <- data.frame(long = 72.68,
lat = 80.65)
northpole <- do.call("st_sfc", c(lapply(1:nrow(northpole), function(i){st_point(as.numeric(northpole[i, ]))}), list(crs = 3995)))
plot(northpole, pch = 3, add = TRUE) # st_geometry(st_as_sf(northpole))
}
dev.off()
}
image <- magick::image_read_pdf(bivmappath, density = 1200)
# image <- magick::image_crop(image, "1730x1550+950+435") # density:300
image <- magick::image_crop(image, "6913x6194+3799+1739") # density:1200
northing <- magick::image_read(paste0(datadir,"onepager/materials/biplot/legend/N.png"), density = 1200)
northing <- magick::image_scale(northing, "x370") # height
# image <- magick::image_composite(image, northing, offset = "+170+5450") # scale bottom at +5650
image <- magick::image_composite(image, northing, offset = "+170+5650")
magick::image_write(image, path = bivmappath, format = "png")
}
}
# produce onepager
output_html <- paste0(datadir,"onepager/html/GMBA_onepager_",uoa,".html")
if(onepager == "countries"){output_pdf <- paste0(datadir,"onepager/v",version,"/",onepager,"/GMBA_onepager_country_",uoa,".pdf")}
if(onepager == "mountains"){output_pdf <- paste0(datadir,"onepager/v",version,"/",onepager,"/GMBA_onepager_mountain_",uoa,".pdf")}
if(file.exists(output_pdf) == FALSE){
suppressWarnings(
rmarkdown::render(paste0(datadir, "onepager/onepager_layout_",onepager,".Rmd"),
output_file = output_html,
params = list(uoa = uoa),
quiet = TRUE)
)
options(pagedown.remote.maxattempts = 40) # number of attempt in total
options(pagedown.remote.sleeptime = 2) # time in second between attempt
pagedown::chrome_print(input = output_html, output = output_pdf, format = "pdf",
wait = 5,
options = list(printBackground = TRUE,
# paperWidth = 8.2677165354,
# paperHeight = 11.6929133858,
marginTop = 0,
marginRight = 0,
marginBottom = 0,
marginLeft = 0,
preferCSSPageSize = TRUE)
# ,verbose = TRUE
)
# options: https://chromedevtools.github.io/devtools-protocol/tot/Page/#method-printToPDF
# cannot find chrome after 20 attempts: https://github.com/rstudio/pagedown/issues/177
}
gc()
}
end_time <- Sys.time()
} ### end of looping the full onepager collection
datadir <- "~/Documents/Documents/Assessment_group/Amina_Fellowship/manuscript/R/"
source(paste0(datadir,"finaldata.R"))
# create fulldata entries for onepager
onepagerdata <- fulldata[-c(1:nrow(fulldata)),]
createonepagerlinks <- T
filenames <- list.files(paste0(datadir, "onepager/v",version,"/"))
version <- 1
recordnumber <- "6626931" # from doi 10.5281/zenodo.6626931
filenames <- list.files(paste0(datadir, "onepager/v",version,"/"))
which(grepl("zip", filenames))
filenames <- filenames[-which(grepl("zip", filenames))]
for(r in 1:length(filenames)){
filename <- filenames[r]
if(grepl("GMBA_onepager_country_", filename)){uoa <- gsub("GMBA_onepager_country_", "", filename)}
if(grepl("GMBA_onepager_mountain_", filename)){uoa <- gsub("GMBA_onepager_mountains_", "", filename)}
uoa <- gsub(".pdf", "", uoa)
if(nchar(uoa) == 3){onepager <- "countries"}
else {onepager <- "mountains"}
downloadurl <- paste0("https://zenodo.org/record/",recordnumber,"/files/",filename,"?download=1")
onepagerdata <- rbind(onepagerdata,
data.frame(ID = uoa,
ID_underscore = uoa,
Year = NA,
UnitOfAnalysis = ifelse(onepager == "countries", "Country", "System"),
Landscape = NA,
Country = ifelse(onepager == "countries", uoa, NA),
Mountain = ifelse(onepager == "countries", NA, uoa),
Name = NA,
Metric = "PDF",
Definition = NA,
Calculation = NA,
ResultValue = NA,
Unit = downloadurl,
FilterString = paste0("GMBA_onepager_",onepager),
Approach = NA)
)
}
if(anyNA(onepagerdata$Unit)){onepagerdata <- onepagerdata[-which(is.na(onepagerdata$Unit)),]}
View(onepagerdata)
createonepagerlinks <- T
# create fulldata entries for onepager
onepagerdata <- fulldata[-c(1:nrow(fulldata)),]
createonepagerlinks <- T
if(createonepagerlinks == TRUE){
version <- 1
recordnumber <- "6626931" # from doi 10.5281/zenodo.6626931
filenames <- list.files(paste0(datadir, "onepager/v",version,"/"))
filenames <- filenames[-which(grepl("zip", filenames))]
for(r in 1:length(filenames)){
filename <- filenames[r]
if(grepl("GMBA_onepager_country_", filename)){uoa <- gsub("GMBA_onepager_country_", "", filename)}
if(grepl("GMBA_onepager_mountain_", filename)){uoa <- gsub("GMBA_onepager_mountain_", "", filename)}
uoa <- gsub(".pdf", "", uoa)
if(nchar(uoa) == 3){onepager <- "countries"}
else {onepager <- "mountains"}
downloadurl <- paste0("https://zenodo.org/record/",recordnumber,"/files/",filename,"?download=1")
onepagerdata <- rbind(onepagerdata,
data.frame(ID = uoa,
ID_underscore = uoa,
Year = NA,
UnitOfAnalysis = ifelse(onepager == "countries", "Country", "System"),
Landscape = NA,
Country = ifelse(onepager == "countries", uoa, NA),
Mountain = ifelse(onepager == "countries", NA, uoa),
Name = NA,
Metric = "PDF",
Definition = NA,
Calculation = NA,
ResultValue = NA,
Unit = downloadurl,
FilterString = paste0("GMBA_onepager_",onepager),
Approach = NA)
)
}
if(anyNA(onepagerdata$Unit)){onepagerdata <- onepagerdata[-which(is.na(onepagerdata$Unit)),]}
}
datadir
paste0(datadir,"onepager/v1_urls.csv")
write.csv2(onepagerdata, paste0(datadir,"onepager/v1_urls.csv"))
citation()
Version()
version()
R. Version()
R.Version()
install.packages("bookdown")
install.packages(c("bslib", "deldir", "fields", "ggfun", "ggimage"))
install.packages(c("deldir", "fields", "ggplotify", "ggspatial", "gifski", "googledrive", "googlesheets4"))
detach("package:base", unload = TRUE)
library(base)
detach("package:datasets", unload = TRUE)
detach("package:graphics", unload = TRUE)
detach("package:grDevices", unload = TRUE)
detach("package:methods", unload = TRUE)
detach("package:stats", unload = TRUE)
detach("package:utils", unload = TRUE)
install.packages(c("deldir", "fields", "gifski", "graticule", "igraph", "KernSmooth", "lwgeom", "Matrix", "mgcv", "mvtnorm", "nlme", "patchwork", "plotly", "proj4", "rgdal", "rgeos", "rmarkdown", "rnaturalearth", "rpf", "sass", "sf", "sfheaders", "shiny", "stars", "terra", "testthat", "units", "usethis", "viridis"))
install.packages(c("deldir", "fields", "gifski", "igraph", "KernSmooth", "lwgeom", "Matrix", "mgcv", "mvtnorm", "nlme", "proj4", "rgdal", "rgeos", "rpf", "sf", "terra", "units"))
load("~/GeDrive/Diss/2_SDG-priorities/R_Env_20230419.RData")
deparse(substitute(africa))
africaQ$summary
africaQ$perspectives
africaQ$`Q method results`
africaQ$`Q method results`$brief
africaQ$`Q method results`$dataset
shiny::runApp('Documents/Documents/Assessment_group/Amina_Fellowship/manuscript/R/onepager/shinyapp/gmbaonepager')
runApp('Documents/Documents/Assessment_group/Amina_Fellowship/manuscript/R/onepager/shinyapp/gmbaonepager')
runApp('Documents/Documents/Assessment_group/Amina_Fellowship/manuscript/R/onepager/shinyapp/gmbaonepager')
library(gmbaR)
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
gmba_read()
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
gmba_select()
remove.packages("gmbaR")
devtools::install_github("GMBA-biodiversity/gmbaR")
library(gmbaR)
library(gmbaR)
devtools::install_github("GMBA-biodiversity/gmbaR")
library(gmbaR)
rm(Europe)
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
gmba_select()
.rs.restartR()
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
Europe <- gmba_lower_id_from_higher(11175, 3, method = "parent")
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
Europe <- gmba_lower_id_from_higher(11175, 2, method = "parent")
Europe <- gmbaR::gmba_lower_id_from_higher(11175, 2, method = "parent")
gmba_read()
gmbaR::gmba_read()
Europe <- gmbaR::gmba_lower_id_from_higher(11175, 2, method = "parent")
shiny::runApp('Documents/Documents/Assessment_group/Amina_Fellowship/manuscript/R/onepager/shinyapp/gmbaonepager')
gmbaR::gmba_search_names("Patagonia")
gmbaR::gmba_read()
gmbaR::gmba_search_names("Patag")
# first set a path object to where the qapproach_code folder is located
setwd(paste0("~", path, "/qapproach_code"))
# first set a path object to where the qapproach_code folder is located
setwd(paste0("~", path, "/qapproach_code"))
path <- "/GeDrive/Diss/1_Method/Paperwriting/submission_4_PLOSONE"
# first set a path object to where the qapproach_code folder is located
setwd(paste0("~", path, "/qapproach_code"))
# first set a path object to where the qapproach_code folder is located
setwd(paste0("~", path, "/qapproach_code"))
path <- "/GeDrive/Diss/1_Method/Paperwriting/submission_4_PLOSONE/documents_for_subm"
# first set a path object to where the qapproach_code folder is located
setwd(paste0("~", path, "/qapproach_code"))
load(paste0(getwd(),"/Case-example_data.RData"))
getwd()
load(paste0(getwd(),"/Case-example_data.RData"))
paste0(getwd(),"/Case-example_data.RData")
load(paste0(getwd(),"/Example_data.RData"))
source(paste0(getwd(),"/qapproach_functions_v1.R"))
source(paste0(getwd(),"/qapproach_sdg_visualization_v1.R"))
names(group1)[which(grepl("sdg", names(group1)))] <- paste0("stat",1:17)
group1 <- prepare_rankings(group1, nstat = 17, idcolumn = NA)
group1Q <- qapproach(group1)
group1Q$summary
group1B <- qaboots(group1Q)
check_distributions(group1Q)
group1V <- validate(group1Q, group1B)
group1standardQ <- qmethod(group1, 2)
group1Q$summary
group1standardQ <- qmethod(group1, nfactors = 2)
group1standardQ <- qmethod(group1, nfactors = 4)
loa.and.flags(group1standardQ)
group1standardQscree <- qmethod(group1, nfactors = 2)
group1standardQdeterm <- qmethod(group1, nfactors = 4)
rm(group1standardQ)
group1standardQscree$zsc_n
group1standardQscree$zsc
group1standardQscree$zsc_n
group1standardQdeterm$zsc_n
cpscores(group1standardQdeterm$zsc_n, group1standardQdeterm$f_char$characteristics$eigenvals)
round(cpscores(group1standardQdeterm$zsc_n, group1standardQdeterm$f_char$characteristics$eigenvals), digits = 2)
round(cpscores(group1standardQscree$zsc_n, group1standardQscree$f_char$characteristics$eigenvals), digits = 2)
cpscores(group1standardQscree$zsc_n
)
group1standardQscree$zsc_n
rm(group1standardQdeterm, group1standardQscree)
group1standardQ <- qmethod(group1, nfactors = 2)
round(cpscores(group1standardQ$zsc_n, group1standardQ$f_char$characteristics$eigenvals), digits = 2)
group1Q$`cp-scores`
sort(round(cpscores(group1standardQ$zsc_n, group1standardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(group1Q$`cp-scores`, digits = 2), decreasing = TRUE)
group1Q$summary
group1standardQ$f_char$characteristics
8+6
100/20*14
group1standardQ <- qmethod(group1, nfactors = 4)
group1standardQ$f_char$characteristics
6+5+4+3
group1standardQ <- qmethod(group1, nfactors = 2)
group1standardQ$f_char$characteristics
names(group2)[which(grepl("sdg", names(group2)))] <- paste0("stat",1:17)
group2 <- prepare_rankings(group2, nstat = 17, idcolumn = NA)
group2Q <- qapproach(group2)
group2Q$summary
group2B <- qaboots(group2Q)
check_distributions(group2Q)
group2V <- validate(group2Q, group2B)
group2standardQ <- qmethod(group2, nfactors = 2)
group2standardQ$f_char$characteristics
group2Q$summary
sort(round(group2Q$`cp-scores`, digits = 3), decreasing = TRUE)
group2standardQ$f_char$characteristics
7+5
100/20*12
sort(round(cpscores(group2standardQ$zsc_n, group2standardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(group2Q$`cp-scores`, digits = 2), decreasing = TRUE)
group2standardQ$zsc_n
group1Q$perspectives
group1standardQ$zsc_n
t(group1standardQ$zsc_n)
data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n))))
qapproach
screeplot(prcomp(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n))))),
main = "Screeplot of unrotated factors", type = "l")
lines(predict(lm(prcomp(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n))))))[["sdev"]]^2 ~ c(1:length(prcomp(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n))))))[["sdev"]]^2)))), col = "red")
lines(predict(lm(prcomp(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))))[["sdev"]]^2 ~ c(1:length(prcomp(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))))[["sdev"]]^2)))), col = "red")
groupsstandardQ <- qmethod(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))),
nfactors = 2)
groupsstandardQ <- qmethod(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))),
nfactors = 1)
nfactordetermination(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))), rotation = "varimax", load_perc = 0.8)
nfactordetermination(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))), rotation = "varimax", load_perc = 0.5)
data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n))))
groupsstandardQ <- qmethod(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))),
nfactors = 2)
groupsstandardQ$f_char$characteristics
groupsstandardQ$zsc_n
sort(round(cpscores(groupsstandardQ$zsc_n, groupsstandardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(group2Q$`cp-scores`, digits = 2), decreasing = TRUE)
sort(round(cpscores(groupsstandardQ$zsc_n, groupsstandardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(groups$`cp-scores`, digits = 2), decreasing = TRUE)
sort(round(cpscores(groupsstandardQ$zsc_n, groupsstandardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(groupsQ$`cp-scores`, digits = 2), decreasing = TRUE)
groups <- data.frame(t(rbind(group1Q$perspectives,
group2Q$perspectives)))
groupsQ <- qapproach(groups)
groupsQ$summary
groupsstandardQ <- qmethod(data.frame(t(rbind(t(group1standardQ$zsc_n),
t(group2standardQ$zsc_n)))),
nfactors = 2)
groupsstandardQ$f_char$characteristics
sort(round(cpscores(groupsstandardQ$zsc_n, groupsstandardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
sort(round(groupsQ$`cp-scores`, digits = 2), decreasing = TRUE)
groupsstandardQ$zsc_n
groupsQ$perspectives
groupsstandardQ$zsc_n
groupsstandardQ$f_char$characteristics$eigenvals
sort(round(cpscores(groupsstandardQ$zsc_n, groupsstandardQ$f_char$characteristics$eigenvals), digits = 2), decreasing = TRUE)
