PDQ 5.0 Test Suite or … How I Spent My Weekend

Subject: Seeking help with PDQ-R ...
Date: Thu, 25 Jun 2009 15:51:21 -0500

My name is James and I've been trying to learn to properly use PDQ after reading two of your books, "Guerrilla Capacity Planning" and "Analyzing Computer System Performance with Perl::PDQ." I'm still getting a grip on PDQ-R. ... I decided to set about of re-creating the queue circuit in the study with PDQ-R as an exercise. ...
The output of my code yields:
[1] "Manual response time for class 1 is 0.864179 seconds"
[1] "PDQ-R response time for class 1 is 0.313637 seconds"
[1] "Manual response time for class 2 is 6.105397 seconds"
[1] "PDQ-R response time for class 2 is 3.552873 seconds"
[1] "Manual response time for class 3 is 4.535833 seconds"
[1] "PDQ-R response time for class 3 is 4.535833 seconds"
If you could give my code a look over and give me some hints I would really appreciate it.

# PDQ-R model

library(pdq)

# Request rates of the 3 transaction streams into the DBMS
Xsys<-c(50/150, 80/150, 70/150)

# Service demands at each resource
Dcpu<-c(0.096, 0.615, 0.193)
Ddk1<-c(0.088, 0.683, 0.763)
Ddk2<-c(0.119, 0.795, 0.400)

# Start PDQ code with Init call
Init("James' DB Model");

# Define the 3 transaction workloads
workname<-1:3
for (w in 1:3) {
 workname[w] <- sprintf("work%d", w)
 CreateOpen(workname[w], Xsys[w])
}

# Define the 3 resources
CreateNode("cpu", CEN, FCFS)
CreateNode("dk1", CEN, FCFS)
CreateNode("dk2", CEN, FCFS)

for (w in 1:3) {
 SetDemand("cpu", workname[w], Dcpu[w])
 SetDemand("dk1", workname[w], Ddk1[w])
 SetDemand("dk2", workname[w], Ddk2[w])
}

Solve(CANON)
Report()

/*   
    multiclass-open.c

    Created by NJG on Thursday,  June 25, 2009
    Updated by NJG on Sunday,  June 28, 2009
*/

#include < stdio.h >
#include < stdlib.h >
#include < string.h >
#include < math.h >
#include "PDQ_Lib.h"


int main(void) {

    extern void     exit();
    extern char     s1[];
    
    char            *p; // dummy pointer for names
    char            *devname[3];
    char            *workname[3];
    int             i, j, k, n, s, w;
    double          actualtR[4][3];
    
    // Expected RT values
    double  expectR[4][3] = {
                {0.174, 1.118, 0.351},
                {0.351, 2.734, 3.054},
                {0.340, 2.270, 1.142},
                {0.865, 6.122, 4.546}               
                };

    // Request rates of the 3 transaction streams into the DBMS
    double Xsys[] = {50.0/150, 80.0/150, 70.0/150};
        
    // Service demands
    double Dcpu[] = {0.096, 0.615, 0.193};
    double Ddk1[] = {0.088, 0.683, 0.763};
    double Ddk2[] = {0.119, 0.795, 0.400};
        
    // Name the workloads
    for(w = 0; w < 3; w++) {
        resets(s1);
        sprintf(s1, "work%d", w+1);
        if ( (p = (char *) malloc(strlen(s1) * sizeof(char)) ) != NULL) {
            strcpy(p, s1); // copy into assigned storage
            workname[w] = p;
        } 
        else { 
            printf("malloc failed!\n");
            exit(-1); 
        }
    }
    free(p);
    
    // Name the resources
    for(k = 0; k < 3; k++) {
        resets(s1);
        if (k == 0) sprintf(s1, "%s", "cpu");
        if (k == 1) sprintf(s1, "%s", "dk1");       
        if (k == 2) sprintf(s1, "%s", "dk2");       
        if ( (p = (char *) malloc(strlen(s1) * sizeof(char)) ) != NULL) {
            strcpy(p, s1); // copy into assigned storage
            devname[k] = p;
        } 
        else { 
            printf("malloc failed!\n");
            exit(-1); 
        }
    }
    free(p);
    
    /************************** Start PDQ code **********************/
    PDQ_Init("Multiclass Test Model");
    
    // Create workloads
    for(w = 0; w < 3; w++) {
        s = PDQ_CreateOpen(workname[w], Xsys[w]);
    }
    
    // Create resources
    n = PDQ_CreateNode("cpu", CEN, FCFS);
    n = PDQ_CreateNode("dk1", CEN, FCFS);
    n = PDQ_CreateNode("dk2", CEN, FCFS);
    
    // Assign demands 
    for(w = 0; w < 3; w++) {
        PDQ_SetDemand("cpu", workname[w], Dcpu[w]);
        PDQ_SetDemand("dk1", workname[w], Ddk1[w]); 
        PDQ_SetDemand("dk2", workname[w], Ddk2[w]);
    }
    
    PDQ_Solve(CANON);
        
    printf("Expected Response Times\n");
    for(i = 0; i < 4; i++) {
        for(j = 0; j < 3; j++) {
            printf("%4.3f\t", expectR[i][j]);
        }
        printf("\n");
    }
    printf("--------------------------\n");   
   
    printf("Actual Response Times\n");
    for(i = 0; i < 4; i++) {
        // System response times for QNM
        if (i == 3) {
            for(w = 0; w < 3; w++) {
                printf("%4.3f\t", 
                actualtR[i][w] = PDQ_GetResponse(TRANS, workname[w]));
            }
        }
        
        // Residence times per resource
        if (i < 3) {
            for(w = 0; w < 3; w++) {
                printf("%4.3f\t", 
                actualtR[i][w] = PDQ_GetResidenceTime(devname[i], workname[w], TRANS));
            }
        }    
        printf("\n");
    }
    
} // main

