Estou tentando formatar o título de um facet_wrapgráfico para corresponder ao estilo das faixas de facetas. No gráfico abaixo, adicionei um título "len", mas sua formatação não se parece com a das faixas de facetas (por exemplo, 0,5, 1, 2) à direita. Como posso fazer o título se parecer com as faixas de facetas (por exemplo, caixa retangular cinza, contorno preto, texto centralizado na largura do gráfico, etc.)?

library(tidyverse)

ToothGrowth |> 
  ggplot(aes(x = dose, y = len)) + 
  geom_boxplot(aes(fill = supp)) +
  labs(title = 'len',
       y = NULL) +
  theme_bw() +
  facet_wrap(~dose, ncol = 1, strip.position = "right")

^{Criado em 28/04/2025 com reprex v2.1.1}

Como posso ajustar a altura da barra de cores da legenda para corresponder à altura dos meus gráficos ao usar facet_wrap()? Esta pergunta SO relacionada oferece uma boa solução para um único gráfico, mas quando vários gráficos estão presentes, a barra de cores se estende até a metade do título de quebra de faceta e do texto do eixo. Gostaria que a barra de cores se estendesse apenas da base do título de quebra de faceta até o topo do texto do eixo.

Fazendo o gráfico base

(observe a pequena altura da barra de cores)

library(tidyverse)
library(ggcorrplot)
library(reshape2)

iris %>%
  group_by(Species) %>%
  summarise(correlation = list(cor(across(where(is.numeric))))) %>%
  ungroup() %>%
  mutate(correlation_df = map(correlation, ~ melt(.x, varnames = c("Var1", "Var2")))) %>%
  select(Species, correlation_df) %>%
  unnest(correlation_df) %>%
  ggplot(aes(x = Var1, y = Var2, fill = value)) +
  geom_tile() +
  scale_fill_gradient2(limit = c(-1, 1)) +
  labs(x = NULL,
       y = NULL,
       fill = NULL) +
  theme_bw() +
  facet_wrap(~Species)

Usando resposta de pergunta SO semelhante

(observe que a barra de cores se estende até as áreas de texto do título e do eixo)

make_fullsize <- function() structure("", class = "fullsizebar")

ggplot_add.fullsizebar <- function(obj, g, name = "fullsizebar") {
  h <- ggplotGrob(g)$heights
  panel <- which(grid::unitType(h) == "null")
  panel_height <- unit(1, "npc") - sum(h[-panel])
  
  g + 
    guides(fill = guide_colorbar(barheight = panel_height,
                                 title.position = "right")) +
    theme(legend.title = element_text(angle = -90, hjust = 0.5))
}

iris %>%
  group_by(Species) %>%
  summarise(correlation = list(cor(across(where(is.numeric))))) %>%
  ungroup() %>%
  mutate(correlation_df = map(correlation, ~ melt(.x, varnames = c("Var1", "Var2")))) %>%
  select(Species, correlation_df) %>%
  unnest(correlation_df) %>%
  ggplot(aes(x = Var1, y = Var2, fill = value)) +
  geom_tile() +
  scale_fill_gradient2(limit = c(-1, 1)) +
  labs(x = NULL,
       y = NULL,
       fill = NULL) +
  theme_bw() +
  coord_cartesian(expand = FALSE) +
  make_fullsize() +
  facet_wrap(~Species)

^{Criado em 2024-12-30 com reprex v2.1.1}

