Kurt Anderson
Kurt Anderson

Reputation: 33

Aesthetics issue in ggplot2 when used in Shiny app

I am writing a Shiny app and using ggplot2 to make graphs. The code I use to generate the ggplot2 executes without a problem when NOT used as part of the Shiny app code, but generates an aesthetics error when used in Shiny. Specifically, I get the error

Warning: Error in : Aesthetics must be either length 1 or the same as the data (501): slope, intercept

I have tried many straightforward solutions to coding the aesthetics, and I am wondering if the way I am coding the aesthetics in the different geometric objects that are plotting different "data" is part of the problem.

library(shiny)
library(deSolve)
library(ggplot2)

# Define UI ----
ui <- fluidPage(
  # This creates the User Interface (UI)

  titlePanel("Lotka-Volterra Competition Model"),

   fluidRow(
    column(4, id = "sidebar2",
           fluidRow(column(5, id = "sidebar1",
                           numericInput("r1", "r1:", 1,
                                       min = 0, max = 100, step = 0.1),
                           numericInput("a", "alpha12:", 0.1,
                                       min = 0, max = 100, step = 0.1),
                           numericInput("K1", "K1:", 1,
                                       min = 0, max = 1000, step = 1),
                           numericInput("N1", "initial N1:", 0.1,
                                        min = 0, max = 1000, step = 1)),
                    column(5, offset = 1, id = "sidebar1",
                           numericInput("r2", "r2:", 1,
                                       min = 0, max = 100, step = 0.1),
                           numericInput("b", "alpha21:", 0.1,
                                       min = 0, max = 1000, step = 0.1),
                           numericInput("K2", "K2:", 1,
                                       min = 0, max = 1000, step = 1),
                           numericInput("N2", "initial N2:", 0.1,
                                        min = 0, max = 1000, step = 1)),
                    column(1)),
           fluidRow(
             column(5, id = "sidebar1",
                    numericInput("Tmax", "Tmax:", 50,
                                 min = 0, max = 1000, step = 1)),
             column(3))
    ),

    mainPanel(plotOutput("plot2")
      )
    )
  )


# Define server logic ----
server <- function(input, output) {
  compLV=function(t, y, parameters){
    N1=y[1]
    N2=y[2]

    with(as.list(parameters),{
      dN1 = r1*N1*((K1-N1-a*N2)/K1)
      dN2 = r2*N2*((K2-N2-b*N1)/K2)
      res=c(dN1, dN2)
      list(res)
    })
  }

    output$plot2 <- renderPlot({

      times  = seq(0, input$Tmax, by=0.1)
      parms=c(r1=input$r1, r2=input$r2,a=input$a,b=input$b,
              K1=input$K1,K2=input$K2)
      xstart = c(N1=input$N1, N2=input$N2)

      out=ode(y=xstart,
              times=times,
              func=compLV,
              parms=parms)

      out.df <- as.data.frame(out)

      ggplot(data = out.df, aes(x = N1, y = N2)) +
        theme_classic() +
        geom_path(aes(color = "black"), size = 1.25) +
        geom_abline(aes(slope = -1/input$alpha12, intercept = input$K1/input$alpha12, color = "blue")) +
        geom_abline(aes(slope = -input$alpha21, intercept = input$K2, color = "red")) +
        scale_x_continuous(expand = c(0, 0), limits = c(0, 1.1*max(input$K1,input$K2/input$alpha21,out.df$N1,out.df$N2))) +
        scale_y_continuous(expand = c(0, 0), limits = c(0, 1.1*max(input$K2,input$K1/input$alpha12,out.df$N1,out.df$N2))) +
        theme(axis.line = element_line(size = 1)) +
        labs(x = "N1", y = "N2") +
        theme(legend.title = element_blank(), legend.position="top") +
        scale_color_manual(values = c("black", "blue", "red"), labels=c("Model trajectory","N1 isocline","N2 isocline"), guide = "legend")

    })

}

  # Run the app ----
  shinyApp(ui = ui, server = server)

Upvotes: 3

Views: 120

Answers (1)

tpetzoldt
tpetzoldt

Reputation: 5813

This is really a nice example. Just correct lines 76 and 77 like this:

   geom_abline(aes(slope = -1/input$a, intercept = input$K1/input$a, color = "blue")) +
   geom_abline(aes(slope = -input$b, intercept = input$K2, color = "red")) +
   ...

Upvotes: 2

Related Questions