::: {.grid}
::: {.g-col-3}
:::
::: {.g-col-8}
# Quarto Shiny ALM
:::
:::


```{r}
pacman::p_load(tidyverse, shiny, reactable, simplevis)

```


```{r}
#| context: server
pacman::p_load(tidyverse, shiny, reactable,plotly)
input.activation <- function(x.target, association.parameter) {
    # return(exp(-1*association.parameter*(100*x.target-100*x.plotting)^2))
    return(exp(-1 * association.parameter * (x.target - x.plotting)^2))
}

output.activation <- function(x.target, weights, association.parameter) {
    return(weights %*% input.activation(x.target, association.parameter))
}

mean.prediction <- function(x.target, weights, association.parameter) {
    probability <- output.activation(x.target, weights, association.parameter) / sum(output.activation(x.target, weights, association.parameter))
    return(y.plotting %*% probability)
}
# function to generate exam predictions
exam.prediction <- function(x.target, weights, association.parameter) {
    trainVec <- sort(unique(x.learning))
    nearestTrain <- trainVec[which.min(abs(trainVec - x.target))]
    aresp <- mean.prediction(nearestTrain, weights, association.parameter)
    xUnder <- ifelse(min(trainVec) == nearestTrain, nearestTrain, trainVec[which(trainVec == nearestTrain) - 1])
    xOver <- ifelse(max(trainVec) == nearestTrain, nearestTrain, trainVec[which(trainVec == nearestTrain) + 1])
    mUnder <- mean.prediction(xUnder, weights, association.parameter)
    mOver <- mean.prediction(xOver, weights, association.parameter)
    exam.output <- round(aresp + ((mOver - mUnder) / (xOver - xUnder)) * (x.target - nearestTrain), 3)
    exam.output
}

update.weights <- function(x.new, y.new, weights, association.parameter, update.parameter) {
    y.feedback.activation <- exp(-1 * association.parameter * (y.new - y.plotting)^2)
    x.feedback.activation <- output.activation(x.new, weights, association.parameter)
    return(weights + update.parameter * (y.feedback.activation - x.feedback.activation) %*% t(input.activation(x.new, association.parameter)))
}

learn.alm <- function(y.learning, association.parameter = 0.05, update.parameter = 0.5) {
    weights <- matrix(rep(0.00, length(y.plotting) * length(x.plotting)), nrow = length(y.plotting), ncol = length(x.plotting))
    for (i in 1:length(y.learning)) {
        weights <- update.weights(x.learning[i], y.learning[i], weights, association.parameter, update.parameter)
        weights[weights < 0] <- 0
    }
    alm.predictions <- sapply(x.plotting, mean.prediction, weights = weights, association.parameter = association.parameter)
    exam.predictions <- sapply(x.plotting, exam.prediction, weights = weights, association.parameter = association.parameter)
    return(list(alm.predictions = alm.predictions, exam.predictions = exam.predictions))
    # return(list(alm.predictions=alm.predictions, exam.predictions=exam.predictions,wmFinal=weights))
}



x.plotting<<-seq(0,90, .5)
y.plotting<<-seq(0, 210, by=2)
#trainOptions=round(seq(1,length(x.plotting),length.out=21),0)
trainOptions=x.plotting[seq(1,181,by=4)]
trainItems=trainOptions[c(10,11,12)]

```



 
::: {.grid} 


::: {.g-col-3}


```{r}
#| panel: sidebar

x.plotting<<-seq(0,90, .5)
y.plotting<<-seq(0, 210, by=2)
#trainOptions=round(seq(1,length(x.plotting),length.out=21),0)
trainOptions=x.plotting[seq(1,181,by=4)]
trainItems=trainOptions[c(10,11,12)]

 sliderInput("assoc",
          "Association Parameter",
          min = .001,
          max = 1,
          value = 0.5,
          step = 0.01
        )
        sliderInput("update",
          "Update Parameter",
          min = 0,
          max = 1,
          value = 0.5,
          step = 0.1
        )
        sliderInput("trainRep",
          "Training Repetitions",
          min = 1,
          max = 50,
          value = 1,
          step = 1
        )
        sliderInput("Noise",
          "Noise",
          min = 0,
          max = 50,
          value = 0,
          step = 1
        )
        checkboxGroupInput("trainItems",
          "Training Items",
          choices = trainOptions,
          selected = trainOptions[c(
            10,
            15,
            35
          )],
          inline = TRUE
        )
        radioButtons("functionForm",
          "Function Form",
          choices = c(
            "Linear",
            "Quadratic",
            "Exponential"
          ),
          selected = "Quadratic"
        )
        # numericInput("nRep",
        #   "Number of Repetitions",
        #   value = 1,
        #   min = 1,
        #   max = 100
        # )
        actionButton(
          "run",
          "Run Simulation"
        )

```
:::


