diff --git a/.gitignore b/.gitignore index c4c4ffc..7dd36cc 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ *.zip +ignored/* diff --git a/README.md b/README.md index bcb9001..2025ed4 100644 --- a/README.md +++ b/README.md @@ -3,3 +3,5 @@ Shiny app to play with Raup's coiling model, for the exhibition at the Museum für Naturkunde in Magdeburg. Meant to be displayed as two screens: one (the Controller window) on a touchscreen display, the second (the Plot window) projected on a screen. + +![The app as displayed at the MfN Magdeburg. Pic: David Ware.](display.jpeg) diff --git a/display.jpeg b/display.jpeg new file mode 100644 index 0000000..263d3ee Binary files /dev/null and b/display.jpeg differ diff --git a/old_scripts/instructions/predefined forms2.ods b/old_scripts/instructions/predefined forms2.ods deleted file mode 100644 index f175a70..0000000 Binary files a/old_scripts/instructions/predefined forms2.ods and /dev/null differ diff --git a/old_scripts/instructions/preselect.tsv b/old_scripts/instructions/preselect.tsv deleted file mode 100644 index dd09604..0000000 --- a/old_scripts/instructions/preselect.tsv +++ /dev/null @@ -1,6 +0,0 @@ -Group RT D W S turns -Ammonite 0 0.3 2 1 3 -Turitella 10 0.1 1.2 0.8 10 -Mussel 0.1 0 10000 3 1 -Solen 10 0 10000 0.1 1 -Scaphopoda 0 0.9 10000 1 1 diff --git a/old_scripts/instructions/silhouettes.csv b/old_scripts/instructions/silhouettes.csv deleted file mode 100644 index ecf5fb5..0000000 --- a/old_scripts/instructions/silhouettes.csv +++ /dev/null @@ -1,15 +0,0 @@ -RT D W S turns Group -2 0.3 1 1 5 W1 -2 0.3 100000 1 5 W2 -2 0 2 1 5 D1 -2 0.9 2 1 5 D2 -2 0.3 2 0.1 5 S1 -2 0.3 2 5 5 S2 -0 0.3 2 1 5 RT1 -35 0.3 2 1 1 RT2 -0 0 3.2 1.3 2 nau -0 0.5 1.9 1 5 amm -12 0 1.2 0.8 10 tow -2 0 2 0.9 5 rom -0.2 0 10000 2 1 mus -0 0.9 10000 1 1 tus diff --git a/old_scripts/print_preselect.R b/old_scripts/print_preselect.R deleted file mode 100644 index a2cd111..0000000 --- a/old_scripts/print_preselect.R +++ /dev/null @@ -1,90 +0,0 @@ -library(shiny) -library(shinyWidgets) -library(mwshiny) -library(rgl) -library(shinyjs) - -setwd("~/Git/raup_model") #Set the working directory containing the script and the picture folder -addResourcePath(prefix = "static", directoryPath = "static") - -#Function to make the aperture shape -make_elliptic_generating_shape <- function(D,S,res=100){ - #Let's define the original ray as 1 - a <- 1 - rc <- (D+1)*a/(1-D) - t<-seq(0,2*pi,by=pi/res) - b <- a/S - circle_0 <- cbind(r=rc + a*cos(t), y= b*sin(t), phi=0) - return(circle_0) -} - -#Function to coil the shape around the axis -coiling <- function(RT,W,generating_shape, turns,steps,dir="dextral"){ - PHI <- seq(0,2*pi*turns,length=steps) - far_end <- generating_shape[1,1] - closest_end <- approx(generating_shape[generating_shape[,1]Wirbelausdehnungsrate (W)
Whorl Expansion Rate
-
-
'), - min = 0, max = 5, value = 0.301, step = .0001), - sliderInput(input="D",label=HTML('Abstand der Muendung von der Wickelachse (D)
Distance of opening from coiling axis
-
-
'), - min=0, max=0.9,value=0.3,step=0.01), - sliderInput(input="S",label=HTML('Muendungsform (S)
Shape of opening
-
-
'), - min=0.1, max=5,value=1,step=0.01), - sliderInput(input="RT",label=HTML('Translationsrate (T)
Rate of translation
-
-
'), - min=0, max=35,value=2,step=1), - hr(), - noUiSliderInput(inputId="phi", label=HTML('
Ausrichtung
Orientation
'), min=-90,max=90,value=0, - update_on="change", color="#428bca", step=1, format = wNumbFormat(decimals = 0), - pips=list(mode="positions",values=c(0,50,100),density=18)), - div(HTML('
unter
below
-
Mundung
Opening
-
ober
above
')), - width=9 - ), - mainPanel( - radioButtons(inputId="preselect", label=HTML("Vorauswahlen:
Preselections:"), - choiceNames=list(HTML('
Kein
None
'), - HTML('
-
-
Perlboote
Nautilus
-
'), - HTML('
-
-
Ammonit
Ammonite
-
'), - HTML('
-
-
Turmschnecke
Tower shell
-
'), - HTML('
-
-
Weinbergschnecke
Roman snail
-
'), - HTML('
-
-
Miesmuschel
Mussel
-
'), - HTML('
-
-
Kahnfuesser
Tusk shell
-
')), - choiceValues=list("nul","nau","amm","tow","rom","mus","tus")), - width=3) - ) -) - -# Plot page -ui_win[["Plot"]] <- fluidPage( - tags$head(tags$link(rel ="stylesheet", type="text/css", href="static/style.css")), - titlePanel(HTML("Placeholder for title in German - Raup's shell coiling model")), - rglwidgetOutput("coilrgl",width=800, height=800), - textOutput("paramstab") -) - - -#Calculations that are not part of the output -serv_calc <- list() - -#Preselections: -presel <- data.frame(species=c("nau","amm","tow","rom","mus","tus"), - RT=c(0,0,12,2,0.2,0), - D=c(0,0.5,0,0,0,0.9), - W=c(3.2,1.9,1.2,2,10000,10000), - S=c(1.3,1,0.8,0.9,2,1), - turns=c(2,5,10,5,1,1)) - -serv_calc[[1]] <- function(input,session){ - session$onFlushed(function()runjs("logifySlider('W');"),once=FALSE) #Necessary for the log scale to still be displayed as log - observeEvent(input$preselect,{ - x <- input$preselect - if(!is.null(x)){ - if(x!="nul"){ - ps <- presel[presel$species==x,] - updateSliderInput(session, "W", value=round(log(ps$W,10),4)) - updateSliderInput(session, "RT", value=ps$RT) - updateSliderInput(session, "D", value=ps$D) - updateSliderInput(session, "S", value=ps$S) - } - } - } - ) -} - -# RGL Output -serv_out <- list() -serv_out[["coilrgl"]] <- function(input,session){ - # Function to produce the shape - mqd <- reactive({ - RT <- input$RT - D <- input$D - res <- 20 - W <- round(10^input$W,2) - S <- input$S - turns <- 5 - if(W<1.5 & RT>2) turns <- 10 - if(D>0.5) turns <- 10 - if(D<0.1 & RT==0) turns <- 2 - if(W>100) turns <- 1 - steps <- 15*turns - circle <- make_elliptic_generating_shape(D,S,res) - ce <- coiling(RT,W,circle,turns,steps,"dextral") - qd <- pt2quad(ce,steps,res) - qd <- qd[,c(2,3,1)] - qd[,2] <- -1*qd[,2] - qd <- apply(qd,2,function(x)x/max(abs(range(qd$X,qd$Y,qd$Z)))) #Rescale - if(W>50){ #For large W delete turns that are too small to be seen - qd <- qd[apply(qd,1,function(x)any(abs(x)>1e-5)),] - if(nrow(qd)%%4) qd <- rbind(matrix(0,nrow=4-nrow(qd)%%4,ncol=3),qd) - } - as.mesh3d(qd,type="quads") - }) - # Orientation - phi <- reactive(input$phi) - # Actual plotting - renderRglwidget({ - rgl.open(useNULL=TRUE) - m <- mqd() - rgl.viewpoint(zoom = 1, theta=0, phi=phi()) - bg3d(color="grey80") - material3d(color="lightsalmon",emission="black",alpha=1,specular="white",ambient="black",textype="luminance") - shade3d(m,override=TRUE) - light3d(theta=10,phi=10) - rglwidget() - }) -} - -# The table showing the chosen params -serv_out[["paramstab"]] <- function(input,session){ - renderText(sprintf("W=%s\tD=%s\tS=%s\tT=%s", round(10^input$W,2),input$D,input$S,input$RT)) -} - -# Launch the app -shinyOptions("launch.browser"=TRUE) -mwsApp(ui_win = ui_win, serv_calc = serv_calc, serv_out = serv_out) diff --git a/old_scripts/raupShiny_old.R b/old_scripts/raupShiny_old.R deleted file mode 100644 index 1a59b58..0000000 --- a/old_scripts/raupShiny_old.R +++ /dev/null @@ -1,208 +0,0 @@ -library(shiny) -library(shinyWidgets) -library(mwshiny) -library(rgl) - -setwd("~/Git/raup_model") #Set the working directory containing the script and the picture folder -addResourcePath(prefix = "static", directoryPath = "static") - -JS.logify <-"function logifySlider (sliderId) { - // regular number style - $('#'+sliderId).data('ionRangeSlider').update({ - 'prettify': function (num) { return (Math.pow(10, num).toFixed(2)); } - }) -}" -JS.onload <-"$(document).ready(function() { - setTimeout(function() { - logifySlider('W') - }, 5)})" - -make_elliptic_generating_shape <- function(D,S,res=100){ - #Let's define the original ray as 1 - a <- 1 - rc <- (D+1)*a/(1-D) - t<-seq(0,2*pi,by=pi/res) - b <- a/S - circle_0 <- cbind(r=rc + a*cos(t), y= b*sin(t), phi=0) - return(circle_0) -} - -coiling <- function(RT,W,generating_shape, turns,steps,dir="dextral"){ - PHI <- seq(0,2*pi*turns,length=steps) - far_end <- generating_shape[1,1] - closest_end <- approx(generating_shape[generating_shape[,1]Wirbelausdehnungsrate (W)
Whorl Expansion Rate"), - # choices=c(0,1,1.1,1.2,1.5,1.9,2,3.2,5,10,20,50,100,200,500,1000,10000,100000), - # selected=2, grid = TRUE), - sliderInput(input="W", - label=HTML('Wirbelausdehnungsrate (W)
Whorl Expansion Rate
-
-
'), - min = 0, max = 5, value = 0.301, step = .0001), - sliderInput(input="D",label=HTML('Abstand der Muendung von der Wickelachse (D)
Distance of opening from coiling axis
-
-
'), - min=0, max=0.9,value=0.3,step=0.01), - sliderInput(input="S",label=HTML('Muendungsform (S)
Shape of opening
-
-
'), - min=0.1, max=5,value=1,step=0.01), - sliderInput(input="RT",label=HTML('Translationsrate (T)
Rate of translation
-
-
'), - min=0, max=35,value=2,step=1), - width=8 - ), - mainPanel( - radioButtons(inputId="preselect", label=HTML("Vorauswahlen:
Preselections:"), - choiceNames=list(HTML('
Kein
None
'), - HTML('
-
-
Perlboote
Nautilus
-
'), - HTML('
-
-
Ammonit
Ammonite
-
'), - HTML('
-
-
Turmschnecke
Tower shell
-
'), - HTML('
-
-
Weinbergschnecke
Roman snail
-
'), - HTML('
-
-
Miesmuschel
Mussel
-
'), - HTML('
-
-
Kahnfuesser
Tusk shell
-
')), - choiceValues=list("nul","nau","amm","tow","rom","mus","tus")), - width=4) - ) -) - -ui_win[["Plot"]] <- fluidPage( - titlePanel(HTML("Placeholder for title in German - Raup's shell coiling model")), - rglwidgetOutput("coilrgl",width=800, height=800), - tableOutput("paramstab") -) - -serv_calc <- list() - -presel <- data.frame(species=c("nau","amm","tow","rom","mus","tus"), - RT=c(0,0,12,2,0.2,0), - D=c(0,0.5,0,0,0,0.9), - W=c(3.2,1.9,1.2,2,10000,10000), - S=c(1.3,1,0.8,0.9,2,1), - turns=c(2,5,10,5,1,1)) - -serv_calc[[1]] <- function(input,session){ - observe({ - session$sendCustomMessage(type='jsCode', list(value = JS.onload)) - x <- input$preselect - if(!is.null(x)){ - if(x!="nul"){ - ps <- presel[presel$species==x,] - updateSliderInput(session, "W", value=round(log(ps$W,10),4)) - updateSliderInput(session, "RT", value=ps$RT) - updateSliderInput(session, "D", value=ps$D) - updateSliderInput(session, "S", value=ps$S) - #Need to set turns too - } - } - } - ) -} - -serv_out <- list() -serv_out[["coilrgl"]] <- function(input,session){ - renderRglwidget({ - rgl.open(useNULL=TRUE) - RT <- input$RT - D <- input$D - res <- 20 - W <- round(10^input$W,2) - S <- input$S - turns <- 5 - if(W<1.5 & RT>2) turns <- 10 - if(D>0.5) turns <- 10 - if(D<0.1 & RT==0) turns <- 2 - if(W>100) turns <- 1 - steps <- 10*turns - circle <- make_elliptic_generating_shape(D,S,res) - ce <- coiling(RT,W,circle,turns,steps,"dextral") - qd <- pt2quad(ce,steps,res) - qd <- qd[,c(2,3,1)] - qd[,2] <- -1*qd[,2] - qd <- apply(qd,2,function(x)x/max(abs(range(qd$X,qd$Y,qd$Z)))) - if(W>50){ - qd <- qd[apply(qd,1,function(x)any(abs(x)>1e-5)),] - if(nrow(qd)%%4) qd <- rbind(matrix(0,nrow=4-nrow(qd)%%4,ncol=3),qd) - } - mqd <- as.mesh3d(qd,type="quads") - rgl.viewpoint(zoom = .8, theta=90, phi=30) - bg3d(color="grey80") - material3d(color="lightsalmon",emission="black",alpha=1,specular="white",ambient="black",textype="luminance") - shade3d(mqd,override=TRUE) - light3d(theta=10,phi=10) - rglwidget() - }) -} - -serv_out[["paramstab"]] <- function(input,session){ - renderTable(data.frame(W=round(10^input$W,2),D=input$D,S=input$S,T=input$RT), - colnames=TRUE) -} - -shinyOptions("launch.browser"=TRUE) -mwsApp(ui_win = ui_win, serv_calc = serv_calc, serv_out = serv_out) diff --git a/old_scripts/shiny.R b/old_scripts/shiny.R deleted file mode 100644 index 30587f3..0000000 --- a/old_scripts/shiny.R +++ /dev/null @@ -1,82 +0,0 @@ -library(shiny) -library(shinyWidgets) -#For rgl part -#library(shinyRGL) -library(scales) -library(rgl) - -make_elliptic_generating_shape <- function(D,S){ - #Let's define the original ray as 1 - a = 1 - rc = (D+1)*a/(1-D) - t<-seq(0,2*pi,by=pi/100) - b = a/S - circle_0 = cbind(r=rc + a*cos(t), y= b*sin(t), phi=0) - return(circle_0) -} - -coiling <- function(RT,W,generating_shape, turns,resolution){ - PHI = seq(0,2*pi*turns,length=resolution) - far_end = generating_shape[1,1] - closest_end = approx(generating_shape[generating_shape[,1]50){ - qd <- qd[apply(qd,1,function(x)any(abs(x)>1e-5)),] - if(nrow(qd)%%4) qd <- rbind(matrix(0,nrow=4-nrow(qd)%%4,ncol=3),qd) - } - mqd <- as.mesh3d(qd,triangles=FALSE) - rgl.viewpoint(zoom = .8, theta=90, phi=30) - bg3d(color="grey80") - material3d(color="lightsalmon",emission="black",alpha=1,specular="white",ambient="black",textype="luminance") - shade3d(mqd,override=TRUE) - light3d(theta=10,phi=10) - rglwidget() - }) -} - -shinyApp(ui = uirgl, server = serverrgl,options=list("launch.browser"=TRUE)) \ No newline at end of file diff --git a/raupShiny_fast.R b/raupShiny_2screens_DE.R similarity index 100% rename from raupShiny_fast.R rename to raupShiny_2screens_DE.R