#! /usr/bin/R ###sink("/dev/null",type="message") file.dump1 <- file("/home/xychris0/R/CGIwithR-log/dump1",open="wt") file.dump2 <- file("/home/xychris0/R/CGIwithR-log/dump2",open="wt") sink(file.dump2,type="message") # to stop getting the messages sink(file.dump1,type="output") # to stop getting the Hmisc announcement text ### combpair.R is a trivial R program written by Chris Evans in 2001 # copyright is asserted by me, Chris Evans # c.o. NPDDNet, Mandala Centre, Gregory Boulevard, Nottingham NG7 6LB, Britain # by telephone at [+44|0] 7768 640 675 # and 'fax at: [+44|0] 709 230 7650 # or http://www.psyctc.org/cgi-bin/mailto.pl?webmaster # like all my shabby programming that I put on the www, this is released under the # "atrribution, share-alike" creative commons licence http://creativecommons.org/licenses/by-sa/1.0/ # what that says is: # You are free: # # * to copy, distribute, display, and perform the work # * to make derivative works # * to make commercial use of the work # # Under the following conditions: # # Attribution. You must give the original author credit. # # Share Alike. If you alter, transform, or build upon this work, you may distribute the resulting work # only under a license identical to this one. # # * For any reuse or distribution, you must make clear to others the license terms of this work. # * Any of these conditions can be waived if you get permission from the author. # If you do change or improve on this (shouldn't be hard as I'm no programmer!) I would hugely appreciate # receiving a copy and your permission to replace this with any improved version with full attribution to you # Ditto if you translate this into another language, human or computer form. library(R2HTML) library(xtable) ### This is absolutely basic algebra returning all the nC2 pairwise combinations of 2 from n things allpairs <- function(n) { # my own crude function to generate all combs of 2 from n upper <- n*(n-1)/2 ret <- matrix(0,upper,2) row <- 1 for (i in 1:(n-1)) { for (j in (i+1):n) { ret[row,1] <- i ret[row,2] <- j row <- row+1 } } return(ret) } sink(NULL,type="output") sink(NULL,type="message") # switch output back to stdout ###sink() tag(HTML) tag(HEAD) tag(TITLE) cat("All pairwise combinations of two objects from n objects") untag(TITLE) untag(HEAD) lf(2) tag(BODY, bgcolor = "lime") lf(2) tag(center) cat("

All pairwise combinations of two objects from n objects

") comments("Let's start with some testing") prob <- 0 n <- as.numeric(scanText(formData$n)) if (is.na(n)) { cat("

No usable n seems to have been read by the program.

") cat("Please go back and try again!") prob <- 1 } if ((trunc(n) != n) || (n < 0)) { cat("

n must be a positive integer, go back and try again!

") prob <- 1 } if ((trunc(n) != n) || (n < 2) || (n > 32)){ cat("

n must be a positive integer: 1 < n <33, go back and try again!

") prob <- 1 } if (prob) { cat("

Go back and try again!

") cat("Something has caused a problem. There should be a message above explaining what it was.") tmp <- paste("

In case it helps, the n value the program read from what you put in was:",n) cat(tmp) cat("

CGI script written by Chris Evans using David Firth's excellent GGIwithR package.
") linkto("Contact me if something isn't working right ...", "http://www.psyctc.org/cgi-bin/mailto.pl?chris") ; br() } lf(2) comments("end of testing") if (!prob) { comments("Got into results section") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("") cat("
") cat("Your input") cat("
") now <- system('date +%Y-%m-%d,%T', intern=TRUE) host <- system("echo $REMOTE_ADDR", intern=TRUE) cat("Request from: ") cat("") cat(host, " at", now,"
") cat("
") cat("n: ") cat("") cat(n) cat("
") cat("Pairs") cat("
") p <- allpairs(n) p.int <- round(p,0) colnames(p.int) <- c("Object #, with:","Object # ") ## p.print <- mapply(frontpad,p.int,5) ## p.print2 <- matrix(p.print,ncol=2) p.x <- xtable(p.int,display=c("d","d","d")) print(p.x,type="html") cat("
") cat("
") cat("Explanation") cat("
That's the list of all possible pairs from ",n) cat("

If you are using this method and publishing the results or finding them of use to you, then ") linkto("I'd love to hear about what you're doing.", "http://www.psyctc.org/cgi-bin/mailto.pl?chris") ; br() cat("

") cat("Technicalities") cat("
") cat("Calculation done in R by a CGI script written by Chris Evans using David Firth's excellent GGIwithR package.") cat(" Neither myself, David Firth or anyone in the R team accept responsibility for the results or consequences of their use, the maths of this is fairly easy and spelled out in my publication on the topic and R is very reliable but it's always possible for things to go wrong so think through what you see here carefully before doing anything serious with it.") linkto("Contact me if something isn't working right ...", "http://www.psyctc.org/cgi-bin/mailto.pl?chris") ; br() lf() cat("

") cat("Output produced at ", date()) cat("

") lf() cat("
") } untag(BODY) untag(HTML) lf() sink("/home/xychris0/R/CGIwithR-log/combpair.R",append=TRUE) cat("program = derange.p.R ; host = ",host, "; ", now, "; n = ",n,"\n") sink()