Eu brinquei com a mudança do valor de panel_heightpor exemplo, panel_height <- unit(0.95...o que fornece uma resposta próxima, mas imprecisa. Essa resposta também não escala bem ao tornar os gráficos maiores/menores.

Estou tentando alterar o título de dois gráficos feitos usando facet_wrap(), um dos quais tem um símbolo maior que ou igual a ( >=). Posso fazer os gráficos analisarem o título, mas assim que coloco o símbolo >= entre parênteses, os títulos falham na análise. Como posso fazer os títulos analisarem quando o símbolo >= está entre parênteses?

library(tidyverse)

mtcars %>% 
  mutate(size = ifelse(hp >= 100, 'greater', 'lesser'),
         size = factor(size, levels = c("greater", "lesser"),
                       labels = c("Horsepower >= 100", "Horsepower < 100"))) %>% 
  ggplot(aes(x = mpg, y = wt)) +
  geom_point() +
  theme_bw() +
  facet_wrap(~size, labeller = label_parsed)

Falha na análise ao colocar >= entre parênteses.

mtcars %>% 
  mutate(size = ifelse(hp >= 100, 'greater', 'lesser'),
         size = factor(size, levels = c("greater", "lesser"),
                       labels = c("Horsepower (>= 100)", "Horsepower (< 100)"))) %>% 
  ggplot(aes(x = mpg, y = wt)) +
  geom_point() +
  theme_bw() +
  facet_wrap(~size, labeller = label_parsed)
#> Error in parse(text = as.character(values)): <text>:1:13: unexpected '>='
#> 1: Horsepower (>=
#>                 ^

^{Criado em 2024-11-18 com reprex v2.1.1}

Nas figuras abaixo, eu gostaria que a legenda mostrasse a cor de preenchimento para a variável 'color'. Eu também gostaria que todos os pontos no gráfico tivessem um contorno preto. Parece que eu posso fazer um ou outro, mas não ambos (ou seja, a legenda tem cor e os pontos têm contorno preto). Eu selecionei formas que têm um contorno preto, como pode ser visto na legenda 'cut'.

Perguntas SO semelhantes:

• Contorno preto ao redor do geom_point e legenda de correspondência de cores - ggplot
• Os pontos ggplot têm cor, mas os pontos da legenda (guia) são todos pretos

Mantém o contorno preto ao redor dos pontos, mas a legenda fica toda preta

library(tidyverse)

diamonds %>% 
  slice(1:20) %>% 
  ggplot(aes(x = x,
             y = y,
             shape = cut,
             fill = color)) +
  geom_point(size = 3,
             alpha = 0.8) +
  scale_shape_manual(values = c('Ideal' = 21,
                                'Premium' = 22,
                                'Good' = 23,
                                'Very Good' = 24,
                                'Fair' = 25)) +
  scale_fill_manual(values = c('E' = '#ca0020',
                               'F' = '#f4a582',
                               'H' = '#ffffbf',
                               'I' = '#92c5de',
                               'J' = '#0571b0')) +
  theme_bw()

Remove o contorno preto ao redor dos pontos, mas a legenda é toda colorida

diamonds %>% 
  slice(1:20) %>% 
  ggplot(aes(x = x,
             y = y,
             shape = cut,
             fill = color,
             color = color)) +
  geom_point(size = 3,
             alpha = 0.8) +
  scale_shape_manual(values = c('Ideal' = 21,
                                'Premium' = 22,
                                'Good' = 23,
                                'Very Good' = 24,
                                'Fair' = 25)) +
  scale_fill_manual(values = c('E' = '#ca0020',
                               'F' = '#f4a582',
                               'H' = '#ffffbf',
                               'I' = '#92c5de',
                               'J' = '#0571b0')) +
  scale_color_manual(values = c('E' = '#ca0020',
                                'F' = '#f4a582',
                                'H' = '#ffffbf',
                                'I' = '#92c5de',
                                'J' = '#0571b0')) +
  theme_bw()

EDIT: Eu entendo que posso adicionar um segundo conjunto de pontos um pouco maior para obter uma solução alternativa, mas isso é desleixado

diamonds %>% 
  slice(1:20) %>% 
  ggplot(aes(x = x,
             y = y,
             shape = cut,
             fill = color,
             color = color)) +
  geom_point(size = 3.5,
             alpha = 0.5,
             color = 'black') +
  geom_point(size = 3,
             alpha = 0.8) +
  scale_shape_manual(values = c('Ideal' = 21,
                                'Premium' = 22,
                                'Good' = 23,
                                'Very Good' = 24,
                                'Fair' = 25)) +
  scale_fill_manual(values = c('E' = '#ca0020',
                               'F' = '#f4a582',
                               'H' = '#ffffbf',
                               'I' = '#92c5de',
                               'J' = '#0571b0')) +
  scale_color_manual(values = c('E' = '#ca0020',
                                'F' = '#f4a582',
                                'H' = '#ffffbf',
                                'I' = '#92c5de',
                                'J' = '#0571b0')) +
  theme_bw()

^{Criado em 2024-11-13 com reprex v2.1.1}

Estou tentando customizar os rótulos em uma matriz de correlação feita usando o ggcorrplotpacote. No entanto, não consigo fazer com que a formatação sobrescrito ou subscrito funcione. Como posso exibir os rótulos corretamente sem usar caracteres Unicode?

library(tidyverse)
library(ggcorrplot)

# Example Data
M <- cor(mtcars)[1:3,1:3]

# Attempt 1: Not formatted correctly
colnames(M) <- c("Temperature\n (^o C)", "PO[4]^2", "Oxygen\n (mg L^-1)")
rownames(M) <- c("Temperature\n (^o C)", "PO[4]^2", "Oxygen\n (mg L^-1)")

ggcorrplot(M,
           type = "lower",
           lab = TRUE,
           ggtheme = theme_bw())

# Attempt 2: Produces error message
ggcorrplot(M,
           type = "lower",
           lab = TRUE,
           scale_x_discrete(labels = c("mpg" = expression(Temperature~(degree*C)),
                                       "cyl" = expression(PO[4]^2),
                                       "disp" = expression(Oxygen~(mg~L^-1)))),
           scale_y_discrete(labels = c("mpg" = expression(Temperature~(degree*C)),
                                       "cyl" = expression(PO[4]^2),
                                       "disp" = expression(Oxygen~(mg~L^-1)))),
           ggtheme = theme_bw())
#> Error in match.arg(method): 'arg' must be NULL or a character vector

^{Criado em 23/04/2024 com reprex v2.1.0}

Estou usando ggplotpara fazer uma figura de três painéis. Quero facet_wrappor estado e incluir o nome da cidade no rótulo, porém, quando faço isso, aparece uma linha horizontal entre os nomes do estado e da cidade. Como posso remover a linha horizontal?

library(tidyverse)

set.seed(333)

# Example dataset
df <- data.frame(
  state = c("North Carolina","North Carolina","North Carolina",
            "North Carolina","North Carolina","North Carolina",
            "Virginia","Virginia","Virginia"),
  city = c("Boone","Boone","Boone",
           "Elizabeth City","Elizabeth City","Elizabeth City",
           "Norfolk","Norfolk","Norfolk"),
  year = rep(seq(2000,2004,2),3),
  value = round(rnorm(9,100,50))
)

# Example plot (how can I remove the horizontal line between the state and city labels?)
df %>%
  ggplot(aes(x = year, y = value)) +
  geom_point() +
  theme_bw() +
  facet_wrap(~state+city)

^{Criado em 19/04/2024 com reprex v2.1.0}

Fiz uma série temporal que tem um eixo x descontínuo, porém, só sei fazer esse tipo de gráfico quando o eixo x Dateé um fator. O problema que isso causa é que os pontos no gráfico se alinham com o fator que sugere que os pontos são coletados no primeiro dia do mês, o que não é verdade. Existe alguma maneira de alinhar os pontos com o real, Datemantendo o eixo x descontínuo?

Exemplo

library(tidyverse)
library(grid)

set.seed(333)

# Create example dataset
df <- data.frame(
  Group = c('A','A','A','A','A','A','B','B','B','B','B','B'),
  Date = rep(c('2021-07-13','2021-08-22','2021-09-04','2022-06-20','2022-07-08','2022-08-25'), 2),
  Value = round(rnorm(12,50,20)))

# Do some data wrangling
df <- df %>%
  mutate(Date = as.Date(Date),
         year = year(Date),
         mon = month(Date),
         mon_abb = month.abb[mon],
         monYear = paste(mon_abb,year, sep = ' ')) %>%
  select(!c(mon,year,mon_abb))

# Will need the month abbreviation
sample_dates <- unique(df$monYear)

# Make figure
# Note: the points align on the month but I would like them to
# align with the actual calendar Date (i.e., all points would move
# to the right because none were collected on the 1st of the month)
ggplot(data = df, aes(x = factor(Date), y = Value, group = Group)) +
  geom_point(aes(fill = Group), size = 3, shape = 21, color = "black") +
  scale_x_discrete(labels = substr(sample_dates, 1, 3)) + # Pulls the month abb. for x-axis label
  xlab("") +
  theme_bw() +
  theme(plot.margin = unit(c(1, 1, 2, 1), "lines"),
        axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
        legend.position = 'right',
        panel.border = element_blank()) +
  guides(fill = guide_legend(nrow = 2)) +
  coord_cartesian(clip = 'off', ylim = c(0, 100)) +
  annotation_custom(rectGrob(gp = gpar(fill = NA))) +
  annotate(geom = "text", x = 2, y = -16, label = 2021, size = 4.5) +
  annotate(geom = "text", x = 5, y = -16, label = 2022, size = 4.5) +
  annotate(geom = 'rect', xmin = 3.4, xmax = 3.6, ymin = -10, ymax = -3, fill = 'white') +
  annotate(geom = 'segment', x = c(3.4,3.6), xend = c(3.4,3.6), y = -8, yend = -3)

^{Criado em 04/04/2024 com reprex v2.0.2}

Eu tenho um dataframe com uma coluna de data e hora espaçada em intervalos de 4 horas. Quando o componente de hora deveria ser 00:00:00(hora: minuto: segundo), a hora está faltando na data. Como posso adicionar 00:00:00a data quando falta tempo?

Dados de exemplo

dat <- data.frame(
  dateTime = c('2016-07-01',
               '2016-07-01 04:00:00',
               '2016-07-01 08:00:00',
               '2016-07-01 12:00:00',
               '2016-07-01 16:00:00',
               '2016-07-01 20:00:00',
               '2016-07-02')
)

str(dat)
#> 'data.frame':    7 obs. of  1 variable:
#>  $ dateTime: chr  "2016-07-01" "2016-07-01 04:00:00" "2016-07-01 08:00:00" "2016-07-01 12:00:00" ...

dat
#>              dateTime
#> 1          2016-07-01
#> 2 2016-07-01 04:00:00
#> 3 2016-07-01 08:00:00
#> 4 2016-07-01 12:00:00
#> 5 2016-07-01 16:00:00
#> 6 2016-07-01 20:00:00
#> 7          2016-07-02

Eu poderia usar isso abaixo, no entanto, meu conjunto de dados real tem linhas faltando, então estou procurando uma alternativa onde possa adicionar 00:00:00quando não houver tempo.

library(tidyverse)

dat <- dat %>%
  mutate(dateTime_cor = seq(from = as.POSIXct("2016-07-01 00:00:00"),
                            to = as.POSIXct("2016-07-02 00:00:00"),
                            by = "4 hours")) %>%
  select(-dateTime)

str(dat)
#> 'data.frame':    7 obs. of  1 variable:
#>  $ dateTime_cor: POSIXct, format: "2016-07-01 00:00:00" "2016-07-01 04:00:00" ...

dat
#>          dateTime_cor
#> 1 2016-07-01 00:00:00
#> 2 2016-07-01 04:00:00
#> 3 2016-07-01 08:00:00
#> 4 2016-07-01 12:00:00
#> 5 2016-07-01 16:00:00
#> 6 2016-07-01 20:00:00
#> 7 2016-07-02 00:00:00

^{Criado em 16/01/2024 com reprex v2.0.2}

Estou desenvolvendo um aplicativo brilhante no Rstudio. O aplicativo cria dois gráficos: uma série temporal e um gráfico de dispersão. As variáveis ​​que estão sendo plotadas são Water Temperaturee Air Temperature. O gráfico de série temporal lida com o espaço nos nomes das variáveis ​​sem problemas. No entanto, recebo um erro com os gráficos de dispersão associados aos nomes das variáveis.

O erro é:

Warning: Error in parse: <text>:1:7: unexpected symbol
1: Water Temperature
          ^

ou

Warning: Error in parse: <text>:1:5: unexpected symbol
1: Air Temperature
        ^

Suspeito que esses erros tenham algo a ver com o espaço entre Água/Ar e Temperatura. É fundamental manter o espaço em vez de substituí-lo por um sublinhado ou algum outro preenchimento de espaço. Como posso manter o espaço no nome da variável ao fazer gráficos de dispersão?

library(tidyverse)
library(shiny)
library(shinydashboard)

# Create example dataset
set.seed(123)

dat <- data.frame(
  Time = rep(seq(1,10,1), times = 2),
  Site = rep(c('A', 'B'), each = 10),
  Water_Temperature = round(rnorm(20, mean = 20, sd = 5)),
  Air_Temperature = round(rnorm(20, mean = 25, sd = 3))
)

dat <- dat %>%
  rename(`Water Temperature` = Water_Temperature,
         `Air Temperature` = Air_Temperature)

dat_long <- dat %>%
  pivot_longer(cols = c("Water Temperature","Air Temperature"),
               names_to = 'Variable',
               values_to = 'Value') %>%
  arrange(Site, Time)

# Define user interface for time series and scatterplot
ui.R <- dashboardPage(
  dashboardHeader(title = "Example", titleWidth = 350),
  dashboardSidebar(
    tags$head(
      tags$style(
        HTML("
          .sidebar-footer {
            text-align: center;
          }
          .sidebar-logo {
            display: flex;
            align-items: center;
            justify-content: center;
          }
          .sidebar-menu a span {
            font-size: 24px;
          }
        ")
      )
    ),
    sidebarMenu(
      menuItem("Time Series", tabName = "time_series", icon = icon("chart-line")),
      menuItem("Scatterplot", tabName = "scatter_plot", icon = icon("chart-line"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "time_series",
        fluidRow(
          box(
            title = "Time Series",
            status = "primary",
            solidHeader = TRUE,
            width = 2,
            selectInput("siteInput", "Select Site", choices = unique(dat_long$Site)),
            selectInput("variableInput", "Select Variable", choices = unique(dat_long$Variable))
          ),
          box(
            title = "Plot",
            status = "primary",
            solidHeader = TRUE,
            width = 10,
            plotOutput("timeSeriesPlot", height = "700px")
          )
        )
      ),
      tabItem(
        tabName = "scatter_plot",
        fluidRow(
          box(
            title = "Scatterplot",
            status = "primary",
            solidHeader = TRUE,
            width = 2,
            selectInput("siteInput2", "Select Site", choices = unique(dat_long$Site)),
            selectInput("xAxisInput", "Select X-axis Variable:", choices = unique(dat_long$Variable)),
            selectInput("yAxisInput", "Select Y-axis Variable:", choices = unique(dat_long$Variable))
          ),
          box(
            title = "Plot",
            status = "primary",
            solidHeader = TRUE,
            width = 10,
            plotOutput("scatterPlot", height = "700px")
          )
        )
      ),
      tabItem(
        tabName = "site_info",
        fluidPage(
          fluidRow(
            selectInput("siteInput3", "Select Site", choices = unique(dat_long$Site)),
            column(4, dataTableOutput('table'))
          )
        )
      )
    )
  )
)

# Define server
server.R <- function(input, output) {
  output$timeSeriesPlot <- renderPlot({
    filteredData <- dat_long %>%
      filter(Site == input$siteInput, Variable == input$variableInput)
    
    variableName <- unique(filteredData$Variable)
    yLabel <- ifelse(variableName == "Water Temperature", expression(Water~Temperature~(degree*C)),
                     ifelse(variableName == "Air Temperature", expression(Air~Temperature~(degree*C))))
    
    ggplot(filteredData, aes(x = Time, y = Value)) +
      geom_line() +
      geom_point() +
      scale_x_continuous(breaks = seq(1,10,1)) +
      labs(x = "", y = yLabel,
           title = paste('Site:', input$siteInput)) +
      theme_bw()
  })
  
  output$scatterPlot <- renderPlot({
    filteredData2 <- dat_long %>%
      filter(Site == input$siteInput2)
    
    # Create a reactive label to display the units for the selected variable on the x and y axes
    xLabel <- reactive({
      switch(input$xAxisInput[1],
             `Air Temperature` = expression(Air~Temperature~(degree*C)),
             `Water Temperature` = expression(Water~Temperature~(degree*C)))
    })
    
    yLabel <- reactive({
      switch(input$yAxisInput[1],
             `Air Temperature` = expression(Air~Temperature~(degree*C)),
             `Water Temperature` = expression(Water~Temperature~(degree*C)))
    })
    
    ggplot(filteredData2, aes_string(x = input$xAxisInput, y = input$yAxisInput)) +
      geom_point() +
      labs(x = xLabel(), y = yLabel(),
           title = paste('Site:', input$siteInput2)) +
      theme_bw()
  })
}

# Run the application
shinyApp(ui = ui.R, server = server.R)

O gráfico de série temporal funciona O gráfico de dispersão não funciona

Estou tentando criar um aplicativo brilhante que permite ao usuário selecionar um grupo ( cut) e uma variável (ou seja depth,, tableou price) para os eixos x e y de um gráfico de dispersão. O código da UI abaixo funciona bem para permitir que o usuário faça as seleções, no entanto, estou tendo problemas com o servidor. Acho que o problema é filtrar as seleções da interface do usuário em dois quadros de dados e usá-los rbind()para combiná-los, mas não sei outra maneira de proceder.

Como posso ggplot()reagir às duas opções que os usuários têm para os eixos x e y?

Exemplo:

library(shiny)
library(tidyverse)

dat <- diamonds %>%
  select(cut,depth,table,price) %>%
  pivot_longer(cols = c('depth','table','price'),
               names_to = 'Variable',
               values_to = 'Value')

ui <- fluidPage(
  selectInput("x_cut", "X-axis Cut", choices = unique(dat$cut)),
  selectInput("x_variable", "X-axis Variable", choices = unique(dat$Variable)),
  selectInput("y_cut", "Y-axis Cut", choices = unique(dat$cut)),
  selectInput("y_variable", "Y-axis Variable", choices = unique(dat$Variable)),
  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    filtered_xdat <- dat %>%
      filter(cut == input$x_cut, Variable == input$x_variable)
    
    filtered_ydat <- dat %>%
      filter(cut == input$y_cut, Variable == input$y_variable)
    
    filtered_dat <- rbind(filtered_xdat, filtered_ydat)
      
    filtered_dat %>%
      ggplot() +
      geom_point(aes(x = input$x_variable,
                     y = input$y_variable)) +
      geom_point()
  })
}

shinyApp(ui, server)

# Warning: Error in geom_point: Problem while setting up geom.
# ℹ Error occurred in the 2nd layer.
# Caused by error in `compute_geom_1()`:
#   ! `geom_point()` requires the following missing aesthetics: x and y

Eu tentei isso:

server <- function(input, output) {
  output$plot <- renderPlot({

    filtered_xdat <- dat %>%
      filter(cut == input$x_cut,
             xVariable == input$x_variable) %>%
      as.data.frame()

    filtered_ydat <- dat %>%
      filter(cut == input$y_cut,
             yVariable == input$y_variable) %>%
      as.data.frame()

    ggplot() +
      geom_point(aes(x = filtered_xdat$xVariable, y = filtered_ydat$yVariable)) +
      theme_minimal()
  })
}

# Warning: Error in filter: ℹ In argument: `xVariable == input$x_variable`.
# Caused by error:
#   ! object 'xVariable' not found

e isso também:

server <- function(input, output) {
  output$plot <- renderPlot({

    filtered_dat <- dat %>%
      filter(cut %in% c(input$x_cut, input$y_cut),
             Variable %in% c(input$x_variable, input$y_variable))
    
    ggplot(data = filtered_dat, aes(x = !!sym(input$x_variable), y = !!sym(input$y_variable))) +
      geom_point() +
      theme_minimal()
  })
}

# Warning: Error in geom_point: Problem while computing aesthetics.
# ℹ Error occurred in the 1st layer.
# Caused by error in `FUN()`:
#   ! object 'depth' not found

Estou trabalhando com um formato de data antigo onde os dois primeiros dígitos representam o ano do século XX. As duas primeiras casas decimais são o mês (ou seja, 01-12) e a terceira e quarta casas decimais são o dia do mês (ou seja, 01-31). O problema é que os dias que terminam em zero (ou seja, 10, 20, 30) têm o zero à direita eliminado, de modo que alguns formatos de data têm apenas três casas decimais.

Como posso restaurar o zero à direita para poder converter esse formato de data antigo em um formato de data moderno (ou seja, aaaa-mm-dd)?

Exemplo:

library(tidyverse)

# Example data

xx <- data.frame(yr_mo_da = c('89.1208','89.1209','89.121', '89.1211'))

# My attempt to extract year, month, day from the old date format
# NOTE how the day is not extracted properly because there is not a fourth decimal place on Dec. 10

xx$year <- as.numeric(gsub("\\..*","",xx$yr_mo_da))
xx$month <- as.numeric(sub("^[0-9]+\\.([0-9]{2}).*", "\\1", xx$yr_mo_da))
xx$day <- as.numeric(sub("^[0-9]+\\.[0-9]{2}([0-9]{2}).*", "\\1", xx$yr_mo_da))
xx
#>   yr_mo_da year month    day
#> 1  89.1208   89    12  8.000
#> 2  89.1209   89    12  9.000
#> 3   89.121   89    12 89.121
#> 4  89.1211   89    12 11.000

# Create modern date format

xx <- xx %>%
  mutate(year = year + 1900,
         Date = make_date(year,month,day)) %>%
  select(-c(yr_mo_da,year,day,month))
xx
#>         Date
#> 1 1989-12-08
#> 2 1989-12-09
#> 3       <NA>
#> 4 1989-12-11

A saída correta deve ser semelhante a esta:

xx
#>         Date
#> 1 1989-12-08
#> 2 1989-12-09
#> 3 1989-12-10
#> 4 1989-12-11

^{Criado em 05/09/2023 com reprex v2.0.2}