::: {.g-col-8}


testing plain text



## Shiny App

### Figure and Table


```{r}
######| panel: fill
#plotOutput("plot",width="100%",height="600px")
plotOutput("plot")
```

## Tables
### Average Model Performance
```{r}
#h3("Average Model Performance")
reactableOutput("table")
```

### Model Performance By Item Type
```{r}
#h3("Model Performance by Item Type")
reactableOutput("table2")
```


### Model Definitions


::: panel-tabset

### ALM Definition


##### Input Activation
$$
a_i(X)=\exp \left|-\gamma \cdot\left[X-X_i\right]^2\right|
$$

##### Output activation
$$
o_j(X)=\Sigma_{i=1, M} w_{j i} \cdot a_i(X) 
$$

##### Output Probability
$$
P\left[Y_j \mid X\right]=o_j(X) / \Sigma_{k=1, L} o_k(X) 
$$

##### Mean Response
$$
m(X)=\Sigma_{j=1, L} Y_j \cdot P\left[Y_j \mid X\right] 
$$




\ \ \ \ \ 



##### Feedback Signal

$$
f_j(Z)=e^{-c\cdot(Z-Y_j)^2}
$$

##### Weight Updates
$$
w_{ji}(t+1)=w_{ji}(t)+\alpha \cdot {f_i(Z(t))-O_j(X(t))} \cdot a_i(X(t))
$$


### Exam Generalization


###### Input node actvation
$$
P[X_i|X] = \frac{a_i(X)}{\\sum_{k=1}^Ma_k(X)}
$$

###### Slope Computation
$$
E[Y|X_i]=m(X_i) + \bigg[\frac{m(X_{i+1})-m(X_{i-1})}{X_{i+1} - X_{i-1}} \bigg]\cdot[X-X_i]
$$
::: 



:::




:::




