The interaction between two groups of images

,

Hi everyone ,

I have two groups of pictures of mouse brain sections. These pictures are 2D pictures. I am writing a shiny app to show these two groups of pictures side by side. I have a sliderbar for each group which allows me to check the images in each group one by one and makes sure that there is only one picture from each group displayed on the app. Now I want to create an "interactive connection" between the images between these two groups, which means when I scroll one of the sliderbars, the images from both groups will change accordingly. Does anyone know how to create this "interactive connection" in shiny? Please let me know if you have any idea about it. Any advice is appreciated! Thanks!

Here is my code :

library(shiny)
library(shinydashboard)
library(shinyjs)
library(magick)

library(png)
library(jpeg)


library(webshot)
library(vembedr)
library(shinythemes)


# Sample image paths for multiple mouse lines
dlx1_paths <- c(
  "slide1_02Image_02.jpg",
  "slide1_02Image_03.jpg",
  "slide1_02Image_04.jpg",
  "slide1_02Image_05.jpg"
)

dlx2_paths <- c(
  "slide1_02Image_06.jpg",
  "slide1_02Image_07.jpg",
  "slide1_02Image_08.jpg",
  "slide1_02Image_09.jpg"
)
dlx3_paths <- c(
  "slide1_02Image_10.jpg",
  " slide1_02Image_11.jpg",
  "slide1_02Image_12.jpg",
  "slide1_02Image_13.jpg",
  "slide1_02Image_14.jpg"
  )

dlx1_atl1 <- c(
  "Ai65F-1.jpg",
  "Ai65F-2.jpg",
  "Ai65F-3.jpg",
  "Ai65F-4.jpg"
)

dlx1_atl2 <- c(
  "Ai65F-5.jpg",
  "Ai65F-6.jpg",
  "Ai65F-7_45.jpg",
  "Ai65F-8_57.jpg"
)
dlx1_atl3 <- c(
  "Ai65F-9_69.jpg",
  "Ai65F-10_76.jpg",
  "Ai65F-11_81.jpg",
  "Ai65F-12_95.jpg"
)


# Combine image paths for all mouse lines
all_image_paths1 <- list(dlx1 = dlx1_paths, dlx2 = dlx2_paths, dlx3 = dlx3_paths)
all_image_paths2 <- list(dlx1 = dlx1_atl1, dlx2 = dlx1_atl2, dlx3 = dlx1_atl3)
# Define UI

ui <- navbarPage(
  "Mouse Brain Image Viewer",
  theme = shinytheme("flatly"),
  tabPanel(
    "Home",
    fluidRow(
      column(6, selectInput(
        "mouse_line", "Select Mouse Line", choices = names(all_image_paths1)
      ),
      sliderInput("image_slider1", "Select Image", 1, 1, 1, step =1),
      br()
    ),
    
    column(6,selectInput(
      "mouse_linealt", "Select Mouse Line", choices = names(all_image_paths2)
      ),
      sliderInput("image_slider2", "Select Image", 1, 1, 1, step =1),
      br()
           )
    
  ),
  fluidRow(
    column(6, imageOutput("brain_image1")),
    column(6, imageOutput("brain_image2"))
  ),
  
  
  tabPanel(
    "stat" #includeMarkdown("about.md")
  )
  )
    


)


server <- function(input, output, session) {
  # Reactive value to store current image
  current_image1 <- reactiveVal(NULL)
  
  observe({
    # Update image paths based on selected mouse line
    image_paths1 <- all_image_paths1[[input$mouse_line]]
    
    # Update slider range based on number of images
    updateSliderInput(session, "image_slider1", max = length(image_paths1))
    
    # Initialize current image with the first image
    current_image1(magick::image_read(image_paths1[1]))
  })
  
  observeEvent(input$image_slider1, {
    # Change current image when slider value changes
    current_image1(magick::image_read(all_image_paths1[[input$mouse_line]][input$image_slider1]))
  })
 
  
  # Display the current image
  output$brain_image1 <- renderImage({
    if (!is.null(current_image1())) {
      # Save the current image to a temporary file with a transparent background
      temp_file1 <- tempfile(fileext = ".jpg")
      magick::image_write(current_image1(), path = temp_file1, format = "jpg")
      
      list(
        src = temp_file1,
        contentType = "image/jpg",
        width = "100%",
        height = "auto"
      )
    }
  }, deleteFile = TRUE)  # Delete the temporary file after rendering
  
  current_image2 <- reactiveVal(NULL)
  
  observe({
    # Update image paths based on selected mouse line
    image_paths2 <- all_image_paths2[[input$mouse_linealt]]
    
    # Update slider range based on number of images
    updateSliderInput(session, "image_slider2", max = length(image_paths2))
    
    # Initialize current image with the first image
    current_image2(magick::image_read(image_paths2[1]))
  })
  
  observeEvent(input$image_slider2, {
    # Change current image when slider value changes
    current_image2(magick::image_read(all_image_paths2[[input$mouse_linealt]][input$image_slider2]))
  })
  
  
  # Display the current image
  output$brain_image2 <- renderImage({
    if (!is.null(current_image2())) {
      # Save the current image to a temporary file with a transparent background
      temp_file2 <- tempfile(fileext = ".jpg")
      magick::image_write(current_image2(), path = temp_file2, format = "jpg")
      
      list(
        src = temp_file2,
        contentType = "image/jpg",
        width = "100%",
        height = "auto"
      )
    }
  }, deleteFile = TRUE)
}

# Run the application
shinyApp(ui, server)

This sort of construction :

library(shiny)

ui <- fluidPage(
  sliderInput("a1","a1",min = 1,max = 10,step = 1,value=1),
  sliderInput("b2","b2",min = 1,max = 10,step = 1,value=1)
)

server <- function(input, output, session) {
  
  current_val <- reactiveVal(NULL)
  
  observeEvent(input$a1,{
    if(!identical(current_val(),input$a1)){
      current_val(input$a1)
    }
  })
  
  observeEvent(input$b2,{
    if(!identical(current_val(),input$b2)){
      current_val(input$b2)
    }
  })
  
  observeEvent(current_val(),{
    if(!identical(current_val(),input$a1)){
      updateSliderInput(inputId = "a1",value = current_val())
    }
    if(!identical(current_val(),input$b2)){
      updateSliderInput(inputId = "b2",value = current_val())
    }
  })
}

shinyApp(ui, server)

Though from a user experience its not clear why this would be preferred to a single slider; what does it add to have the same control twice ?

@nirgrahamuk Thanks a lot for your reply! I will try it. The reason to show the two groups of images is to give an overview of the brain atlas (which has the names of the brain regions as additional information) and the real scanned image of the brain sections(no annotations, such as names of brain images, the quantitative feature of positive cells in the images) at the same time. I also attached one image from each group.

Thanks again!
Best,

Chen

@nirgrahamuk I can only attach one image in a reply. There was one image in my last reply. Here is anther image.

Yes, I understand the concept of paired images; and showing them.
I was questioning why two linked sliders would be needed to control which pair to show, when presumably one slider would do just as well.

@nirgrahamuk good question! I completely overlooked this! Thanks! That's true. There is no need to have two sliderbars.

Thanks a lot!

Best,
Chen

you're welcome Chenz