[njg]~/PDQ/Test Suite/C-PDQ% ./mulclass-open
Expected Response Times
0.174    1.118    0.351    
0.351    2.734    3.054    
0.340    2.270    1.142    
0.865    6.122    4.546    <--
--------------------------
Actual Response Times
0.175    1.118    0.351    
0.352    2.728    3.048    
0.340    2.274    1.144    
0.866    6.120    4.543    <--

August Guerrilla Class: Using R for Performance Analysis

(Click on the image for details)

Time series data

RSI(2) Evaluation

# Attach packages. You can install packages via:
# install.packages(c("quantmod","TTR","PerformanceAnalytics"))
library(quantmod)
library(TTR)
library(PerformanceAnalytics)

# Pull S&P500 index data from Yahoo! Finance
getSymbols("^GSPC", from="2000-01-01")

# Calculate the RSI indicator
rsi <- RSI(Cl(GSPC), 2)

# Calculate Close-to-Close returns
ret <- ROC(Cl(GSPC))
ret[1] <- 0

# This function gives us some standard summary
# statistics for our trades.
tradeStats <- function(signals, returns) {
# Inputs:
# signals : trading signals
# returns : returns corresponding to signals

# Combine data and convert to data.frame
sysRet <- signals * returns * 100
posRet <- sysRet > 0 # Positive rule returns
negRet <- sysRet < 0 # Negative rule returns
dat <- cbind(signals,posRet*100,sysRet[posRet],sysRet[negRet],1)
dat <- as.data.frame(dat)

# Aggreate data for summary statistics
means <- aggregate(dat[,2:4], by=list(dat[,1]), mean, na.rm=TRUE)
medians <- aggregate(dat[,3:4], by=list(dat[,1]), median, na.rm=TRUE)
sums <- aggregate(dat[,5], by=list(dat[,1]), sum)

colnames(means) <- c("Signal","% Win","Mean Win","Mean Loss")
colnames(medians) <- c("Signal","Median Win","Median Loss")
colnames(sums) <- c("Signal","# Trades")

all <- merge(sums,means)
all <- merge(all,medians)

wl <- cbind( abs(all[,"Mean Win"]/all[,"Mean Loss"]),
abs(all[,"Median Win"]/all[,"Median Loss"]) )
colnames(wl) <- c("Mean W/L","Median W/L")

all <- cbind(all,wl)
return(all)
}

