`HolzingerSwineford1939`

data.
See http://rpubs.com/candrea/latintsem .

]]>

## recursive intersect function intersect.rec <- function(x, ...) { a <- list(...) if(length(a) == 0) stop("Two or more arguments are needed.") if(is.list(a[[1]])) a <- a[[1]] if(length(a) == 1) return(intersect(x, a[[1]])) else intersect.rec(intersect(x, a[[1]]), a[-1]) }

Sample usage:

x <- letters[1:5] y <- letters[2:5] z <- letters[3:5] intersect.rec(x, y, z) ## returns ## [1] "c" "d" "e"

This is especially a basic example of an R function using dots argument and recursively iterating over them.

]]>The idea is to replace this tag with appropriate HTML code. To replace the h2 tag I use the jQuery function replaceWith(). Because the needed code can be very long, I created a separate JavaScript file. The file is added to the shiny app with the function includeScript().

Make sure to define max-width for the sidebar in ui.R file:

## shiny app to demonstrate placing multiple company logos in the top of the page library(shiny) shinyUI(fluidPage( titlePanel("Company Logos"), # outputs h2 tag sidebarLayout( sidebarPanel( tags$head( ## define max-width of sidebar panel tags$style(type='text/css', ".col-sm-4 { max-width: 270px; margin-top: 41px;}"), includeScript("www/script.js") ), uiOutput("sidebar") ), mainPanel( tabsetPanel( tabPanel("tab1", htmlOutput("tab1")), tabPanel("tab2", htmlOutput("tab2")), tabPanel("tab3", htmlOutput("tab3")) ) )) ))

The server.R file

library(shiny) shinyServer(function(input, output) { output$sidebar <- renderUI({ HTML('Sidebar') }) output$tab1 <- renderUI({ HTML('<h4>Source Code and Explanation:</h4> <a href="https://candrea.ch/blog/adding-multiple-company-logos-to-shiny-app/"> candrea.ch/blog/adding-multiple-company-logos-to-shiny-app/</a> ') }) })

And finaly the script.js file. Please note the css rules for each div tag.

$( document ).ready(function() { var divstart = '<div style="width: 100%; display: table;">' + '<div style="display: table-row">'; // same with as sidebar, ie. 270px var logoLeft = '<div style="width: 270px; display: table-cell;position:relative;float:left">'+ '<a href="https://5c.careers/" target="_blank">' + '<img src="logoleft.jpg" height="75" align="left"></a></div>'; var logoRight = '<div style="display: table-cell;position:relative;float:left;width:66\%">' + '<a href="https://www.phsz.ch/" target="_blank">' + '<img src="logoright.jpg" height="60" align="right" style="margin-top:10px"></a></div>'; var divend = '</div></div>'; $( "h2" ).replaceWith( divstart + logoLeft + logoRight + divend ); });

You can find the shiny app here: https://phsz.shinyapps.io/Shiny_Company_Logo/

Happy Logoing!

]]>

By consulting the chapter “Polytomous Rasch Models and their Estimation” in the book “Rasch Models” (Fischer, 1995), and combining the formulas (15.3) with (15.8) there, we get

Now by comparing the meaning of all the symbols and applying it on the formula from PISA Technical Report – by respecting as much as possible of the notations used by them – we get

We see that we have to change in the numerator of the very first formula above to , and to .

That makes sense!

]]>We consider the case where we want to calculate the sample size for a multiple logistic regression with continous response variable and with continous covariates.

Fomula (1) in the paper computes the required sample size for a simple logistic regression, given the effect size to be tested, the event rate at the mean of the (single) covariate, level of significance, and required power for the test. This formula is implemented in the function SSizeLogisticCon() from R package “powerMediation” and can easily be applied.

For the multiple case, Hsieh et al. introduce the variance inflation factor (VIF), with which the sample size for the simple case can be inflated to get the sample size for the multiple case. I have implemented it as R function:

