Related
I have some data which looks like:
# A tibble: 100 × 4
price habs mts2 type
<dbl> <dbl> <dbl> <chr>
1 338000 3 92 comprar
2 288000 4 79 comprar
3 3000 2 55 alquiler
4 775 1 10 alquiler
5 288000 4 76 comprar
In R I can plot the data using the following:
library(highcharter)
library(tidyverse)
library(broom)
highcharterPlotterFunction = function(TYPE){
filteredDF = df %>%
filter(type == TYPE)
# formula = as.formula(y ~ x + I(x^2))
lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
mutate(
.fitted = round(.fitted, 0)
)
highchart() %>%
hc_add_series(data = lm.model,
type = "scatter",
hcaes(x = price, y = mts2, color = mts2),
showInLegend = FALSE,
dataLabels = list(enabled = TRUE, format='{point.games}')
) %>%
hc_add_series(data = lm.model,
type = "line",
hcaes(x = .fitted, y = mts2),
color = "#0099F9",
showInLegend = FALSE,
dataLabels = list(enabled = TRUE, format='{point.games}')
) %>%
hc_title(text = str_to_title(TYPE))
}
c("comprar", "alquiler") %>%
map(., ~highcharterPlotterFunction(.x)) %>%
hw_grid(rowheight = 300, ncol = 1) %>%
htmltools::browsable()
Which plots two highercharter graphics on top of each other. However, when I try to put it into a shiny App I do not get any output:
Shiny App:
library(shiny)
ui <- fluidPage(
fluidRow(
p("plot goes below here"),
highchartOutput('regressionPlots')
)
)
server <- function(input, output) {
highcharterPlotterFunction = function(TYPE){
filteredDF = reactive_regression_data() %>%
filter(type == TYPE)
# formula = as.formula(y ~ x + I(x^2))
lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
mutate(
.fitted = round(.fitted, 0)
)
highchart() %>%
hc_add_series(data = lm.model,
type = "scatter",
hcaes(x = price, y = mts2, color = mts2),
showInLegend = FALSE
) %>%
hc_add_series(data = lm.model,
type = "line",
hcaes(x = .fitted, y = mts2),
color = "#0099F9",
showInLegend = FALSE
) %>%
hc_title(text = str_to_title(TYPE))
}
reactive_regression_data = reactive(
df %>%
# filter(provincia == input$provinceSelect) %>%
# filter(municipio == input$municipioSelect) %>%
# filter(distrito == input$distritoSelect) %>%
filter(price <= 1000000) %>%
filter(mts2 <= 200)
)
output$regressionPlots <- renderHighchart({
c("comprar", "alquiler") %>%
map(., ~highcharterPlotterFunction(.x)) %>%
hw_grid(rowheight = 300, ncol = 1) %>%
htmltools::browsable()
})
}
shinyApp(ui = ui, server = server)
Data:
df <- structure(list(price = c(338000, 288000, 3000, 775, 288000, 230000,
218000, 2900, 845000, 1250, 288000, 299000, 356000, 1500, 300000,
1300, 1500, 288000, 405000, 715000, 225000, 294000, 790, 329000,
320000, 1200, 1150, 715000, 415000, 715000, 295000, 1500, 348000,
1100, 3000, 249000, 379000, 761000, 320000, 1995, 715000, 715000,
229000, 1600, 389000, 330000, 212000, 415000, 288000, 950, 1850,
365000, 1050, 1650, 1750, 350000, 288000, 715000, 1200, 990,
260000, 234500, 1400, 288000, 1100, 1650, 348000, 332000, 288000,
350000, 1350, 360000, 2800, 379000, 799000, 288000, 685000, 1700,
890, 294000, 338000, 590000, 294000, 1050, 320000, 1990, 350000,
1100, 365000, 365000, 294000, 299000, 288000, 490000, 229000,
2095, 560000, 288000, 715000, 360000), habs = c(3, 4, 2, 1, 4,
3, 2, 4, 3, 2, 4, 2, 2, 4, 2, 4, 2, 4, 3, 3, 1, 2, 1, 4, 3, 3,
NA, NA, 3, NA, 3, 2, 4, 2, 4, 2, 3, 3, 2, 2, 3, 3, 3, 1, 4, 4,
2, 4, 4, 1, 4, 3, 1, 2, 2, 4, 4, 3, 3, 2, NA, 3, 4, 4, 3, 1,
4, 4, 4, 4, 3, 4, 2, 3, 4, 4, 4, 4, 2, 2, 3, 4, 2, 1, 3, 1, 4,
3, 3, 3, 2, 2, 4, 4, 3, 3, 4, 4, 3, 2), mts2 = c(92, 79, 55,
10, 76, 65, 57, 95, 121, 57, 76, 90, 70, 102, 74, 83, 88, 79,
83, 109, 60, 75, 47, 75, 68, 70, 30, 109, 80, 109, 100, 75, 80,
70, 135, 65, 95, 121, 68, 110, 109, 109, 63, 70, 100, 85, 54,
100, 76, 45, 100, 94, 46, 71, 92, 87, 76, 109, 88, 68, 58, 65,
104, 75, 75, 40, 80, 80, 76, 87, 75, 112, 95, 111, 135, 79, 88,
115, 43, 75, 92, 145, 75, 46, 92, 47, 87, 75, 90, 63, 70, 85,
76, 111, 60, 132, 140, 79, 109, 70), type = c("comprar", "comprar",
"alquiler", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar",
"comprar", "comprar", "alquiler", "comprar", "comprar", "alquiler",
"alquiler", "comprar", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar",
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "comprar", "comprar", "comprar", "comprar", "alquiler",
"alquiler", "comprar", "alquiler", "alquiler", "alquiler", "comprar",
"comprar", "comprar", "alquiler", "alquiler", "comprar", "comprar",
"alquiler", "comprar", "alquiler", "alquiler", "comprar", "comprar",
"comprar", "comprar", "alquiler", "comprar", "alquiler", "comprar",
"comprar", "comprar", "comprar", "alquiler", "alquiler", "comprar",
"comprar", "comprar", "comprar", "alquiler", "comprar", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "comprar", "comprar", "alquiler", "comprar", "comprar",
"comprar", "comprar")), row.names = c(NA, -100L), class = c("tbl_df",
"tbl", "data.frame"))
You when you use renderHighchart(), the expression in the curly braces expects a return value of class highchart. However, when you combine multiple charts using hw_grid(), the return value is of class shiny.tag. Therefore, the output binding is not able to render the output and (silently) fails.
The simplest fix for this is to replace renderHighchart() with renderUI() and highchartOutput() with uiOutput().
shiny::shinyApp(
shiny::fluidPage(
shiny::uiOutput("chart")
),
function(input, output, session) {
output$chart <- shiny::renderUI({
highcharter::hw_grid(
highcharter::highcharts_demo(),
highcharter::highcharts_demo()
)
})
}
)
Annother approach would be to use two separate calls to renderHighchart()/highchartOutput() and combine the charts inside the UI. However, with this approach you won't be able to use hw_grid()
A third way, which is probably the most challenging yet the most flexible is to use the highcharts.js API to generate multiple axes as in the examples here. This way, the dual-axis chart will be represented as a single highcharter object which means that it can be passed to renderHighchart().
I have to do a ggplot barplot with errorbars, Tukey sig. letters for plants grown with different fertilizer concentraitions.
The data should be grouped after the dif. concentrations and the sig. letters should be added automaticaly.
I have already a code for the same problem but for Boxplot - which is working nicely. I tried several tutorials with barplots but I always get the problem; stat_count() can only have an x or y aesthetic.
So I thought, is it possible to get my boxplot code to a barplot code? I tried but I couldnt do it :) And if not - how do I automatically add tukeyHSD Test result sig. letters to a ggplot barplot?
This is my Code for the boxplot with the tukey letters:
value_max = Dünger, group_by(Duenger.g), summarize(max_value = max(Höhe.cm))
hsd=HSD.test(aov(Höhe.cm~Duenger.g, data=Dünger),
trt = "Duenger.g", group = T) sig.letters <- hsd$groups[order(row.names(hsd$groups)), ]
J <- ggplot(Dünger, aes(x = Duenger.g, y = Höhe.cm))+ geom_boxplot(aes(fill= Duenger.g))+ scale_fill_discrete(labels=c("0.5g", '1g', "2g", "3g", "4g"))+ geom_text(data = value_max, aes(x=Duenger.g, y = 0.1 + max_value, label = sig.letters$groups), vjust=0)+ stat_boxplot(geom = 'errorbar', width = 0.1)+ ggtitle("Auswirkung von Dünger auf die Höhe von Pflanzen") + xlab("Dünger in g") + ylab("Höhe in cm"); J
This is how it looks:
boxplot with tukey
Data from dput:
structure(list(Duenger.g = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4), plant = c(1, 2, 3, 4, 5, 7, 10, 11, 12, 13, 14, 18, 19,
21, 23, 24, 25, 26, 27, 29, 30, 31, 33, 34, 35, 37, 38, 39, 40,
41, 42, 43, 44, 48, 49, 50, 53, 54, 55, 56, 57, 58, 61, 62, 64,
65, 66, 67, 68, 69, 70, 71, 72, 73, 75, 79, 80, 81, 83, 85, 86,
88, 89, 91, 93, 99, 100, 102, 103, 104, 105, 106, 107, 108, 110,
111, 112, 113, 114, 115, 116, 117, 118, 120, 122, 123, 125, 126,
127, 128, 130, 131, 132, 134, 136, 138, 139, 140, 141, 143, 144,
145, 146, 147, 149), height.cm = c(5.7, 2.8, 5.5, 8, 3.5, 2.5,
4, 6, 10, 4.5, 7, 8.3, 11, 7, 8, 2.5, 7.4, 3, 14.5, 7, 12, 7.5,
30.5, 27, 6.5, 19, 10.4, 12.7, 27.3, 11, 11, 10.5, 10.5, 13,
53, 12.5, 12, 6, 12, 35, 8, 16, 56, 63, 69, 62, 98, 65, 77, 32,
85, 75, 33.7, 75, 55, 38.8, 39, 46, 35, 59, 44, 31.5, 49, 34,
52, 37, 43, 38, 28, 14, 28, 19, 20, 23, 17.5, 32, 16, 17, 24.7,
34, 50, 12, 14, 21, 33, 39.3, 41, 29, 35, 48, 40, 65, 35, 10,
26, 34, 41, 32, 38, 23.5, 22.2, 20.5, 29, 34, 45)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -105L))
Thank you
mirai
A bar chart and a boxplot are two different things. By default geom_boxplot computes the boxplot stats by default (stat="boxplot"). In contrast when you use geom_bar it will by default count the number of observations (stat="count") which are then mapped on y. That's the reason why you get an error. Hence, simply replacing geom_boxplot by geom_bar will not give your your desired result. Instead you could use e.g. stat_summary to create your bar chart with errorbars. Additionally I created a summary dataset to add the labels on the top of the error bars.
library(ggplot2)
library(dplyr)
library(agricolae)
Dünger <- Dünger |>
rename("Höhe.cm" = height.cm) |>
mutate(Duenger.g = factor(Duenger.g))
hsd <- HSD.test(aov(Höhe.cm ~ Duenger.g, data = Dünger), trt = "Duenger.g", group = T)
sig.letters <- hsd$groups %>% mutate(Duenger.g = row.names(.))
duenger_sum <- Dünger |>
group_by(Duenger.g) |>
summarize(mean_se(Höhe.cm)) |>
left_join(sig.letters, by = "Duenger.g")
ggplot(Dünger, aes(x = Duenger.g, y = Höhe.cm, fill = Duenger.g)) +
stat_summary(geom = "bar", fun = "mean") +
stat_summary(geom = "errorbar", width = .1) +
scale_fill_discrete(labels = c("0.5g", "1g", "2g", "3g", "4g")) +
geom_text(data = duenger_sum, aes(y = ymax, label = groups), vjust = 0, nudge_y = 1) +
labs(
title = "Auswirkung von Dünger auf die Höhe von Pflanzen",
x = "Dünger in g", y = "Höhe in cm"
)
#> No summary function supplied, defaulting to `mean_se()`
But as the summary dataset now already contains the mean and the values for the error bars a second option would be to do:
ggplot(duenger_sum, aes(x = Duenger.g, y = y, fill = Duenger.g)) +
geom_col() +
geom_errorbar(aes(ymin = ymin, ymax = ymax), width = .1) +
scale_fill_discrete(labels = c("0.5g", "1g", "2g", "3g", "4g")) +
geom_text(aes(y = ymax, label = groups), vjust = 0, nudge_y = 1) +
labs(
title = "Auswirkung von Dünger auf die Höhe von Pflanzen",
x = "Dünger in g", y = "Höhe in cm"
)
Could you help me make a graph in R similar to the one I inserted in the image below, which shows the properties on a map, differentiating by cluster. See in my database that I have 4 properties, properties 1 and 3 are of cluster 1 and properties 2 and 4 are of cluster 2. In addition, the database has the coordinates of the properties, so I believe that with this information I can generate a graph similar to what I inserted. Surely, there must be some package in R that does something similar. Any help is welcome!
This link can help: https://rstudio-pubs-static.s3.amazonaws.com/176768_ec7fb4801e3a4772886d61e65885fbdd.html
#database
df<-structure(list(Properties = c(1,2,3,4),
Latitude = c(-24.930473, -24.95575,-24.924161,-24.95579),
Longitude = c(-49.994889, -49.990162,-50.004343, -50.007371),
cluster = c(1,2,1,2)), class = "data.frame", row.names = c(NA, -4L))
Properties Latitude Longitude cluster
1 1 -24.93047 -49.99489 1
2 2 -24.95575 -49.99016 2
3 3 -24.92416 -50.00434 1
4 4 -24.95579 -50.00737 2
Example of figure:
Your code
#database
df<-structure(list(Propertie = c(1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28,
30, 31, 32, 33, 34, 35, 38, 39, 40, 42, 43, 44, 45, 46, 47, 48,
49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 61, 62, 64, 65, 66,
67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82,
83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98,
99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111,
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124,
125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137,
138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150,
151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163,
164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 176,
177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189,
190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202,
203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215,
216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228,
229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241,
242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254,
255, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267,
268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280,
281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293,
294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306,
307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319,
320, 321, 322, 323, 324, 325), Latitude = c(-24.927417, -24.927417,
-24.927417, -24.927417, -24.930195, -24.930473, -24.946306, -24.949361,
-24.949361, -24.950195, -24.950195, -24.951584, -24.95575, -24.954084,
-24.96075, -24.957139, -24.95825, -24.96825, -24.961334, -24.968806,
-24.976861, -24.982139, -24.986584, -24.985487, -24.994362, -24.994362,
-24.999084, -24.771583, -24.77186, -24.772138, -24.772138, -24.78686,
-24.78436, -24.872139, -24.822222, -24.83549, -24.874916, -24.874916,
-24.874639, -24.865472, -24.873838, -24.87325, -24.858611, -24.874361,
-24.874361, -24.86, -24.860472, -24.874916, -24.814638, -24.814666,
-24.818527, -24.818527, -24.822694, -24.822694, -24.845472, -24.844638,
-24.878528, -24.879639, -24.879639, -24.906028, -24.897972, -24.900278,
-24.900278, -24.90075, -24.902972, -24.899361, -24.898611, -24.899083,
-24.913889, -24.908333, -24.914361, -24.914361, -24.924361, -24.915472,
-24.91075, -24.913805, -24.913528, -24.912139, -24.919917, -24.914083,
-24.914361, -24.914361, -24.925194, -24.92575, -24.928528, -24.929361,
-24.934361, -24.935278, -24.922694, -24.927139, -24.927972, -24.931861,
-24.936861, -24.878537, -24.887972, -24.882972, -24.901583, -24.901667,
-24.902139, -24.902139, -24.90325, -24.902972, -24.90299, -24.90575,
-24.905791, -24.899639, -24.899083, -24.875472, -24.878805, -24.883805,
-24.884916, -24.8905, -24.884083, -24.884087, -24.905194, -24.904125,
-24.894722, -24.895222, -24.895194, -24.911028, -24.907972, -24.908805,
-24.919916, -24.919361, -24.919639, -24.919639, -24.920194, -24.920472,
-24.917972, -24.908805, -24.911305, -24.91325, -24.917416, -24.928528,
-24.929083, -24.92325, -24.923805, -24.93188, -24.932139, -24.936028,
-24.935472, -24.937139, -24.923805, -24.922139, -24.922139, -24.926861,
-24.908805, -24.908333, -24.908805, -24.913805, -24.913805, -24.929638,
-24.939917, -24.943806, -24.942695, -24.94325, -24.944639, -24.946028,
-24.94825, -24.954084, -24.956111, -24.958611, -24.958806, -24.959084,
-24.958528, -24.958528, -24.956584, -24.955833, -24.95825, -24.960833,
-24.967417, -24.962695, -24.958611, -24.959083, -24.96075, -24.96075,
-24.964361, -24.961306, -24.961028, -24.962417, -24.965833, -24.964639,
-24.963806, -24.964917, -24.965472, -24.966861, -24.968528, -24.942972,
-24.948611, -24.950556, -24.951028, -24.951028, -24.93825, -24.941889,
-24.943528, -24.944639, -24.945194, -24.945472, -24.949083, -24.946861,
-24.94825, -24.949361, -24.951306, -24.948805, -24.948, -24.95075,
-24.952694, -24.959722, -24.961583, -24.96325, -24.96325, -24.96325,
-24.964639, -24.96575, -24.959361, -24.954639, -24.960472, -24.960472,
-24.966583, -24.970195, -24.972417, -24.976306, -24.974084, -24.974167,
-24.974639, -24.979362, -24.979639, -24.980278, -24.982973, -24.982973,
-24.977417, -24.979639, -24.981028, -24.981028, -24.98325, -24.969361,
-24.988056, -24.987139, -24.987139, -24.986584, -24.984639, -24.984639,
-24.984917, -24.984917, -24.994917, -24.987139, -24.989917, -24.992139,
-24.991861, -24.991861, -24.989639, -24.989917, -24.989917, -24.991861,
-24.989639, -24.992417, -24.975195, -24.97325, -24.979361, -24.972694,
-24.972972, -24.942417, -24.941861, -24.93825, -24.938273, -24.949639,
-24.948333, -24.948805, -24.949639, -24.949639, -24.951615, -24.951583,
-24.951615, -24.953611, -24.954639, -24.954639, -24.954639, -24.956861,
-24.956861, -24.966028, -24.956861, -24.955556, -24.957176, -24.96075,
-24.960194, -24.960231, -24.980194, -24.969106, -24.986306, -24.986306,
-24.993806, -24.877972, -24.878889, -24.87686, -24.886305, -24.875749,
-24.876305, -24.876319, -24.878805, -24.891027, -24.898527, -24.898527,
-24.904083, -24.904083, -24.905, -24.901328, -24.902138, -24.898268,
-24.900782, -24.901305, -24.88493, -24.887138, -24.929638, -25.001862,
-25.004084, -25.011028, -25.000194, -25.000472), Longitude = c(-49.98793,
-49.98793, -49.98793, -49.988778, -49.98962, -49.994889, -49.999912,
-49.991273, -49.991273, -49.996551, -49.996551, -49.995704, -49.990162,
-49.992945, -49.990718, -49.999056, -49.998222, -49.981259, -49.997389,
-49.979357, -49.999908, -49.995713, -49.980449, -49.995736, -49.980444,
-49.980444, -49.986852, -50.200149, -50.200172, -50.199602, -50.199603,
-50.199339, -50.209899, -50.038787, -50.243338, -50.235446, -50.139343,
-50.139348, -50.154871, -50.164607, -50.179621, -50.179895, -50.226412,
-50.196297, -50.196297, -50.233639, -50.234066, -50.242649, -50.251816,
-50.252098, -50.258233, -50.258233, -50.288502, -50.288525, -50.251001,
-50.261575, -50.039037, -50.044333, -50.044333, -50.015148, -50.115163,
-50.094472, -50.094472, -50.094899, -50.108204, -50.111829, -50.113653,
-50.114079, -50.010278, -50.017523, -50.010704, -50.010704, -50.004343,
-50.087667, -50.106547, -50.103487, -50.116283, -50.117968, -50.101301,
-50.119913, -50.120191, -50.120191, -50.079593, -50.080167, -50.082112,
-50.093519, -50.070172, -50.074194, -50.095459, -50.117959, -50.121024,
-50.094079, -50.102677, -50.129635, -50.140468, -50.143492, -50.166288,
-50.166426, -50.166816, -50.166844, -50.166024, -50.169635, -50.169635,
-50.165154, -50.165154, -50.175427, -50.182686, -50.188496, -50.203515,
-50.208765, -50.208487, -50.220728, -50.24933, -50.24933, -50.190159,
-50.204603, -50.241421, -50.241576, -50.241849, -50.135746, -50.144894,
-50.142117, -50.14408, -50.146839, -50.148223, -50.148223, -50.143802,
-50.144066, -50.151269, -50.163802, -50.159357, -50.160168, -50.159066,
-50.138232, -50.137107, -50.151288, -50.151001, -50.137376, -50.139061,
-50.132691, -50.132968, -50.152399, -50.170709, -50.176566, -50.176566,
-50.173237, -50.195182, -50.196949, -50.197376, -50.209608, -50.209608,
-50.239872, -50.007371, -50.006579, -50.007931, -50.008523, -50.01044,
-50.013787, -50.014607, -50.014037, -50.013056, -50.004181, -50.006569,
-50.004607, -50.008482, -50.008482, -50.026278, -50.030861, -50.018523,
-50.019444, -50.014903, -50.020181, -50.045875, -50.046301, -50.057121,
-50.057121, -50.036278, -50.040176, -50.043227, -50.044894, -50.036125,
-50.050158, -50.055186, -50.04876, -50.053213, -50.062385, -50.061561,
-50.085727, -50.093361, -50.083352, -50.083227, -50.083228, -50.10488,
-50.10351, -50.108783, -50.121816, -50.121279, -50.098487, -50.093788,
-50.104315, -50.10238, -50.107121, -50.108482, -50.111024, -50.124043,
-50.115723, -50.124343, -50.083375, -50.074315, -50.073515, -50.073514,
-50.073769, -50.070459, -50.072959, -50.106561, -50.116857, -50.113797,
-50.113797, -50.103802, -50.007107, -50.001815, -50.005185, -50.022371,
-50.021685, -50.022111, -50.004597, -50.006269, -50.007778, -50.001843,
-50.001843, -50.01906, -50.020185, -50.020185, -50.020426, -50.021843,
-50.06044, -50.00362, -50.00519, -50.00519, -50.007102, -50.024079,
-50.024079, -50.023778, -50.023778, -50.010732, -50.037686, -50.032936,
-50.03657, -50.038204, -50.038223, -50.041283, -50.042375, -50.044885,
-50.043227, -50.05851, -50.03988, -50.062653, -50.087385, -50.077112,
-50.110996, -50.119061, -50.126279, -50.132691, -50.149052, -50.149052,
-50.137371, -50.141431, -50.141858, -50.170992, -50.170992, -50.176288,
-50.176844, -50.176844, -50.14225, -50.142404, -50.142404, -50.142408,
-50.155432, -50.155432, -50.14852, -50.159344, -50.160579, -50.157409,
-50.158209, -50.170436, -50.170436, -50.132121, -50.165154, -50.144052,
-50.144052, -50.13408, -50.263247, -50.264755, -50.26821, -50.257386,
-50.28265, -50.2924, -50.2924, -50.303516, -50.264891, -50.251543,
-50.251543, -50.261302, -50.261539, -50.264755, -50.270455, -50.270747,
-50.294067, -50.290159, -50.290432, -50.315715, -50.320456, -50.251849,
-49.989338, -49.986551, -49.976296, -50.127404, -50.127654),
cluster = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 1,
4, 4, 5, 5, 5, 5, 5, 5, 4, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 1, 1, 1, 1, 5, 5, 5, 5, 5, 5, 5, 5, 1, 1, 1, 1,
1, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 4, 4, 5, 5, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 4, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 5, 5, 5, 5, 5, 5, 2, 5, 5, 5, 5, 5, 5,
5, 5, 2, 2, 2, 2, 2, 2, 2, 5, 5, 5, 5, 5, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 2, 2, 2, 5, 5)), row.names = c(NA,
-318L), class = c("tbl_df", "tbl", "data.frame"))
w1<-convexhull.xy(df$Longitude[df$cluster==1], df$Latitude[df$cluster==1])
w2<-convexhull.xy(df$Longitude[df$cluster==2], df$Latitude[df$cluster==2])
w3<-convexhull.xy(df$Longitude[df$cluster==3], df$Latitude[df$cluster==3])
w4<-convexhull.xy(df$Longitude[df$cluster==4], df$Latitude[df$cluster==4])
w5<-convexhull.xy(df$Longitude[df$cluster==5], df$Latitude[df$cluster==5])
p1<-st_as_sf(w1, crs=4269)
p2<-st_as_sf(w2, crs=4269)
p3<-st_as_sf(w3, crs=4269)
p4<-st_as_sf(w4, crs=4269)
p5<-st_as_sf(w5, crs=4269)
poly<-rbind(p1,p2,p3,p4,p5)
poly[,"cluster"]<-c(1,2,3,4,5)
pts<-st_as_sf(df, coords=c("Longitude", "Latitude"), crs=4269)
tmap_mode("plot")
tm_shape(poly)+
tm_polygons(col="cluster", palette=c("darkolivegreen","skyblue","skyblue","yellow","pink"), style="cat", title="cluster")+
tm_shape(pts)+
tm_dots(size=2)+
tm_layout(legend.outside = TRUE)
One approach would be use a voronoi partition. ggvoronoi will do this for you with ggplot2, and you could easily overlay it on a ggmap map.
There is also a st_voronoi function in the sf package which will create a voronoi partition shapefile from a MULTIPOINT shape (see update below).
Here is a simple example using your data. I have removed duplicated points (i.e. the same point in different clusters) which break the voronoi algorithm!
library(tidyverse) #specifically ggplot2 and dplyr for the pipe
library(ggvoronoi)
df %>% distinct(Longitude, Latitude, .keep_all = TRUE) %>%
ggplot(aes(x = Longitude, y = Latitude, fill = factor(cluster), label = cluster)) +
geom_voronoi() +
geom_text()
Update:
To do this with sf_voronoi you can do the following (unlike ggvoronoi, sf_voronoi works without having to weed out the duplicates)...
pts_vor <- pts %>% st_union() %>% #merge points into a MULTIPOINT
st_voronoi() %>% #calculate voronoi polygons
st_cast() %>% #next three lines return it to a useable list of polygons
data.frame(geometry = .) %>%
st_sf(.) %>%
st_join(., pts) #merge with clusters and other variables
pts_vor %>% ggplot(aes(fill = factor(cluster))) +
geom_sf(colour = NA) + #draw voronoi tiles (no borders)
geom_sf_text(data = pts, aes(label = cluster)) + #plot points
coord_sf(xlim = c(-50.35, -49.95), ylim = c(-25.05, -24.75))
#Antonio, I think this might be the solution you are after, but it requires at least three points per cluster to work, which from your figure I am assuming you have in your full dataset. The trick is to create convex hulls and convert them into polygons. This can be accomplished using the convexhull.xy() function in the spatstat:: package. Then these can be converted into simple features in the sf:: package, and then drawn with your mapping package of choice. I personally am a fan of the tmap:: package. Here is a reproducible example. Note, I had to add two more points to your example data to make this work (you cannot compute a polygon from only two points).
##Loading Necessary Packages##
library(spatstat)#For convexhull.xy() function
library(tmap)# For drawing the map
library(sf) #To create simple features for mapping
##Loading Example Data##
df<-structure(list(Properties = c(1,2,3,4,5,6),
Latitude = c(-24.930473, -24.95575,-24.924161,-24.95579, -24.94557, -24.93267),
Longitude = c(-49.994889, -49.990162,-50.004343, -50.007371, -50.01542, -50.00702),
cluster = c(1,2,1,2,1,2)), class = "data.frame", row.names = c(NA, -6L))
##Calculating convexhulls for each cluster##
w1<-convexhull.xy(df$Longitude[df$cluster==1], df$Latitude[df$cluster==1])
w2<-convexhull.xy(df$Longitude[df$cluster==2], df$Latitude[df$cluster==2])
##Converting hulls to simple features. Note, I assumed that you are using the EPSG 4269 projection (WGS84)
p1<-st_as_sf(w1, crs=4269)
p2<-st_as_sf(w2, crs=4269)
#Combining the two simple features together
poly<-rbind(p1,p2)
#Labelling the clusters
poly[,"cluster"]<-c(1,2)
#Creating a point simple feature from your property data in the dataframe
pts<-st_as_sf(df, coords=c("Longitude", "Latitude"), crs=4269)
#Setting the mapping mode to plot. Change this to "view" if you want an interactive map
tmap_mode("plot")
#Drawing the map
tm_shape(poly)+
tm_polygons(col="cluster", palette=c("darkolivegreen", "skyblue"), style="cat", title="cluster")+
tm_shape(pts)+
tm_dots(size=2)+
tm_layout(legend.outside = TRUE)
I am using ggpubr to combine multiple graphs in a single plot, but cannot seem to correctly generate one graph with the title that I would like. I would like the title to say "Customized legend," given that it is a common legend for both graphs. Does anybody know how I can do this?
Here is my data:
data1 = data.frame(var1 = c(1,
1,
1,
1,
2,
2,
2,
2,
3,
3,
3,
3,
4,
4,
4,
4,
5,
5,
5,
5,
6,
6,
6,
6,
7,
7,
7,
7,
8,
8,
8,
8,
9,
9,
9,
9,
10,
10,
10,
10,
11,
11,
11,
11,
12,
12,
12,
12,
13,
13,
13,
13,
14,
14,
14,
14,
15,
15,
15,
15,
16,
16,
16,
16,
17,
17,
17,
17,
18,
18,
18,
18,
19,
19,
19,
19,
20,
20,
20,
20,
21,
21,
21,
21,
22,
22,
22,
22,
23,
23,
23,
23,
24,
24,
24,
24,
25,
25,
25,
25,
26,
26,
26,
26,
27,
27,
27,
27,
28,
28,
28,
28,
29,
29,
29,
29,
30,
30,
30,
30,
31,
31,
31,
31,
32,
32,
32,
32,
33,
33,
33,
33),
var2 = c(1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4),
var3 = c(113,
89,
99,
41,
72,
64,
39,
139,
135,
17,
3,
135,
63,
126,
34,
87,
84,
125,
123,
18,
115,
11,
68,
85,
48,
95,
56,
129,
41,
78,
82,
122,
124,
4,
60,
132,
67,
128,
46,
79,
110,
88,
19,
88,
88,
126,
30,
11,
52,
66,
15,
52,
6,
74,
14,
101,
88,
70,
58,
20,
104,
76,
134,
23,
40,
1,
47,
25,
49,
110,
96,
100,
106,
26,
93,
19,
87,
41,
13,
40,
63,
87,
137,
105,
89,
95,
24,
49,
112,
92,
45,
105,
112,
105,
114,
129,
84,
33,
95,
95,
15,
90,
1,
62,
20,
7,
18,
96,
4,
71,
42,
94,
45,
102,
55,
98,
124,
80,
76,
97,
41,
31,
25,
21,
135,
138,
121,
93,
17,
13,
49,
26))
data2 <- data.frame(var1a = c(1,
1,
1,
1,
2,
2,
2,
2,
3,
3,
3,
3,
4,
4,
4,
4,
5,
5,
5,
5,
6,
6,
6,
6,
7,
7,
7,
7,
8,
8,
8,
8,
9,
9,
9,
9,
10,
10,
10,
10,
11,
11,
11,
11,
12,
12,
12,
12,
13,
13,
13,
13,
14,
14,
14,
14,
15,
15,
15,
15,
16,
16,
16,
16,
17,
17,
17,
17,
18,
18,
18,
18,
19,
19,
19,
19,
20,
20,
20,
20,
21,
21,
21,
21,
22,
22,
22,
22,
23,
23,
23,
23,
24,
24,
24,
24,
25,
25,
25,
25,
26,
26,
26,
26,
27,
27,
27,
27,
28,
28,
28,
28,
29,
29,
29,
29,
30,
30,
30,
30,
31,
31,
31,
31,
32,
32,
32,
32,
33,
33,
33,
33),
var2a = c(1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4,
1,
2,
3,
4),
var3a = c(113,
89,
99,
41,
72,
64,
39,
139,
135,
17,
3,
135,
63,
126,
34,
87,
84,
125,
123,
18,
115,
11,
68,
85,
48,
95,
56,
129,
41,
78,
82,
122,
124,
4,
60,
132,
67,
128,
46,
79,
110,
88,
19,
88,
88,
126,
30,
11,
52,
66,
15,
52,
6,
74,
14,
101,
88,
70,
58,
20,
104,
76,
134,
23,
40,
1,
47,
25,
49,
110,
96,
100,
106,
26,
93,
19,
87,
41,
13,
40,
63,
87,
137,
105,
89,
95,
24,
49,
112,
92,
45,
105,
112,
105,
114,
129,
84,
33,
95,
95,
15,
90,
1,
62,
20,
7,
18,
96,
4,
71,
42,
94,
45,
102,
55,
98,
124,
80,
76,
97,
41,
31,
25,
21,
135,
138,
121,
93,
17,
13,
49,
26))
Here is the code that I am using:
#Open packages
library(ggplot2)
library(ggpubr)
#Set the theme
theme_set(theme_pubr())
#Change necessary columns to factor
data1$var2 <- factor(data1$var2, levels = c(1,2,3,4))
data2$var2a <- factor(data2$var2a, levels = c(1,2,3,4))
#Generate the plots
#Generate plots
plot1 <- ggplot(data1, aes(x = var1, y = var3, group = var2)) +
geom_line(size = 1.5, aes(linetype = var2, color = var2)) +
xlab('x_label') +
ylab('y_label')+
scale_fill_discrete(name = 'customized legend')
plot2 <- ggplot(data2, aes(x = var1a, y = var3a, group = var2a)) +
geom_line(size = 1.5, aes(linetype = var2a, color = var2a)) +
xlab('x_label') +
ylab('y_label')+
scale_fill_discrete(name = 'customized legend')
#Combine both into one picture
fig <- ggarrange(plot1, plot2,
ncol = 2,
nrow = 1,
common.legend = TRUE,
legend = "bottom")
fig
Since you didn't use the fill aesthetic in your ggplot, you should not use scale_fill_discrete. What you need is to set the legend title of linetype and color to "customized legend", since those are the aesthetics that you used.
library(ggplot2)
library(ggpubr)
plot1 <- ggplot(data1, aes(x = var1, y = var3, group = var2)) +
geom_line(size = 1.5, aes(linetype = var2, color = var2)) +
xlab('x_label') +
ylab('y_label') +
labs(linetype = "customized legend", color = "customized legend")
plot2 <- ggplot(data2, aes(x = var1a, y = var3a, group = var2a)) +
geom_line(size = 1.5, aes(linetype = var2a, color = var2a)) +
xlab('x_label') +
ylab('y_label') +
labs(linetype = "customized legend", color = "customized legend")
#Combine both into one picture
ggarrange(plot1, plot2,
ncol = 2,
nrow = 1,
common.legend = TRUE,
legend = "bottom")
I know that polr does not give p-values because they are not very reliable. Nevertheless, I would like to add them to my modelsummary (Vignette) output. I know to get the values as follows:
library(MASS)
polr_res <- polr(as.ordered(rep77) ~ foreign + length + mpg, Hess=TRUE, data=fullauto);summary(polr_res)
Call:
polr_res(formula = as.ordered(rep77) ~ foreign + length + mpg, data = fullauto,
Hess = TRUE)
## coefficient test
library("AER")
coeftest(polr_res)
modelsummary
Because polr has no p-values, I cannot call modelsummary(models, stars=TRUE) on my models (which includes other models which do have p-values and for which I want to show stars).
library(modelsummary)
models <- list(
"Ordinal Probit" = polr_res,
)
# model_names <- c("OLS", "")
modelsummary(models, stars=TRUE)
I tried first to simply add the p-values to the tidy object, but I cannot add that object to the list of models.
polr_pval <- coeftest(polr)[,4]
polr_pval <- as.data.frame(polr_pval)
tidy_polr <- tidy(polr)
tidy_polr[,5] <- polr_pval
The vignette describes that I can make a custom class which adapts the polr, but I do not understand how:
https://vincentarelbundock.github.io/modelsummary/articles/modelsummary.html#customizing-existing-models-part-i-
https://vincentarelbundock.github.io/modelsummary/articles/modelsummary.html#customizing-existing-models-part-ii-
Could anyone help me figure this out?
EDIT:
I am posting an edit showing the problem I was having when using Vincent's answer, with R version 3.6.1 (2019-07-05). If you are encountering this issue, (preferably) update to R version 4.0.0 or download an update for modelsummary from Github (see also Vincent's comments below).:
library(remotes)
remotes::install_github('vincentarelbundock/modelsummary')
Output:
DATA for R
fullauto <- structure(list(make = structure(c(1, 1, 1, 2, 2, 3, 4, 4, 4,
4, 4, 4, 4, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,
9, 10, 10, 11, 11, 12, 12, 12, 13, 14, 14, 14, 14, 14, 14, 15,
15, 15, 15, 15, 15, 15, 16, 17, 17, 17, 17, 17, 18, 18, 18, 18,
18, 18, 19, 20, 21, 21, 21, 22, 22, 22, 22, 23), label = "Make", format.stata = "%8.0g", class = c("haven_labelled",
"vctrs_vctr", "double"), labels = c(AMC = 1, Audi = 2, BMW = 3,
Buick = 4, Cad. = 5, Chev. = 6, Datsun = 7, Dodge = 8, Fiat = 9,
Ford = 10, Honda = 11, Linc. = 12, Mazda = 13, Merc. = 14, Olds = 15,
Peugeot = 16, Plym. = 17, Pont. = 18, Renault = 19, Subaru = 20,
Toyota = 21, VW = 22, Volvo = 23)), model = structure(c(1, 2,
3, 4, 5000, 320, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
18, 19, 20, 200, 210, 510, 810, 21, 22, 23, 24, 25, 26, 27, 28,
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
45, 98, 604, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,
58, 59, 60, 61, 62, 63, 64, 65, 260), label = "Model", format.stata = "%8.0g", class = c("haven_labelled",
"vctrs_vctr", "double"), labels = c(Concord = 1, Pacer = 2, Spirit = 3,
Fox = 4, Century = 5, Electra = 6, LeSabre = 7, Opel = 8, Regal = 9,
Riviera = 10, Skylark = 11, Deville = 12, Eldrado = 13, Seville = 14,
Chevette = 15, Impala = 16, Malibu = 17, MCarlo = 18, Monza = 19,
Nova = 20, Colt = 21, Diplomat = 22, Magnum = 23, StRegis = 24,
Strada = 25, Fiesta = 26, Mustang = 27, Accord = 28, Civic = 29,
Cntntl = 30, `Mark V` = 31, Vrsills = 32, GLC = 33, Bobcat = 34,
Cougar = 35, `XR-7` = 36, Marquis = 37, Monarch = 38, Zephyr = 39,
Cutlass = 40, CutlSupr = 41, `Delta 88` = 42, Omega = 43, Starfire = 44,
Toronado = 45, Arrow = 46, Champ = 47, Horizon = 48, Sapporo = 49,
Volare = 50, Catalina = 51, Firebird = 52, GranPrix = 53, `Le Mans` = 54,
Phoenix = 55, Sunbird = 56, `Le Car` = 57, Subaru = 58, Celica = 59,
Corolla = 60, Corona = 61, Rabbit = 62, Diesel = 63, Scirocco = 64,
Dasher = 65)), price = structure(c(4099, 4749, 3799, 6295, 9690,
9735, 4816, 7827, 5788, 4453, 5189, 10372, 4082, 11385, 14500,
15906, 3299, 5705, 4504, 5104, 3667, 3955, 6229, 4589, 5079,
8129, 3984, 4010, 5886, 6342, 4296, 4389, 4187, 5799, 4499, 11497,
13594, 13466, 3995, 3829, 5379, 6303, 6165, 4516, 3291, 4733,
5172, 4890, 4181, 4195, 10371, 8814, 12990, 4647, 4425, 4482,
6486, 4060, 5798, 4934, 5222, 4723, 4424, 4172, 3895, 3798, 5899,
3748, 5719, 4697, 5397, 6850, 7140, 11995), label = "Price", format.stata = "%8.0g"),
mpg = structure(c(22, 17, 22, 23, 17, 25, 20, 15, 18, 26,
20, 16, 19, 14, 14, 21, 29, 16, 22, 22, 24, 19, 23, 35, 24,
21, 30, 18, 16, 17, 21, 28, 21, 25, 28, 12, 12, 14, 30, 22,
14, 14, 15, 18, 20, 19, 19, 18, 19, 24, 16, 21, 14, 38, 34,
25, 26, 18, 18, 18, 19, 19, 19, 24, 26, 35, 18, 31, 18, 25,
41, 25, 23, 17), label = "Mileage (mpg)", format.stata = "%8.0g"),
rep78 = structure(c(3, 3, NA, 3, 5, 4, 3, 4, 3, NA, 3, 3,
3, 3, 2, 3, 3, 4, 3, 2, 2, 3, 4, 5, 4, 4, 5, 2, 2, 2, 3,
4, 3, 5, 4, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 4, 3, 1,
3, 4, NA, 3, 5, 3, NA, 2, 4, 1, 3, 3, NA, 2, 3, 5, 5, 5,
5, 4, 5, 4, 4, 5), label = "Repair Record 1978", format.stata = "%9.0g", class = c("haven_labelled",
"vctrs_vctr", "double"), labels = c(Poor = 1, Fair = 2, Average = 3,
Good = 4, Excellent = 5)), rep77 = structure(c(2, 1, NA,
3, 2, 4, 3, 4, 4, NA, 3, 4, 3, 3, 2, 3, 3, 4, 3, 3, 2, 3,
3, 5, 4, 4, 4, 2, 2, 2, 1, NA, 3, 5, 4, 4, 4, 3, 4, 3, 3,
4, 2, NA, 3, 3, 4, 4, 3, 1, 3, 4, NA, 3, 4, NA, NA, 2, 4,
2, 3, 3, NA, 2, 3, 4, 5, 5, 5, 3, 4, 3, 3, 3), label = "Repair Record 1977", format.stata = "%9.0g", class = c("haven_labelled",
"vctrs_vctr", "double"), labels = c(Poor = 1, Fair = 2, Average = 3,
Good = 4, Excellent = 5)), hdroom = structure(c(2.5, 3, 3,
2.5, 3, 2.5, 4.5, 4, 4, 3, 2, 3.5, 3.5, 4, 3.5, 3, 2.5, 4,
3.5, 2, 2, 3.5, 1.5, 2, 2.5, 2.5, 2, 4, 4, 4.5, 2.5, 1.5,
2, 3, 2.5, 3.5, 2.5, 3.5, 3.5, 3, 3.5, 3, 3.5, 3, 3.5, 4.5,
2, 4, 4.5, 2, 3.5, 4, 3.5, 2, 2.5, 4, 1.5, 5, 4, 1.5, 2,
3.5, 3.5, 2, 3, 2.5, 2.5, 3, 2, 3, 3, 2, 2.5, 2.5), label = "Headroom (in.)", format.stata = "%6.1f"),
rseat = structure(c(27.5, 25.5, 18.5, 28, 27, 26, 29, 31.5,
30.5, 24, 28.5, 30, 27, 31.5, 30, 30, 26, 29.5, 28.5, 28.5,
25, 27, 21, 23.5, 22, 27, 24, 29, 29, 28, 26.5, 26, 23, 25.5,
23.5, 30.5, 28.5, 27, 25.5, 25.5, 29.5, 25, 30.5, 27, 29,
28, 28, 29, 27, 25.5, 30, 31.5, 30.5, 21.5, 23, 25, 22, 31,
29, 23.5, 28.5, 28, 27, 25, 23, 25.5, 22, 24.5, 23, 25.5,
25.5, 23.5, 37.5, 29.5), label = "Rear Seat (in.)", format.stata = "%6.1f"),
trunk = structure(c(11, 11, 12, 11, 15, 12, 16, 20, 21, 10,
16, 17, 13, 20, 16, 13, 9, 20, 17, 16, 7, 13, 6, 8, 8, 8,
8, 17, 17, 21, 16, 9, 10, 10, 5, 22, 18, 15, 11, 9, 16, 16,
23, 15, 17, 16, 16, 20, 14, 10, 17, 20, 14, 11, 11, 17, 8,
16, 20, 7, 16, 17, 13, 7, 10, 11, 14, 9, 11, 15, 15, 16,
12, 14), label = "Trunk space (cu. ft.)", format.stata = "%8.0g"),
weight = structure(c(2930, 3350, 2640, 2070, 2830, 2650,
3250, 4080, 3670, 2230, 3280, 3880, 3400, 4330, 3900, 4290,
2110, 3690, 3180, 3220, 2750, 3430, 2370, 2020, 2280, 2750,
2120, 3600, 3600, 3740, 2130, 1800, 2650, 2240, 1760, 4840,
4720, 3830, 1980, 2580, 4060, 4130, 3720, 3370, 2830, 3300,
3310, 3690, 3370, 2730, 4030, 4060, 3420, 3260, 1800, 2200,
2520, 3330, 3700, 3470, 3210, 3200, 3420, 2690, 1830, 2050,
2410, 2200, 2670, 1930, 2040, 1990, 2160, 3170), label = "Weight (lbs.)", format.stata = "%8.0g"),
length = structure(c(186, 173, 168, 174, 189, 177, 196, 222,
218, 170, 200, 207, 200, 221, 204, 204, 163, 212, 193, 200,
179, 197, 170, 165, 170, 184, 163, 206, 206, 220, 161, 147,
179, 172, 149, 233, 230, 201, 154, 169, 221, 217, 212, 198,
195, 198, 198, 218, 200, 180, 206, 220, 192, 170, 157, 165,
182, 201, 214, 198, 201, 199, 203, 179, 142, 164, 174, 165,
175, 155, 155, 156, 172, 193), label = "Length (in.)", format.stata = "%8.0g"),
turn = structure(c(40, 40, 35, 36, 37, 34, 40, 43, 43, 34,
42, 43, 42, 44, 43, 45, 34, 43, 31, 41, 40, 43, 35, 32, 34,
38, 35, 46, 46, 46, 36, 33, 43, 36, 34, 51, 48, 41, 33, 39,
48, 45, 44, 41, 43, 42, 42, 42, 43, 40, 43, 43, 38, 37, 37,
36, 38, 44, 42, 42, 45, 40, 43, 41, 34, 36, 36, 35, 36, 35,
35, 36, 36, 37), label = "Turn Circle (ft.) ", format.stata = "%8.0g"),
displ = structure(c(121, 258, 121, 97, 131, 121, 196, 350,
231, 304, 196, 231, 231, 425, 350, 350, 231, 250, 200, 200,
151, 250, 119, 85, 119, 146, 98, 318, 318, 225, 105, 98,
140, 107, 91, 400, 400, 302, 86, 140, 302, 302, 302, 250,
140, 231, 231, 231, 231, 151, 350, 350, 163, 156, 86, 105,
119, 225, 231, 231, 231, 231, 231, 151, 79, 97, 134, 97,
134, 89, 90, 97, 97, 163), label = "Displacement (cu. in.)", format.stata = "%8.0g"),
gratio = structure(c(3.57999992370605, 2.52999997138977,
3.07999992370605, 3.70000004768372, 3.20000004768372, 3.64000010490417,
2.9300000667572, 2.41000008583069, 2.73000001907349, 2.86999988555908,
2.9300000667572, 2.9300000667572, 3.07999992370605, 2.27999997138977,
2.19000005722046, 2.24000000953674, 2.9300000667572, 2.55999994277954,
2.73000001907349, 2.73000001907349, 2.73000001907349, 2.55999994277954,
3.89000010490417, 3.70000004768372, 3.53999996185303, 3.54999995231628,
3.53999996185303, 2.47000002861023, 2.47000002861023, 2.94000005722046,
3.36999988555908, 3.15000009536743, 3.07999992370605, 3.04999995231628,
3.29999995231628, 2.47000002861023, 2.47000002861023, 2.47000002861023,
3.73000001907349, 2.73000001907349, 2.75, 2.75, 2.25999999046326,
2.4300000667572, 3.07999992370605, 2.9300000667572, 2.9300000667572,
2.73000001907349, 3.07999992370605, 2.73000001907349, 2.41000008583069,
2.41000008583069, 3.57999992370605, 3.04999995231628, 2.97000002861023,
3.36999988555908, 3.53999996185303, 3.23000001907349, 2.73000001907349,
3.07999992370605, 2.9300000667572, 2.9300000667572, 3.07999992370605,
2.73000001907349, 3.72000002861023, 3.80999994277954, 3.05999994277954,
3.21000003814697, 3.04999995231628, 3.77999997138977, 3.77999997138977,
3.77999997138977, 3.74000000953674, 2.98000001907349), label = "Gear Ratio", format.stata = "%6.2f"),
order = structure(c(1, 2, 3, 5, 4, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27,
28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42,
43, 44, 45, 47, 48, 49, 50, 51, 52, 46, 53, 54, 55, 56, 57,
58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
73, 74), label = "Original order", format.stata = "%8.0g"),
foreign = structure(c(0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1,
0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1), label = "Foreign", format.stata = "%8.0g", class = c("haven_labelled",
"vctrs_vctr", "double"), labels = c(Domestic = 0, Foreign = 1
)), wgtd = structure(c(2930, 3350, 2640, NA, NA, NA, 3250,
4080, 3670, 2230, 3280, 3880, 3400, 4330, 3900, 4290, 2110,
3690, 3180, 3220, 2750, 3430, NA, NA, NA, NA, 2120, 3600,
3600, 3740, NA, 1800, 2650, NA, NA, 4840, 4720, 3830, NA,
2580, 4060, 4130, 3720, 3370, 2830, 3300, 3310, 3690, 3370,
2730, 4030, 4060, NA, 3260, 1800, 2200, 2520, 3330, 3700,
3470, 3210, 3200, 3420, 2690, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA), format.stata = "%9.0g"), wgtf = structure(c(NA,
NA, NA, 2070, 2830, 2650, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, 2370, 2020, 2280, 2750, NA,
NA, NA, NA, 2130, NA, NA, 2240, 1760, NA, NA, NA, 1980, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 3420, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1830, 2050, 2410,
2200, 2670, 1930, 2040, 1990, 2160, 3170), format.stata = "%9.0g")), label = "Automobile Models", row.names = c(NA,
-74L), class = c("tbl_df", "tbl", "data.frame"))
I think the easiest way to achieve this is to define a tidy_custom.polr method as described here in the documentation.. For instance, you could do:
library(MASS)
library(AER)
library(modelsummary)
tidy_custom.polr <- function(x, ...) {
s <- coeftest(x)
out <- data.frame(
term = row.names(s),
p.value = s[, "Pr(>|z|)"])
out
}
mod = list(
"LM" = lm(gear ~ hp + mpg, data = mtcars),
"POLR" = polr(as.ordered(gear) ~ hp + mpg, data = mtcars))
modelsummary(mod, stars = TRUE)