rte-antares-rpackage / manipulatewidget Goto Github PK

<simpleError in get(fun, mode = "function", envir = parent.frame()): object 'shiny' of mode 'function' was not found>
<simpleError in system.file(config, package = package): 'package' must be of length 1>

#' @get /plotly
#' @serializer htmlwidget
library(plotly)
data(iris)
library(plumber)
library(manipulateWidget)
varNames <- names(iris)[1:4]

plotlygraph <- function(){manipulateWidget(
  plotClusters(xvar, yvar, nclusters),
  xvar = mwSelect(varNames),
  yvar = mwSelect(varNames, value = "Sepal.Width"),
  nclusters = mwSlider(1, 10, value = 3),
  plot_ly(x = ~iris[[xvar]], y = ~iris[[yvar]], color = ~clusters,
          type = "scatter", mode = "markers") %>% 
    layout(xaxis = list(title=xvar), yaxis = list(title=yvar))
)
}

r <- plumber::plumb("html_widget.R")
r$run(host="0.0.0.0", port=8000)

                                                           regards,
                                                           Mahesh Kulkarni

entity	information
"**_statTest** ; The statistical test performed to interpret the results of the study. _e.g._ **Linear Regression**, **Logistic Regression**, **Gene Burden Test (SKAT)**, **Gene Burden Test (cmcWald)**, **Survival (SKAT)**, **Survival (Burden)**"	Logisitc Regression
"**_metaAnalysisTestType** ; The type of meta-analysis run. Values must be one of: **Cochran's Q Test**, **Fixed Effects**, **Random Effects**, **Fixed Effects and Random Effects**", **Unknown**, and **NA**
**_sampleSizeTotal** ; The sample size (N) of total observations	216257
**_numGenotypesPerMarker** ; The number of genotypes per marker used for the statistical test of association. This may be different from the sample size of the subjects since some genotypes may fail QC	_NA_
**_pValue_** ; A quantitative confidence value that represents the probability of obtaining a result at least as extreme as that actually obtained  assuming that the actual value was the result of chance alone. This version will transform any values <=5e-324 to 5e-324 (the lower limit of double values)	0.04726
"**_pValueOrig** ; The [pValueOrig](http://purl.obolibrary.org/obo/OBI_0000175) quantitative confidence value that represents the probability of obtaining a result at least as extreme as that actually obtained, assuming that the actual value was the result of chance alone. This version will contain the raw values provided in string format to avoid any float conversion errors"	0.04726
**_standardError** ; The [standard error](https://en.wikipedia.org/wiki/Standard_error) of a statistic is the standard deviation of its sampling distribution	0.0607
**_zScore** ; A [z-score](https://en.wikipedia.org/wiki/Standard_score) is the signed number of standard deviations by which the value of an observation or data point differs from the mean value of what is being observed or measured	NA
**_oddsRatio** ; [oddsRatio](https://en.wikipedia.org/wiki/Odds_ratio) is the quantification of how strongly the presence or absence of property A is associated with the presence or absence of property B in a given population	0.8865657
**_beta** ; The [beta coefficient](https://www.listendata.com/2015/04/standardized-vs-unstandardized.html). It represents the amount by which dependent variable changes if we change independent variable by one unit keeping other independent variables constant	-0.1204
"**_bayesFactor** ; The [Bayes factor](https://en.wikipedia.org/wiki/Bayes_factor) is a ratio of the likelihood probability of two competing hypotheses, usually a null and an alternative"	_NA_
**_fdr** ; The False Discovery Rate (FDR) of a set of predictions is the expected percent of false predictions in the set of predictions	_NA_
**_ciLower** ; The lower bound of a [confidence interval](https://en.wikipedia.org/wiki/Confidence_interval)	_NA_
**_ciUpper** ; The upper bound of a [confidence interval](https://en.wikipedia.org/wiki/Confidence_interval)	_NA_
"**_ciPercentile** ; The percentile used for determining a confidence interval. If this field is filled in, then ciUper and ciLower must be filled in"	_NA_
**_numBurdenMarkers** ; The number of markers examined for the statistical test performed in a gene burden test	_NA_
**_isPrimaryAnalysisPValue** ; A boolean value that indicates if the values in this entity (_i.e._ `pValue`) should be used as the main results when examining a gene in a dataset for GERMLINE scoring algorithms	TRUE
**_copyNumber** ; The number of measured copies found for a specific Copy Number Variation (CNV) marker	_NA_
"**_hazardRatio** ; In survival analysis, the [hazard ratio](https://en.wikipedia.org/wiki/Hazard_ratio) (HR) is the ratio of the hazard rates corresponding to the conditions described by two levels of an explanatory variable"	_NA_
**_effectDirection** ; The direction of effect that a marker or allele has on a trait. Two possible values (**+** or **-**). In the context of a _case/control_ analysis **+** implies increased risk  **-** implies decreased risk ; in the context of a _quantitative trait_  **+** means increased value **-** means decreased value	**-**
**cochranQStat** ; The test statistic for a Cochran's Q Test for heterogeneity of effect sizes. [Cochran's Q test](https://www.itl.nist.gov/div898/software/dataplot/refman1/auxillar/cochran.htm) is a non-parametric statistical test to verify whether k treatments have identical effects	_NA_

digraph Association{
   node [shape=box, style=rounded]
   Lorem -> ipsum
   dolor -> sit
   sit -> amet
   amet -> Lorem
   amet -> consectetur
   amet -> adipiscing
   amet -> elit
   Lorem -> sed [optional="true"]
   sed -> Lorem [optional="true"]
   Lorem -> do
   do -> eiusmod [optional="true"]
   do -> tempor [optional="true"]
   do -> incididunt [optional="true"]
   ut -> do [optional="true"]
   do -> labore [optional="true"]
   git -> labore [optional="true"]
   do -> et
   et -> do
   ipsum -> et
   dolore -> ipsum [optional="true"]
   magna -> ipsum [optional="true"]
   ipsum -> aliqua [optional="true"]
   ipsum -> enim [optional="true"]
}

library(vroom)
library(gt)

# load table
entity_table <- vroom::vroom("result.txt", delim = "\t")

# create table and diagram
table <- entity_table %>% 
  mutate(entity = str_replace_all(entity, ";", "<br>")) %>% 
  gt() %>% 
  fmt_markdown(columns =  everything()) %>% 
  tab_header(
    title = md("**Lorem**"),
    subtitle = md("Lorem ipsum is a placeholder text commonly used to demonstrate the visual form of a document or a typeface without relying on meaningful content.")
  ) %>% 
  tab_options(
    column_labels.hidden = TRUE,
    table.font.size = px(12L)
  ) %>% 
    fmt_missing(
    columns = 1:2,
    missing_text = "---"
  )
  
table

library(DiagrammeR)
diagram <- DiagrammeR::grViz('edr.gv')

library(manipulateWidget)
combineWidgets(ncol=2, table, diagram)

library(manipulateWidget)
combineWidgets(ncol=2, diagram, diagram)

library(manipulateWidget)
library(plotly)
library(DT)

if (require(plotly)) {
  data(iris)
  
  combineWidgets(title = "The iris data set: sepals", ncol = 2, colsize = c(2,1),
                 plot_ly(iris, x = ~Sepal.Length, y = ~Sepal.Width, type = "scatter",
                         mode = "markers", color = ~Species),
                 datatable(iris)
                 )
}

require(shiny)
require(dygraphs)
require(pipeR)
require(manipulateWidget)
ui <- fillPage(
  fillRow(
    flex = c(NA, 1),
    div(
      textInput("title", label = "Title", value = "glop"),
      sliderInput("obs", "Number of observations:",
                  min = 10, max = 1000, value = 500),
      sliderInput("ncharts", label = "Select number of charts to view", min = 1, max = 6, step = 1, value = 8),
      sliderInput("nrow", label = "Select number of rows to view", min = 1, max = 6, step = 1, value = 4),
      sliderInput("ncol", label = "Select number of columns to view", min = 1, max = 6, step = 1, value = 3)
    ),
    mwModuleUI("ui", height = "100%")
  )
)

server <- function(input, output, session) {

  data <- reactive({
    if(runif(1) > 0.5){
      data.frame(
        year = 2000+1:input$obs,
        series1 = rnorm(input$obs),
        series2 = rnorm(input$obs),
        series3 = rnorm(input$obs)
      )
    } else {
      data.frame(
        year = 2000+1:input$obs,
        series1 = rnorm(input$obs),
        series2 = rnorm(input$obs)
      )
    }
    
  })

  c <- manipulateWidget(
    {  
      dygraph(data[range[1]:range[2] - 2000, c("year", series)], main = title)
    },
    range = mwSlider(min = 2001, max = 2001 + (nrow(data)-1), c(2001, 2001 + (nrow(data)-1))),
    series = mwSelect(choices = colnames(data)[-1], value = colnames(data)[3]),
    title = mwSharedValue(),
    data = mwSharedValue(), .runApp = FALSE,
    .compare = "range",
    .compareOpts = compareOptions(ncharts = input$ncharts, nrow = input$nrow, ncol = input$ncol)
  )
  mwModule("ui", c, title = reactive(input$title), data = data)
}

shinyApp(ui, server)

Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

c <- manipulateWidget(
    {  
      dygraph(data[range[1]:range[2] - 2000, c("year", series)], main = title)
    },
    range = mwSlider(min = 2001, max = 2001 + (nrow(data)-1), c(2001, 2001 + (nrow(data)-1))),
    series = mwSelect(choices = colnames(data)[-1], value = colnames(data)[3]),
    title = mwSharedValue(),
    ncharts = mwSlider(min = 1, max = 10, value = 4),
    nrow = mwSlider(min = 1, max = 10, value = 4),
    ncol = mwSlider(min = 1, max = 10, value = 4),
    data = mwSharedValue(), .runApp = FALSE,
    .compare = "range",
    .compareOpts = compareOptions(ncharts = "ncharts", nrow = "nrow", ncol = "ncol")
  )
  mwModule("ui", c, title = reactive(input$title), 
           ncharts = reactive(input$ncharts), 
           ncol = reactive(input$mcol), 
           nrow = reactive(input$nrow),
           data = data)

Warning: Error in *: non-numeric argument to binary operator
Stack trace (innermost first):
    39: .getRowAndCols
    38: manipulateWidget
    37: server [C:/Users/jla995/Documents/Work Projects/R - Panel Plots in Shiny.R#41]
     1: runApp
Error in nrow * ncol : non-numeric argument to binary operator

ncharts = 10
nrow = 4
ncol = 3

R version 3.4.0 (2017-04-21)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] manipulateWidget_0.8.0 pipeR_0.6.1.3          dygraphs_1.1.1.4       shiny_1.0.5            rAmCharts_2.1.5       

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.12      lattice_0.20-35   zoo_1.8-0         digest_0.6.12     mime_0.5          grid_3.4.0        R6_2.2.2          xtable_1.8-2     
 [9] magrittr_1.5      miniUI_0.1.1      data.table_1.10.4 tools_3.4.0       htmlwidgets_0.9   httpuv_1.3.5      yaml_2.1.14       compiler_3.4.0   
[17] htmltools_0.3.6

can now pass value as expr (and can depend of sharedValue or current variable) +fix dateRange control

library(crosstalk)
library(manipulateWidget)
sd <- SharedData$new(mtcars)
combineWidgets(filter_slider("mpg", "Miles per gallon", sd, "mpg"))

# map created and saved 
m1 <- leaflet() %>% addTiles()

# map rendered
output$mymap <- renderLeaflet({
  leaflet() %>% addTiles()
})
# and then retrieved
m2 <- manipulateWidget(leafletProxy("mymap"))

# these are identical objects
identical(m1, m2)