```{r}
#| context: server
nRep=1
  user_choice <- eventReactive(input$run, {
    return(list(assoc = input$assoc, update = input$update, Noise=input$Noise,
                functionForm=input$functionForm,trainRep = as.numeric(input$trainRep),
                trainItems = input$trainItems))
    
  }, ignoreNULL = FALSE)
  

    output_df <- eventReactive(input$run, {
      uc <- reactive({user_choice()})
    if (uc()$functionForm == "Linear") {
      f.plotting <<- as.numeric(x.plotting * 2.2 + 30)
    } else if (uc()$functionForm == "Quadratic") {
      f.plotting <<- as.numeric(210 - ((x.plotting - 50)^2) / 12)
    } else if (uc()$functionForm == "Exponential") {
      # f.plotting<<-as.numeric(scale(200*(1-exp(-x.plotting/25))))
      f.plotting <<- as.numeric(200 * (1 - exp(-x.plotting / 25)))
    }
    trainItems <- as.numeric(uc()$trainItems)
    y.plotting <<- seq(0, max(f.plotting), by = 1)
    x.learning <<- rep(trainItems, times = uc()$trainRep)
    f.learning <<- rep(f.plotting[which(x.plotting %in% trainItems)], times = uc()$trainRep)
    # print(x.learning)
    # print(f.learning)
    # print(uc()$trainRep)
    # print(trainItems)
    # print(uc()$functionForm)
    
    
    output_list <- replicate(nRep, list(learn.alm(f.learning + rnorm(length(f.learning), sd = uc()$Noise),
                                                  association.parameter = uc()$assoc, update.parameter = uc()$update)))
    
    output_df <- lapply(output_list, function(x) as.data.frame(x))
    #output_df <- lapply(output_list, function(x) lapply(x, as.data.frame)) # 10 dfs x 9 lists
    output_df <- Reduce(rbind, output_df) %>% mutate(x = x.plotting, y = f.plotting)
    #output_df <- lapply(output_df, function(x) Reduce(rbind,x))# 1 df x 9 lists
    output_df <- output_df %>%
      pivot_longer(names_to = "Model", values_to = "Prediction", cols = c(alm.predictions, exam.predictions)) %>%
      rbind(data.frame(data.frame(x = x.plotting, y = f.plotting, Model = "True Function", Prediction = f.plotting)), .)
    str(output_df)
    return(output_df)
    
    }, ignoreNULL = FALSE)
    
    
    # output$plot <- renderPlotly({
    #    output_df2 <- reactive({output_df2()})
    #   p<-ggplot(data = output_df2(), aes(x = x, y = Prediction,color=Model),alpha=.2) + 
    #     geom_line(aes(linetype=Model,alpha=Model)) + 
    #     geom_point(data = data.frame(x.learning, f.learning), 
    #                aes(x = x.learning,y = f.learning),color="black",size=4,shape=4) +
    #     # geom_line(data = data.frame(x.plotting, f.plotting), 
    #     #           aes(x = x.plotting, y = f.plotting),linetype=2, color = "black",alpha=.3) + 
    #     scale_color_manual(values = c("red", "blue", "black"))+
    #     scale_alpha_manual(values=c(.8,.8,.4))+
    #     scale_linetype_manual(values=c(1,1,2))+
    #     ggtitle(paste("Association Parameter:", assoc, " Update Parameter:", update, " Train Reps:", trainRep, " Noise:", Noise))
    #   ggplotly(p) #tooltip=c("Prediction","Model")
    # }) 
      
    
    output$plot <- renderPlot({
      
      output_df2 <- reactive({output_df()})
      ggplot(data = output_df2(), aes(x = x, y = Prediction,color=Model),alpha=.2) + 
        geom_line(aes(linetype=Model,alpha=Model)) + 
        geom_point(data = data.frame(x.learning, f.learning), 
                   aes(x = x.learning,y = f.learning),color="black",size=4,shape=4) +
        # geom_line(data = data.frame(x.plotting, f.plotting), 
        #           aes(x = x.plotting, y = f.plotting),linetype=2, color = "black",alpha=.3) + 
        scale_color_manual(values = c("red", "blue", "black"))+
        scale_alpha_manual(values=c(.8,.8,.4))+
        scale_linetype_manual(values=c(1,1,2))+
        ylim(c(0,250))#+
        # ggtitle(paste("Association Parameter:", user_choice()$assoc, " Update Parameter:", 
        #               uc$update, " Train Reps:", 
        #               uc$trainRep, " Noise:", uc$Noise))
    }) 
    
   
    # table 1 reports the summary stats for all items. Table uses GT library to make gt table
    output$table <- renderReactable({
      output_df <- output_df()
      output_df() %>% group_by(Model) %>% filter(Model !="True Function") %>%
        summarise(MeanDeviation = mean(abs(Prediction - y)), 
                  RMSD = sqrt(mean((Prediction -y)^2)),Correlation = cor(Prediction, y)) %>%
        mutate(across(where(is.numeric), round, 1)) %>%
        reactable::reactable(compact=TRUE,bordered = TRUE, highlight = TRUE, resizable=TRUE)
    })
    # table 2 reports the summary stats separately for training items, interpolation items, and extrapolation items
    output$table2 <- renderReactable({
      uc <- reactive({user_choice()})
      output_df() %>% filter(Model !="True Function") %>% 
        mutate(ItemType = ifelse(x %in% x.learning, "Training", ifelse(x > min(x.learning) & x < max(x.learning), "Interpolation", "Extrapolation"))) %>%
        group_by(ItemType,Model) %>%
        summarise(MeanDeviation = mean(abs(Prediction - y)), 
                  RMSD = sqrt(mean((Prediction -y)^2)),Correlation = cor(Prediction, y)) %>% 
        mutate(across(where(is.numeric), round, 1)) %>%
        reactable::reactable(compact=TRUE,bordered = TRUE, highlight = TRUE, resizable=TRUE) 
    })
    
    
    output$code <- renderPrint({
      # code to implement the ALM and EXAM models
      # code to generate data
      # code to run models
      # code to format output
      cat(" input.activation <- function(x,assoc,update,trainRep){
  # activation function for ALM
  # x is the input vector
  # assoc is the association parameter
  # update is the update parameter

    ")
    })

```





