I have a problem, I'm programming a code for the calculation of a simulated economy. However, at the moment of running the model, the coding contains four errors.
The model is running in JuliaBox 1.0.3
using Distributions
using DataFrames
# n = numero de familias
# t = numero de periodos para la simulacion
function inequality2(; n =5000 , t =15000 )
# Simulador de la economía e indices de desigualdad %%
# Parametros de Economia
gamma = 2; # Aversión al riesgo
delta = 0.057; # Depreciación de activos
betta = 0.99; # Factor de descuento
alfa = 0.47; # Elasticidad producto del capital en la producción
miz = 1; # Productividad en estado estacionario
roz = 0.75; # Ajuste de productividad
sigmaz = 0.013; # Volatilidad de la productividad
phi = 0.05; # Penalización de los hogares (activos)
rok = 0.7; # Parámetro inicial del movimiento de capital
mie = 1; # Empleo en estado estacionatio
roe = 0.7; # Ajuste del empleo
sigmae1 = 0.05; # Volatilidad del empleo de los hogares capitalistas
sigmae2 = 0.1; # Volatilidad del empelo de los hogares trabajadores
roez = 0.3; # Ciclicidad del empleo para los hogares trabajadores
lambda = 0.8; # Participación de los capitalistas en la economía
tau = 0; # Tasa de impuestos sobre la renta
ass = 31.7838916986589918973; # Desviación estandar de los activos
kss = lambda*ass; # Desviación estandar del capital
vtheta1 =0.1; # parametro 1 de la ecuación de movimiento de capital
vtheta2 =0.2; # parametro 2 de la ecuación de movimiento de capital
vtheta3 =0.3; # parametro 3 de la ecuación de movimiento de capital
vtheta4 =0.4; # parametro 4 de la ecuación de movimiento de capital
vtheta5 =0.5; # parametro 5 de la ecuación de movimiento de capital
n_lambda = trunc(Int, lambda ∗ n)
eshocks1= rand(Normal(0.0,sigmae1), n_lambda ,t); # choque sobre capitalistas
eshocks2= rand(Normal(0.0,sigmae2), n-n_lambda , t); # choque sobre capitalistas
zshocks1= rand(Normal(0.0, sigmaz), 1, t); # choque sobre capitalistas
# Variables:
a = ones(t,n);
c = ones(t,n);
y = ones(t,n);
k = ones(t);
w = ones(t);
r = ones(t);
z = ones(t);
l = ones(t);
e = ones(t,n);
# Valores iniciales de las variables:
a[1:2,1:n_lambda] = ass ;
a[1:t,(n_lambda+1):n]=0;
k[1:2] = lambda∗ass;
c[1:n_lambda,1] = (assˆalfa)∗(1-tau∗ alfa) - delta∗ass;
# Loop de Simulacion
for i = 2:(t-1)
k[i] = lambda∗mean(a[i,1:n_lambda]);
z[i] = (1-roz) + roz∗z[i-1]+zshocks[i];
l[i] = 1 + (1-lambda)∗roez*(z[i]-1)/(1-roe);
w[i] = (1-alfa)*z[i]∗((k[i])^(alfa))*l[i]^(-alfa);
r[i] = alfa∗z[i]*((k[i])^(alfa-1))*l[i]^(1-alfa);
for j = 1:n_lambda
e[i,j] = (1-roe) + roe∗e[i-1,j]+eshocks1[j,i];
a[i+1,j] = (vtheta1) + (vtheta2)*a[i,j]+ (vtheta3)*e[i,j] + (vtheta4)∗z[i] + (vtheta5)∗k[i];
c[i,j] = (1-tau)∗r[i]∗a[i,j] + w[i]∗e[i,j]+(1-delta )∗a[i,j] - a[i+1,j];
y[i,j] = (1-tau)∗r[i]∗a[i,j] + w[i]∗e[i,j];
end
for m = 1:(n - n_lambda)
e[i,m+n_lambda] = (1-roe ) + roe∗e[i-1,m+n_lambda]+ roez∗(z[i]-1) + eshocks2[m,i];
c[i,m+n_lambda] = w[i]∗e[i,m+n_lambda]+ tau∗r[i]∗k[i]/(1-lambda);
y[i,m+n_lambda] = c[i,m+n_lambda];
end
end
# Preparando las variables para el calculo del indice de Gini
asort = ones(t,n);
csort = ones(t,n);
ysort = ones(t,n);
for i = 1:(t-1)
asort[i,:]=sort(a[i,:]);
csort[i,:]=sort(c[i,:]);
ysort[i,:]=sort(y[i,:]);
end
# Calculo del Gini de la Riqueza
giniA = ones(t);
for i = 1:(t-1)
sum1 = 0.0;
sum2 = 0.0;
for j = 1:n
sum1 = (n+1-j)∗asort[i,j] + sum1;
sum2 = asort[i,j] + sum2;
end
giniA[i] = (n+1-2∗(sum1/sum2))/n;
end
# Calculo del Gini de Consumo
giniC = ones(t);
for i = 1:(t-1)
sum1 = 0;
sum2 = 0;
for j = 1:n
sum1 = (n+1-j)∗csort[i,j] + sum1;
sum2 = csort[i,j] + sum2;
end
giniC[i] = (n+1-2∗(sum1/sum2))/n;
end
# Calculo del Gini de la Renta
giniY = ones(t);
for i = 1:(t-1)
sum1 = 0;
sum2 = 0;
for j = 1:n
sum1 = (n+1-j)∗ysort[i,j] + sum1;
sum2 = ysort[i,j] + sum2;
end
giniY[i] = (n+1-2∗(sum1/sum2))/n;
end
# Calculo de la Curva de Lorenz ( lor )
sum = 0;
lor = ones(n);
atrim = asort[t-1,1:n];
atrim[1:350]=0;
for i = 1:n
sum = atrim[i] + sum;
end
cum = 0;
ind = 1:n;
for i = 1:n
cum = atrim[i]+cum;
lor[i] = cum/sum;
end
# Calculo del Coeficiente de Theil
theilY = ones(t);
for i = 1:(t-1)
ybar = mean(y[i,:]);
sum1 = 0;
for j = 1:n
sum1 = (y[i,j]/ybar)∗log(y[i,j]/ybar)+sum1;
end
theilY[i] = sum1/n;
end
# Calculo de Razoes de Porcentajes de Renda
ratio1 = ones(t);
r_n = trunc(Int, 0.9 ∗ n)
for i = 1:(t-1)
ratio1[i] = ysort[i,r_n]/ysort[i,n - r_n];
end
ratio2 = ones(t);
half_n = trunc(Int, 0.5 ∗ n)
for i = 1:(t-1)
ratio2[i] = ysort[i,r_n]/ ysort[i,half_n];
end
ratio3=ones(t);
for i = 1:(t-1)
ratio3[i] = ysort[i,half_n]/ ysort[i,n - r_n];
end
# Calculo de la Decomposicion del Coeficiente de Theil
theilC = ones(t);
ytotalC = ones(t);
for i = 1:(t-1)
ybarC = mean(y[i,1:n_lambda]);
sum1 = 0;
sum2 = 0;
for j = 1:n_lambda
sum1 = (y[i,j]/ybarC)∗log(y[i,j]/ybarC)+sum1;
sum2 = y[i,j] + sum2;
end
ytotalC[i] = sum2;
theilC[i] = sum1/(lambda∗n);
end
theilW = ones(t);
ytotalW = ones(t);
for i = 1:(t-1)
ybarW = mean(y[i,(1+n_lambda):n]);
sum1 = 0;
sum2 = 0;
for j = 1:(n - n_lambda)
sum1 = (y[i,j+n_lambda]/ybarW)∗log(y[i,j+n_lambda]/ybarW)+sum1;
sum2 = y[i,j+n_lambda]+sum2;
end
ytotalW[i] = sum2;
theilW[i] = sum1/((1-lambda)∗n);
end
ytotal = ones(t);
for i = 1:(t-1)
sum1 = 0;
for j = 1:n
sum1 = y[i,j] + sum1;
end
ytotal[i]=sum1;
end
shareC = ones(t);
shareW = ones(t);
meanC = ones(t);
meanW = ones(t);
meantotal = ones(t);
theilCW = ones(t);
for i = 1:(t-1)
shareC[i] = ytotalC[i]/ytotal[i];
shareW[i] = ytotalW[i]/ytotal[i];
meanC[i] = mean(y[i,1:n_lambda]);
meanW[i] = mean(y[i,(1+n_lambda):n]);
meantotal[i] = mean(y[i,:]);
theilCW[i] = shareC[i]∗theilC[i] + shareW[i]∗ theilW[i] + shareC[i]∗log(meanC[i]/ meantotal[i]) + shareW[i]∗log(meanW[i]/ meantotal[i]);
end
tab = DataFrame()
tab[ :periodos] = 15000
tab[ :familias] = 5000
tab[ :gamma] = gamma
tab[ :delta] = delta
tab[ :betta] = betta
tab[ :alfa] = alfa
tab[ :miz] = miz
tab[ :roz] = roz
tab[ :sigmaz] = sigmaz
tab[ :phi] = phi
tab[ :rok] = rok
tab[ :mie] = mie
tab[ :roe] = roe
tab[ :sigmae1] = sigmae1
tab[ :sigmae2] = sigmae2
tab[ :roez] = roez
tab[ :sigmae1] = sigmae1
tab[ :sigmae2] = sigmae2
tab[ :roez] = roez
tab[ :lambda] = lambda
tab[ :tau] = tau
tab[ :ass] = ass
tab[ :kss] = kss
tab[ :GiniY] = mean(giniY) # valor medio
tab[ :GiniC] = mean(giniC) # valor medio
tab[ :GiniA] = mean(giniA) # valor medio
tab[ :TheilY] = mean(theilY) # valor medio
tab[ :TheilC] = mean(theilC) # valor medio
tab[ :TheilW] = mean(theilW) # valor medio
tab[ :TheilCW] = mean(theilCW) # valor medio
tab[ :Ratio1] = mean(ratio1) # valor medio
tab[ :Ratio2] = mean(ratio2) # valor medio
tab[ :Ratio3] = mean(ratio3) # valor medio
tab[ :ShareC] = mean(shareC) # valor medio
tab[ :ShareW] = mean(shareW) # valor medio
tab[ :MeanC] = mean(meanC) # valor medio
tab[ :MeanW] = mean(meanW) # valor medio
tab[ :MeanTotal] = mean(meantotal) # valor medio
return tab
end
#time tab = inequality2(n =5000,t =15000);
writetable(”experimento.csv”,tab ,separator=’ ; ’)
The following errors occur when running the model:
UndefVarError: ∗ not defined
Stacktrace:
[1] #inequality2#13(::Int64, ::Int64, ::Function) at ./In[11]:40
[2] (::getfield(Main, Symbol("#kw##inequality2")))(::NamedTuple{(:n, :t),Tuple{Int64,Int64}}, ::typeof(inequality2)) at ./none:0
[3] top-level scope at util.jl:156
[4] top-level scope at In[11]:297
Related
and thanks for reading me again
I am working with a table in which in the "Valor" column I have a vector with numbers from 0 to 1 for bars with percentages as seen in the following image:
But I would like that in the fields where there is a value of "0%" instead of having the progress bar it would simply have the text "nd". Is there a way to do that?
The code used is the following:
library(dplyr)
library(reactable)
library(htmltools)
# df for the table
Objetivo_1 <- data.frame(
Estrategia = c("1.1", "1.2", "1.3", "1.4", "1.5", "1.6"),
`Nombre del indicador` = c("Porcentaje de indicadores de la estrategia 1.1
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior",
"Porcentaje de indicadores de la estrategia 1.2
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior",
"Porcentaje de indicadores de la estrategia 1.3
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior",
"Porcentaje de indicadores de la estrategia 1.4
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior",
"Porcentaje de indicadores de la estrategia 1.5
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior",
"Porcentaje de indicadores de la estrategia 1.6
que cumplen con la tendencia esperada entre el periodo
actual y el periodo inmediato anterior"
),
Valor = round(c(0.111,0.4111,0.25,0,0.2,432), digits = 2),
`Método de cálculo` = c("Número de indicadores que cumplen/Total de indicadores de la estrategia 1.1",
"Número de indicadores que cumplen/Total de indicadores de la estrategia 1.2",
"Número de indicadores que cumplen/Total de indicadores de la estrategia 1.3",
"Número de indicadores que cumplen/Total de indicadores de la estrategia 1.4",
"Número de indicadores que cumplen/Total de indicadores de la estrategia 1.5",
"Número de indicadores que cumplen/Total de indicadores de la estrategia 1.6"))
# Function for barchart
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
###table
reactable(
Objetivo_1,
bordered = TRUE,
searchable = TRUE,
language = reactableLang(
searchPlaceholder = "Busqueda",
noData = "Sin coincidencias",
pageInfo = "{rowStart} a {rowEnd} de {rows} entries",
pagePrevious = "\u276e",
pageNext = "\u276f",
# Accessible labels for assistive technologies such as screen readers.
# These are already set by default, but don't forget to update them when
# changing visible text.
pagePreviousLabel = "Página anterior",
pageNextLabel = "Siguiente página"
),
defaultSorted = "Valor",
columns = list(
Nombre.del.indicador = colDef(
name = "Nombre del indicador"
),
Método.de.cálculo = colDef(
name = "Método de cálculo"
),
Valor = colDef(
name = " Valor",
defaultSortOrder = "desc",
# Render the bar charts using a custom cell render function
cell = function(value) {
# Format as percentages with 1 decimal place
value <- paste0(format(value * 100, nsmall = 1), "%")
bar_chart(value, width = value, fill = "#822b2b", background = "#e1e1e1")
},
# And left-align the columns
align = "left"
)
)
)
By changing bar_chart slightly,
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
if (label == "0.0%"){
div('nd')
} else{
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
}
You may get nd instead of bar
I am doing this graph with this code
ggplot(c_clinicos) +
aes(x = Condición, fill = Estado, weight = Conteo) +
geom_bar() +
scale_fill_manual(values = list(
Ausente = "#FF1100", Presente = "#538FF6")) +
labs(x = "Condición clínica", y = "Nº Personas. ",
title = "Distribución de la presencia por enfermedad", subtitle = "Muestra de 810 pacientes", fill = "Estado:") +
coord_flip() +
theme_linedraw()
I want to get a little square for each bar (blue and red) that tells me how many people there is and a %. I have been trying to use geom_label but I couldn't make that work.
I am using this data:
structure(list(Condición = c("Cianosis Aguda", "Cianosis Aguda",
"Gassping", "Gassping", "FR mayor de 40 o menor de 6 rpm", "FR mayor de 40 o menor de 6 rpm",
"Oliguria que no responde a volumen y uso de diuréticos", "Oliguria que no responde a volumen y uso de diuréticos",
"Transtornos de la coagulación", "Transtornos de la coagulación",
"Pérdida de la conciencia mayor de 12 horas", "Pérdida de la conciencia mayor de 12 horas",
"Pérdida de la conciencia y ausencia de pulso y latidos cardíacos.",
"Pérdida de la conciencia y ausencia de pulso y latidos cardíacos.",
"Stroke", "Stroke", "Parálisis total o convulsiones incontrolables",
"Parálisis total o convulsiones incontrolables", "Ictericia más preeclampsia",
"Ictericia más preeclampsia"), Estado = c("Presente", "Ausente",
"Presente", "Ausente", "Presente", "Ausente", "Presente", "Ausente",
"Presente", "Ausente", "Presente", "Ausente", "Presente", "Ausente",
"Presente", "Ausente", "Presente", "Ausente", "Presente", "Ausente"
), Conteo = c(13, 797, 0, 810, 520, 290, 314, 496, 150, 659,
1, 809, 1, 809, 9, 801, 49, 761, 114, 696)), row.names = c(NA,
-20L), class = c("tbl_df", "tbl", "data.frame"))
Thanks in Advance.
We can calculate the labels that we want to display and use it in geom_label.
library(dplyr)
library(ggplot2)
c_clinicos %>%
group_by(Condición) %>%
mutate(label = sprintf('%d \n(%.2f %%)', Conteo, prop.table(Conteo) * 100),
label = replace(label, Conteo == 0, '')) %>%
ggplot() +
aes(x = Condición, fill = Estado, y = Conteo, label = label) +
geom_col() +
scale_fill_manual(values = list(
Ausente = "#FF1100", Presente = "#538FF6")) +
labs(x = "Condición clínica", y = "Nº Personas. ",
title = "Distribución de la presencia por enfermedad",
subtitle = "Muestra de 810 pacientes", fill = "Estado:") +
geom_label(position=position_stack(vjust=0.5), color = 'white') +
coord_flip() +
theme_linedraw()
I am working in a email classification supervised model, the emails are classified in 20 different groups, I have finished the model for the first group (G1) (a very large code) and I would like to know if there's some function which can repeat the code but with the others groups as variable, because changing G1 for (G2...G20)manually would be so tedious.
I have not idea how I could do it.
####G1####
datos_pivot1= cast(datosArg[,c('Descripción', 'Subcategoría_Servicio', 'value')], Descripción ~ Subcategoría_Servicio, mean)
datos_pivot1=datos
datos_G1=datos[datos$G1>0 & is.na(datos$G1)==F ,c('Descripción','G1')]
wordcloud(datos_G1$Descripción, max.words = 200, min.freq = 200, random.order = F, colors = brewer.pal(name = "Dark2", n = 8))
length(datos_G1$Descripción)
# casos FALSE
datos_G1_no=datos[is.na(datos$G1)==T ,c('Descripción','G1')]
# numero de casos sin O2C
length(datos_G1_no$Descripción)
#para balancear la cantidad de True vs False, se selecciona una muestra del mismo número de casos True
datos_G1_no_sample =datos_G1_no[sample(1:length(datos_G1_no$Descripción),size=length(datos_G1$Descripción)),]
datos_G1_no_sample$G1=0
cor1=head(datos_G1_no_sample)
#unir casos TRUE Y casos FALSE
datos_G1 = rbind(datos_G1, datos_G1_no_sample)
table(datos_G1$G1)
#corpus
base_corpus_G1 <- Corpus(VectorSource(datos_G1$Descripción))
#Matriz de términos
base_tdm_G1 <- TermDocumentMatrix(base_corpus_G1)
#Eliminar términos dispersos
base_tdm_G1 <- removeSparseTerms(base_tdm_G1, sparse = .95)
#Matriz por filas=Analisis, columnas = palabras
base_mat_G1 <- t(as.matrix(base_tdm_G1))
base_mat_G1= cbind(base_mat_G1, data.frame(G1=c(rep(1,table(datos_G1$G1)[2]),rep(0,table(datos_G1$G1)[2]))))
head(base_mat_G1)
##ENTRENAMIENTO Y PRUEBA
## 75% Train.
smp_size <- floor(0.75 * nrow(datos_G1))
#definimos una semilla para que cuando volvamos a ejecutar obtengamos la misma muestra
set.seed(456)
train_ind <- sample(seq_len(nrow(base_mat_G1)), size = smp_size)
#Filtro de Entrenamiento 75% (basado en el sample de la linea anterior)
train_G1 <- base_mat_G1[train_ind, ]
#Filtro de prueba 75% (los otros) (el menos indica las contratias)
test_G1 <- base_mat_G1[-train_ind, ]
table(train_G1$G1)
##MODELOS O2C
##Arbol de decision
library(rpart)
tree_G1 <- rpart(G1 ~ ., data = train_G1)
#Predict
pred.tree_G1 <- predict(tree_G1, newdata = test_G1)
pred.tree_G1=(as.data.frame(pred.tree_G1))
names(pred.tree_G1)=c('prob')
pred.tree_G1$G1.pred=0
pred.tree_G1$G1.pred[pred.tree_G1$prob>0.51] = 1
table(test_G1$G1, pred.tree_G1$G1.pred)
rpart.plot(tree_G1)
#Curva ROC
roc.curve(test_G1$G1, pred.tree_G1$G1.pred, curve=TRUE)
##GLM
#train
glm_G1 <- glm(G1 ~ ., family=binomial(logit), data=train_G1)
#predict
pred.glm_G1 = test_G1[,c('G1','G1')]
pred.glm_G1 = cbind(pred.glm_G1, data.frame(predict(glm_G1, newdata=test_G1,type='response')))
pred.glm_G1$G1 = NULL
pred.glm_G1$G1.1 = NULL
names(pred.glm_G1)=c('prob')
pred.glm_G1$G1.pred=0
pred.glm_G1$G1.pred[pred.glm_G1$prob>0.51] = 1
table(test_G1$G1, pred.glm_G1$G1.pred)
#Curva ROC:
roc.curve(test_G1$G1, pred.glm_G1$G1.pred, curve=TRUE)
##KKNN
kknn_G1 <- kknn(G1 ~ ., train_G1, test_G1, distance = 1, k=350, kernel = "optimal")
pred.kknn_G1 = test_G1[,c('G1','G1')]
pred.kknn_G1$prob<-kknn_G1$fitted.values
pred.kknn_G1$G1 = NULL
pred.kknn_G1$G1.1 = NULL
pred.kknn_G1$G1.pred=0
pred.kknn_G1$G1.pred[pred.kknn_G1$prob>0.51] = 1
table(test_G1$G1, pred.kknn_G1$G1.pred)
#Curva ROC
roc.curve(test_G1$G1, pred.kknn_G1$G1.pred, curve=TRUE)
head(pred.kknn_G1)
If you are using R studio, just press command + F or press the Find/Replace button in your R console you can easily replace all 'G1' with 'G2'.
I built a graph and used the coord_polar function. However, the x labels are too long, so I used the str_wrap() function from the stringr library to wrap them. Unfortunately when they are plotted, the text in every label is centered.
I want the text IN the labels to be aligned to the left, normally this is done with the hjust function in theme(), but when using coord_polar() it does not work. What am I doing wrong?
Data:
preguntas = c("Mi superior restringe mis posibihdlidades de comunicarme,hablar o reunirme con él",
"Me ignoran, me excluyen o me hfacen el vacio, fingen no verme o me hacfen invisible",
"Me interrumpen continuamente impidiendo expfresarme","Me fuerzan a realifzar trabajos que van contra mis principios o mi ética",
"Evalúan mi trabajo de manera inequitativfa o de forma sesgada","Me dejan sifn ningún trabajo que hacer, ni siquiera a iniciativa propia",
"Me asignan tareas o trabajos absurdos o sin sentido","Me impiden que adopte flas medidas de seguridad necesarias para realizar mi trabajo con la debida seguridad",
"Mi superior restringe mis posibilidades de comunicarme, hablar o reunirme conf él",
"Me ignoran, me excluyen o me hacen el vacio, fingen no verme o me hacen invisifble",
"Me interrumpen continuamente impidiendo expresarme","Me fuerzan a realizar trabfajos que van contra mis principios o mi ética",
"Evalúan mi trabajo de manera idnequitativa o de forma sesgada","Me dejan sin ningfún trabajo que hacer, ni siquiera a iniciativa propia",
"Me asignan tareas o trabajos absurdos o sin sefntido","Me impiden que adopte las mfedidas de seguridad necesarias para realizar mi trabajo con la debida seguridad",
"Mi superior restringe mis posibilidades de comufnicarme", "hablar o reunirme con éfl",
"Me ignoran, me excluyen o me hacen el vacio, fingen no verme o me hacen invisiblfe",
"Me interrumpen continuamente impidiendo expresarmfe","Me fuerzan a realizar trabajfos que van contra mis principios o mi ética",
"Evalúan mi trabajo de manera inequitativa o de fforma sesgada","Me dejan sin ningúnf trabajo que hacer, ni siquiera a iniciativa propia",
"Me asignan tareas o trabajos absurdos o sin senftido","Me impiden que adopte las medfidas de seguridad necesarias para realizar mi trabajo con la debida seguridad",
"Mi superior restringe mis posibilidades de comfunicarme, hablar o reunifrme con él",
"Me ignoran, me exclujyen o me hacen el vacio, ffingen no verme o me hacenf invisible",
"Me interrumpen continuamente impidiendo exprfesarme","Me fuerzan a realizfar trabajos que van contra mis principios o mi ética",
"Evalúan mi trabajo de manera inequitativa of de forma sesgada","Me dejan sfin ningún trabajo que hacer, ni siquiera a iniciativa propia",
"Me asignan tareas o trabajos absurdos o sifn sentido","Me impiden que adoptfe las medidas de seguridad necesarias para realizar mi trabajo con la debida seguridad",
"Mi superior restringe mis posibilidades dfe comunicarme, hablar o reunirme cfon él",
"Me ignoran, me excluyen o me hacen el vafcio, fingen no verme o me hacen invifsible",
"Me interrumpen continuamente impidiendof expresarme","Me fuerzan a realizar trfabajos que van contra mis principios o mi ética",
"Evalúan mi trabajo de manera inequitatfiva o de forma sesgada","Me dejan sin nifngún trabajo que hacer, ni siquiera a iniciativa propia",
"Me asignan tareas o trabajos absurdosf o sin sentido","Me impiden que adopte lasf medidas de seguridad necesarias para realizar mi trabajo con la debida seguridad",
"Evalúan mi trabajo de magnera inequitatfiva o de forma sesgada","Me dejan siin nifngún trabajo que hacer, ni siquiera a iniciativa propia")
valores = floor(runif(43, min=1, max=6))
dataset = data.frame(preguntas, valores)
Code:
library(ggplot2)
library(stringr)
dataset$preguntasCortas = str_wrap(dataset$preguntas, width = 8)
ggplot (data = dataset,
aes(x = preguntasCortas, y = valores, fill = valores)
) +
geom_bar(width = .4, stat = "identity", na.rm = TRUE)+
scale_fill_gradient(low = "gray", high = "red", limits = c(1, 6)) +
coord_polar() +
scale_y_discrete(limits = c(0,7)) +
theme(
axis.text.y = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 0,hjust = 0),
legend.title = element_blank(),
legend.text = element_text(size = 10),
axis.title = element_blank(),
axis.ticks = element_blank(),
panel.background = element_rect(fill = "transparent", color = NA),
plot.margin = unit(c(-.1, -.1, -.1, -.1), "cm"),
text = element_text(
family = "Century Gothic", size=5, color = "#595959"
)
)
In polar coordinates, the hjust / vjust parameter values are hard-coded to 0.5 in CoordPolar$render_fg (See source code here).
You can get around it by defining your own version of CoordPolar that codes hjust differently in render_fg, & define a coord_polar2() function that calls on that instead of the original CoordPolar:
CoordPolar2 <- ggproto("CoordPolar2",
CoordPolar,
render_fg = function (self, panel_params, theme) {
if (is.null(panel_params$theta.major)) {
return(element_render(theme, "panel.border"))
}
theta <- ggplot2:::theta_rescale(self, panel_params$theta.major, panel_params)
labels <- panel_params$theta.labels
theta <- theta[!is.na(theta)]
ends_apart <- (theta[length(theta)] - theta[1])%%(2 * pi)
if (length(theta) > 0 && ends_apart < 0.05) {
n <- length(labels)
if (is.expression(labels)) {
combined <- substitute(paste(a, "/", b), list(a = labels[[1]],
b = labels[[n]]))
}
else {
combined <- paste(labels[1], labels[n], sep = "/")
}
labels[[n]] <- combined
labels <- labels[-1]
theta <- theta[-1]
}
grid::grobTree(if (length(labels) > 0)
ggplot2:::element_render(theme,
"axis.text.x",
labels,
unit(0.45 * sin(theta) + 0.5, "native"),
unit(0.45 * cos(theta) + 0.5, "native"),
hjust = 0, # hjust = 0.5,
vjust = 0.5),
ggplot2:::element_render(theme, "panel.border"))
})
coord_polar2 <- function (theta = "x", start = 0, direction = 1, clip = "on") {
theta <- match.arg(theta, c("x", "y"))
r <- if (theta == "x")
"y"
else "x"
ggproto(NULL,
CoordPolar2, #CoordPolar,
theta = theta, r = r, start = start,
direction = sign(direction), clip = clip)
}
Usage example (I simplified the code & took only the first few rows of data for illustration):
p <- ggplot(data = dataset[1:8, ], # first 8 rows
aes(x = preguntasCortas, y = valores, fill = valores)) +
geom_col(width = .4, na.rm = TRUE)+
scale_fill_gradient(low = "gray", high = "red", limits = c(1, 6)) +
scale_y_discrete(limits = c(0,7)) +
theme_void() +
theme(axis.text.x = element_text(size = 5, lineheight = 0.9, angle = 45))
cowplot::plot_grid(
p + coord_polar(),
p + coord_polar2(),
nrow = 1,
labels = c("Original", "New")
)
I´ve made a little simulator to teach the basics of population dynamics under stochasticity. This is a simple viz for the Ricker equation. It works in linux, however, I get a criptic error while running it under other environment (macos, win).
So, I wonder what my best options are to debug this error:
<simpleError in is.list(x): object of type 'closure' is not subsettable>
here is the code. I suspect on the plotly library in R... any hint?
# Ejercicio para ensenar curvas de crecimiento poblacional
# _author_ = horacio.samaniego#gmail.com
# _date_ = August 2018
# Check whether required packages are installed
list.of.packages <- c("manipulateWidget", "plotly")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
# librerias requeridas
library(manipulateWidget)
library(plotly)
# Simulador
crecLogistico <- function(t=80,r=1,n0=10,K=60,d=0){
# Simulacion de crecimiento poblacional con tasa de crecimiento (r) variable
# que simula variabilidad (estocasticidad ambiental)
# t, numero de generaciones a simular
# r, tasa intrinsica de crecimiento
# n0, abundancia inicial
# K, capacidad de carga
# d, estocasticidad
N <- matrix(n0,ncol=t,nrow=1) # vector con tamano poblacional (abundancia) inicial
R <- matrix(NA,ncol=t,nrow=1) # vector con tasas de crecimiento
for(i in 1:t) {
if(d>0) R[i] <- rnorm(1,mean=r,sd=d) else R[i] <- r
# N[i+1] <- N[i]+N[i]*R[i]*(1-N[i]/K) # Logistica
N[i+1] <- N[i]*exp(R[i]*(1 - N[i]/K)) # Ricker
}
res <- matrix(c(1:t,N[-(t+1)],R),ncol=3)
res <- as.data.frame(res)
names(res) <- c("t","Abundancia","r")
return(res)
}
## Plot de Crecimiento Logistico
if ( require(plotly) ) {
manipulateWidget({
# Modela abundancias
res = crecLogistico(n0=n0,t=t,r=r,K=K,d=d)
# Colecta informacion para construir mapa logistico
mapa = data.frame("N_1"=res$Abundancia[-t],"N_0"=res$Abundancia[-1])
combineWidgets( # crea ventanas donde plotear (proporcion 3:1). Una grande a la izq y otra con 2 lineas a la dcha (1:1)
ncol = 2,colsize=c(3,1),
# Evolucion temporal de poblacion
p = plot_ly(res[rango[1]:rango[2],],x=~t,y=~Abundancia,type="scatter",
mode="lines+markers",line=~r,color=~r), # %>%
# agrega linea para remarcar abundancia = 0
add_segments(p, x = rango[1], xend = rango[2], y = 0, yend = 0,mode="lines") %>%
# muestra escocasticidad a cada tiempo segun color
colorbar(title="Tasa de Crecimiento") %>%
layout(title="Crecimiento Logistico",showlegend = FALSE,yaxis=list(zerolinecolor=toRGB("red"))),
combineWidgets(
ncol = 1,
# histograma de estocasticidad a lo largo de todo el tiempo
plot_ly(res,x=~r,type="histogram") %>%
layout(title="Tasa de Crecimiento"),
# mapa logistico, muestra estados estacionarios en primer orden, de t-a a t
plot_ly(mapa,x=~N_1,y=~N_0,type="scatter",mode="markers") %>%
add_segments(x=0,xend=max(res$Abundancia),y=0,yend=max(res$Abundancia)) %>%
layout(title="Mapa Logistico", xaxis = list(title = "abundancia (t)"),
yaxis = list(title="abundancia (t-1)"))
)
)
},
n0 = mwNumeric(100, min = 2, step = 1 , label = "Poblacion Inicial"),
t = mwNumeric(100, min = 2, step = 1 , label = "Generaciones (t)"),
r = mwNumeric(0.9, min = -4, step = 0.05 , label = "Tasa de Crecimiento (r)"),
K = mwNumeric(60, min = 5, step = 2, label = "Capacidad de Carga"),
d = mwNumeric(0.05, min = 0, step = 0.05 ,label = "Estocasticidad"),
rango = mwSlider(0, t, c(1, t),label="Generaciones a Visualizar")
)
}
will report... thanks a bunch!!
Ok, I've got the issue... the problem is that plotly in R (or rstudio) for linux is not too picky about the 'line' flag in plot_ly, which macos strictly enforces.
I unfortunately have no training in debugging code and would not be able diagnose this using the standard tools mentioned here (will learn though!)
recasting the line to this:
plot_ly(res[rango[1]:rango[2],],x=~t,y=~Abundancia,type="scatter", mode="lines+markers",color=~r) %>%
did all the trick.
Thanks,
I'll copy my equation explorer here just in case:
# Ejercicio para ensenar curvas de crecimiento poblacional
# _author_ = horacio.samaniego#gmail.com
# _date_ = August 2018
# Check whether required packages are installed
list.of.packages <- c("manipulateWidget", "plotly")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) install.packages(new.packages)
# librerias requeridas
library(manipulateWidget)
library(plotly)
# Simulador
crecLogistico <- function(t=80,r=1,n0=10,K=60,d=0){
# Simulacion de crecimiento poblacional con tasa de crecimiento (r) variable
# que simula variabilidad (estocasticidad ambiental)
# t, numero de generaciones a simular
# r, tasa intrinsica de crecimiento
# n0, abundancia inicial
# K, capacidad de carga
# d, estocasticidad
N <- matrix(n0,ncol=t,nrow=1) # vector con tamano poblaciona (abundancia) inicial
R <- matrix(NA,ncol=t,nrow=1) # vector con tasas de crecimiento
for(i in 1:t) {
if(d>0) R[i] <- rnorm(1,mean=r,sd=d) else R[i] <- r # adds stochasticity
# N[i+1] <- N[i]+N[i]*R[i]*(1-N[i]/K) # Logistica
N[i+1] <- N[i]*exp(R[i]*(1 - N[i]/K)) # Ricker
}
res <- matrix(c(1:t,N[-(t+1)],R),ncol=3)
res <- as.data.frame(res)
names(res) <- c("t","Abundancia","r")
return(res)
}
## Plot de Crecimiento Logistico
if ( require(plotly) ) {
manipulateWidget({
# Modela abundancias
res = crecLogistico(n0=n0,t=t,r=r,K=K,d=d)
# Colecta informacion para construir mapa logistico
mapa = data.frame("N_1"=res$Abundancia[-t],"N_0"=res$Abundancia[-1])
combineWidgets( # crea ventanas donde plotear (proporcion 3:1). Una grande a la izq y otra con 2 lineas a la dcha (1:1)
ncol = 2,colsize=c(3,1),
# Evolucion temporal de poblacion
plot_ly(res[rango[1]:rango[2],],x=~t,y=~Abundancia,type="scatter", mode="lines+markers",color=~r) %>%
# # muestra escocasticidad a cada tiempo segun color
colorbar(title="Tasa de Crecimiento") %>%
layout(title="Crecimiento Logistico",showlegend = FALSE,yaxis=list(zerolinecolor=toRGB("red"))),
combineWidgets(
ncol = 1,
# histograma de estocasticidad a lo largo de todo el tiempo
plot_ly(res,x=~r,type="histogram") %>%
layout(title="Tasa de Crecimiento"),
# mapa logistico, muestra estados estacionarios en primer orden, de t-a a t
plot_ly(mapa,x=~N_1,y=~N_0,type="scatter",mode="markers") %>%
add_segments(x=0,xend=max(res[[2]]),y=0,yend=max(res[[2]])) %>%
layout(title="Mapa Logistico", xaxis = list(title = "abundancia (t)"),
yaxis = list(title="abundancia (t-1)"),showlegend = FALSE)
)
)
},
n0 = mwNumeric(100, min = 2, step = 1 , label = "Poblacion Inicial"),
t = mwNumeric(100, min = 2, step = 1 , label = "Generaciones (t)"),
r = mwNumeric(0.9, min = -4, step = 0.05 , label = "Tasa de Crecimiento (r)"),
K = mwNumeric(60, min = 5, step = 2, label = "Capacidad de Carga"),
d = mwNumeric(0.05, min = 0, step = 0.05 ,label = "Estocasticidad"),
rango = mwSlider(0, t, c(1, t),label="Generaciones a Visualizar")
)
}