# This function determines position size and
# enables us to test several ideas with much
# greater speed and flexibility.
rsi2pos <- function(ind, indIncr=5, posIncr=0.25) {
# Inputs:
# ind : indicator vector
# indIncr : indicator value increments/breakpoints
# posIncr : position value increments/breakpoints

# Initialize result vector
size <- rep(0,NROW(ind))

# Long
size <- ifelse(ind < 4*indIncr, (1-posIncr*3), size)
size <- ifelse(ind < 3*indIncr, (1-posIncr*2), size)
size <- ifelse(ind < 2*indIncr, (1-posIncr*1), size)
size <- ifelse(ind < 1*indIncr, (1-posIncr*0), size)

# Short
size <- ifelse(ind > 100-4*indIncr, 3*posIncr-1, size)
size <- ifelse(ind > 100-3*indIncr, 2*posIncr-1, size)
size <- ifelse(ind > 100-2*indIncr, 1*posIncr-1, size)
size <- ifelse(ind > 100-1*indIncr, 0*posIncr-1, size)

# Today's position ('size') is based on today's
# indicator, but we need to apply today's position
# to the Close-to-Close return at tomorrow's close.
size <- lag(size)

# Replace missing signals with no position
# (generally just at beginning of series)
size[is.na(size)] <- 0

# Return results
return(size)
}

# Calculate signals with the 'rsi2pos()' function,
# using 5 as the RSI step: 5, 10, 15, 20, 80, 85, 90, 95
# and 0.25 as the size step: 0.25, 0.50, 0.75, 1.00
sig <- rsi2pos(rsi, 5, 0.25)

# Break out the long (up) and short (dn) signals
sigup <- ifelse(sig > 0, sig, 0)
sigdn <- ifelse(sig < 0, sig, 0)

# Calculate rule returns
ret_up <- ret * sigup
colnames(ret_up) <- 'Long System Return'
ret_dn <- ret * sigdn
colnames(ret_dn) <- 'Short System Return'
ret_all <- ret * sig
colnames(ret_all) <- 'Total System Return'

# Create performance graphs
png(filename="20090606_rsi2_performance.png", 720, 720)
charts.PerformanceSummary(cbind(ret_up,ret_dn),methods='none',
main='RSI(2) Performance - RSI steps = 5, Size steps = 0.25')
dev.off()

# Print trade statistics table
cat('\nRSI(2) Trade Statistics - RSI steps = 5, Size steps = 0.25\n')
print(tradeStats(sig,ret))

# Print drawdown table
cat('\nRSI(2) Drawdowns - RSI steps = 5, Size steps = 0.25\n')
print(table.Drawdowns(ret_all, top=10))

# Print downside risk table
cat('\nRSI(2) Downside Risk - RSI steps = 5, Size steps = 0.25\n')
print(table.DownsideRisk(ret_all))

# Calculate signals with the 'rsi2pos()' function
# using new RSI and size step values
sig <- rsi2pos(rsi, 10, 0.3)

# Break out the long (up) and short (dn) signals
sigup <- ifelse(sig > 0, sig, 0)
sigdn <- ifelse(sig < 0, sig, 0)

# Calculate rule returns
ret_up <- ret * sigup
colnames(ret_up) <- 'Long System Return'
ret_dn <- ret * sigdn
colnames(ret_dn) <- 'Short System Return'
ret_all <- ret * sig
colnames(ret_all) <- 'Total System Return'

# Calculate performance statistics
png(filename="20090606_rsi2_performance_updated.png", 720, 720)
charts.PerformanceSummary(cbind(ret_up,ret_dn),methods='none',
main='RSI(2) Performance - RSI steps = 10, Size steps = 0.30')
dev.off()

# Print trade statistics table
cat('\nRSI(2) Trade Statistics - RSI steps = 10, Size steps = 0.30\n')
print(tradeStats(sig,ret))

# Print drawdown table
cat('\nRSI(2) Drawdowns - RSI steps = 10, Size steps = 0.30\n')
print(table.Drawdowns(ret_all, top=10))

# Print downside risk table
cat('\nRSI(2) Downside Risk - RSI steps = 10, Size steps = 0.30\n')
print(table.DownsideRisk(ret_all))

Conservatism of Congressional delegation and %Bush vote

R 2.9.1, CRANberries outage, and missing Java support