## p1: the event rate at the mean of the predictor X ## OR: expected odds ratio. log(OR) is the change in log odds ## for an increase of one unit in X. ## beta*=log(OR) is the effect size to be tested ## r2: r2 = rho^2 = R^2, for X_1 ~ X_2 + ... + X_p ssize.multi <- function(p1, OR, r2, alpha=0.05, power=0.8) { n1 <- SSizeLogisticCon(p1, OR, alpha, power) np <- n1 / (1-r2) return(np) }

Another approximation for the simple case is given in Formula (4), and is based on formulae given by A. Whittemore in “Sample size for logistic regression with small response probability”. I have implemente the simple case,

## p1: as above ## p2: event rate at one SD above the mean of X ssize.whittemore <- function (p1, p2, alpha = 0.05, power = 0.8) { beta.star <- log(p2*(1-p1)/(p1*(1-p2))) za <- qnorm(1 - alpha/2) zb <- qnorm(power) V0 <- 1 Vb <- exp(-beta.star^2 / 2) delta <- (1+(1+beta.star^2)*exp(5*beta.star^2 / 4)) * (1+exp(-beta.star^2 / 4))^(-1) n <- (V0^(1/2)*za + Vb^(1/2)*zb)^2 * (1+2*p1*delta) / (p1*beta.star^2) n.int <- ceiling(n) return(n.int) }

and the multiple case.

## all parameters as above ssize.whittemore.multi <- function(p1, p2, r2, alpha=0.05, power=0.8) { n1 <- ssize.whittemore(p1, p2, alpha, power) np <- n1 / (1-r2) return(np) }

The complete R script, the examples from the paper included, can be found under http://rpubs.com/candrea/ssizelogreg .

]]>

There are two approaches how you can obtain betas. You Z-standardize the data before fitting or you compute the betas after fitting the model.

The first approach has flaws if you have non-numeric variables in your data or if you intent to incorporate interaction terms in your model.

The second approach is a way more convenient, but until now there was no R package helping you compute betas for as many kinds of models as you needed. For example with lm.beta() from “QuantPsyc” Package you cannot handle models with factors with more than two levels.

The features of the “betas” R package are (so far for v0.1.1):

Compute standardized beta coefficients and corresponding standard errors for the following models:

- linear regression models with numerical covariates only
- linear regression models with numerical and factorial covariates
- weighted linear regression models
- all these linear regression models with interaction terms
- robust linear regression models with numerical covariates only

You can install the package from CRAN (http://cran.r-project.org/web/packages/betas/):

install.packages("betas") library(betas)

The package is maintained on GitHub: https://github.com/andreaphsz/betas .

Feel free to report issues: https://github.com/andreaphsz/betas/issues .

Enjoy hassle-free computations of betas in R!

]]>beta = b * sd_x/sd_y

where b are the coefficients from OLS linear regression, and sd_x and sd_y are standard deviations of each x variable and of y.

In the case where you performe a robust linear regression, sd_x and sd_y seems not be very meanigfull anymore, because variances and hence standard deviations are not robust. The R package “robust” provides the function covRob() to compute a robust covariance estimator.

I have written the following function to compute standardized beta coefficients for a robust linear regression. Setting the parameter classic=TRUE gives you the classic estimation of the beta coefficients. For very bad data, the covRob() function cannot compute the covariance due singularities. In this case the classical estimator is returned.