```{r}
#| eval: false
#| context: server
observeEvent(input$run, {
     assoc = input$assoc
     update = input$update
     nRep = input$nRep
     Noise = input$Noise
     functionForm = input$functionForm
     trainRep = input$trainRep
     trainItems <- input$trainItems
     trainItems <- as.numeric(trainItems)

     if (functionForm == "Linear") {
         f.plotting <<- as.numeric(x.plotting * 2.2 + 30)
     } else if (functionForm == "Quadratic") {
         f.plotting <<- as.numeric(210 - ((x.plotting - 50)^2) / 12)
     } else if (functionForm == "Exponential") {
         # f.plotting<<-as.numeric(scale(200*(1-exp(-x.plotting/25))))
         f.plotting <<- as.numeric(200 * (1 - exp(-x.plotting / 25)))
     }

     y.plotting <<- seq(0, max(f.plotting), by = 1)
     x.learning <<- rep(x.plotting[trainItems], times = trainRep)
     f.learning <<- rep(f.plotting[trainItems], times = trainRep)

     output_list <- replicate(nRep, list(learn.alm(f.learning + rnorm(length(f.learning), sd = Noise),
         association.parameter = assoc, update.parameter = update
     )))


     # weight.mat = output_list[[1]]$wmFinal
     # output_list = list(output_list[[1]][1], output_list[[1]][2])

     output_df <- lapply(output_list, function(x) as.data.frame(x))
     output_df <- Reduce(rbind, output_df) %>% mutate(x = x.plotting, y = f.plotting)
     output_df <- output_df %>%
         pivot_longer(names_to = "Model", values_to = "Prediction", cols = c(alm.predictions, exam.predictions)) %>%
         rbind(data.frame(data.frame(x = x.plotting, y = f.plotting, Model = "True Function", Prediction = f.plotting)), .)
    
   output$plot <- renderPlotly({
      p<-ggplot(data = output_df, aes(x = x, y = Prediction,color=Model),alpha=.2) + 
        geom_line(aes(linetype=Model,alpha=Model)) + 
        geom_point(data = data.frame(x.learning, f.learning), 
                   aes(x = x.learning,y = f.learning),color="black",size=4,shape=4) +
        # geom_line(data = data.frame(x.plotting, f.plotting), 
        #           aes(x = x.plotting, y = f.plotting),linetype=2, color = "black",alpha=.3) + 
        scale_color_manual(values = c("red", "blue", "black"))+
        scale_alpha_manual(values=c(.8,.8,.4))+
        scale_linetype_manual(values=c(1,1,2))+
        ggtitle(paste("Association Parameter:", assoc, " Update Parameter:", update, " Train Reps:", trainRep, " Noise:", Noise))
      ggplotly(p) #tooltip=c("Prediction","Model")
    }) 
    # table 1 reports the summary stats for all items. Table uses GT library to make gt table
    output$table <- renderReactable({
      output_df %>% group_by(Model) %>% filter(Model !="True Function") %>%
        summarise(MeanDeviation = mean(abs(Prediction - y)), 
                  RMSD = sqrt(mean((Prediction -y)^2)),Correlation = cor(Prediction, y)) %>%
        mutate(across(where(is.numeric), round, 1)) %>%
        reactable::reactable(compact=TRUE,bordered = TRUE, highlight = TRUE, resizable=TRUE)
    })
    # table 2 reports the summary stats separately for training items, interpolation items, and extrapolation items
    output$table2 <- renderReactable({
      output_df %>% filter(Model !="True Function") %>% 
        mutate(ItemType = ifelse(x %in% x.learning, "Training", ifelse(x > min(x.learning) & x < max(x.learning), "Interpolation", "Extrapolation"))) %>%
        group_by(ItemType,Model) %>%
        summarise(MeanDeviation = mean(abs(Prediction - y)), 
                  RMSD = sqrt(mean((Prediction -y)^2)),Correlation = cor(Prediction, y)) %>% 
        mutate(across(where(is.numeric), round, 1)) %>%
        reactable::reactable(compact=TRUE,bordered = TRUE, highlight = TRUE, resizable=TRUE) 
    })
})

```








```{r}
#| eval: false

quarto::quarto_run("quarto_shiny.qmd",
                   render=TRUE)


#quarto::quarto_run(input="quarto_shiny.qmd",host=getOption("shinyHost","127.0.0.1"),browse=TRUE)
```




```{r}


```




```{r}


```