working on shiny frontend

DESCRIPTION

@@ -2,8 +2,8 @@ Package: sadists
 Maintainer: Steven E. Pav <shabbychef@gmail.com>
 Authors@R: c(person(c("Steven", "E."), "Pav", role=c("aut","cre"),
     email="shabbychef@gmail.com"))
-Version: 0.2.0
-Date: 2015-03-30
+Version: 0.2.5000
+Date: 2015-06-04
 License: LGPL-3
 Title: Some Additional Distributions
 BugReports: https://github.com/shabbychef/sadists/issues
@@ -20,6 +20,7 @@ Imports:
     hypergeo,
     orthopolynom
 Suggests: 
+	shiny,
     testthat, 
     ggplot2, 
     xtable,

Makefile

@@ -31,7 +31,7 @@ M4_FILES					?= $(wildcard m4/*.m4)
 
 VMAJOR 						 = 0
 VMINOR 						 = 2
-VPATCH  					 = 0
+VPATCH  					 = 5000
 VDEV 							 = 
 VERSION 					 = $(VMAJOR).$(VMINOR).$(VPATCH)$(VDEV)
 TODAY 						:= $(shell date +%Y-%m-%d)

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.1.0): do not edit by hand
+# Generated by roxygen2 (4.1.1): do not edit by hand
 
 export(ddnbeta)
 export(ddneta)

R/runExample.r

@@ -0,0 +1,37 @@
+# Copyright 2014-2015 Steven E. Pav. All Rights Reserved.
+# Author: Steven E. Pav
+#
+# This file is part of sadists.
+#
+# sadists is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# sadists is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with sadists.  If not, see <http://www.gnu.org/licenses/>.
+
+# Created: 2015.03.16
+# Copyright: Steven E. Pav, 2015
+# Author: Steven E. Pav
+# Comments: Steven E. Pav
+
+# h/t Dean Attali http://deanattali.com/2015/04/21/r-package-shiny-app/
+
+#' @export
+runExample <- function() {
+  appDir <- system.file("shiny-examples", "myapp", package = "sadists")
+  if (appDir == "") {
+    stop("Could not find example directory. Try re-installing `sadists`.", call. = FALSE)
+  }
+
+  shiny::runApp(appDir, display.mode = "normal")
+}
+
+#for vim modeline: (do not edit)
+# vim:fdm=marker:fmr=FOLDUP,UNFOLD:cms=#%s:syn=r:ft=r

R/sadists.r

@@ -159,6 +159,13 @@ NULL
 #'
 #' \newcommand{\sadists}{\href{https://github.com/shabbychef/sadists}}
 #'
+#' @section \sadists{} Version 0.3.0 (2015-07-01) :
+#' \itemize{
+#' \item shiny apps (h/t Dean Attali).
+#' \item add (sum of) log generalized gamma distribution.
+#' \item add (sum of) generalized gamma distribution.
+#' }
+#'
 #' @section \sadists{} Version 0.2.0 (2015-04-01) :
 #' \itemize{
 #' \item add doubly non-central Beta and Eta distributions.

inst/shiny-examples/sadists/server.R

@@ -0,0 +1,171 @@
+# Created: 2015.05.18
+# Copyright: Steven E. Pav, 2015
+# Author: Steven E. Pav <shabbychef@gmail.com>
+# Comments: Steven E. Pav
+
+library(shiny)
+library(ggplot2)
+library(reshape2)
+library(sadists)
+
+text.size <<- 8   # sigh
+
+# convert a string like "234, 12, 99" to an array of numerics c(234, 12, 99)
+chars_to_num <- function(astr) {
+	unlist(lapply(strsplit(astr,'\\s+|,'),as.numeric))
+}
+
+server <- function(input, output) {
+
+	get_dpqr <- reactive({
+		dpqr <- switch(input$distro,
+						dnbeta = {
+							argslist = list(df1=input$dnbeta_df1,df2=input$dnbeta_df2,
+															ncp1=input$dnbeta_ncp1,ncp2=input$dnbeta_ncp2)
+							list(d=function(x) do.call(ddnbeta,c(argslist,list(x=x))),
+									 p=function(q) do.call(pdnbeta,c(argslist,list(q=q))),
+									 q=function(p) do.call(qdnbeta,c(argslist,list(p=p))),
+									 r=function(n) do.call(rdnbeta,c(argslist,list(n=n))))
+						},
+						dneta = {
+							argslist = list(df=input$dneta_df,
+															ncp1=input$dneta_ncp1,ncp2=input$dneta_ncp2)
+							list(d=function(x) do.call(ddneta,c(argslist,list(x=x))),
+									 p=function(q) do.call(pdneta,c(argslist,list(q=q))),
+									 q=function(p) do.call(qdneta,c(argslist,list(p=p))),
+									 r=function(n) do.call(rdneta,c(argslist,list(n=n))))
+						},
+						dnf = {
+							argslist = list(df1=input$dnf_df1,df2=input$dnf_df2,
+															ncp1=input$dnf_ncp1,ncp2=input$dnf_ncp2)
+							list(d=function(x) do.call(ddnf,c(argslist,list(x=x))),
+									 p=function(q) do.call(pdnf,c(argslist,list(q=q))),
+									 q=function(p) do.call(qdnf,c(argslist,list(p=p))),
+									 r=function(n) do.call(rdnf,c(argslist,list(n=n))))
+						},
+						dnt = {
+							argslist = list(df=input$dnt_df,
+															ncp1=input$dnt_ncp1,ncp2=input$dnt_ncp2)
+							list(d=function(x) do.call(ddnt,c(argslist,list(x=x))),
+									 p=function(q) do.call(pdnt,c(argslist,list(q=q))),
+									 q=function(p) do.call(qdnt,c(argslist,list(p=p))),
+									 r=function(n) do.call(rdnt,c(argslist,list(n=n))))
+						},
+						kprime = {
+							argslist = list(a=input$kprime_a,b=input$kprime_b,
+															v1=input$kprime_v1,v2=input$kprime_v2)
+							list(d=function(x) do.call(dkprime,c(argslist,list(x=x))),
+									 p=function(q) do.call(pkprime,c(argslist,list(q=q))),
+									 q=function(p) do.call(qkprime,c(argslist,list(p=p))),
+									 r=function(n) do.call(rkprime,c(argslist,list(n=n))))
+						},
+						lambdap = {
+							argslist = list(df=input$lambdap_df,t=input$lambdap_t)
+							list(d=function(x) do.call(dlambdap,c(argslist,list(x=x))),
+									 p=function(q) do.call(plambdap,c(argslist,list(q=q))),
+									 q=function(p) do.call(qlambdap,c(argslist,list(p=p))),
+									 r=function(n) do.call(rlambdap,c(argslist,list(n=n))))
+						},
+						prodchisqpow = {
+							argslist = list(df=chars_to_num(input$prodchisqpow_df),
+															ncp=chars_to_num(input$prodchisqpow_ncp),
+															pow=chars_to_num(input$prodchisqpow_pow))
+							list(d=function(x) do.call(dprodchisqpow,c(argslist,list(x=x))),
+									 p=function(q) do.call(pprodchisqpow,c(argslist,list(q=q))),
+									 q=function(p) do.call(qprodchisqpow,c(argslist,list(p=p))),
+									 r=function(n) do.call(rprodchisqpow,c(argslist,list(n=n))))
+						},
+						proddnf = {
+							argslist = list(df1=chars_to_num(input$proddnf_df1),
+															df2=chars_to_num(input$proddnf_df2),
+															ncp1=chars_to_num(input$proddnf_ncp1),
+															ncp2=chars_to_num(input$proddnf_ncp2))
+							list(d=function(x) do.call(dproddnf,c(argslist,list(x=x))),
+									 p=function(q) do.call(pproddnf,c(argslist,list(q=q))),
+									 q=function(p) do.call(qproddnf,c(argslist,list(p=p))),
+									 r=function(n) do.call(rproddnf,c(argslist,list(n=n))))
+						},
+						sumchisqpow = {
+							argslist = list(wts=chars_to_num(input$sumchisqpow_wts),
+															df=chars_to_num(input$sumchisqpow_df),
+															ncp=chars_to_num(input$sumchisqpow_ncp),
+															pow=chars_to_num(input$sumchisqpow_pow))
+							list(d=function(x) do.call(dsumchisqpow,c(argslist,list(x=x))),
+									 p=function(q) do.call(psumchisqpow,c(argslist,list(q=q))),
+									 q=function(p) do.call(qsumchisqpow,c(argslist,list(p=p))),
+									 r=function(n) do.call(rsumchisqpow,c(argslist,list(n=n))))
+						},
+						sumlogchisq = {
+							argslist = list(wts=chars_to_num(input$sumlogchisq_wts),
+															df=chars_to_num(input$sumlogchisq_df),
+															ncp=chars_to_num(input$sumlogchisq_ncp))
+							list(d=function(x) do.call(dsumlogchisq,c(argslist,list(x=x))),
+									 p=function(q) do.call(psumlogchisq,c(argslist,list(q=q))),
+									 q=function(p) do.call(qsumlogchisq,c(argslist,list(p=p))),
+									 r=function(n) do.call(rsumlogchisq,c(argslist,list(n=n))))
+						},
+						upsilon = {
+							argslist = list(df=chars_to_num(input$upsilon_df),
+															t=chars_to_num(input$upsilon_t))
+							list(d=function(x) do.call(dupsilon,c(argslist,list(x=x))),
+									 p=function(q) do.call(pupsilon,c(argslist,list(q=q))),
+									 q=function(p) do.call(qupsilon,c(argslist,list(p=p))),
+									 r=function(n) do.call(rupsilon,c(argslist,list(n=n))))
+						}
+						)
+		dpqr
+	})
+
+  sims <- reactive({
+		dpqr <- get_dpqr()
+    set.seed(input$randseed)
+		rv <- sort(dpqr$r(input$nsamples))
+		data <- data.frame(draws=rv,pvals=dpqr$p(rv))
+		data
+  })
+
+  # dd plot the results.
+  output$ddplot <- renderPlot({
+		dpqr <- get_dpqr()
+    data <- sims()
+
+		# http://stackoverflow.com/a/5688125/164611
+		p1 <- qplot(data$draws, geom = 'blank') +   
+			geom_line(aes(y = ..density.., colour = 'Empirical'), stat = 'density') +  
+			stat_function(fun = dpqr$d, aes(colour = 'Theoretical')) +                       
+			geom_histogram(aes(y = ..density..), alpha = 0.3) +                        
+			scale_colour_manual(name = 'Density', values = c('red', 'blue')) +
+			theme(text=element_text(size=text.size)) + 
+			labs(title="Density (tests dfunc)")
+		return(p1)
+  })
+
+  # qq plot the results.
+  output$qqplot <- renderPlot({
+		dpqr <- get_dpqr()
+    data <- sims()
+
+		# Q-Q plot
+		p2 <- ggplot(data, aes(sample = draws)) + stat_qq(dist=function(p) { dpqr$q(p) }) +
+			geom_abline(slope=1,intercept=0,colour='red') + 
+			theme(text=element_text(size=text.size)) + 
+			labs(title="Q-Q plot (tests qfunc)")
+		return(p2)
+	})
+
+  # pp plot the results.
+  output$ppplot <- renderPlot({
+    data <- sims()
+
+		# empirical CDF of the p-values; should be uniform
+		p3 <- ggplot(data, aes(sample = pvals)) + stat_qq(dist=qunif) + 
+			geom_abline(slope=1,intercept=0,colour='red') + 
+			theme(text=element_text(size=text.size)) + 
+			labs(title="P-P plot (tests pfunc)")
+		return(p3)
+	})
+}
+shinyServer(server)
+
+#for vim modeline: (do not edit)
+# vim:fdm=marker:fmr=FOLDUP,UNFOLD:cms=#%s:syn=r:ft=r

inst/shiny-examples/sadists/ui.R

@@ -0,0 +1,69 @@
+# Created: 2015.05.18
+# Copyright: Steven E. Pav, 2015
+# Author: Steven E. Pav <shabbychef@gmail.com>
+# Comments: Steven E. Pav
+
+library(shiny)
+
+ui <- shinyUI(fluidPage(
+  titlePanel("Simulations"),
+  sidebarLayout(
+    sidebarPanel(
+      h3("parameters"),
+      selectInput("distro", "Distribution:", 
+									choices=c("dnbeta","dneta","dnf","dnt","kprime","lambap",
+														"prodchisqpow","proddnf","sumchisqpow","sumlogchisq","upsilon"),
+									selected="upsilon",
+									multiple=FALSE),
+			conditionalPanel(
+				condition = "input.distro == 'dnbeta'",
+				numericInput("dnbeta_df1", "df1:", min=1, max=Inf, value=50, step=0.1),
+				numericInput("dnbeta_df2", "df2:", min=1, max=Inf, value=100, step=0.1),
+				numericInput("dnbeta_ncp1", "ncp1:", min=0, max=Inf, value=1, step=0.001),
+				numericInput("dnbeta_ncp2", "ncp2:", min=0, max=Inf, value=2, step=0.001)
+			),
+			conditionalPanel(
+				condition = "input.distro == 'dneta'",
+				numericInput("dneta_df", "df:", min=-Inf, max=Inf, value=50, step=0.1),
+				numericInput("dneta_ncp1", "ncp1:", min=0, max=Inf, value=1, step=0.001),
+				numericInput("dneta_ncp2", "ncp2:", min=0, max=Inf, value=2, step=0.001)
+			),
+			conditionalPanel(
+				condition = "input.distro == 'dnf'",
+				numericInput("dnf_df1", "df1:", min=1, max=Inf, value=50, step=0.1),
+				numericInput("dnf_df2", "df2:", min=1, max=Inf, value=100, step=0.1),
+				numericInput("dnf_ncp1", "ncp1:", min=0, max=Inf, value=1, step=0.001),
+				numericInput("dnf_ncp2", "ncp2:", min=0, max=Inf, value=2, step=0.001)
+			),
+			conditionalPanel(
+				condition = "input.distro == 'dnt'",
+				numericInput("dnt_df", "df:", min=1, max=Inf, value=50, step=0.1),
+				numericInput("dnt_ncp1", "ncp1:", min=-Inf, max=Inf, value=1, step=0.001),
+				numericInput("dnt_ncp2", "ncp2:", min=0, max=Inf, value=2, step=0.001)
+			),
+			conditionalPanel(
+				condition = "input.distro == 'kprime'",
+				numericInput("kprime_a", "a:", min=0, max=Inf, value=5, step=0.1),
+				numericInput("kprime_b", "b:", min=1, max=Inf, value=1, step=0.1),
+				numericInput("kprime_v1", "v1:", min=0, max=Inf, value=1, step=0.001),
+				numericInput("kprime_v2", "v2:", min=0, max=Inf, value=2, step=0.001)
+			),
+								 #2FIX: start here... from lambdap
+								 # add warnings about the parameters being recycled ... 
+      hr(),
+      numericInput("nsamples", "Number of draws:", min = 50, max = 10000, value = 5000, step=50),
+      numericInput("randseed", "Rand seed:", min = 1, max = .Machine$integer.max, value = 2015, step=1)
+    ,width=3),
+    mainPanel(
+			tabsetPanel(
+				tabPanel("d-d",plotOutput("ddplot")),
+				tabPanel("q-q",plotOutput("qqplot")),
+				tabPanel("p-p",plotOutput("ppplot"))
+			)
+		))
+,title="Monte Carlo Simulations"))
+
+shinyUI(ui)
+
+#for vim modeline: (do not edit)
+# vim:fdm=marker:fmr=FOLDUP,UNFOLD:cms=#%s:syn=r:ft=r

m4/DESCRIPTION.m4

@@ -24,6 +24,7 @@ Imports:
     hypergeo,
     orthopolynom
 Suggests: 
+	shiny,
     testthat, 
     ggplot2, 
     xtable,

man-roxygen/ref-gengamma.R

@@ -0,0 +1,6 @@
+#' @references 
+#'
+#' Stacey, E. W. "A Generalization of the Gamma Distribution."
+#' Annals of Mathematical Statistics 33, no. 3 (1962): 1187--1192.
+#' \url{http://projecteuclid.org/euclid.aoms/1177704481}
+#'

man/NEWS.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/sadists.r
 \name{sadists-NEWS}
 \alias{sadists-NEWS}
@@ -8,6 +8,15 @@ History of the 'sadists' package.
 
 \newcommand{\sadists}{\href{https://github.com/shabbychef/sadists}}
 }
+\section{\sadists{} Version 0.3.0 (2015-07-01) }{
+
+\itemize{
+\item shiny apps (h/t Dean Attali).
+\item add (sum of) log generalized gamma distribution.
+\item add (sum of) generalized gamma distribution.
+}
+}
+
 \section{\sadists{} Version 0.2.0 (2015-04-01) }{
 
 \itemize{

man/ddnbeta.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/dnbeta.r
 \name{dnbeta}
 \alias{ddnbeta}

man/ddneta.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/dneta.r
 \name{dneta}
 \alias{ddneta}

man/ddnf.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/dnf.r
 \name{dnf}
 \alias{ddnf}

man/ddnt.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/dnt.r
 \name{dnt}
 \alias{ddnt}

man/dkprime.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/kprime.r
 \name{kprime}
 \alias{dkprime}