Split by...

Control for...

Filter by...

Results Options



 

Condition-Matching Options

Match by...

Results Options

Download

Results Format
Ignore Filters

Sorting Options

Distance Measures

Euclidean Distance

City Block Distance

1) Stimuli Input


2) Choose Target Features

3) Results




Plot Controls





1) Upload Data


2) Choose Target Features

3) Summary of Uploaded Variables

show with app
library(shiny)
library(shinydashboard)
library(shinyjs)
library(tidyverse)
library(plotly)
library(viridis)
library(ggwordcloud)
library(DT)
library(vwr)
library(colourpicker)

lexops_loadingdone <- function() {
  hide(id = "loading_page", anim = TRUE, animType = "fade")    
  show("main_content")
}

# IMPORT DATA
cat(sprintf('\nIMPORTING DATA...\n'))
dat <- readRDS('dat.rds')
cat(sprintf(' -DONE.\n'))

# Create lexops dataframe
source("server/get_lexops_data.R", local=T)
lexopsraw <- lexops

# simple functions for rounding decimals up or down
source("misc_functions/rounding.R", local=T)

# set options for visualisation
source("server/get_viscats.R", local=T)

# functions for visualising distributions in boxes
source("misc_functions/box_vis_functions.R", local=T)

# function for converting CMU phoneme representations between one and two-letter
source("misc_functions/arpabet_convert.R", local=T)

# function for calculating Euclidean distance from target word for selected columns
source("misc_functions/get_euclidean_distance.R", local=T)

# function for calculating City-Block distance from target word for selected columns
source("misc_functions/get_cityblock_distance.R", local=T)

# function for getting a word's possible pronunciations
source("misc_functions/get_pronunciations.R", local=T)

# function for returning which alternate pronunciation for a string has been selected
source("misc_functions/get_pron_nr.R", local=T)

# functions for converting between short-hand and variable names or APA citations
source("misc_functions/corpus_recoders.R", local=T)

# functions used in matching
source("server/match/matcher_functions.R", local=T)

# Define server logic
shinyServer(function(input, output) {
  
  # get the lexopsReact() reactive df
  source("server/lexops_reactive_df.R", local=T)
  
  visualise.opts <- reactive({
    names(lexopsReact())[!(names(lexopsReact()) %in% c('string'))]
  })
  
  # functions used in the generate tab to create the UIs
  source("server/generate/splitby_UIfunction.R", local=T)
  source("server/generate/controlfor_UIfunction.R", local=T)
  source("server/generate/filterby_UIfunction.R", local=T)
  
  # initial numbers of boxes on generate tab
  gen_splitby_boxes_N <- reactiveVal(0)
  gen_controlfor_boxes_N <- reactiveVal(0)
  gen_filterby_boxes_N <- reactiveVal(0)
  
  # Generate tab boxes
  source("server/generate/splitby_boxes.R", local=T)
  source("server/generate/controlfor_boxes.R", local=T)
  source("server/generate/filterby_boxes.R", local=T)
  
  # Get the generated stimuli
  source("server/generate/generate.R", local=T)
  
  # Generate tab results
  source("server/generate/results_generate.R", local=T)
  
  # initial number of boxes on generate tab
  matchboxes_N <- reactiveVal(0)
  
  # Match tab UI
  source("server/match/match_UIfunction.R", local=T)
  
  # Match tab boxes
  source("server/match/match_boxes.R", local=T)
  
  # get matches
  source("server/match/match.R", local=T)
  
  # put matches in datatable & sorting options
  source("server/match/results_match.R", local=T)
  
  # fetch tab
  source("server/fetch.R", local=T)
  
  # custom variables tab
  source("server/custom_variables.R", local=T)
  
  # Info page download button
  output$LexOPS.csv <- downloadHandler(
    filename = 'LexOPS.csv',
    content = function(file) {
      write.csv(lexopsraw, file, row.names = FALSE)
    }
  )
  
  source("server/update_visualisation.R", local=T)
  
  # loading screen finish
  lexops_loadingdone()
  
}

)
library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinycssloaders)
library(tidyverse)
library(plotly)
library(viridis)
library(DT)
library(colourpicker)

