[Rsiena-commits] r16 - in pkg/RSiena: . R inst inst/doc man src src/data src/model src/model/effects src/model/tables src/model/variables src/utils src/win32
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Oct 31 22:31:03 CET 2009
Author: ripleyrm
Date: 2009-10-31 22:31:02 +0100 (Sat, 31 Oct 2009)
New Revision: 16
Modified:
pkg/RSiena/DESCRIPTION
pkg/RSiena/NAMESPACE
pkg/RSiena/R/RSienaRDocumentation.r
pkg/RSiena/R/Sienatest.r
pkg/RSiena/R/effects.r
pkg/RSiena/R/effectsInfo.R
pkg/RSiena/R/getTargets.r
pkg/RSiena/R/globals.r
pkg/RSiena/R/phase1.r
pkg/RSiena/R/phase2.r
pkg/RSiena/R/phase3.r
pkg/RSiena/R/print01Report.r
pkg/RSiena/R/print07Report.r
pkg/RSiena/R/printDataReport.r
pkg/RSiena/R/printInitialDescription.r
pkg/RSiena/R/robmon.r
pkg/RSiena/R/siena01.r
pkg/RSiena/R/siena07.r
pkg/RSiena/R/siena07gui.r
pkg/RSiena/R/sienaDataCreate.r
pkg/RSiena/R/sienaDataCreateFromSession.r
pkg/RSiena/R/sienaModelCreate.r
pkg/RSiena/R/sienaprint.r
pkg/RSiena/R/sienautils.r
pkg/RSiena/R/simstatsc.r
pkg/RSiena/R/zzz.R
pkg/RSiena/cleanup
pkg/RSiena/cleanup.win
pkg/RSiena/configure.win
pkg/RSiena/inst/doc/s_man400.pdf
pkg/RSiena/inst/sienascript
pkg/RSiena/man/RSiena-package.Rd
pkg/RSiena/man/coCovar.Rd
pkg/RSiena/man/coDyadCovar.Rd
pkg/RSiena/man/getEffects.Rd
pkg/RSiena/man/installGui.Rd
pkg/RSiena/man/print01Report.Rd
pkg/RSiena/man/s501.Rd
pkg/RSiena/man/s502.Rd
pkg/RSiena/man/s503.Rd
pkg/RSiena/man/s50a.Rd
pkg/RSiena/man/siena01Gui.Rd
pkg/RSiena/man/siena07.Rd
pkg/RSiena/man/sienaCompositionChange.Rd
pkg/RSiena/man/sienaDataCreate.Rd
pkg/RSiena/man/sienaDataCreateFromSession.Rd
pkg/RSiena/man/sienaGroupCreate.Rd
pkg/RSiena/man/sienaModelCreate.Rd
pkg/RSiena/man/sienaModelOptions.Rd
pkg/RSiena/man/sienaNet.Rd
pkg/RSiena/man/sienaNodeSet.Rd
pkg/RSiena/man/simstats0c.Rd
pkg/RSiena/man/tmp3.Rd
pkg/RSiena/man/tmp4.Rd
pkg/RSiena/man/varCovar.Rd
pkg/RSiena/man/varDyadCovar.Rd
pkg/RSiena/src/Makefile.profile
pkg/RSiena/src/Makefile.win
pkg/RSiena/src/Makevars
pkg/RSiena/src/data/ActorSet.cpp
pkg/RSiena/src/data/ActorSet.h
pkg/RSiena/src/data/BehaviorLongitudinalData.cpp
pkg/RSiena/src/data/BehaviorLongitudinalData.h
pkg/RSiena/src/data/ChangingCovariate.cpp
pkg/RSiena/src/data/ChangingCovariate.h
pkg/RSiena/src/data/ChangingDyadicCovariate.cpp
pkg/RSiena/src/data/ChangingDyadicCovariate.h
pkg/RSiena/src/data/CommonNeighborIterator.cpp
pkg/RSiena/src/data/CommonNeighborIterator.h
pkg/RSiena/src/data/ConstantCovariate.cpp
pkg/RSiena/src/data/ConstantCovariate.h
pkg/RSiena/src/data/ConstantDyadicCovariate.cpp
pkg/RSiena/src/data/ConstantDyadicCovariate.h
pkg/RSiena/src/data/Covariate.cpp
pkg/RSiena/src/data/Covariate.h
pkg/RSiena/src/data/Data.cpp
pkg/RSiena/src/data/Data.h
pkg/RSiena/src/data/DataUtils.cpp
pkg/RSiena/src/data/DataUtils.h
pkg/RSiena/src/data/DyadicCovariate.cpp
pkg/RSiena/src/data/DyadicCovariate.h
pkg/RSiena/src/data/DyadicCovariateValueIterator.cpp
pkg/RSiena/src/data/DyadicCovariateValueIterator.h
pkg/RSiena/src/data/ExogenousEvent.cpp
pkg/RSiena/src/data/ExogenousEvent.h
pkg/RSiena/src/data/IncidentTieIterator.cpp
pkg/RSiena/src/data/IncidentTieIterator.h
pkg/RSiena/src/data/LongitudinalData.cpp
pkg/RSiena/src/data/LongitudinalData.h
pkg/RSiena/src/data/Network.cpp
pkg/RSiena/src/data/Network.h
pkg/RSiena/src/data/NetworkLongitudinalData.cpp
pkg/RSiena/src/data/NetworkLongitudinalData.h
pkg/RSiena/src/data/OneModeNetwork.cpp
pkg/RSiena/src/data/OneModeNetwork.h
pkg/RSiena/src/data/OneModeNetworkLongitudinalData.cpp
pkg/RSiena/src/data/OneModeNetworkLongitudinalData.h
pkg/RSiena/src/data/TieIterator.cpp
pkg/RSiena/src/data/TieIterator.h
pkg/RSiena/src/model/EffectInfo.cpp
pkg/RSiena/src/model/EffectInfo.h
pkg/RSiena/src/model/EpochSimulation.cpp
pkg/RSiena/src/model/EpochSimulation.h
pkg/RSiena/src/model/Function.cpp
pkg/RSiena/src/model/Function.h
pkg/RSiena/src/model/Model.cpp
pkg/RSiena/src/model/Model.h
pkg/RSiena/src/model/SimulationActorSet.cpp
pkg/RSiena/src/model/SimulationActorSet.h
pkg/RSiena/src/model/State.cpp
pkg/RSiena/src/model/State.h
pkg/RSiena/src/model/StatisticCalculator.cpp
pkg/RSiena/src/model/StatisticCalculator.h
pkg/RSiena/src/model/effects/AllEffects.h
pkg/RSiena/src/model/effects/AverageAlterEffect.cpp
pkg/RSiena/src/model/effects/AverageAlterEffect.h
pkg/RSiena/src/model/effects/AverageSimilarityEffect.cpp
pkg/RSiena/src/model/effects/AverageSimilarityEffect.h
pkg/RSiena/src/model/effects/BalanceEffect.cpp
pkg/RSiena/src/model/effects/BalanceEffect.h
pkg/RSiena/src/model/effects/BehaviorDependentBehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorDependentBehaviorEffect.h
pkg/RSiena/src/model/effects/BehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorEffect.h
pkg/RSiena/src/model/effects/BehaviorMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/BehaviorMainBehaviorEffect.h
pkg/RSiena/src/model/effects/BetweennessEffect.cpp
pkg/RSiena/src/model/effects/BetweennessEffect.h
pkg/RSiena/src/model/effects/ChangingCovariateBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ChangingCovariateBehaviorEffect.h
pkg/RSiena/src/model/effects/ChangingCovariateMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ChangingCovariateMainBehaviorEffect.h
pkg/RSiena/src/model/effects/ConstantCovariateBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ConstantCovariateBehaviorEffect.h
pkg/RSiena/src/model/effects/ConstantCovariateMainBehaviorEffect.cpp
pkg/RSiena/src/model/effects/ConstantCovariateMainBehaviorEffect.h
pkg/RSiena/src/model/effects/CovariateAlterEffect.cpp
pkg/RSiena/src/model/effects/CovariateAlterEffect.h
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.cpp
pkg/RSiena/src/model/effects/CovariateDependentNetworkEffect.h
pkg/RSiena/src/model/effects/CovariateEgoAlterEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoAlterEffect.h
pkg/RSiena/src/model/effects/CovariateEgoEffect.cpp
pkg/RSiena/src/model/effects/CovariateEgoEffect.h
pkg/RSiena/src/model/effects/CovariateIndirectTiesEffect.cpp
pkg/RSiena/src/model/effects/CovariateIndirectTiesEffect.h
pkg/RSiena/src/model/effects/CovariateSimilarityEffect.cpp
pkg/RSiena/src/model/effects/CovariateSimilarityEffect.h
pkg/RSiena/src/model/effects/DenseTriadsEffect.cpp
pkg/RSiena/src/model/effects/DenseTriadsEffect.h
pkg/RSiena/src/model/effects/DensityEffect.cpp
pkg/RSiena/src/model/effects/DensityEffect.h
pkg/RSiena/src/model/effects/DistanceTwoEffect.cpp
pkg/RSiena/src/model/effects/DistanceTwoEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateDependentNetworkEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateDependentNetworkEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateMainEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateMainEffect.h
pkg/RSiena/src/model/effects/DyadicCovariateReciprocityEffect.cpp
pkg/RSiena/src/model/effects/DyadicCovariateReciprocityEffect.h
pkg/RSiena/src/model/effects/Effect.cpp
pkg/RSiena/src/model/effects/Effect.h
pkg/RSiena/src/model/effects/EffectFactory.cpp
pkg/RSiena/src/model/effects/EffectFactory.h
pkg/RSiena/src/model/effects/FourCyclesEffect.cpp
pkg/RSiena/src/model/effects/FourCyclesEffect.h
pkg/RSiena/src/model/effects/HigherCovariateEffect.cpp
pkg/RSiena/src/model/effects/HigherCovariateEffect.h
pkg/RSiena/src/model/effects/InInDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/InInDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/InOutDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/InOutDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/IndegreeActivityEffect.cpp
pkg/RSiena/src/model/effects/IndegreeActivityEffect.h
pkg/RSiena/src/model/effects/IndegreeEffect.cpp
pkg/RSiena/src/model/effects/IndegreeEffect.h
pkg/RSiena/src/model/effects/IndegreePopularityEffect.cpp
pkg/RSiena/src/model/effects/IndegreePopularityEffect.h
pkg/RSiena/src/model/effects/InverseOutdegreeEffect.cpp
pkg/RSiena/src/model/effects/InverseOutdegreeEffect.h
pkg/RSiena/src/model/effects/InverseSquaredOutdegreeEffect.cpp
pkg/RSiena/src/model/effects/InverseSquaredOutdegreeEffect.h
pkg/RSiena/src/model/effects/LinearShapeEffect.cpp
pkg/RSiena/src/model/effects/LinearShapeEffect.h
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.cpp
pkg/RSiena/src/model/effects/NetworkDependentBehaviorEffect.h
pkg/RSiena/src/model/effects/NetworkEffect.cpp
pkg/RSiena/src/model/effects/OutInDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/OutInDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/OutOutDegreeAssortativityEffect.cpp
pkg/RSiena/src/model/effects/OutOutDegreeAssortativityEffect.h
pkg/RSiena/src/model/effects/OutdegreeActivityEffect.cpp
pkg/RSiena/src/model/effects/OutdegreeActivityEffect.h
pkg/RSiena/src/model/effects/OutdegreeActivitySqrtEffect.cpp
pkg/RSiena/src/model/effects/OutdegreeActivitySqrtEffect.h
pkg/RSiena/src/model/effects/OutdegreeEffect.cpp
pkg/RSiena/src/model/effects/OutdegreeEffect.h
pkg/RSiena/src/model/effects/OutdegreePopularityEffect.cpp
pkg/RSiena/src/model/effects/OutdegreePopularityEffect.h
pkg/RSiena/src/model/effects/QuadraticShapeEffect.cpp
pkg/RSiena/src/model/effects/QuadraticShapeEffect.h
pkg/RSiena/src/model/effects/ReciprocityEffect.cpp
pkg/RSiena/src/model/effects/ReciprocityEffect.h
pkg/RSiena/src/model/effects/SameCovariateEffect.cpp
pkg/RSiena/src/model/effects/SameCovariateEffect.h
pkg/RSiena/src/model/effects/StructuralRateEffect.cpp
pkg/RSiena/src/model/effects/StructuralRateEffect.h
pkg/RSiena/src/model/effects/ThreeCyclesEffect.cpp
pkg/RSiena/src/model/effects/ThreeCyclesEffect.h
pkg/RSiena/src/model/effects/TotalSimilarityEffect.cpp
pkg/RSiena/src/model/effects/TotalSimilarityEffect.h
pkg/RSiena/src/model/effects/TransitiveMediatedTripletsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveMediatedTripletsEffect.h
pkg/RSiena/src/model/effects/TransitiveTiesEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTiesEffect.h
pkg/RSiena/src/model/effects/TransitiveTriadsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTriadsEffect.h
pkg/RSiena/src/model/effects/TransitiveTripletsEffect.cpp
pkg/RSiena/src/model/effects/TransitiveTripletsEffect.h
pkg/RSiena/src/model/effects/WWXClosureEffect.cpp
pkg/RSiena/src/model/effects/WWXClosureEffect.h
pkg/RSiena/src/model/effects/WXXClosureEffect.h
pkg/RSiena/src/model/effects/XWXClosureEffect.h
pkg/RSiena/src/model/tables/ConfigurationTable.cpp
pkg/RSiena/src/model/tables/ConfigurationTable.h
pkg/RSiena/src/model/tables/CriticalInStarTable.cpp
pkg/RSiena/src/model/tables/CriticalInStarTable.h
pkg/RSiena/src/model/tables/TwoPathTable.cpp
pkg/RSiena/src/model/tables/TwoPathTable.h
pkg/RSiena/src/model/variables/BehaviorVariable.cpp
pkg/RSiena/src/model/variables/BehaviorVariable.h
pkg/RSiena/src/model/variables/DependentVariable.cpp
pkg/RSiena/src/model/variables/DependentVariable.h
pkg/RSiena/src/model/variables/EffectValueTable.cpp
pkg/RSiena/src/model/variables/EffectValueTable.h
pkg/RSiena/src/model/variables/NetworkVariable.cpp
pkg/RSiena/src/model/variables/NetworkVariable.h
pkg/RSiena/src/siena07.cpp
pkg/RSiena/src/utils/NamedObject.cpp
pkg/RSiena/src/utils/NamedObject.h
pkg/RSiena/src/utils/Random.cpp
pkg/RSiena/src/utils/Random.h
pkg/RSiena/src/utils/SqrtTable.cpp
pkg/RSiena/src/utils/SqrtTable.h
pkg/RSiena/src/utils/Utils.cpp
pkg/RSiena/src/utils/Utils.h
pkg/RSiena/src/win32/Makefile
pkg/RSiena/src/win32/siena.c
pkg/RSiena/src/win32/siena_rc.rc
Log:
Change eolstyle to native
Modified: pkg/RSiena/DESCRIPTION
===================================================================
--- pkg/RSiena/DESCRIPTION 2009-09-23 16:19:59 UTC (rev 15)
+++ pkg/RSiena/DESCRIPTION 2009-10-31 21:31:02 UTC (rev 16)
@@ -1,17 +1,17 @@
-Package: RSiena
-Type: Package
-Title: Siena - Simulation Investigation for Empirical Network Analysis
-Version: 1.0.5
-Date: 2009-08-10
-Author: Various
-Depends: R (>= 2.7.0)
-Imports: Matrix
-Suggests: tcltk, snow, rlecuyer, network, codetools, xtable
-SystemRequirements: GNU make, tcl/tk 8.5, Tktable
-Maintainer: <ruth at stats.ox.ac.uk>
-Description: Fits models to longitudinal networks
-License: GPL (>=2)
-LazyLoad: yes
-LazyData: yes
-URL: http://www.stats.ox.ac.uk/~snijders/siena
-Packaged: 2009-09-22 21:01:10 UTC; ruth
+Package: RSiena
+Type: Package
+Title: Siena - Simulation Investigation for Empirical Network Analysis
+Version: 1.0.5
+Date: 2009-08-10
+Author: Various
+Depends: R (>= 2.7.0)
+Imports: Matrix
+Suggests: tcltk, snow, rlecuyer, network, codetools, xtable
+SystemRequirements: GNU make, tcl/tk 8.5, Tktable
+Maintainer: <ruth at stats.ox.ac.uk>
+Description: Fits models to longitudinal networks
+License: GPL (>=2)
+LazyLoad: yes
+LazyData: yes
+URL: http://www.stats.ox.ac.uk/~snijders/siena
+Packaged: 2009-09-22 21:01:10 UTC; ruth
Property changes on: pkg/RSiena/DESCRIPTION
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: pkg/RSiena/NAMESPACE
===================================================================
--- pkg/RSiena/NAMESPACE 2009-09-23 16:19:59 UTC (rev 15)
+++ pkg/RSiena/NAMESPACE 2009-10-31 21:31:02 UTC (rev 16)
@@ -1,15 +1,15 @@
-useDynLib("RSiena")
-export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
-siena01Gui, siena07, sienaCompositionChange,
-sienaCompositionChangeFromFile, sienaDataCreate, sienaDataCreateFromSession,
-sienaGroupCreate, sienaModelCreate, sienaNet, sienaNodeSet, simstats0c, varCovar, varDyadCovar,
- installGui)
-
-import(Matrix)
-
-S3method(print, siena)
-S3method(print, sienaGroup)
-S3method(print, sienaFit)
-S3method(print, summary.sienaFit)
-S3method(print, sienaModel)
-S3method(summary, sienaFit)
+useDynLib("RSiena")
+export(coCovar, coDyadCovar, getEffects, model.create, print01Report,
+siena01Gui, siena07, sienaCompositionChange,
+sienaCompositionChangeFromFile, sienaDataCreate, sienaDataCreateFromSession,
+sienaGroupCreate, sienaModelCreate, sienaNet, sienaNodeSet, simstats0c, varCovar, varDyadCovar,
+ installGui)
+
+import(Matrix)
+
+S3method(print, siena)
+S3method(print, sienaGroup)
+S3method(print, sienaFit)
+S3method(print, summary.sienaFit)
+S3method(print, sienaModel)
+S3method(summary, sienaFit)
Property changes on: pkg/RSiena/NAMESPACE
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: pkg/RSiena/R/RSienaRDocumentation.r
===================================================================
--- pkg/RSiena/R/RSienaRDocumentation.r 2009-09-23 16:19:59 UTC (rev 15)
+++ pkg/RSiena/R/RSienaRDocumentation.r 2009-10-31 21:31:02 UTC (rev 16)
@@ -1,253 +1,253 @@
-#/******************************************************************************
-# * SIENA: Simulation Investigation for Empirical Network Analysis
-# *
-# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
-# *
-# * File: RSienaRDocumentation.r
-# *
-# * Description: This module contains the code for documenting the
-# * RSiena R source.
-# *****************************************************************************/
-##
-##@getInternals Documentation
-getInternals <- function()
-{
- fnlist <- read.csv("RSienafnlist.csv", as.is=TRUE)
- mylist <- ls(parent.frame())
- ## print(mylist)
- library(codetools)
- mylist <- mylist[mylist %in% fnlist[, 3]]
- mytt <- lapply(mylist, function(x)
- {
- x <- get(x, envir=parent.frame(3))
- if (is.function(x))
- {
- tt <- findGlobals(x, merge=FALSE)[[1]]
- tt2 <- findLocals(body(x))
- tt <- c(tt, tt2)
- tt[tt %in% fnlist[, 3]]
- }
- else
- {
- NULL
- }
- }
- )
- names(mytt) <- mylist
- mytt
-}
-##@getRSienaDocumentation Documentation
-getRSienaRDocumentation <- function(Rdir)
-{
- library(xtable)
- library(codetools)
-
- thisdir <- getwd()
- ## temporarily move directory
- setwd(Rdir)
-
- ## extract comment lines
- shell('grep "##@" *.r *.R > comments.lis')
- ## read them in
- comms <- readLines('comments.lis')
- ## remove the file
- file.remove("comments.lis")
- ## remove the shell line
- comms <- comms[!grepl("comments.lis", comms)]
- ## split off
- mystr <- paste("##", "@", sep="")
- comms1 <- strsplit(comms, mystr)
- ## join up rest
- comms2 <- do.call(rbind, comms1)
- ## turn into dataframe
- comms3 <- sapply(comms1, function(x)
- {
- tmp <- strsplit(x[2], " ")[[1]]
- if (tmp[2] == "internal")
- {
- c(x[1], tmp[1], tmp[2], paste('internal to', tmp[3],
- collapse=" "))
- }
- else
- {
- c(x[1], tmp[1], tmp[2], paste(tmp[-c(1,2)],
- collapse=" "))
- }
- }
- )
- comms3 <- t(comms3)
-
- ## get the calls (global)
- codet <- lapply(comms3[,2], function(x)
- {
- x <- try(getFromNamespace(x, "RSiena"), silent=TRUE)
- if (is.function(x))
- {
- tmp1 <- findGlobals(x, merge=FALSE)[[1]]
- tmp2 <- findLocals(body(x))
- tmp <- c(tmp1, tmp2)
- }
- else
- tmp <- NULL
- unique(as.vector(tmp[tmp %in% comms3[,2]]))
- }
- )
- names(codet) <- comms3[, 2]
-
- ## now the internal ones
- ## find the list of files from comms3
- ttmp <- unique(comms3[grepl("internal to", comms3[, 4]), 4])
- ttmp <- sub("internal to ", "", ttmp)
- ttmp2 <- comms3[match(ttmp, comms3[, 2]), 1]
- ttmp2 <- sub(":", "", ttmp2)
-
- ## write out the fnlist in the Rdir
- write.csv(data.frame(comms3), "RSienafnlist.csv")
- ## get the list of internals
- tt <- lapply(1:length(ttmp), function(x, y, z)
- {
- yy <- y[x]
- zz <- z[[x]]
- yy <- getFromNamespace(yy, "RSiena")
- targs <- formals(yy)
- n <- length(targs)
- myargs <- targs
- for (i in 1:n)
- myargs[[i]] <- 1
- myargs['getDocumentation'] <- TRUE
- do.call(yy, myargs)
- }, y=ttmp, z=ttmp2)
- names(tt) <- ttmp
- ## remove the file
- file.remove("RSienafnlist.csv")
- ## reformat this
- ttt <- lapply(1:length(tt), function(x,y)
- {
- yy <- y[[x]]
- n <- length(y[[x]])
- bb <- names(yy)
- t1<- lapply(1:length(yy), function(x, b, a)
- {
- y <- a[[x]]
- bb <- b[[x]]
- n <- length(y)
- if ( n > 0)
- cbind( rep(bb, n), y)
- else
- c( bb, " ")
- }, a=yy, b=bb)
- t2 <- do.call(rbind,t1)
- }, y=tt
- )
-
- tttt <- as.data.frame(do.call(rbind,ttt))
- names(tttt) <- c('Function', 'Calls')
-
- ## create an object that will tabify to the right output
- tmp2 <- codet
-
- tmp4 <- lapply(1 : length(tmp2), function(x, y, z, a)
- {
- n <- length(y[[x]])
- if (n > 0)
- {
- cbind( rep(a[x, 1], n), rep(z[x], n), y[[x]], rep(a[x, 3], n),
- rep(a[x, 4], n))
- }
- else
- {
- cbind(a[x, 1], z[x], " ", a[x, 3], a[x, 4])
- }
-
- }, y=tmp2, z=names(tmp2), a=comms3)
-
- tmp5 <- do.call(rbind, tmp4)
- tmp5 <- as.data.frame(tmp5, stringsAsFactors=FALSE)
- names(tmp5) <- c('Source File', 'Function', 'Calls', 'Type', 'Notes')
-
- ## now merge in the internals
- tmp5bit <- tmp5[tmp5$Function %in%tttt$Function,]
- tmerge <- merge(tmp5bit, tttt, by="Function")
- tmerge <- tmerge[, -3]
- tmerge <- tmerge[, c(2, 1, 5, 3, 4)]
- names(tmerge)[3] <- "Calls"
- tmp5new <- rbind(tmp5[!tmp5$Function %in% tttt$Function,], tmerge)
- tmp55 <- split(tmp5new, tmp5new$Function)
-
- ## same for called by
- tmp6 <- lapply(1 : length(tmp2), function(x, y, z)
- {
- n <- length(y[[x]])
- if (n > 0)
- {
- cbind( rep(z[x], n), y[[x]] )
- }
- else
- {
- cbind(z[x], " ")
- }
-
- }, y=tmp2, z=names(tmp2))
-
- tmp7 <- do.call(rbind, tmp6)
-
- tmp7 <- as.data.frame(tmp7, stringsAsFactors=FALSE)
- names(tmp7) <- c( 'Called from', 'Function')
-
- tmp7 <- tmp7[order(tmp7[,2],tmp7[,1]), ]
-
- tttt7 <- tttt
- names(tttt7) <- c("Called from", "Function")
- tttt7 <- tttt7[order(tttt7[,2],tttt7[,1]), ]
-
- tmp7bit <- tmp7[tmp7$Function %in% tttt7$Function, ]
-
- tmp7new <- merge(tmp7, tttt7, by=c("Function", "Called from"), all=TRUE)
-
- tmp7new <- tmp7new[order(tmp7new[,1], tmp7new[,2]),]
-
- tmp77new <- split(tmp7new, tmp7new$Function)
-
- tmp77new <- tmp77new[-1]
-
- ## create desired output format
- tmp11 <- lapply(1:length(names(tmp55)), function(x,y,z)
- {
- thisone <- names(tmp55)[x]
- yy <- y[[thisone]]
- zz <- z[[thisone]]
- d <- max(nrow(yy), nrow(zz))
- fn <- yy$Function[1]
- src<- yy$`Source File`[1]
- type<- yy$Type[1]
- notes<- yy$Notes[1]
- if (!is.null(zz))
- {
- called <- c(zz[,2], rep(' ', d-nrow(zz)))
- }
- else
- {
- called <- rep(' ', d)
- }
- tmp <- data.frame(src=rep(src,d),
- fun=rep(fn, d),
- type=rep(type, d),
- notes=rep(notes, d),
- calls=c(yy[,3], rep(' ', d-nrow(yy))),
- called=called, stringsAsFactors=FALSE)
- tmp
- }, y=tmp55, z=tmp77new)
- ## join into a data frame
- tmp12 <- do.call(rbind, tmp11)
- names(tmp12)[2] <- "Function"
-
- tmp12 <- tmp12[order(tmp12[, "type"], row.names(tmp12)), ]
- tmp12 <- tmp12[, c(3, 2, 5, 6, 4, 1)]
- ff <- xtable(tmp12)
- ## go back to start directory
- setwd(thisdir)
- print(ff, tabular.environment="longtable",
- file="RSienaRDocumentation.tex", floating=FALSE)
-
- write.csv(tmp12, "RSienaRDocumentation.csv")
-}
+#/******************************************************************************
+# * SIENA: Simulation Investigation for Empirical Network Analysis
+# *
+# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
+# *
+# * File: RSienaRDocumentation.r
+# *
+# * Description: This module contains the code for documenting the
+# * RSiena R source.
+# *****************************************************************************/
+##
+##@getInternals Documentation
+getInternals <- function()
+{
+ fnlist <- read.csv("RSienafnlist.csv", as.is=TRUE)
+ mylist <- ls(parent.frame())
+ ## print(mylist)
+ library(codetools)
+ mylist <- mylist[mylist %in% fnlist[, 3]]
+ mytt <- lapply(mylist, function(x)
+ {
+ x <- get(x, envir=parent.frame(3))
+ if (is.function(x))
+ {
+ tt <- findGlobals(x, merge=FALSE)[[1]]
+ tt2 <- findLocals(body(x))
+ tt <- c(tt, tt2)
+ tt[tt %in% fnlist[, 3]]
+ }
+ else
+ {
+ NULL
+ }
+ }
+ )
+ names(mytt) <- mylist
+ mytt
+}
+##@getRSienaDocumentation Documentation
+getRSienaRDocumentation <- function(Rdir)
+{
+ library(xtable)
+ library(codetools)
+
+ thisdir <- getwd()
+ ## temporarily move directory
+ setwd(Rdir)
+
+ ## extract comment lines
+ shell('grep "##@" *.r *.R > comments.lis')
+ ## read them in
+ comms <- readLines('comments.lis')
+ ## remove the file
+ file.remove("comments.lis")
+ ## remove the shell line
+ comms <- comms[!grepl("comments.lis", comms)]
+ ## split off
+ mystr <- paste("##", "@", sep="")
+ comms1 <- strsplit(comms, mystr)
+ ## join up rest
+ comms2 <- do.call(rbind, comms1)
+ ## turn into dataframe
+ comms3 <- sapply(comms1, function(x)
+ {
+ tmp <- strsplit(x[2], " ")[[1]]
+ if (tmp[2] == "internal")
+ {
+ c(x[1], tmp[1], tmp[2], paste('internal to', tmp[3],
+ collapse=" "))
+ }
+ else
+ {
+ c(x[1], tmp[1], tmp[2], paste(tmp[-c(1,2)],
+ collapse=" "))
+ }
+ }
+ )
+ comms3 <- t(comms3)
+
+ ## get the calls (global)
+ codet <- lapply(comms3[,2], function(x)
+ {
+ x <- try(getFromNamespace(x, "RSiena"), silent=TRUE)
+ if (is.function(x))
+ {
+ tmp1 <- findGlobals(x, merge=FALSE)[[1]]
+ tmp2 <- findLocals(body(x))
+ tmp <- c(tmp1, tmp2)
+ }
+ else
+ tmp <- NULL
+ unique(as.vector(tmp[tmp %in% comms3[,2]]))
+ }
+ )
+ names(codet) <- comms3[, 2]
+
+ ## now the internal ones
+ ## find the list of files from comms3
+ ttmp <- unique(comms3[grepl("internal to", comms3[, 4]), 4])
+ ttmp <- sub("internal to ", "", ttmp)
+ ttmp2 <- comms3[match(ttmp, comms3[, 2]), 1]
+ ttmp2 <- sub(":", "", ttmp2)
+
+ ## write out the fnlist in the Rdir
+ write.csv(data.frame(comms3), "RSienafnlist.csv")
+ ## get the list of internals
+ tt <- lapply(1:length(ttmp), function(x, y, z)
+ {
+ yy <- y[x]
+ zz <- z[[x]]
+ yy <- getFromNamespace(yy, "RSiena")
+ targs <- formals(yy)
+ n <- length(targs)
+ myargs <- targs
+ for (i in 1:n)
+ myargs[[i]] <- 1
+ myargs['getDocumentation'] <- TRUE
+ do.call(yy, myargs)
+ }, y=ttmp, z=ttmp2)
+ names(tt) <- ttmp
+ ## remove the file
+ file.remove("RSienafnlist.csv")
+ ## reformat this
+ ttt <- lapply(1:length(tt), function(x,y)
+ {
+ yy <- y[[x]]
+ n <- length(y[[x]])
+ bb <- names(yy)
+ t1<- lapply(1:length(yy), function(x, b, a)
+ {
+ y <- a[[x]]
+ bb <- b[[x]]
+ n <- length(y)
+ if ( n > 0)
+ cbind( rep(bb, n), y)
+ else
+ c( bb, " ")
+ }, a=yy, b=bb)
+ t2 <- do.call(rbind,t1)
+ }, y=tt
+ )
+
+ tttt <- as.data.frame(do.call(rbind,ttt))
+ names(tttt) <- c('Function', 'Calls')
+
+ ## create an object that will tabify to the right output
+ tmp2 <- codet
+
+ tmp4 <- lapply(1 : length(tmp2), function(x, y, z, a)
+ {
+ n <- length(y[[x]])
+ if (n > 0)
+ {
+ cbind( rep(a[x, 1], n), rep(z[x], n), y[[x]], rep(a[x, 3], n),
+ rep(a[x, 4], n))
+ }
+ else
+ {
+ cbind(a[x, 1], z[x], " ", a[x, 3], a[x, 4])
+ }
+
+ }, y=tmp2, z=names(tmp2), a=comms3)
+
+ tmp5 <- do.call(rbind, tmp4)
+ tmp5 <- as.data.frame(tmp5, stringsAsFactors=FALSE)
+ names(tmp5) <- c('Source File', 'Function', 'Calls', 'Type', 'Notes')
+
+ ## now merge in the internals
+ tmp5bit <- tmp5[tmp5$Function %in%tttt$Function,]
+ tmerge <- merge(tmp5bit, tttt, by="Function")
+ tmerge <- tmerge[, -3]
+ tmerge <- tmerge[, c(2, 1, 5, 3, 4)]
+ names(tmerge)[3] <- "Calls"
+ tmp5new <- rbind(tmp5[!tmp5$Function %in% tttt$Function,], tmerge)
+ tmp55 <- split(tmp5new, tmp5new$Function)
+
+ ## same for called by
+ tmp6 <- lapply(1 : length(tmp2), function(x, y, z)
+ {
+ n <- length(y[[x]])
+ if (n > 0)
+ {
+ cbind( rep(z[x], n), y[[x]] )
+ }
+ else
+ {
+ cbind(z[x], " ")
+ }
+
+ }, y=tmp2, z=names(tmp2))
+
+ tmp7 <- do.call(rbind, tmp6)
+
+ tmp7 <- as.data.frame(tmp7, stringsAsFactors=FALSE)
+ names(tmp7) <- c( 'Called from', 'Function')
+
+ tmp7 <- tmp7[order(tmp7[,2],tmp7[,1]), ]
+
+ tttt7 <- tttt
+ names(tttt7) <- c("Called from", "Function")
+ tttt7 <- tttt7[order(tttt7[,2],tttt7[,1]), ]
+
+ tmp7bit <- tmp7[tmp7$Function %in% tttt7$Function, ]
+
+ tmp7new <- merge(tmp7, tttt7, by=c("Function", "Called from"), all=TRUE)
+
+ tmp7new <- tmp7new[order(tmp7new[,1], tmp7new[,2]),]
+
+ tmp77new <- split(tmp7new, tmp7new$Function)
+
+ tmp77new <- tmp77new[-1]
+
+ ## create desired output format
+ tmp11 <- lapply(1:length(names(tmp55)), function(x,y,z)
+ {
+ thisone <- names(tmp55)[x]
+ yy <- y[[thisone]]
+ zz <- z[[thisone]]
+ d <- max(nrow(yy), nrow(zz))
+ fn <- yy$Function[1]
+ src<- yy$`Source File`[1]
+ type<- yy$Type[1]
+ notes<- yy$Notes[1]
+ if (!is.null(zz))
+ {
+ called <- c(zz[,2], rep(' ', d-nrow(zz)))
+ }
+ else
+ {
+ called <- rep(' ', d)
+ }
+ tmp <- data.frame(src=rep(src,d),
+ fun=rep(fn, d),
+ type=rep(type, d),
+ notes=rep(notes, d),
+ calls=c(yy[,3], rep(' ', d-nrow(yy))),
+ called=called, stringsAsFactors=FALSE)
+ tmp
+ }, y=tmp55, z=tmp77new)
+ ## join into a data frame
+ tmp12 <- do.call(rbind, tmp11)
+ names(tmp12)[2] <- "Function"
+
+ tmp12 <- tmp12[order(tmp12[, "type"], row.names(tmp12)), ]
+ tmp12 <- tmp12[, c(3, 2, 5, 6, 4, 1)]
+ ff <- xtable(tmp12)
+ ## go back to start directory
+ setwd(thisdir)
+ print(ff, tabular.environment="longtable",
+ file="RSienaRDocumentation.tex", floating=FALSE)
+
+ write.csv(tmp12, "RSienaRDocumentation.csv")
+}
Property changes on: pkg/RSiena/R/RSienaRDocumentation.r
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: pkg/RSiena/R/Sienatest.r
===================================================================
--- pkg/RSiena/R/Sienatest.r 2009-09-23 16:19:59 UTC (rev 15)
+++ pkg/RSiena/R/Sienatest.r 2009-10-31 21:31:02 UTC (rev 16)
@@ -1,228 +1,228 @@
-#/******************************************************************************
-# * SIENA: Simulation Investigation for Empirical Network Analysis
-# *
-# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
-# *
-# * File: Sienatest.r
-# *
-# * Description: This module contains the function for instability analysis and
-# * score tests.
-# *
-# *****************************************************************************/
-##@InstabilityAnalysis siena07 Not currently used
-InstabilityAnalysis<- function(z)
-{
- ##I think this is not correct, because of scaling. cond number of var matrix of X
- ## can be obtained via svd(data) (which is stored in z$sf). Square of ratio
- ## of smallest to largest singular value.
- Report('Instability Analysis\n')
- pp<- length(z$diver)
- constant<- z$diver
- test<- z$test
- covtheta<- z$covtheta
- covZ<- z$msf
- covth<- covtheta[!(test|constant),!(test|constant)]
- covth<- MatrixNorm(covth)
- eigenv<- eigen(covth,symmetric=TRUE)$values
- ma<- max(eigenv)
- mi<- min(eigenv)
- if (mi!=0)
- cond.n <- ma/mi
- Report('Instability analysis\n',lf)
- Report('--------------------\n\n',lf)
- Report('Variance-covariance matrix of parameter estimates',lf)
- ##if (global boolean1 )
- ## Report(' (without coordinates that are kept constant):\n',lf)
- ##else
- Report(c(':\n\nCondition number = ',format(cond.n,width=4,nsmall=4,digits=1),
- ' \n\n'),sep='',lf)
- Report(c('Eigen Values ',format(eigenv,width=6,nsmall=6,digits=1)),lf)
- Report('\n\n',lf)
- covZ<- MatrixNorm(covZ)
- eigenvZ<-eigen(covZ,symmetric=TRUE)$values
- ma<- max(eigenvZ)
- mi<- min(eigenvZ)
- if (mi!=0)
- cond.n <- ma/mi
- Report('Variance-covariance matrix of X',lf)
- Report(c(':\n\nCondition number = ',format(cond.n,width=4,nsmall=4,digits=1),
- ' \n\n'),sep='',lf)
- Report(c('Eigen Values ',format(eigenvZ,width=6,nsmall=6,digits=1)),lf)
- Report(c('\n\n',date(),'\n'),sep='',lf)
- mysvd<- svd(z$sf)$d
- ma<- max(mysvd)
- mi<- min(mysvd)
- cond.n<- (ma/mi)^2
- Report(c(':\n\nCondition number2 = ',format(cond.n,width=4,nsmall=4,digits=1),
- ' \n\n'),sep='',lf)
- Report(c('Singular Values ',format(mysvd,width=6,nsmall=6,digits=1)),lf)
- Report(c('\n\n',date(),'\n'),sep='',lf)
-}
-
-##@MatrixNorm siena07 Not currently used. May be incorrect.
-MatrixNorm<- function(mat)
-{
- tmp<- apply(mat,2,function(x)x/sqrt(crossprod(x)))
- ##or sweep(mat,2,apply(mat,2,function(x)x/sqrt(crossprod(x))
- tmp
-}
-##@TestOutput siena07 Print report
-TestOutput <- function(z,x)
-{
- testn<- sum(z$test)
- # browser()
- if (testn)
- {
- if (x$maxlike)
- Heading(2, outf,'Score test <c>')
- else
- Heading(2, outf, 'Generalised score test <c>')
- Report('Testing the goodness-of-fit of the model restricted by\n',outf)
- j<- 0
- for (k in 1:z$pp)
- if (z$test[k])
- {
- j<- j+1
- Report(c(' (',j,') ',format(paste(z$effects$type[k],': ',
- z$effects$effectName[k],
- sep=''),
- width=50),' = ',
- sprintf("%8.4f",z$theta[k]),'\n'),
- sep = '', outf)
- }
- Report('_________________________________________________\n',outf)
- Report(' ',outf)
- Report(' \n',outf)
- if (testn > 1)
- Report('Joint test:\n-----------\n',outf)
- Report(c(' c = ',sprintf("%8.4f",z$testresOverall),
- ' d.f. = ',j,' p-value '),sep='',outf)
- pvalue <- 1-pchisq(z$testresOverall,j)
- if (pvalue < 0.0001)
- Report('< 0.0001',outf)
- else
- Report(c('= ',sprintf("%8.4f",pvalue)), sep = '', outf)
- if (testn==1)
- Report(c('\n one-sided (normal variate): ',
- sprintf("%8.4f",z$testresulto[1])), sep = '', outf)
- if (testn> 1)
- {
- Report('\n\n',outf)
- for (k in 1:j)
- {
- Report(c('(',k,') tested separately:\n'),sep='',outf)
- Report('-----------------------\n',outf)
- Report(' - two-sided:\n',outf)
- Report(c(' c = ', sprintf("%8.4f", z$testresult[k]),
- ' d.f. = 1 p-value '), sep = '', outf)
- pvalue<- 1-pchisq(z$testresult[k],1)
- if (pvalue < 0.0001)
- Report('< 0.0001\n',outf)
- else
- Report(c('= ', sprintf("%8.4f", pvalue), '\n'), sep = '',
- outf)
- Report(c(' - one-sided (normal variate): ',
- sprintf("%8.4f", z$testresulto[k])), sep = '', outf)
- if (k<j)
- Report('\n\n',outf)
- }
- }
- Report(' \n_________________________________________________\n\n',outf)
- Report('One-step estimates: \n\n',outf)
- for (i in 1 : z$pp)
- {
- onestepest<- z$oneStep[i]+z$theta[i]
- Report(c(format(paste(z$effects$type[i],': ',
- z$effects$effectName[i], sep = ''),
- width=50),
- sprintf("%8.4f", onestepest), '\n'), sep = '', outf)
- }
- Report('\n',outf)
- }
-}
-##@ScoreTest siena07 Do score tests
-ScoreTest<- function(z,x)
-{
- z$testresult<- rep(NA,z$pp) ##for chisq per parameter
- z$testresulto <- rep(NA,z$pp) ##for one-sided tests per parameter
- ##first the general one
- ans<-EvaluateTestStatistic(x,z$test,z$dfra,z$msf,z$fra)
- z$testresOverall<- ans$cvalue
- if (sum(z$test)==1)
- z$testresulto[1]<- ans$oneSided
- else
- {
- ## single df tests
- use<- !z$test
- k<- 0
- for (i in 1:z$pp)
- {
- if (z$test[i])
- {
- k<- k+1
- use[i]<- TRUE
- ans<-EvaluateTestStatistic(x,z$test[use],z$dfra[use,use],
- z$msf[use,use],z$fra[use])
- z$testresult[k]<- ans$cvalue
- z$testresulto[k]<- ans$oneSided
- use[i]<- FALSE
- }
- }
- }
- ##onestep estimator
- if (x$maxlike)
- dfra2<- z$dfra+ z$msf
- else
- dfra2<- z$dfra
- dinv2<- solve(dfra2)
- z$oneStep<- -dinv2%*%z$fra
- z
-}
-##@EvaluateTestStatistic siena07 Calculate score test statistics
-EvaluateTestStatistic<- function(x,test,dfra,msf,fra)
-{
- ##uses local arrays set up in the calling procedure
- d11 <- dfra[!test,!test,drop=FALSE]
- d22 <- dfra[test,test,drop=FALSE]
- d21 <- dfra[test,!test,drop=FALSE]
- d12 <- t(d21)
- sigma11 <- msf[!test,!test,drop=FALSE]
- sigma22<- msf[test,test,drop=FALSE]
- sigma12 <- msf[!test,test,drop=FALSE]
- sigma21<- t(sigma12)
- z1 <- fra[!test]
- z2 <- fra[test]
- id11 <- solve(d11)
- rg<- d21%*%id11
- if (!x$maxlike)
- {
- ##orthogonalise deviation vector
- ov<- z2-rg%*%z1
- ##compute var(ov) = sigma22- (d21%*%id11) %*%sigma12 -
- ## sigma21 %*% t(id11)%*% t(d21) +
- ## d21%*%id11 %*% sigma11 %*% t(id11) %*% t(d21)
- v2<- sigma21 - rg%*%sigma11
- v6<- v2 %*% t(id11) %*% t(d21)
- v9<- sigma22 - rg %*% sigma12 -v6
- }
- else
- {
- ov <- -z2
- v9 <- d22 - rg %*% d12
- }
- vav<- solve(v9) ## vav is the inverse variance matrix of ov
- cvalue <- t(ov) %*% vav %*% ov
- if (cvalue < 0) cvalue <- 0
- if (sum(test)==1)
- {
- if (vav>0)
- oneSided <- ov * sqrt(vav)
- else
- oneSided <- 0
- if (!x$maxlike) oneSided<- - oneSided
- ## change the sign for intuition for users
- }
- else
- oneSided <- 0
- list(cvalue=cvalue,oneSided=oneSided)
-}
+#/******************************************************************************
+# * SIENA: Simulation Investigation for Empirical Network Analysis
+# *
+# * Web: http://www.stats.ox.ac.uk/~snidjers/siena
+# *
+# * File: Sienatest.r
+# *
+# * Description: This module contains the function for instability analysis and
+# * score tests.
+# *
+# *****************************************************************************/
+##@InstabilityAnalysis siena07 Not currently used
+InstabilityAnalysis<- function(z)
+{
+ ##I think this is not correct, because of scaling. cond number of var matrix of X
+ ## can be obtained via svd(data) (which is stored in z$sf). Square of ratio
+ ## of smallest to largest singular value.
+ Report('Instability Analysis\n')
+ pp<- length(z$diver)
+ constant<- z$diver
+ test<- z$test
+ covtheta<- z$covtheta
+ covZ<- z$msf
+ covth<- covtheta[!(test|constant),!(test|constant)]
+ covth<- MatrixNorm(covth)
+ eigenv<- eigen(covth,symmetric=TRUE)$values
+ ma<- max(eigenv)
+ mi<- min(eigenv)
+ if (mi!=0)
+ cond.n <- ma/mi
+ Report('Instability analysis\n',lf)
+ Report('--------------------\n\n',lf)
+ Report('Variance-covariance matrix of parameter estimates',lf)
+ ##if (global boolean1 )
+ ## Report(' (without coordinates that are kept constant):\n',lf)
+ ##else
+ Report(c(':\n\nCondition number = ',format(cond.n,width=4,nsmall=4,digits=1),
+ ' \n\n'),sep='',lf)
+ Report(c('Eigen Values ',format(eigenv,width=6,nsmall=6,digits=1)),lf)
+ Report('\n\n',lf)
+ covZ<- MatrixNorm(covZ)
+ eigenvZ<-eigen(covZ,symmetric=TRUE)$values
+ ma<- max(eigenvZ)
+ mi<- min(eigenvZ)
+ if (mi!=0)
+ cond.n <- ma/mi
+ Report('Variance-covariance matrix of X',lf)
+ Report(c(':\n\nCondition number = ',format(cond.n,width=4,nsmall=4,digits=1),
+ ' \n\n'),sep='',lf)
+ Report(c('Eigen Values ',format(eigenvZ,width=6,nsmall=6,digits=1)),lf)
+ Report(c('\n\n',date(),'\n'),sep='',lf)
+ mysvd<- svd(z$sf)$d
+ ma<- max(mysvd)
+ mi<- min(mysvd)
+ cond.n<- (ma/mi)^2
+ Report(c(':\n\nCondition number2 = ',format(cond.n,width=4,nsmall=4,digits=1),
+ ' \n\n'),sep='',lf)
+ Report(c('Singular Values ',format(mysvd,width=6,nsmall=6,digits=1)),lf)
+ Report(c('\n\n',date(),'\n'),sep='',lf)
+}
+
+##@MatrixNorm siena07 Not currently used. May be incorrect.
+MatrixNorm<- function(mat)
+{
+ tmp<- apply(mat,2,function(x)x/sqrt(crossprod(x)))
+ ##or sweep(mat,2,apply(mat,2,function(x)x/sqrt(crossprod(x))
+ tmp
+}
+##@TestOutput siena07 Print report
+TestOutput <- function(z,x)
+{
+ testn<- sum(z$test)
+ # browser()
+ if (testn)
+ {
+ if (x$maxlike)
+ Heading(2, outf,'Score test <c>')
+ else
+ Heading(2, outf, 'Generalised score test <c>')
+ Report('Testing the goodness-of-fit of the model restricted by\n',outf)
+ j<- 0
+ for (k in 1:z$pp)
+ if (z$test[k])
+ {
+ j<- j+1
+ Report(c(' (',j,') ',format(paste(z$effects$type[k],': ',
+ z$effects$effectName[k],
+ sep=''),
+ width=50),' = ',
+ sprintf("%8.4f",z$theta[k]),'\n'),
+ sep = '', outf)
+ }
+ Report('_________________________________________________\n',outf)
+ Report(' ',outf)
+ Report(' \n',outf)
+ if (testn > 1)
+ Report('Joint test:\n-----------\n',outf)
+ Report(c(' c = ',sprintf("%8.4f",z$testresOverall),
+ ' d.f. = ',j,' p-value '),sep='',outf)
+ pvalue <- 1-pchisq(z$testresOverall,j)
+ if (pvalue < 0.0001)
+ Report('< 0.0001',outf)
+ else
+ Report(c('= ',sprintf("%8.4f",pvalue)), sep = '', outf)
+ if (testn==1)
+ Report(c('\n one-sided (normal variate): ',
+ sprintf("%8.4f",z$testresulto[1])), sep = '', outf)
+ if (testn> 1)
+ {
+ Report('\n\n',outf)
+ for (k in 1:j)
+ {
+ Report(c('(',k,') tested separately:\n'),sep='',outf)
+ Report('-----------------------\n',outf)
+ Report(' - two-sided:\n',outf)
+ Report(c(' c = ', sprintf("%8.4f", z$testresult[k]),
+ ' d.f. = 1 p-value '), sep = '', outf)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rsiena -r 16
More information about the Rsiena-commits
mailing list