Speaking of broken, I had neither noticed that this R version now returns an additional field (for the repository) in the per-package metadata via available.packages(), nor that this change had broken my oh-so-useful and increasingly popular CRANberrries html and rss summaries of CRAN changes. So with the usual beta and rc releases or R 2.9.1 in Debian starting a week prior, CRANberries had been silent for six days from Friday the 21st to last Thursday. I rectified it once I noticed, and changed the code to no longer fall on its nose at that spot. Sorry for the few days without service.

Multiple Imputation with Diagnostics (mi) in R: Opening Windows into the Black Box

Filtering cases

Set the significant digits for each column in a xtable for fancy Sweave output

A bit about linear models

Next Page »

• Website Sections

  • About
  • add your blog!
  • Articles List
  • Blogs list
  • Contact us

• On Facebook

• Recent Posts

  • Canterbury Earthquakes part III
  • Julien on R shortcomings
  • Straight, curly, or compiled?
  • Revolution R Enterprise 4.0 free download for academics
  • Example 8.4: Including subsetting conditions in output
  • Embed #rstats Code with Syntax Highlighting on your Blog
  • Writing a Spatial Function: The Location Quotient
  • Canterbury Earthquakes part II
  • Confidence Bands for Universal Scalability Models
  • Truly random?!
  • Gdb Macros for R
  • R Maps
  • Less than negative?
  • R Reshape Package
  • Canterbury Earthquake

• Popular Searches

  • boxplot
  • bar chart
  • ggplot
  • ggplot background grid colour
  • ggplot and geom
  • quantmod
  • finance
  • ggplot2
  • Rcmdr
  • plyr
  • sweave
  • how to import image file to R
  • maps
  • rattle
  • missing values
  • axis
  • cca
  • market research
  • Excel
  • ecdf
  • mysql
  • network visual
  • animation
  • matrix
  • spatial
  • map
  • .rda
  • geographical
  • GIS
  • coplot
• Search for:

• Search the posts

  Search for:

• E-mail updates

  A maximum of one e-mail a day.

  No new posts-> no e-mail.

  

• Top visited articles

  • 100 Prisoners, 100 lines of code
  • Getting Started with Sweave: R, LaTeX, Eclipse, StatET, & TeXlipse
  • Hacker News User Base Changed?
  • R Tutorial Series: R Beginner's Guide and R Bloggers Updates
  • Select operations on R data frames
  • Top 10 Algorithms in Data Mining
  • Advanced graphics in R
• Search for:

• Topics of interest

  • analytics Announcements Books BUGS Climate Trends Climatechange Climatology code computing cran Data data mining events ggplot2 Global Warming graphics gui Introducing Monte Carlo Methods with R LaTex lattice linux package plot programming R code R Language R Programming R scripts r-project random RClimate Script Rcpp Research tips REvolution Rmedia rstats SAS Simulation Software SPSS statistics sweave Time Series Charts Trend Chart tutorial Tutorials Uncategorized University life video visualization

• Archives

  • September 2010 (40)
  • August 2010 (197)
  • July 2010 (177)
  • June 2010 (163)
  • May 2010 (169)
  • April 2010 (152)
  • March 2010 (158)
  • February 2010 (136)
  • January 2010 (131)
  • December 2009 (121)
  • November 2009 (60)
  • October 2009 (75)
  • September 2009 (67)
  • August 2009 (59)
  • July 2009 (61)
  • June 2009 (49)
  • May 2009 (35)
  • April 2009 (36)
  • March 2009 (47)
  • February 2009 (36)
  • January 2009 (40)
  • December 2008 (16)
  • November 2008 (9)
  • October 2008 (7)
  • September 2008 (6)
  • August 2008 (7)
  • July 2008 (6)
  • June 2008 (9)
  • May 2008 (6)
  • April 2008 (2)
  • March 2008 (6)
  • February 2008 (6)
  • January 2008 (8)
  • December 2007 (1)
  • November 2007 (3)
  • October 2007 (8)
  • September 2007 (8)
  • August 2007 (19)
  • July 2007 (5)
  • June 2007 (1)
  • May 2007 (3)
  • March 2007 (1)
  • October 2006 (2)
  • August 2006 (4)
  • July 2006 (1)
  • June 2006 (1)
  • May 2006 (5)
  • April 2006 (1)
  • March 2006 (1)
  • February 2006 (5)
  • October 2005 (1)
  • September 2005 (2)