corruption/BasicModel_v1.0_ShinyUI.R at main · PHB-Methods/corruption · GitHub

1
2
3
4
5
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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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
# Lade benötigte R-Pakete
library(shiny)

# Binde die ausgelagerte Modell-Logik ein
source("BasicModel_v1.0.R")

# ==============================================================================
# SHINY UI (Frontend)
# ==============================================================================
ui <- fluidPage(

  titlePanel("Live Kooperations-Modell (Natives R)"),

  sidebarLayout(
    sidebarPanel(
      helpText("Dieses Modell aktualisiert sich live, ähnlich wie in NetLogo."),

      # Steuerungs-Buttons (Setup und Go)
      fluidRow(
        column(6, actionButton("setup_btn", "Setup", icon = icon("undo"), class = "btn-warning", style = "width: 100%;")),
        column(6, actionButton("play_btn", "Play / Pause", icon = icon("play"), class = "btn-success", style = "width: 100%;"))
      ),

      hr(),

      # Slider für die Parameter
      sliderInput("coop_prob",
                  "Kooperationswahrscheinlichkeit:",
                  min = 0.0, max = 1.0, value = 0.5, step = 0.05),

      sliderInput("speed_log",
                  "Simulationsgeschwindigkeit (Log-Skala):",
                  min = 0, max = 3, value = 1, step = 0.1),
      helpText(strong(textOutput("actual_speed_text"))),

      hr(),
      h4(textOutput("tick_display"))
    ),

    mainPanel(
      fluidRow(
        column(6, plotOutput("mapPlot", height = "500px")),
        column(6, plotOutput("giniPlot", height = "500px"))
      )
    )
  )
)

# ==============================================================================
# SHINY SERVER (Controller)
# ==============================================================================
server <- function(input, output, session) {

  # Lokaler State Manager (verbindet UI mit dem Modell)
  rv <- reactiveValues(
    playing = FALSE,
    num_agents = 100,
    step = 0, wealth = NULL, x = NULL, y = NULL, color = NULL, gini_history = NULL
  )

  # ----------------------------------------------------------------------------
  # SETUP LOGIK
  # ----------------------------------------------------------------------------
  observeEvent(input$setup_btn, {
    rv$playing <- FALSE
    updateActionButton(session, "play_btn", label = "Play", icon = icon("play"))

    # Ruft setup_model() aus der model.R auf
    init_state <- setup_model(rv$num_agents)

    rv$step <- init_state$step
    rv$wealth <- init_state$wealth
    rv$x <- init_state$x
    rv$y <- init_state$y
    rv$color <- init_state$color
    rv$gini_history <- init_state$gini_history
  }, ignoreNULL = FALSE)

  # ----------------------------------------------------------------------------
  # PLAY / PAUSE LOGIK
  # ----------------------------------------------------------------------------
  observeEvent(input$play_btn, {
    rv$playing <- !rv$playing

    if (rv$playing) {
      updateActionButton(session, "play_btn", label = "Pause", icon = icon("pause"))
    } else {
      updateActionButton(session, "play_btn", label = "Play", icon = icon("play"))
    }
  })

  # ----------------------------------------------------------------------------
  # SIMULATIONS-SCHLEIFE
  # ----------------------------------------------------------------------------
  observe({
    req(rv$playing)
    invalidateLater(100, session)

    isolate({
      # Ruft die Schleife aus der model.R auf
      new_state <- run_model_steps(
        step = rv$step,
        wealth = rv$wealth,
        gini_history = rv$gini_history,
        speed = round(10^input$speed_log),
        prob = input$coop_prob,
        num_agents = rv$num_agents
      )

      # Neue Werte übernehmen
      rv$step <- new_state$step
      rv$wealth <- new_state$wealth
      rv$color <- new_state$color
      rv$gini_history <- new_state$gini_history
    })
  })

  # ----------------------------------------------------------------------------
  # OUTPUTS ZEICHNEN
  # ----------------------------------------------------------------------------
  output$actual_speed_text <- renderText({
    paste("Aktuelle Ticks pro Frame:", round(10^input$speed_log))
  })

  output$tick_display <- renderText({
    paste("Aktueller Tick:", rv$step)
  })

  output$mapPlot <- renderPlot({
    req(rv$step >= 0)
    par(mar = c(2, 2, 4, 1))
    plot(rv$x, rv$y, col = rv$color, pch = 19, cex = 2,
         xlim = c(-16, 16), ylim = c(-16, 16), asp = 1,
         main = "Räumliche Verteilung\n(Grün = Kooperierende im ZULETZT berechneten Tick)",
         xlab = "", ylab = "", axes = FALSE, frame.plot = TRUE)
  })

  output$giniPlot <- renderPlot({
    req(rv$step > 0)
    step_seq <- 1:rv$step
    gini_vals <- rv$gini_history[1:rv$step]

    par(mar = c(4, 4, 4, 1))
    plot(step_seq, gini_vals, type = "l",
         col = "darkred", lwd = 2,
         ylim = c(0, max(0.1, max(gini_vals, na.rm = TRUE))),
         main = "Gini-Index über die Zeit",
         xlab = "Ticks", ylab = "Gini-Index")
  })
}

# Starte die App
shinyApp(ui = ui, server = server)