R version 2.8.0 (2008-10-20) Copyright (C) 2008 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. Natural language support but running in an English locale R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- c(6282929 + ,4324047 + ,4108272 + ,-1212617 + ,1485329 + ,1779876 + ,1367203 + ,2519076 + ,912684 + ,1443586 + ,1220017 + ,984885 + ,1457425 + ,-572920 + ,929144 + ,1151176 + ,790090 + ,774497 + ,990576 + ,454195 + ,876607 + ,711969 + ,702380 + ,264449 + ,450033 + ,541063 + ,588864 + ,-37216 + ,783310 + ,467359 + ,688779 + ,608419 + ,696348 + ,597793 + ,821730 + ,377934 + ,651939 + ,697458 + ,700368 + ,225986 + ,348695 + ,373683 + ,501709 + ,413743 + ,379825 + ,336260 + ,636765 + ,481231 + ,469107 + ,211928 + ,563925 + ,511939 + ,521016 + ,543856 + ,329304 + ,423262 + ,509665 + ,455881 + ,367772 + ,406339 + ,493408 + ,232942 + ,416002 + ,337430 + ,361517 + ,360962 + ,235561 + ,408247 + ,450296 + ,418799 + ,247405 + ,378519 + ,326638 + ,328233 + ,386225 + ,283662 + ,370225 + ,269236 + ,365732 + ,420383 + ,345811 + ,431809 + ,418876 + ,297476 + ,416776 + ,357257 + ,458343 + ,388386 + ,358934 + ,407560 + ,392558 + ,373177 + ,428370 + ,369419 + ,358649 + ,376641 + ,467427 + ,364885 + ,436230 + ,329118 + ,317365 + ,286849 + ,376685 + ,407198 + ,377772 + ,271483 + ,153661 + ,513294 + ,324881 + ,264512 + ,420968 + ,129302 + ,191521 + ,268673 + ,353179 + ,354624 + ,363713 + ,456657 + ,211742 + ,338381 + ,418530 + ,351483 + ,372928 + ,485538 + ,279268 + ,219060 + ,325560 + ,325314 + ,322046 + ,325560 + ,325599 + ,377028 + ,325560 + ,323850 + ,325560 + ,331514 + ,325632 + ,325560 + ,325560 + ,325560 + ,322265 + ,325560 + ,325906 + ,325985 + ,346145 + ,325898 + ,325560 + ,325356 + ,325560 + ,325930 + ,318020 + ,326389 + ,325560 + ,302925 + ,325540 + ,325560 + ,325560 + ,326736 + ,340580 + ,325560 + ,325560 + ,325560 + ,325560 + ,331828 + ,323299 + ,325560 + ,325560 + ,387722 + ,325560 + ,325560 + ,325560 + ,324598 + ,325560 + ,328726 + ,325560 + ,325043 + ,325560 + ,325806 + ,325560 + ,325560 + ,387732 + ,349729 + ,332202 + ,305442 + ,329537 + ,327055 + ,356245 + ,328451 + ,307062 + ,325560 + ,331345 + ,325560 + ,331824 + ,325560 + ,325685 + ,325560 + ,404480 + ,325560 + ,325560 + ,318314 + ,325560 + ,325560 + ,325560 + ,311807 + ,337724 + ,326431 + ,327556 + ,325560 + ,356850 + ,325560 + ,325560 + ,325560 + ,322741 + ,310902 + ,324295 + ,325560 + ,326156 + ,326960 + ,325560 + ,333411 + ,297761 + ,325560 + ,325536 + ,325560 + ,325762 + ,327957 + ,325560 + ,325560 + ,318521 + ,325560 + ,319775 + ,325560 + ,325560 + ,332128 + ,325560 + ,325486 + ,325560 + ,325838 + ,325560 + ,325560 + ,325560 + ,331767 + ,325560 + ,324523 + ,339995 + ,325560 + ,325560 + ,319582 + ,325560 + ,325560 + ,307245 + ,325560 + ,317967 + ,331488 + ,335452 + ,325560 + ,334184 + ,313213 + ,325560 + ,325560 + ,325560 + ,325560 + ,348678 + ,328727 + ,325560 + ,325560 + ,325560 + ,387978 + ,325560 + ,336704 + ,325560 + ,325560 + ,325560 + ,322076 + ,325560 + ,334272 + ,338197 + ,325560 + ,321024 + ,322145 + ,325560 + ,325560 + ,323351 + ,325560 + ,327748 + ,325560 + ,325560 + ,328157 + ,325560 + ,311594 + ,325560 + ,335962 + ,372426 + ,325560 + ,319844 + ,355822 + ,325560 + ,325560 + ,325560 + ,325560 + ,324047 + ,311464 + ,325560 + ,325560 + ,353417 + ,325590 + ,325560 + ,328576 + ,326126 + ,325560 + ,325560 + ,369376 + ,325560 + ,332013 + ,325871 + ,342165 + ,324967 + ,314832 + ,325557 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,322649 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,324598 + ,325567 + ,325560 + ,324005 + ,325560 + ,325748 + ,323385 + ,315409 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,312275 + ,325560 + ,325560 + ,325560 + ,320576 + ,325246 + ,332961 + ,323010 + ,325560 + ,325560 + ,345253 + ,325560 + ,325560 + ,325560 + ,325559 + ,325560 + ,325560 + ,319634 + ,319951 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,325560 + ,318519 + ,343222 + ,317234 + ,325560 + ,325560 + ,314025 + ,320249 + ,325560 + ,325560 + ,325560 + ,349365 + ,289197 + ,325560 + ,329245 + ,240869 + ,327182 + ,322876 + ,323117 + ,306351 + ,335137 + ,308271 + ,301731 + ,382409 + ,279230 + ,298731 + ,243650 + ,532682 + ,319771 + ,171493 + ,347262 + ,343945 + ,311874 + ,302211 + ,316708 + ,333463 + ,344282 + ,319635 + ,301186 + ,300381 + ,318765 + ,286146 + ,306844 + ,307705 + ,312448 + ,299715 + ,373399 + ,299446 + ,325586 + ,291221 + ,261173 + ,255027 + ,-78375 + ,-58143 + ,227033 + ,235098 + ,21267 + ,238675 + ,197687 + ,418341 + ,-297706) > ylimmax = '' > ylimmin = '' > main = 'Robustness of Central Tendency' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Prof. Dr. P. Wessa > #To cite this work: AUTHOR(S), (YEAR), YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ > #Source of accompanying publication: Office for Research, Development, and Education > #Technical description: Write here your technical program description (don't use hard returns!) > geomean <- function(x) { + return(exp(mean(log(x)))) + } > harmean <- function(x) { + return(1/mean(1/x)) + } > quamean <- function(x) { + return(sqrt(mean(x*x))) + } > winmean <- function(x) { + x <-sort(x[!is.na(x)]) + n<-length(x) + denom <- 3 + nodenom <- n/denom + if (nodenom>40) denom <- n/40 + sqrtn = sqrt(n) + roundnodenom = floor(nodenom) + win <- array(NA,dim=c(roundnodenom,2)) + for (j in 1:roundnodenom) { + win[j,1] <- (j*x[j+1]+sum(x[(j+1):(n-j)])+j*x[n-j])/n + win[j,2] <- sd(c(rep(x[j+1],j),x[(j+1):(n-j)],rep(x[n-j],j)))/sqrtn + } + return(win) + } > trimean <- function(x) { + x <-sort(x[!is.na(x)]) + n<-length(x) + denom <- 3 + nodenom <- n/denom + if (nodenom>40) denom <- n/40 + sqrtn = sqrt(n) + roundnodenom = floor(nodenom) + tri <- array(NA,dim=c(roundnodenom,2)) + for (j in 1:roundnodenom) { + tri[j,1] <- mean(x,trim=j/n) + tri[j,2] <- sd(x[(j+1):(n-j)]) / sqrt(n-j*2) + } + return(tri) + } > midrange <- function(x) { + return((max(x)+min(x))/2) + } > q1 <- function(data,n,p,i,f) { + np <- n*p; + i <<- floor(np) + f <<- np - i + qvalue <- (1-f)*data[i] + f*data[i+1] + } > q2 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + qvalue <- (1-f)*data[i] + f*data[i+1] + } > q3 <- function(data,n,p,i,f) { + np <- n*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + qvalue <- data[i+1] + } + } > q4 <- function(data,n,p,i,f) { + np <- n*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- (data[i]+data[i+1])/2 + } else { + qvalue <- data[i+1] + } + } > q5 <- function(data,n,p,i,f) { + np <- (n-1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i+1] + } else { + qvalue <- data[i+1] + f*(data[i+2]-data[i+1]) + } + } > q6 <- function(data,n,p,i,f) { + np <- n*p+0.5 + i <<- floor(np) + f <<- np - i + qvalue <- data[i] + } > q7 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + qvalue <- f*data[i] + (1-f)*data[i+1] + } + } > q8 <- function(data,n,p,i,f) { + np <- (n+1)*p + i <<- floor(np) + f <<- np - i + if (f==0) { + qvalue <- data[i] + } else { + if (f == 0.5) { + qvalue <- (data[i]+data[i+1])/2 + } else { + if (f < 0.5) { + qvalue <- data[i] + } else { + qvalue <- data[i+1] + } + } + } + } > midmean <- function(x,def) { + x <-sort(x[!is.na(x)]) + n<-length(x) + if (def==1) { + qvalue1 <- q1(x,n,0.25,i,f) + qvalue3 <- q1(x,n,0.75,i,f) + } + if (def==2) { + qvalue1 <- q2(x,n,0.25,i,f) + qvalue3 <- q2(x,n,0.75,i,f) + } + if (def==3) { + qvalue1 <- q3(x,n,0.25,i,f) + qvalue3 <- q3(x,n,0.75,i,f) + } + if (def==4) { + qvalue1 <- q4(x,n,0.25,i,f) + qvalue3 <- q4(x,n,0.75,i,f) + } + if (def==5) { + qvalue1 <- q5(x,n,0.25,i,f) + qvalue3 <- q5(x,n,0.75,i,f) + } + if (def==6) { + qvalue1 <- q6(x,n,0.25,i,f) + qvalue3 <- q6(x,n,0.75,i,f) + } + if (def==7) { + qvalue1 <- q7(x,n,0.25,i,f) + qvalue3 <- q7(x,n,0.75,i,f) + } + if (def==8) { + qvalue1 <- q8(x,n,0.25,i,f) + qvalue3 <- q8(x,n,0.75,i,f) + } + midm <- 0 + myn <- 0 + roundno4 <- round(n/4) + round3no4 <- round(3*n/4) + for (i in 1:n) { + if ((x[i]>=qvalue1) & (x[i]<=qvalue3)){ + midm = midm + x[i] + myn = myn + 1 + } + } + midm = midm / myn + return(midm) + } > (arm <- mean(x)) [1] 399177.6 > sqrtn <- sqrt(length(x)) > (armse <- sd(x) / sqrtn) [1] 21551.31 > (armose <- arm / armse) [1] 18.52220 > (geo <- geomean(x)) [1] NaN Warning message: In log(x) : NaNs produced > (har <- harmean(x)) [1] 354098.2 > (qua <- quamean(x)) [1] 599216.3 > (win <- winmean(x)) [,1] [,2] [1,] 396116.9 18757.5153 [2,] 396392.7 18141.5329 [3,] 386857.7 13215.9207 [4,] 380185.1 10858.9623 [5,] 377010.9 9874.4969 [6,] 377436.6 9698.9775 [7,] 378966.4 9511.9421 [8,] 378000.8 9121.7783 [9,] 375299.7 8350.3214 [10,] 374167.1 7955.2701 [11,] 370225.6 7059.4934 [12,] 370458.5 7005.7109 [13,] 368782.8 6669.5199 [14,] 368479.8 6553.1723 [15,] 367465.3 6301.2123 [16,] 365467.0 5925.0493 [17,] 364452.1 5692.1321 [18,] 364259.0 5638.2226 [19,] 363890.9 5570.2541 [20,] 361133.8 5079.9055 [21,] 360773.5 4999.2819 [22,] 360812.8 4975.1251 [23,] 360857.9 4939.6574 [24,] 361220.5 4907.8365 [25,] 361137.9 4820.7098 [26,] 359113.2 4465.7629 [27,] 358166.6 4321.8163 [28,] 356595.4 4036.3820 [29,] 355918.3 3931.4259 [30,] 355453.2 3834.9806 [31,] 354216.6 3557.0509 [32,] 352729.4 3355.9884 [33,] 352852.0 3310.9507 [34,] 352386.8 3214.6666 [35,] 351496.5 3089.6617 [36,] 351047.7 2998.4448 [37,] 351105.1 2975.5809 [38,] 351456.1 2925.6267 [39,] 350762.0 2834.6568 [40,] 350081.6 2736.0935 [41,] 349401.0 2642.6543 [42,] 349007.5 2591.4541 [43,] 347864.3 2446.9739 [44,] 347775.0 2423.5552 [45,] 347824.8 2420.2078 [46,] 346913.8 2308.6214 [47,] 346807.8 2284.5306 [48,] 347001.7 2262.6135 [49,] 346913.3 2236.8115 [50,] 346518.2 2184.1792 [51,] 346512.9 2179.6534 [52,] 344869.6 1998.0460 [53,] 344382.5 1938.1364 [54,] 344022.6 1890.0544 [55,] 343706.5 1808.4022 [56,] 343481.4 1774.9521 [57,] 343421.3 1766.3843 [58,] 343247.1 1744.6864 [59,] 343245.8 1743.2398 [60,] 343264.1 1737.1398 [61,] 343261.9 1733.4310 [62,] 343146.8 1706.2765 [63,] 343152.4 1690.1294 [64,] 342936.7 1651.8238 [65,] 342194.9 1566.3994 [66,] 342288.6 1548.3065 [67,] 342314.1 1539.6708 [68,] 342199.3 1525.6217 [69,] 341998.0 1492.9607 [70,] 340070.3 1307.7850 [71,] 339431.5 1242.2983 [72,] 339397.6 1234.7066 [73,] 339356.3 1230.8829 [74,] 339396.4 1229.0837 [75,] 339278.1 1199.8317 [76,] 338614.4 1138.7596 [77,] 338152.9 1097.7258 [78,] 337941.2 1075.9613 [79,] 337834.7 1066.5424 [80,] 337817.4 1063.4103 [81,] 337697.7 1050.4236 [82,] 337689.1 1042.5274 [83,] 337743.6 1039.3557 [84,] 337254.5 986.1487 [85,] 337400.0 973.7816 [86,] 337361.7 969.7557 [87,] 337325.4 964.9307 [88,] 337247.4 955.2491 [89,] 336872.2 913.6078 [90,] 336723.1 898.6473 [91,] 336742.5 896.8509 [92,] 336428.7 866.9403 [93,] 336011.6 829.2542 [94,] 335866.6 812.4517 [95,] 335619.7 790.6358 [96,] 335138.1 750.1459 [97,] 335117.9 736.1700 [98,] 334692.0 697.4493 [99,] 334636.2 691.8178 [100,] 334370.8 663.7929 [101,] 334328.8 654.2775 [102,] 334203.4 642.2146 [103,] 334102.3 634.1544 [104,] 333881.5 608.8243 [105,] 333608.4 584.8737 [106,] 333568.6 579.6249 [107,] 333197.9 544.9103 [108,] 332775.4 510.1940 [109,] 332694.0 502.7264 [110,] 332556.2 488.4411 [111,] 332564.7 487.6721 [112,] 332197.8 459.4687 [113,] 331909.4 437.0603 [114,] 331821.6 430.3572 [115,] 331672.9 419.1107 [116,] 331411.6 399.4725 [117,] 331320.1 392.6247 [118,] 331122.2 377.8525 [119,] 330830.3 356.1847 [120,] 330389.0 323.6916 [121,] 330224.8 311.6926 [122,] 329767.9 278.6047 [123,] 329715.4 274.8327 [124,] 329579.3 265.0873 [125,] 329494.1 259.0030 [126,] 329281.8 243.9304 [127,] 329151.0 234.6931 [128,] 329062.5 228.4681 [129,] 328909.9 217.7752 [130,] 328814.8 211.1482 [131,] 328551.9 192.9266 [132,] 328525.0 191.0693 [133,] 328302.5 175.8103 [134,] 328286.3 174.7071 [135,] 328145.4 165.1187 [136,] 327905.9 148.9603 [137,] 327882.4 147.3836 [138,] 327845.5 144.9190 [139,] 327785.9 140.9340 [140,] 327784.6 140.8474 [141,] 327765.9 139.6041 [142,] 327682.6 134.0559 [143,] 327673.9 133.4826 > (tri <- trimean(x)) [,1] [,2] [1,] 389219.7 16305.90822 [2,] 382257.9 13344.01541 [3,] 375090.7 10000.72313 [4,] 371094.2 8603.66084 [5,] 368767.5 7902.51236 [6,] 367071.6 7414.97003 [7,] 365286.1 6925.36631 [8,] 363256.5 6428.29905 [9,] 361333.1 5961.04979 [10,] 359705.7 5593.32168 [11,] 358181.8 5259.58309 [12,] 357022.3 5035.54122 [13,] 355830.8 4802.73042 [14,] 354765.3 4597.44589 [15,] 353712.3 4392.03217 [16,] 352722.0 4202.03554 [17,] 351857.2 4041.54952 [18,] 351048.8 3895.33527 [19,] 350243.9 3745.24691 [20,] 349452.2 3592.03603 [21,] 348805.0 3476.03421 [22,] 348170.3 3360.39732 [23,] 347527.0 3239.75956 [24,] 346874.7 3114.40284 [25,] 346198.6 2983.06915 [26,] 345519.0 2849.92981 [27,] 344921.2 2738.41702 [28,] 344357.4 2631.53829 [29,] 343852.4 2540.68141 [30,] 343369.0 2452.34090 [31,] 342898.5 2365.78798 [32,] 342469.8 2294.30283 [33,] 342091.2 2232.94273 [34,] 341704.0 2171.06671 [35,] 341328.9 2112.15270 [36,] 340980.1 2058.26368 [37,] 340642.5 2007.25459 [38,] 340299.2 1954.84124 [39,] 339940.7 1902.34463 [40,] 339600.0 1852.70169 [41,] 339276.4 1806.42651 [42,] 338969.7 1763.31838 [43,] 338671.1 1720.96702 [44,] 338402.5 1684.83628 [45,] 338133.2 1648.14232 [46,] 337859.4 1609.67055 [47,] 337607.7 1575.53785 [48,] 337355.8 1540.93641 [49,] 337095.8 1505.54019 [50,] 336834.9 1469.61627 [51,] 336581.2 1434.68595 [52,] 336324.5 1398.03427 [53,] 336106.6 1369.56272 [54,] 335898.2 1342.79050 [55,] 335696.2 1317.13930 [56,] 335499.4 1294.19573 [57,] 335305.6 1271.75804 [58,] 335110.8 1248.60728 [59,] 334917.6 1225.36061 [60,] 334722.0 1200.95877 [61,] 334523.4 1175.51701 [62,] 334322.3 1148.83810 [63,] 334121.2 1122.03411 [64,] 333917.3 1094.46053 [65,] 333715.5 1067.28897 [66,] 333527.4 1043.16721 [67,] 333334.8 1018.44994 [68,] 333139.0 992.64882 [69,] 332943.0 966.02506 [70,] 332748.6 939.50455 [71,] 332592.7 921.56404 [72,] 332448.0 905.92370 [73,] 332302.0 889.77973 [74,] 332154.9 872.92714 [75,] 332004.8 855.16307 [76,] 331855.0 837.77780 [77,] 331716.6 822.56317 [78,] 331585.6 808.57297 [79,] 331456.9 794.86953 [80,] 331328.5 780.86302 [81,] 331198.6 766.19323 [82,] 331069.0 751.31823 [83,] 330937.7 735.91186 [84,] 330803.4 719.65931 [85,] 330676.5 705.21380 [86,] 330544.9 690.33002 [87,] 330412.0 674.70896 [88,] 330277.7 658.31671 [89,] 330142.7 641.35056 [90,] 330012.9 625.58742 [91,] 329883.9 609.60205 [92,] 329752.3 592.55634 [93,] 329624.7 576.09323 [94,] 329502.9 560.73946 [95,] 329381.8 545.26094 [96,] 329263.4 529.99792 [97,] 329152.1 516.13878 [98,] 329039.3 501.99221 [99,] 328932.6 489.18261 [100,] 328825.1 475.76259 [101,] 328720.7 463.04043 [102,] 328615.3 449.88162 [103,] 328510.4 436.46245 [104,] 328405.4 422.50851 [105,] 328302.8 409.05328 [106,] 328203.3 396.12146 [107,] 328102.8 382.43502 [108,] 328007.3 369.99449 [109,] 327918.0 358.93972 [110,] 327828.5 347.46292 [111,] 327828.5 335.97302 [112,] 327649.3 323.48140 [113,] 327564.0 312.02076 [114,] 327482.3 301.22868 [115,] 327482.3 289.95852 [116,] 327320.2 278.51659 [117,] 327243.1 267.57594 [118,] 327166.1 256.12017 [119,] 327166.1 244.76934 [120,] 327020.3 234.14599 [121,] 326956.3 225.24971 [122,] 326894.0 216.48730 [123,] 326894.0 209.62667 [124,] 326784.0 202.41728 [125,] 326730.4 195.32097 [126,] 326677.1 188.03726 [127,] 326677.1 181.33414 [128,] 326577.8 174.76103 [129,] 326529.5 168.06498 [130,] 326483.0 161.64382 [131,] 326437.2 155.15290 [132,] 326395.6 149.67212 [133,] 326353.4 143.77580 [134,] 326314.7 138.69447 [135,] 326275.3 133.16104 [136,] 326237.7 127.95946 [137,] 326204.1 123.75930 [138,] 326170.0 119.24927 [139,] 326135.8 114.47314 [140,] 326101.9 109.55315 [141,] 326067.1 104.02450 [142,] 326031.8 97.89935 [143,] 325997.3 91.61385 > (midr <- midrange(x)) [1] 2535156 > midm <- array(NA,dim=8) > for (j in 1:8) midm[j] <- midmean(x,j) > midm [1] 327994.5 328102.8 328102.8 328102.8 328007.3 327994.5 328102.8 328102.8 > postscript(file="/var/www/html/freestat/rcomp/tmp/1tkh71295814568.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > lb <- win[,1] - 2*win[,2] > ub <- win[,1] + 2*win[,2] > if ((ylimmin == '') | (ylimmax == '')) plot(win[,1],type='b',main=main, xlab='j', pch=19, ylab='Winsorized Mean(j/n)', ylim=c(min(lb),max(ub))) else plot(win[,1],type='l',main=main, xlab='j', pch=19, ylab='Winsorized Mean(j/n)', ylim=c(ylimmin,ylimmax)) > lines(ub,lty=3) > lines(lb,lty=3) > grid() > dev.off() null device 1 > postscript(file="/var/www/html/freestat/rcomp/tmp/28a601295814568.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > lb <- tri[,1] - 2*tri[,2] > ub <- tri[,1] + 2*tri[,2] > if ((ylimmin == '') | (ylimmax == '')) plot(tri[,1],type='b',main=main, xlab='j', pch=19, ylab='Trimmed Mean(j/n)', ylim=c(min(lb),max(ub))) else plot(tri[,1],type='l',main=main, xlab='j', pch=19, ylab='Trimmed Mean(j/n)', ylim=c(ylimmin,ylimmax)) > lines(ub,lty=3) > lines(lb,lty=3) > grid() > dev.off() null device 1 > > #Note: the /var/www/html/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/freestat/rcomp/createtable") > > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Central Tendency - Ungrouped Data',4,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'Measure',header=TRUE) > a<-table.element(a,'Value',header=TRUE) > a<-table.element(a,'S.E.',header=TRUE) > a<-table.element(a,'Value/S.E.',header=TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/arithmetic_mean.htm', 'Arithmetic Mean', 'click to view the definition of the Arithmetic Mean'),header=TRUE) > a<-table.element(a,arm) > a<-table.element(a,hyperlink('http://www.xycoon.com/arithmetic_mean_standard_error.htm', armse, 'click to view the definition of the Standard Error of the Arithmetic Mean')) > a<-table.element(a,armose) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/geometric_mean.htm', 'Geometric Mean', 'click to view the definition of the Geometric Mean'),header=TRUE) > a<-table.element(a,geo) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/harmonic_mean.htm', 'Harmonic Mean', 'click to view the definition of the Harmonic Mean'),header=TRUE) > a<-table.element(a,har) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/quadratic_mean.htm', 'Quadratic Mean', 'click to view the definition of the Quadratic Mean'),header=TRUE) > a<-table.element(a,qua) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > for (j in 1:length(win[,1])) { + a<-table.row.start(a) + mylabel <- paste('Winsorized Mean (',j) + mylabel <- paste(mylabel,'/') + mylabel <- paste(mylabel,length(win[,1])) + mylabel <- paste(mylabel,')') + a<-table.element(a,hyperlink('http://www.xycoon.com/winsorized_mean.htm', mylabel, 'click to view the definition of the Winsorized Mean'),header=TRUE) + a<-table.element(a,win[j,1]) + a<-table.element(a,win[j,2]) + a<-table.element(a,win[j,1]/win[j,2]) + a<-table.row.end(a) + } > for (j in 1:length(tri[,1])) { + a<-table.row.start(a) + mylabel <- paste('Trimmed Mean (',j) + mylabel <- paste(mylabel,'/') + mylabel <- paste(mylabel,length(tri[,1])) + mylabel <- paste(mylabel,')') + a<-table.element(a,hyperlink('http://www.xycoon.com/arithmetic_mean.htm', mylabel, 'click to view the definition of the Trimmed Mean'),header=TRUE) + a<-table.element(a,tri[j,1]) + a<-table.element(a,tri[j,2]) + a<-table.element(a,tri[j,1]/tri[j,2]) + a<-table.row.end(a) + } > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/median_1.htm', 'Median', 'click to view the definition of the Median'),header=TRUE) > a<-table.element(a,median(x)) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,hyperlink('http://www.xycoon.com/midrange.htm', 'Midrange', 'click to view the definition of the Midrange'),header=TRUE) > a<-table.element(a,midr) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_1.htm','Weighted Average at Xnp',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[1]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_2.htm','Weighted Average at X(n+1)p',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[2]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_3.htm','Empirical Distribution Function',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[3]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_4.htm','Empirical Distribution Function - Averaging',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[4]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_5.htm','Empirical Distribution Function - Interpolation',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[5]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_6.htm','Closest Observation',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[6]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_7.htm','True Basic - Statistics Graphics Toolkit',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[7]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > mymid <- hyperlink('http://www.xycoon.com/midmean.htm', 'Midmean', 'click to view the definition of the Midmean') > mylabel <- paste(mymid,hyperlink('http://www.xycoon.com/method_8.htm','MS Excel (old versions)',''),sep=' - ') > a<-table.element(a,mylabel,header=TRUE) > a<-table.element(a,midm[8]) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'Number of observations',header=TRUE) > a<-table.element(a,length(x)) > a<-table.element(a,'') > a<-table.element(a,'') > a<-table.row.end(a) > a<-table.end(a) > table.save(a,file="/var/www/html/freestat/rcomp/tmp/3ffav1295814568.tab") > > try(system("convert tmp/1tkh71295814568.ps tmp/1tkh71295814568.png",intern=TRUE)) character(0) > try(system("convert tmp/28a601295814568.ps tmp/28a601295814568.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 2.845 0.560 2.948