Skip to content

Commit

Permalink
Merge pull request #57 from JanOkul/master
Browse files Browse the repository at this point in the history 
Issue #56: Pull request accepted
  • Loading branch information
@davidcsterratt
davidcsterratt authored Jan 30, 2025
2 parents d1406a0 + a60e781 commit 9d852a2
Show file tree
Hide file tree
Showing 15 changed files with 1,006 additions and 1,012 deletions.
13 changes: 7 additions & 6 deletions pkg/retistruct/DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,14 +26,15 @@ Imports:
rgl,
R.matlab,
R6,
tiff
tiff,
shiny,
shinyjs,
shinyFiles,
bslib,
fs
Suggests:
spelling,
testthat,
gWidgets2RGtk2 (>= 1.0.6),
gWidgets2 (>= 1.0.6),
cairoDevice,
RGtk2
testthat
Language: en-GB
RoxygenNote: 7.3.2
Encoding: UTF-8
19 changes: 15 additions & 4 deletions pkg/retistruct/NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -102,9 +102,13 @@ export(tri.area)
export(tri.area.signed)
export(vecnorm)
import(rgl, except = triangulate)
import(shiny)
import(ttutils)
importFrom(R6,R6Class)
importFrom(RTriangle,pslg)
importFrom(bslib,nav_panel)
importFrom(bslib,navset_tab)
importFrom(fs,path_home)
importFrom(geometry,Unique)
importFrom(geometry,bary2cart)
importFrom(geometry,delaunayn)
Expand All @@ -113,11 +117,9 @@ importFrom(geometry,sph2cart)
importFrom(geometry,trimesh)
importFrom(geometry,tsearch)
importFrom(grDevices,dev.copy2pdf)
importFrom(grDevices,dev.cur)
importFrom(grDevices,dev.new)
importFrom(grDevices,dev.off)
importFrom(grDevices,dev.print)
importFrom(grDevices,dev.set)
importFrom(grDevices,palette)
importFrom(grDevices,rainbow)
importFrom(grDevices,svg)
Expand All @@ -126,7 +128,6 @@ importFrom(graphics,arrows)
importFrom(graphics,axis)
importFrom(graphics,boxplot)
importFrom(graphics,hist)
importFrom(graphics,identify)
importFrom(graphics,lines)
importFrom(graphics,mtext)
importFrom(graphics,par)
Expand All @@ -136,11 +137,21 @@ importFrom(graphics,rasterImage)
importFrom(graphics,segments)
importFrom(graphics,text)
importFrom(graphics,title)
importFrom(shiny,observeEvent)
importFrom(shiny,renderPlot)
importFrom(shiny,renderText)
importFrom(shiny,shinyApp)
importFrom(shinyFiles,parseDirPath)
importFrom(shinyFiles,shinyDirButton)
importFrom(shinyFiles,shinyDirChoose)
importFrom(shinyjs,delay)
importFrom(shinyjs,disable)
importFrom(shinyjs,enable)
importFrom(shinyjs,useShinyjs)
importFrom(stats,na.omit)
importFrom(stats,runif)
importFrom(stats,sd)
importFrom(stats,uniroot)
importFrom(utils,packageVersion)
importFrom(utils,read.csv)
importFrom(utils,write.csv)
useDynLib(retistruct)
103 changes: 87 additions & 16 deletions pkg/retistruct/R/ReconstructedOutline.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,9 +152,11 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",
##' @param dev.polar Device handle for plotting polar plot updates
##' to. If \code{NA} don't make any polar plots.
##' @param Control argument to pass to \code{optim}
##' @param shinyOutput A Shiny output element used to render and display a
##' plot in the application.
##' @param report Function to report progress.
reconstruct = function(plot.3d=FALSE, dev.flat=NA, dev.polar=NA,
report=getOption("retistruct.report")) {
reconstruct = function(plot.3d=FALSE, dev.flat=NA, dev.polar=NA, shinyOutput=NA,
report=getOption("retistruct.report")) {
## ## Initial plot in 3D space
## if (plot.3d) {
## sphericalplot(r)
Expand All @@ -168,27 +170,31 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",
report("Optimising mapping with no area constraint using BFGS...")
self$optimiseMapping(alpha=0, x0=0, nu=1,
plot.3d=plot.3d,
dev.flat=dev.flat, dev.polar=dev.polar)
dev.flat=dev.flat, dev.polar=dev.polar,
shinyOutput=shinyOutput)
report("Optimising mapping with area constraint using FIRE...")
## FIXME: Need to put in some better heuristics for scaling
## maxmove, and perhaps other parameters
self$optimiseMappingCart(alpha=self$alpha, x0=self$x0, nu=1,
dtmax=500, maxmove=0.002*sqrt(self$ol$A.tot),
tol=1e-5,
dev.flat=dev.flat, dev.polar=dev.polar,
plot.3d=plot.3d,
dev.flat=dev.flat, dev.polar=dev.polar)
shinyOutput=shinyOutput)
report("Optimising mapping with strong area constraint using BFGS...")
self$optimiseMapping(alpha=self$alpha, x0=self$x0, nu=1,
plot.3d=plot.3d,
dev.flat=dev.flat, dev.polar=dev.polar)
dev.flat=dev.flat, dev.polar=dev.polar,
shinyOutput=shinyOutput)
report("Optimising mapping with weak area constraint using BFGS...")
self$optimiseMapping(alpha=self$alpha, x0=self$x0, nu=0.5,
plot.3d=plot.3d,
dev.flat=dev.flat, dev.polar=dev.polar)
dev.flat=dev.flat, dev.polar=dev.polar,
shinyOutput=shinyOutput)

