我需要为 excel 文件中的每个问题生成不同的李克特图形，所以我总是使用相同的脚本，更改问题的编号和名称。这是我适应我的数据的脚本：
echo=FALSE
warning=FALSE
message=FALSE
cache=F
library(dplyr)
library(knitr)
library(printr)
library(ggplot2)
library(sjPlot)
library(readxl)
library(tidyr)
library(sjmisc)
library(dplyr)
library(knitr)
library(printr)
library(ggplot2)
library(sjPlot)
library(readxl)
library(tidyr)
library(sjmisc)
opts_chunk$set(fig.width=8,fig.height=3,dpi=300,echo=F,warnings=F,messages=F)
setwd("/Users/fede/Desktop/FEDE/_/Sondaggi")
raw_data = read_excel("Questionario_cleaned.xlsx", sheet = "Italy")
data=as.data.frame(raw_data)
legend = read_excel("Questionario_cleaned.xlsx", sheet = "legenda")
legend = as.data.frame(legend)
legend$ResponseCat = as.factor(legend$ResponseCat)
levels(legend$ResponseCat)
factor_cols=c(3:5, 64, 67)
for(i in factor_cols){data[,i] = as.factor(data[,i])}
rm(factor_cols)
rm(i)
levels(data$Stakeholder_group) = c("Allevatori", "Cacciatori", "Pubblico generale")
data$Stakeholder_group[is.na(data$Stakeholder_group)] = "Allevatori"
likert_vars = legend$Order[legend$ResponseCat == "Likert1" | legend$ResponseCat == "Attitude1"]
attitude_vars = legend$Order[legend$ResponseCat == "Attitude"]
for_against = legend$Order[legend$ResponseCat == "Attitude1"]
agree_disagree = legend$Order[legend$ResponseCat == "Likert1"]
yes_no_dn = legend$Order[legend$ResponseCat == "YesNoDontKnow"]
yes_no = legend$Order[legend$ResponseCat == "YesNo"]
no_yes = legend$Order[legend$ResponseCat == "NoYes"]
for (i in likert_vars){
data[,i]=(data[,i]*-1)+5
data[,i]=as.numeric(as.character(data[,i]*-1))+5
data[data[,i]==2 & !is.na(data[,i]),i]=5
data[data[,i]==1 & !is.na(data[,i]),i]=2
data[data[,i]==0 & !is.na(data[,i]),i]=1
data[,i] = as.factor(data[,i])
}
_Error in data[, i] * -1 : non-numeric argument to binary operator
_levels(data[,for_against]) = c("Completamente favorevole", "Moderatamente favorevole,"Sfavorevole", "Completamente sfavorevole","Né favorevole né sfavorevole")
_Error: unexpected symbol in "levels(data[for_against]) = c("Completamente favorevole", "Moderatamente favorevole,"Sfavorevole"
likert_vars = legend$Order[legend$ResponseCat == "Likert1" | legend$ResponseCat == "Attitude1"]
attitude_vars = legend$Order[legend$ResponseCat == "Attitude"]
for_against = legend$Order[legend$ResponseCat == "Attitude1"]
agree_disagree = legend$Order[legend$ResponseCat == "Likert1"]
for (i in agree_disagree){
levels(data[,i])=c("Completamente d'accordo","D'accordo","Contrario","Del tutto contrario","Neutrale/Non so")
}
for (i in attitude_vars){
data[,i] = data[,i]*-1+4
data[,i] = as.factor(data[,i])
levels(data[,i])=c("+++", "++", "+", "Neutral", "-", "--", "---")
}
for (i in yes_no_dn){
data[,i] = as.factor(data[,i])
levels(data[,i])=c("Yes","No","Not sure")
}
no_yes = c(yes_no, no_yes)
levels(data$Sex) = c("Donna", "Uomo")
data$Stakeholder_group[data$Hunter == "Hunter"] = "Cacciatori"
data$Stakeholder_group[data$has_livestock == "Has livestock"] = "Allevatori"
qtext = legend
qtext$Questions = qtext$DomandaIT
graph_colors = c("seagreen4", "sienna")
cbind.fill <- function(...){
nm <- list(...)
dfdetect <- grepl("data.frame|matrix", unlist(lapply(nm, function(cl) paste(class(cl), collapse = " ") )))
vec <- data.frame(nm[!dfdetect])
n <- max(sapply(nm[dfdetect], nrow))
vec <- data.frame(lapply(vec, function(x) rep(x, n)))
if (nrow(vec) > 0) nm <- c(nm[dfdetect], list(vec))
nm <- lapply(nm, as.data.frame)
do.call(cbind, lapply(nm, function (df1)
rbind(df1, as.data.frame(matrix(NA, ncol = ncol(df1), nrow = n-nrow(df1), dimnames = list(NULL, names(df1))))) ))
}
PickAQuestion <- function(x, question, grouping) {
xys <- split(x, x[, grouping])
out <- do.call("cbind.fill", sapply(xys, FUN = function(x, question) {
out <- x[, question, drop = FALSE]
names(out) <- unique(x[,grouping])
out
}, question = question, simplify = FALSE))
rownames(out) <- 1:nrow(out)
out <- as.data.frame(out)
out
}
set_theme(base=theme_bw(),axis.textsize.x = 0.95,legend.size = 1.08,title.size = 1.25)
titi=PickAQuestion(data, "4 preservation not needed", "Stakeholder_group")
plot_likert(items=titi,legend.labels=levels(data[,"1attitude"]),cat.neutral=5,
title=paste(12, qtext$Questions[12]),sort.frq="neg.asc", values="sum.inside",reverse.colors=T)这些是我在excel中的数据：
我不知道为什么脚本只适用于第一个问题，我得到了这个结果： 在此处输入图像描述
但是，如果我更改问题的编号和标题，则没有中立的响应（但有图例）：