my.lmr.beta <- function (object, classic = FALSE) { if(class(object) != "lmRob") stop("Object must be of class 'lmRob'") model <- object$model num <- sapply(model, is.numeric) # numeric vars only b <- object$coefficients[num][-1] # final coefficients w/o intercept ## compute robust covariance covr <- NULL try(covr <- diag(covRob(model[num])$cov), silent = TRUE) if(is.null(covr) & classic == FALSE) warning("covRob() coud not be computed, instead covClassic() was applied.") ## compute classic covariance if robust failed if(is.null(covr) | classic == TRUE) covr <- diag(covClassic(model[num])$cov) sx <- sqrt(covr[-1]) # standard deviation of x's sy <- sqrt(covr[1]) # standard deviation of y beta <- b * sx/sy return(beta) }

** UPDATE — 2014-07-23**

Computing standard deviations for factors makes sense, because variance is definded for the binomial distribution. So I have removed the num variable.

my.lmr.beta <- function (object, classic = FALSE) { if(class(object) != "lmRob") stop("Object must be of class 'lmRob'") model <- object$model #num <- sapply(model, is.numeric) # numeric vars only b <- object$coefficients[-1] # final coefficients w/o intercept ## compute robust covariance covr <- NULL try(covr <- diag(covRob(model)$cov), silent = TRUE) if(is.null(covr) & classic == FALSE) warning("covRob() coud not be computed, instead covClassic() was applied.") ## compute classic covariance if robust failed if(is.null(covr) | classic == TRUE) covr <- diag(covClassic(sapply(model, as.numeric))$cov) sx <- sqrt(covr[-1]) # standard deviation of x's sy <- sqrt(covr[1]) # standard deviation of y beta <- b * sx/sy return(beta) }

]]>

That is where the very nice dplyr package comes in.

We build and print the data frame:

df <- data.frame(id=1:9, classid=c(1,1,1,2,2,3,3,3,3), math=round(runif(9,1,6),1))

> print(df) id classid math 1 1 1 5.4 2 2 1 4.0 3 3 1 1.1 4 4 2 2.2 5 5 2 3.9 6 6 3 2.7 7 7 3 6.0 8 8 3 2.0 9 9 3 1.6

Now, we want to select – i.e. “filter” in terms of the dplyr package – pupils that are part of groups/classes with more than two pupils per class. In dplyr there are three different syntaxes to achieve this.

# step-by-step df.g <- group_by(df, classid) df.n <- filter(df.g, n()>2) # or nested syntax df.n <- filter(group_by(df, classid), n()>2) # or with %.% operator df.n <- df %.% group_by(classid) %.% filter(n()>2)

The result is the same for all:

> print(df.n) Source: local data frame [7 x 3] Groups: classid id classid math 1 1 1 5.4 2 2 1 4.0 3 3 1 1.1 4 6 3 2.7 5 7 3 6.0 6 8 3 2.0 7 9 3 1.6

Of course, you can do this the pure-R-way,

> df.c <- df[df$classid %in% which(xtabs(~classid, df)>2), ] > print(df.c) id classid math 1 1 1 5.4 2 2 1 4.0 3 3 1 1.1 6 6 3 2.7 7 7 3 6.0 8 8 3 2.0 9 9 3 1.6

but I think with dplyr it looks quite a bit nicer.

Happy dpylr!

]]>For the rest of us (me included) thinking ./configure without any options will do the job are getting the following error:

configure: error: "You need to install the LAPACK library"

(It will not work even with the –with-lapack=’-framework vecLib’ option.)

Do not follow this instruction! You do not have to install the LAPACK library because on OS X 10.9 the optimized (accelerated by Apple engineers) version of LAPACK is allready installed, see the LAPACK(7) Mac OS X Manual Page.

From now on just type the slightly modified commands in your bash-shell (terminal):

export CC=/usr/bin/clang export CXX=/usr/bin/clang++ export CFLAGS="-g -Os -mmacosx-version-min=10.6 -isysroot /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.9.sdk -arch i386 -arch x86_64" export CXXFLAGS="-g -Os -mmacosx-version-min=10.6 -isysroot /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.9.sdk -arch i386 -arch x86_64" export FFLAGS="-g -Os -mmacosx-version-min=10.6 -isysroot /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.9.sdk -arch i386 -arch x86_64" export LDFLAGS="-mmacosx-version-min=10.6 -arch i386 -arch x86_64" ./configure --disable-dependency-tracking --with-included-ltdl make -j 8 sudo make install

Of course, make sure you have installed all the required tools before executing the commands.

Happy ./configuring!

]]>