# Visualilsation vector categories - needed in UI for Visualisation tab
vis.cats <- c('Word Frequency', 'Part of Speech', 'Length', 'Bigram Probability', 'Orthographic Neighbourhood', 'Syllables', 'Phonemes', 'Rhyme', 'Phonological Neighbourhood', 'Number of Pronunciations', 'Familiarity', 'Age of Acquisition', 'Concreteness', 'Arousal', 'Valence', 'Dominance', 'Imageability', 'Semantic Size', 'Semantic Gender', 'Humour', 'Word Prevalence', 'Proportion Known', 'Lexical Decision Response Time', 'Lexical Decision Accuracy', 'Custom Variable')

tagList(
  useShinyjs(),
  tags$head(
    tags$link(href = "style.css", rel = "stylesheet")
  ),
  div(
    id = "loading_page",
    img(src = "lexopslogo_white.png", class = 'center-fit'),
    br(), br(),
    img(src = "ajax-loader.gif")
  ),
  
  hidden(
    div(
      id = "main_content",
      dashboardPage(title='LexOPS',
                    skin='black',
                    
                    dashboardHeader(title=tags$a(href="javascript:history.go(0)",
                                                 tags$img(src='lexopslogo_black_textonly.png', height='30px')),
                                    titleWidth=200),
                    
                    dashboardSidebar(width=200,
                                     sidebarMenu(
                                       style = 'position: fixed; overflow: visible;',  # Stationary sidebar while scrolling
                                       menuItem('Generate', icon=icon('cogs'),
                                                startExpanded = T,
                                                menuSubItem('Options', tabName="generate_options", icon=icon('sliders-h')),
                                                menuSubItem('Results', tabName="generate_results", icon=icon('sort-amount-down'))),
                                       menuItem('Match', icon=icon('balance-scale'),
                                                startExpanded = F,
                                                textInput('matchstring', 'Word:', 'thicket', width="90%"),  # must explicitly give width of UI items in sidebar to avoid overflowing
                                                column(1, textOutput('nrow.matchresults')),
                                                br(), br(),
                                                menuSubItem('Options', tabName="match_options", icon=icon('sliders-h')),
                                                menuSubItem('Results', tabName="match_results", icon=icon('sort-amount-down'))),
                                       menuItem('Fetch', tabName='fetch', icon=icon('file-import')),
                                       menuItem('Visualise', tabName="visualise", icon=icon('chart-bar')),
                                       br(),
                                       menuItem('Custom Variables', tabName='custom_variables', icon=icon('plus')),
                                       menuItem('Preferences', tabName='preferences', icon=icon('wrench')),
                                       menuItem('Info', tabName='info', icon=icon('info-circle'))
                                     )),
                    
                    dashboardBody(
    
                      tabItems(
                        tabItem(tabName = 'generate_options',
                                fluidRow(
                                  column(4, fluidRow(
                                    valueBox("Split by...", width = 12, color='light-blue', icon=icon("sitemap"),
                                             subtitle=fluidRow(column(12,
                                                                      actionButton('gen_splitby_add', icon("plus-square")),
                                                                      actionButton('gen_splitby_minus', icon("minus-square"))
                                             ))),
                                    lapply(1:25, function(i) {
                                      boxid <- sprintf('gen_splitby_%i', i)
                                      uiOutput(boxid)
                                    })
                                  )),
                                  column(4, fluidRow(
                                    valueBox("Control for...", width = 12, color='yellow', icon=icon("balance-scale"),
                                             subtitle=fluidRow(column(12,
                                                                      actionButton('gen_controlfor_add', icon("plus-square")),
                                                                      actionButton('gen_controlfor_minus', icon("minus-square"))
                                             ))),
                                    lapply(1:25, function(i) {
                                      boxid <- sprintf('gen_controlfor_%i', i)
                                      uiOutput(boxid)
                                    })
                                  )),
                                  column(4, fluidRow(
                                    valueBox("Filter by...", width = 12, color='purple', icon=icon("filter"),
                                             subtitle=fluidRow(column(12,
                                                                      actionButton('gen_filterby_add', icon("plus-square")),
                                                                      actionButton('gen_filterby_minus', icon("minus-square"))
                                             ))),
                                    lapply(1:25, function(i) {
                                      boxid <- sprintf('gen_filterby_%i', i)
                                      uiOutput(boxid)
                                    })
                                  ))
                                )),
                        tabItem(tabName = 'generate_results',
                                fluidRow(
                                  box(title='Results Options', status='primary',
                                      collapsible=T, collapsed=F, width=12,
                                      fluidRow(
                                        column(6, align="center", actionButton("gen_generate", "Generate/Regenerate Stimuli List", icon=icon("redo-alt"))),
                                        column(6, align="center", downloadButton('generated.csv', 'Download Generated Stimuli')),
                                        column(12, br()),
                                        column(12, br()),
                                        column(6, radioButtons('gen_limit_N', 'Number of Items', c('Generate N Items'='N', 'Generate All Possible Items'='all'), 'N')),
                                        column(6, uiOutput('gen_N_stim_choice')),
                                        column(12, uiOutput('gen_dataformat_choice')),
                                        column(12, HTML('&nbsp;')),
                                        box(
                                          title='Condition-Matching Options', status='primary',
                                          collapsible=T, collapsed=T, width=12,
                                          fluidRow(
                                            column(12, uiOutput('gen_controlnull_choice')),
                                            column(12, checkboxInput('gen_check.dist', 'Filter by Euclidean/CityBlock Distance from Null Condition', 0)),
                                            uiOutput('gen_dist_opts_choice')
                                          ))
                                        ))),
                                DT::dataTableOutput('gen_results_dt')),
                        # Match Options tab
                        tabItem(tabName='match_options',
                                
                                fluidRow(
                                  column(12, fluidRow(
                                    valueBox("Match by...", width = 12, color='light-blue', icon=icon("balance-scale"),
                                             subtitle=fluidRow(column(12,
                                                                      actionButton('match_add', icon("plus-square")),
                                                                      actionButton('match_minus', icon("minus-square"))
                                             ))),
                                    lapply(1:50, function(i) {
                                      boxid <- sprintf('matchbox_%i', i)
                                      uiOutput(boxid)
                                    })
                                  ))
                                )
                                
                                ),
                        # Match Results tab
                        tabItem(tabName='match_results',
                                fluidRow(
                                  box(title='Results Options', status='primary',
                                      collapsible=T, collapsed=T, width=12,
                                      fluidRow(
                                        column(12, h5(strong("Download"))),
                                        column(12, downloadButton('matched.csv', 'Download Suggested Matches')),
                                        column(12, br()),
                                        column(12, h5(strong("Results Format"))),
                                        column(12, selectInput('results.format', NULL, c('Raw Values'='rv',
                                                                                                     'Distances (Absolute Difference from Target Word)'='dist',
                                                                                                     'Differences (from Target Word)'='diff'), selected='dist')),
                                        column(12, h5(strong("Ignore Filters"))),
                                        column(12, checkboxInput('check.match.ignorefilters', 'Ignore Tolerances on Options Tab', 0)),
                                        column(12, br()),
                                        box(
                                          title='Sorting Options', status='primary',
                                          collapsible=T, collapsed=T, width=12,
                                          fluidRow(
                                            column(6, uiOutput('match_results_sort_1_choice')),
                                            column(6, uiOutput('match_results_sort_1_order_choice')),
                                            column(6, uiOutput('match_results_sort_2_choice')),
                                            column(6, uiOutput('match_results_sort_2_order_choice')),
                                            column(6, uiOutput('match_results_sort_3_choice')),
                                            column(6, uiOutput('match_results_sort_3_order_choice')),
                                            column(6, uiOutput('match_results_sort_4_choice')),
                                            column(6, uiOutput('match_results_sort_4_order_choice')),
                                            column(6, uiOutput('match_results_sort_5_choice')),
                                            column(6, uiOutput('match_results_sort_5_order_choice'))
                                          )),
                                        box(
                                          title='Distance Measures', status='primary',
                                          collapsible=T, collapsed=T, width=12,
                                          fluidRow(
                                            column(12, h5(strong("Euclidean Distance"))),
                                            column(12, checkboxInput('check.matchdist.ed', 'Calculate Euclidean Distance', 1)),
                                            column(12, textOutput('match_results_ed_all_choice_text')),
                                            column(12, uiOutput('match_results_ed_all_choice')),
                                            column(12, uiOutput('match_results_ed_opts_choice')),
                                            column(12, br()),
                                            column(12, h5(strong("City Block Distance"))),
                                            column(12, checkboxInput('check.matchdist.cb', 'Calculate City Block Distance', 0)),
                                            column(12, textOutput('match_results_cb_all_choice_text')),
                                            column(12, uiOutput('match_results_cb_all_choice')),
                                            column(12, uiOutput('match_results_cb_opts_choice'))
                                          ))
                                      ))
                                  
                                ),
                                DT::dataTableOutput('match_results_dt')
                        ),
                        # Fetch tab
                        tabItem(tabName='fetch',
                                fluidRow(
                                  box(
                                    title='1) Stimuli Input', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, radioButtons('fetch.inputtype', 'Input Type', c("File (.csv, .tsv, .xls, .xlsx)"="file", "Text Box (type/copy-paste the words in)"="cp"))),
                                      column(12, uiOutput('fetch.opts.inputfile.choice')),
                                      column(12, uiOutput('fetch.opts.inputtext.choice')),
                                      column(12, textOutput('fetch.filename')),
                                      column(12, uiOutput('fetch.opts.filehasheaders.choice')),
                                      column(12, br()),
                                      column(12, uiOutput('fetch.opts.column.choice')),
                                      column(12, uiOutput('fetch.textsep.choice'))
                                    )),
                                  box(
                                    title='2) Choose Target Features', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, uiOutput('fetch.includeorig.choice')),
                                      column(12, radioButtons('fetch.opts.all', NULL, c("Include all LexOPS Features"="all", "Select LexOPS Features Manually"="some"))),
                                      lapply(1:length(vis.cats), function(catnr) {
                                        column(12, uiOutput(sprintf("fetch.opts.choice.%i", catnr)))
                                      })
                                    )
                                  ),
                                  box(
                                    title='3) Results', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, textOutput('fetch.results.plsinput')),
                                      column(12, uiOutput('fetched.csv.choice')),
                                      br(), br(), br(),
                                      column(12, DT::dataTableOutput('fetch_df_res_dt'))
                                    )
                                  )
                                )),
                        # Visualise tab
                        tabItem(
                          
                          # Get screen dimensions with java
                          tags$head(tags$script('var dimension = [0, 0];
                                                $(document).on("shiny:connected", function(e) {
                                                dimension[0] = window.innerWidth;
                                                dimension[1] = window.innerHeight;
                                                Shiny.onInputChange("dimension", dimension);
                                                });
                                                $(window).resize(function(e) {
                                                dimension[0] = window.innerWidth;
                                                dimension[1] = window.innerHeight;
                                                Shiny.onInputChange("dimension", dimension);
                                                });
                                                ')),
                          tabName='visualise',
                          fluidRow(box(
                            title='Plot Controls', status='primary',
                            collapsible = T, width=12,
                            fluidRow(
                              column(6, selectInput('vis.xaxis.opts', 'X Axis', vis.cats, "Word Frequency")),
                              column(6, uiOutput('vis.xsource.choice'))
                            ),
                            fluidRow(
                              column(6, selectInput('vis.yaxis.opts', 'Y Axis', vis.cats, "Lexical Decision Response Time")),
                              column(6, uiOutput('vis.ysource.choice'))
                            ),
                            fluidRow(
                              column(6, selectInput('vis.zaxis.opts', 'Z Axis', c('(None)', vis.cats))),
                              column(6, uiOutput('vis.zsource.choice'))
                            ),
                            fluidRow(
                              column(6, selectInput('vis.colour.opts', 'Colour', c('(None)', 'Generated Stimuli', 'Generated Stimuli Condition', 'Target Match Word', 'Suggested Matches', 'Words Uploaded to Fetch Tab', 'Part of Speech', vis.cats), "(None)")),
                              column(6, uiOutput('vis.coloursource.choice'))
                            ),
                            br(),
                            fluidRow(
                              column(6, sliderInput('vis.opacity.sl', 'Point Opacity', value=0.85, min=0.1, max=1, step=0.05)),
                              column(6, sliderInput('vis.pointsize.sl', 'Point Size', value=4, min=1, max=10, step=1))
                            ),
                            br(),
                            fluidRow(
                              column(6, colourInput('vis.bgcolour', 'Background Colour', value="black")),
                              column(6, colourInput('vis.textcolour', 'Text Colour', value="white"))
                            ),
                            br(),
                            br(),
                            fluidRow(
                              column(12, align="center", actionButton('vis.generateplot', 'Regenerate Plot', icon=icon("chart-bar"), style='font-size:125%'))
                            )
                          )),
                          
                          uiOutput('visualisation.ui_box')
                        ),
                        # Custom Variables tab
                        tabItem(tabName='custom_variables',
                                fluidRow(
                                  box(
                                    title='1) Upload Data', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, uiOutput('cust.opts.inputfile.choice')),
                                      column(12, textOutput('cust.filename')),
                                      column(12, uiOutput('cust.opts.filehasheaders.choice')),
                                      column(12, br()),
                                      column(12, uiOutput('cust.opts.column.choice'))
                                    )),
                                  box(
                                    title='2) Choose Target Features', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, radioButtons('cust.opts.all', NULL, c("Include all Columns from Uploaded Data as Custom Variables"="all", "Select which Variables to Include Manually"="some"))),
                                      column(12, uiOutput("cust.opts.choice"))
                                    )
                                  ),
                                  box(
                                    title='3) Summary of Uploaded Variables', status='primary',
                                    collapsible=T, collapsed=F, width=12,
                                    fluidRow(
                                      column(12, tableOutput('cust.uploadedvars'))
                                    )
                                  )
                                  )),
                        # Preferences tab
                        tabItem(tabName='preferences',
                                box(
                                  title=NULL, status='primary',
                                  collabsible=F, width=12,
                                  fluidRow(
                                    column(12, radioButtons('preference.toleranceUI', 'How Should Tolerances be Selected?', c('Click and Drag Sliders'='slider', 'Type Numeric Input'='numericinput'), selected='slider', inline=T))
                                  )
                                )
                        ),
                        # Info tab
                        tabItem(tabName='info',
                                downloadButton('LexOPS.csv', 'Download the LexOPS Database')
                        )
                          )
                      
                      )
                    )
    )
)
  
  
  
  
)

#loading_page {
	position: fixed;
	background: #000000;
	z-index: 10000;
	left: 0;
	right: 0;
	top: 0;
	padding-top: 50px;
	bottom: 0;
	font-size: 50px;
	font-family: "Century Schoolbook", serif;
	text-align: center;
	color: #FFFFFF;
}

.center-fit {
	max-width: 100%;
	max-height: 100vh;
	margin: auto;
}

.main-header .logo {
	font-family: "Century Schoolbook", serif;
	font-style: italic;
	font-weight: bold;
	font-size: 24px;
}

.box.box-solid.box-info>.box-header {
	color:#fff;
	background:#641e68
}

.box.box-solid.box-info {
	border-top-color:#641e68;
	border:1px solid #641e68;
}

.box.box-info {
	border-bottom-color:#641e68;
	border-left-color:#641e68;
	border-right-color:#641e68;
	border-top-color:#641e68;
}

.bg-purple {
	background-color:#641e68!important
}

.small-box .icon-large {
	color:rgba(0.25, 0.25, 0.25, 0.25);
	bottom:-5px;
	right:10px
}

.main-header .logo {
	text-align:left;
}

.shiny-output-error-validation {
	color: red;
}