report(paste("Mapping optimised. Deformation energy E:", format(self$opt$value, 5),
";", self$nflip, "flipped triangles."))
},
},

##' @description Merge stitched points and edges.
##' Create merged and transformed versions (all suffixed with \code{t})
Expand Down Expand Up @@ -423,13 +429,15 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",
##' @param optim.method Method to pass to \code{optim}
##' @param plot.3d If \code{TRUE} make a 3D plot in an RGL window
##' @param dev.flat Device handle for plotting flatplot updates to. If
##' @param shinyOutput A Shiny output element used to render and display a
##' plot in the application.
##' \code{NA} don't make any flat plots
##' @param dev.polar Device handle for plotting polar plot updates
##' to. If \code{NA} don't make any polar plots.
##' @param control Control argument to pass to \code{optim}
optimiseMapping = function(alpha=4, x0=0.5, nu=1, optim.method="BFGS",
plot.3d=FALSE, dev.flat=NA, dev.polar=NA,
control=list()) {
shinyOutput=NULL, control=list()) {
phi <- self$phi
lambda <- self$lambda
R <- self$R
Expand Down Expand Up @@ -494,16 +502,44 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",

## Plot
if (plot.3d) {
sphericalplot(self, datapoints=FALSE, strain=FALSE)
if (is.null(shinyOutput)) {
sphericalplot(self, datapoints=FALSE, strain=FALSE)
} else {
shinyOutput$plot3 <- renderRglwidget({
sphericalplot(self, datapoints=FALSE, strain=FALSE)
rglwidget()
})
}
}

## FIXME try to get iterative update working in shiny
if (!is.null(shinyOutput)) {
shinyOutput$plot1 <- renderPlot({
flatplot(self, grid=TRUE, strain=TRUE, mesh=FALSE, markup=FALSE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
})
}

if (!is.na(dev.flat)) {
dev.set(dev.flat)
flatplot(self, grid=TRUE, strain=TRUE, mesh=FALSE, markup=FALSE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
}


## FIXME try to get iterative update working in shiny
if (!is.null(shinyOutput)) {
## Wipe any previous reconstruction of coordinates of pixels and feature sets
private$ims <- NULL
self$clearFeatureSets()
shinyOutput$plot2 <- renderPlot({
projection(self, mesh=TRUE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
})
}

if (!is.na(dev.polar)) {
## Wipe any previous reconstruction of coordinates of pixels and feature sets
private$ims <- NULL
Expand All @@ -523,9 +559,12 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",
##' @param plot.3d If \code{TRUE} make a 3D plot in an RGL window
##' @param dev.flat Device handle for plotting grid to
##' @param dev.polar Device handle for plotting polar plot to
##' @param shinyOutput A Shiny output element used to render and display a
##' plot in the application.
##' @param ... Extra arguments to pass to \code{\link{fire}}
optimiseMappingCart = function(alpha=4, x0=0.5, nu=1, method="BFGS",
plot.3d=FALSE, dev.flat=NA, dev.polar=NA, ...) {
plot.3d=FALSE, dev.flat=NA, dev.polar=NA,
shinyOutput=NULL, ...) {
phi <- self$phi
lambda <- self$lambda
R <- self$R
Expand Down Expand Up @@ -586,18 +625,50 @@ ReconstructedOutline <- R6Class("ReconstructedOutline",

## Plot
if (plot.3d) {
sphericalplot(list(phi=phi, lambda=lambda, R=R,
Tt=Tt, Rsett=Rsett, gb=self$ol$gb, ht=self$ol$ht),
datapoints=FALSE)
if (is.null(shinyOutput)) {
sphericalplot(list(phi=phi, lambda=lambda, R=R,
Tt=Tt, Rsett=Rsett, gb=self$ol$gb, ht=self$ol$ht),
datapoints=FALSE)
} else {
shinyOutput$plot3 <- renderRglwidget({
sphericalplot(list(phi=phi, lambda=lambda, R=R,
Tt=Tt, Rsett=Rsett, gb=self$ol$gb, ht=self$ol$ht),
datapoints=FALSE)
rglwidget()
})
}
}


## FIXME try to get iterative update working in shiny
if (!is.null(shinyOutput)) {
shinyOutput$plot1 <- renderPlot({
flatplot(self, grid=TRUE, strain=TRUE, mesh=FALSE, markup=FALSE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
})
}

if (!is.na(dev.flat)) {
dev.set(dev.flat)
flatplot(self, grid=TRUE, strain=TRUE, mesh=FALSE, markup=FALSE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
}


## FIXME try to get iterative update working in shiny
if (!is.null(shinyOutput)) {
## Wipe any previous reconstruction of coordinates of pixels and feature sets
private$ims <- NULL
self$clearFeatureSets()
self$phi <- phi
self$lambda <- lambda
shinyOutput$plot2 <- renderPlot({
projection(self, mesh=TRUE,
datapoints=FALSE, landmarks=FALSE,
image=FALSE)
})
}

if (!is.na(dev.polar)) {
## Wipe any previous reconstruction of coordinates of pixels and feature sets
private$ims <- NULL
Expand Down
10 changes: 10 additions & 0 deletions pkg/retistruct/R/app.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
##' Start the Retistruct GUI
##' @return Object with \code{getData()} method to return
##' reconstructed retina data and environment \code{this} which
##' contains variables in object.
##' @importFrom shiny shinyApp
##' @export
retistruct <- function() {
options(rgl.useNULL = TRUE) ## Prevents rgl from making its own window
shinyApp(ui = ui, server = server)
}
Loading

0 comments on commit 9d852a2

Please sign in to comment.