celestialgod

Shiny App for Ising Model

Apr 20th, 2015
330
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 4.34 KB | None | 0 0
  1. library(lattice)
  2. library(shiny)
  3. app = shinyApp(
  4.   ui = shinyUI(pageWithSidebar(
  5.     headerPanel('Ising Model'),
  6.     sidebarPanel(
  7.       sliderInput('girdSize', 'Gird Size', 2, 200, 30),
  8.       selectInput('updateAlgorithm', 'Algorithm',
  9.         c("Metropolis-Hasting Algorithm", "Gibbs sampling"),
  10.         "Metropolis-Hasting Algorithm"),
  11.       numericInput('iteration', 'Iteration', 50000, 1, 4000000),
  12.       numericInput('updateFreq', 'Draw Model Every N Iteration', 1000, 1, 10000),
  13.       sliderInput('temperature', 'Reciprocal of Temperature', -5, 5, 2, step = 0.1),
  14.       actionButton('reset', 'Reset'),
  15.       actionButton('stop', 'Stop'),
  16.       actionButton('start', 'Start')
  17.     ),
  18.     mainPanel(
  19.       h3(textOutput("currentIteration")),
  20.       plotOutput('IsingPlot', width = "600px", height = "600px")
  21.     )
  22.   )),
  23.   server = function(input, output, session) {
  24.     vals = reactiveValues()
  25.     range_f = function(X, loc) c(X[loc[1], c(loc[2]-1, loc[2]+1)], X[c(loc[1]-1, loc[1]+1), loc[2]])
  26.     resetIsingMatrix = observe({
  27.       input$reset
  28.       runProcess$suspend()
  29.       isolate({
  30.         vals$IsingMatrix = replicate(input$girdSize+2, rbinom(input$girdSize+2, 1, .5))
  31.         vals$IsingMatrix[c(1, input$girdSize+2),] = vals$IsingMatrix[c(input$girdSize+1, 2),]
  32.         vals$IsingMatrix[,c(1, input$girdSize+2)] = vals$IsingMatrix[,c(input$girdSize+1, 2)]
  33.       })
  34.     }, priority=30)
  35.    
  36.     changeGridSize = observe({
  37.       input$girdSize
  38.       runProcess$suspend()
  39.       isolate({
  40.         vals$IsingMatrix = replicate(input$girdSize+2, rbinom(input$girdSize+2, 1, .5))
  41.         vals$IsingMatrix[c(1, input$girdSize+2),] = vals$IsingMatrix[c(input$girdSize+1, 2),]
  42.         vals$IsingMatrix[,c(1, input$girdSize+2)] = vals$IsingMatrix[,c(input$girdSize+1, 2)]
  43.       })
  44.     }, priority = 100)
  45.  
  46.     setup_to_run = observe({
  47.       input$start
  48.       isolate({
  49.         if (is.null(vals$IsingMatrix))
  50.         {
  51.           vals$IsingMatrix = replicate(input$girdSize+2, rbinom(input$girdSize+2, 1, .5))
  52.           vals$IsingMatrix[c(1, input$girdSize+2),] = vals$IsingMatrix[c(input$girdSize+1, 2),]
  53.           vals$IsingMatrix[,c(1, input$girdSize+2)] = vals$IsingMatrix[,c(input$girdSize+1, 2)]
  54.         }
  55.         if (input$updateAlgorithm == "Metropolis-Hasting Algorithm")
  56.         {
  57.           vals$algo_f = function(mat, temperature){
  58.             N = nrow(mat) - 2
  59.             loc = floor(N*runif(2)) + 2
  60.             if (runif(1) < exp(2*(2-sum(range_f(mat, loc) == mat[loc[1], loc[2]]))*temperature))
  61.               mat[loc[1],loc[2]] = 1 - mat[loc[1],loc[2]]
  62.             mat[c(1, N+2),] = mat[c(N+1, 2),]
  63.             mat[,c(1, N+2)] = mat[,c(N+1, 2)]
  64.             mat
  65.           }
  66.         } else
  67.         {
  68.           vals$algo_f = function(mat, temperature){
  69.             N = nrow(mat) - 2
  70.             loc = floor(N*runif(2)) + 2
  71.             S = 2-sum(range_f(mat, loc) == mat[loc[1], loc[2]])
  72.             if (runif(1) < 1/(exp(-S*temperature)**2+1))
  73.               mat[loc[1],loc[2]] = 1 - mat[loc[1],loc[2]]
  74.             mat[c(1, N+2),] = mat[c(N+1, 2),]
  75.             mat[,c(1, N+2)] = mat[,c(N+1, 2)]
  76.             mat
  77.           }
  78.         }
  79.         vals$iteration = input$iteration
  80.         vals$updateFreq = input$updateFreq
  81.         vals$temperature = input$temperature
  82.         vals$iter = 0
  83.       })
  84.       runProcess$resume()
  85.     }, priority=20)
  86.    
  87.     runProcess = observe({
  88.       if (input$start == 0) return()
  89.       isolate({
  90.         result = vals$IsingMatrix
  91.         i = 0
  92.         while (i < vals$updateFreq)
  93.         {
  94.           result = vals$algo_f(result, vals$temperature)
  95.           i = i + 1
  96.         }
  97.         vals$IsingMatrix = result
  98.         vals$iter = vals$iter + vals$updateFreq
  99.       })
  100.       if (isolate(vals$iter) < isolate(vals$iteration))
  101.         invalidateLater(500, session)
  102.     }, priority=10)
  103.    
  104.     output$currentIteration = renderText({
  105.       paste0("Current iteration: ", vals$iter)
  106.     })
  107.    
  108.     stopProcess = observe({
  109.       input$stop
  110.       runProcess$suspend()
  111.     })
  112.    
  113.     output$IsingPlot = renderPlot({
  114.       levelplot(vals$IsingMatrix[2:(input$girdSize+1), 2:(input$girdSize+1)],
  115.         col.regions = c("red", "green"),
  116.         colorkey  = FALSE, xlab = "", ylab = "")
  117.     })
  118.    
  119.     session$onSessionEnded(function() {
  120.       runProcess$suspend()
  121.     })
  122.   }
  123. )
  124. runApp(app)
Advertisement
Add Comment
Please, Sign In to add comment