[med-svn] [r-cran-blockmodeling] 01/08: New upstream version 0.1.9
Andreas Tille
tille at debian.org
Fri Sep 8 06:55:18 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-blockmodeling.
commit 101c366a0d0368f0eab0c797556987a044f96804
Author: Andreas Tille <tille at debian.org>
Date: Fri Sep 8 08:39:40 2017 +0200
New upstream version 0.1.9
---
CHANGES | 13 +++++-
DESCRIPTION | 25 ++++------
MD5 | 109 +++++++++++++++++++++++++++++++++++++++++++
NAMESPACE | 8 +++-
R/REGE_for.R | 28 +++++------
R/check.these.par.R | 3 +-
R/crit.fun.R | 4 ++
R/gen.crit.fun.R | 10 ++--
R/gen.opt.par.R | 8 ++--
R/gplot.R | 6 +--
R/loadnetwork.R | 12 ++---
R/loadnetwork2.R | 12 ++---
R/loadpajek.R | 2 +-
R/opt.par.R | 4 ++
R/opt.random.par.R | 4 +-
R/opt.these.par.R | 6 ++-
R/plot.mat.R | 2 +-
R/savecluster.R | 2 +-
R/savematrix.R | 2 +-
R/savenetwork.R | 4 +-
R/savepajek.R | 2 +-
R/savevector.R | 2 +-
man/REGE.Rd | 4 --
man/blockmodeling-package.Rd | 2 +-
man/crit.fun.Rd | 27 +++++++++++
man/genRandomPar.Rd | 2 +-
man/opt.random.par.Rd | 2 +-
src/REGD_NE_R.f90 | 2 +-
src/REGD_R.f90 | 2 +-
src/init.c | 57 ++++++++++++++++++++++
30 files changed, 288 insertions(+), 78 deletions(-)
diff --git a/CHANGES b/CHANGES
index 14f0875..8f01ebc 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,6 +1,15 @@
Name: blockmodeling
-Title: An R package for Generalized and classical blockmodeling of valued networks
-Version: 0.1.7
+Title: An R Package for Generalized and Classical Blockmodeling of Valued Networks
+Version: 0.1.9
+
+December 7, 2016
+New version: 0.1.9
+Addapted to not give warnings on R check
+
+January 12, 2010:
+New version: 0.1.8
+Some minor bug fixes
+Addapted to be compatible with new version of R.
February 8, 2009:
A bug fixed in savevector, savenetwork and savematrix. Now these functions should aslo work on non-windows systems.
diff --git a/DESCRIPTION b/DESCRIPTION
index 7a4bdf8..1dfe7aa 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,22 +1,17 @@
Package: blockmodeling
Type: Package
-Title: An R package for Generalized and classical blockmodeling of
- valued networks
-Version: 0.1.8
-Date: 2010-01-12
-Imports: stats
+Title: An R Package for Generalized and Classical Blockmodeling of
+ Valued Networks
+Version: 0.1.9
+Date: 2017-07-02
+Imports: stats, methods
Suggests: sna, Matrix
Author: Ales Ziberna
Maintainer: Ales Ziberna <ales.ziberna at gmail.com>
-Description: The package is primarly ment as an implementation of
- Generalized blockmodeling for valued networks. In addition,
- measurese of similarity or dissimilarity based on structural
- equivalence and regular equivalence (REGE algorithem) can be
- computed and partitioned matrices can be ploted.
-License: GPL (>= 2)
+Description: This is primarily meant as an implementation of Generalized blockmodeling for valued networks. In addition, measures of similarity or dissimilarity based on structural equivalence and regular equivalence (REGE algorithm) can be computed and partitioned matrices can be plotted. This is a CRAN version. A newer version is available on R-forge, which for however lacks help files.
+License: GPL-2 | GPL-3
Encoding: UTF-8
+NeedsCompilation: yes
+Packaged: 2017-07-03 13:04:28 UTC; zibernaa
Repository: CRAN
-Repository/R-Forge/Project: blockmodeling
-Repository/R-Forge/Revision: 26
-Date/Publication: 2010-01-13 15:43:51
-Packaged: 2010-01-12 21:10:55 UTC; rforge
+Date/Publication: 2017-07-03 13:29:03 UTC
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..dbd6635
--- /dev/null
+++ b/MD5
@@ -0,0 +1,109 @@
+78a7ab16f29f637c5ec2a756a1cb5e01 *CHANGES
+685c6872b36d339b3194aa35697e9faf *DESCRIPTION
+f62eb0e79caff472eea25019b3339406 *NAMESPACE
+db734e1bfa1d22e3057002e27a93f5cd *R/IM.R
+3ac8e889e539ebcddfce9b06116c3a29 *R/REGE.FC.R
+727dcc0bba82292d4891430e98e909b1 *R/REGE.FC.ow.R
+7d966022a14f3022931c7c37917b86b9 *R/REGE.R
+f4c2c791561a7473780a51b7ff113984 *R/REGE.ow.R
+10892b7742b1e25c8161b0d46cff47e1 *R/REGE_for.R
+0462637eb324ebc7a292036db143370a *R/ad.R
+73221da7929ef5e10003990f248efc77 *R/check.these.par.R
+9d68cec02e267de15e54d237dbcbc31f *R/clu.R
+601ded4f03167badfeac1a6939e2c538 *R/crand.R
+4c97f844190be3a00bedd110fc66057c *R/crand2.R
+44b75ea2b5a7c5d76221fa552e8374c0 *R/crit.fun.R
+06764e6237e416845a90c9f564162b8a *R/err.R
+df5a5a7fea005e084b0161ccb5af993a *R/find.cut.R
+a977bb36598f9afc57c031d0dc71ea35 *R/find.m.R
+c6167792777eeaf8727d430d82e26899 *R/find.m2.R
+0d402201cbc4fee68d9d983360aafe3b *R/formatA.R
+3381111228d5eda92f751d79fc81a829 *R/fun.by.blocks.R
+a38840a5d3f37002599580397db15717 *R/fun.by.blocks.default.R
+d32292104d5f90c9e972ce2f221bb8b9 *R/fun.by.blocks.opt.more.par.R
+4c35db17d7b3cbfade898bd3e001a85f *R/gen.crit.fun.R
+4367f57cddb1821273335d5307867320 *R/gen.opt.par.R
+c74f7342180c231948edd0d2c35b819c *R/genRandomPar.R
+6471680113a196880a13826db1279a70 *R/genRandomParGroups.R
+d6eba01f943aa724ebf1826f14d2a487 *R/gplot.R
+caa622aa57f49ef911d4092475b47010 *R/ircNorm.R
+093a9c50c339915ef4ac0e0b48fcfdbe *R/loadmatrix.R
+2af1122d6fb10a407780bc4ad6408941 *R/loadnetwork.R
+19db10fc632785c51f4ee4d254501e4d *R/loadnetwork2.R
+9783501bd9fe4dc59f0e391e661fb67b *R/loadpajek.R
+9f0933075dc58648c567f6027b0be683 *R/loadvector.R
+a4d7c0c481c4ff85c9777b264c98c0c6 *R/loadvector2.R
+ef2edf6e5ff44270119306a108458aac *R/mean.max.col.R
+c5c9b0bb964a09c8ca251539ce0b65bc *R/mean.max.row.R
+0949efc03bfecf760f309b6cd674e915 *R/meanpos.R
+ea963ede050b8166e03e93df69282344 *R/nkpar.R
+8472ede47bbb38971741f8d2b516059b *R/nkpartitions.R
+e7942ed973f79375fe4ef4cab477a948 *R/one2two.R
+309adeb2867cdeb4641bf5a7485df2e2 *R/opt.par.R
+1280df3f7c4cbb142f6e79dc3491b477 *R/opt.random.par.R
+723bf832e943f7fe30a61b68282d4771 *R/opt.these.par.R
+85b3127c3cea0e54ff37382b36e04226 *R/parOKgroups.R
+1c0500ce587f38efb1b6c43d10f68a0f *R/plot.check.these.par.R
+871d52ed689b3fbbb0c7a6f6b1da969b *R/plot.crit.fun.R
+27e889ce4ee6b6302f3720a42753523b *R/plot.mat.R
+d5cf9e254e6883f7da4b274bfb83c8af *R/plot.mat.nm.R
+26574da588edffa972704643bed40385 *R/plot.opt.more.par.R
+a5defacfcf43caecb72e8abc0efa44a4 *R/plot.opt.more.par.mode.R
+a18d7e750d0bd79169ed6d15d914cf50 *R/plot.opt.par.R
+35d41e265eb1fd901971a930e01348e8 *R/plot.opt.par.mode.R
+9eb44fbc9c6d4fa5d37392a89ad6b6f8 *R/rand.R
+00246d8c66e181e31c12714bf6bf5562 *R/rand2.R
+573b1c8048f9a5801f2150579ac3d09b *R/recode.R
+b29784b7003e28f426a4c354f4aa3f39 *R/reorderImage.R
+8a1e7e47ee3647d7824b639ddb15a55f *R/savecluster.R
+c11ee17a795138caa7a91f0188a114a1 *R/savematrix.R
+c0d398ecc0e188afaacae5b3d28ff83f *R/savenetwork.R
+f042522f4664938a07a838218ff6a599 *R/savepajek.R
+bef7f3ca7f34f0dfbc4f54c9e2635f4d *R/savevector.R
+3448937243577a4a498a7edb31f7da3c *R/sedist.R
+ad59aec2182068c236097be840bccc6e *R/ss.R
+83f0894ed4e7b2baebc45ce5e4d3ea1a *R/sumpos.R
+57d9f97d53a521b00cb96f961f8c40d6 *R/two2one.R
+cf56197339441d8de415e553dd25c348 *R/useneg.R
+5c0c2aad9d5189b18bde757c5a4c595d *R/usepos.R
+38f96ceb382b8c3428b584ca53c810da *man/Pajek.Rd
+ff16ab4c4d1a052f88bd1394031da05a *man/REGE.Rd
+7021336091cc42a2c8cbf2ac9a0e1e26 *man/blockmodeling-package.Rd
+0a302972f1704b07281863a6909b86d8 *man/check.these.par.Rd
+4e60e804f06dc8fd208ead083241fcd9 *man/clu.Rd
+359de21145afbacef5c48ad76eb2d7cf *man/crit.fun.Rd
+4cb3b84bb1314673c743ae8f68088c8b *man/find.m.Rd
+fd829fa12cc7cdaef1ae3ae31d7177bb *man/formatA.Rd
+e5d41175152b104acfd5c4d729c4bab8 *man/fun.by.blocks.Rd
+7e37211c43db225ac7969bfddf3ff545 *man/genRandomPar.Rd
+f96ce260c3e6c2806237d273431ddcf1 *man/gplot1.Rd
+5f2f2bc69f3c8fc48e2fc014d09c0e57 *man/ircNorm.Rd
+5f8351b73d8fed500a56527325d770a3 *man/nkpartitions.Rd
+63913c6872d75cdf931fbbc0968908ad *man/opt.par.Rd
+8fe95b38b95e30146bc796b670ee7979 *man/opt.random.par.Rd
+4ad473a57af39a7fe69798a4fd96918d *man/plot.mat.Rd
+944a302498d3d232b77835b6192e97b6 *man/rand.Rd
+dfbb5d39a770c6ed5175ad4543321b48 *man/recode.Rd
+51f39556592659a0d83247ef42e1895f *man/reorderImage.Rd
+61b0990e9cf220f57562d19b4925a4c0 *man/sedist.Rd
+dfa38d3eed5dd63b1a67df526f778bb1 *man/ss.Rd
+d40c3f157231862e59b3fcc764494227 *man/two2one.Rd
+c4ee7ce96a3f1c356b5bd1d3e01f93ba *src/REGD_NE_R.f90
+3baf9084c6c77f62ac8b3676ad81cc07 *src/REGD_OW_NE_R.f90
+532e6e17bfc2b32594116409e84949ab *src/REGD_OW_R.f90
+2e77fce72c78f5c41afe70361c9ccfba *src/REGD_R.f90
+6778a7e33182298c0f4749daef39f72b *src/REGE_NE_R.f90
+40fcdc88221b4416a949efeb7aee0f3a *src/REGE_NM_DIAG_R.f90
+d190202a85cc1098f68086384fda645c *src/REGE_NM_NE_R.f90
+584adb960410a03e3ed615c6fc004a09 *src/REGE_NM_R.f90
+31fe95b1095865f376e5d3da08d7a7af *src/REGE_OWNM_DIAG_R.f90
+8bb7cf306b4934e48837fd50d13a20d3 *src/REGE_OWNM_NE_R.f90
+cfb54b286212bc9eeeb6b2b996bd67b9 *src/REGE_OWNM_R.f90
+21b5ef693769e7f78f280d525cff9611 *src/REGE_OW_NE_R.f90
+3886927020893d9dbe8457072f5671fc *src/REGE_OW_R.f90
+2ec2b06c10fe87236bb1b1426f58bca1 *src/REGE_R.f90
+5042baa4c468cd07fc0cf32e230987ab *src/init.c
+0955664133907bb9b49ecf6dc35ba88c *src/opt_par_ss_com.f90
+e73c104826a4479da565feb927cfd927 *src/opt_par_ss_com_twoMode.f90
+899cee9d9586fbe0a2ffaf0da5b2fd1f *src/opt_par_ss_com_twoMode_forMoreRel.f90
+e8ec5794c034630341803faa04b37752 *src/ss_blocks.f90
diff --git a/NAMESPACE b/NAMESPACE
index 0c30226..9791c40 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,13 @@
-useDynLib(blockmodeling)
+useDynLib(blockmodeling,.registration = TRUE)
#importFrom(sna, gplot)
+importFrom("grDevices", "gray", "grey")
+importFrom("graphics", "mtext", "par", "plot.default", "rect", "segments", "text", "title")
+importFrom("methods", "as")
+importFrom("stats", "as.dist", "median", "na.omit", "optimize", "runif")
+importFrom("utils", "read.table", "write.table")
+
export(check.these.par, crit.fun, opt.par, opt.random.par, opt.these.par) #basic front end functions
export(genRandomPar)
export(plot.mat,plot.mat.nm)
diff --git a/R/REGE_for.R b/R/REGE_for.R
index 108ed46..52c25dc 100644
--- a/R/REGE_for.R
+++ b/R/REGE_for.R
@@ -19,7 +19,7 @@ REGE.for<-function(
dimnames(M)<-dnM
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("rege",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(rege,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -49,7 +49,7 @@ REGD.for<-function(
dimnames(M)<-dnM
E<-matrix(as.double(E),ncol=N, nrow=N)
- res<-.Fortran("regd",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regd,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -79,7 +79,7 @@ REGE.ow.for<-function(
M<-structure(as.double(M),dim=dM)
dimnames(M)<-dnM
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regeow",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regeow,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -108,7 +108,7 @@ REGD.ow.for<-function(
dimnames(M)<-dnM
E<-matrix(as.double(E),ncol=N, nrow=N)
- res<-.Fortran("regdow",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regdow,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -156,7 +156,7 @@ REGE.ownm.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regeownm",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regeownm,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -202,7 +202,7 @@ REGE.ownm.diag.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regeownmdiag",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regeownmdiag,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -250,7 +250,7 @@ REGE.nm.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regenm",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regenm,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -295,7 +295,7 @@ REGE.nm.diag.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regenmdiag",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regenmdiag,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -329,7 +329,7 @@ REGE.ne.for<-function(
dimnames(M)<-dnM
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regene",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regene,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -358,7 +358,7 @@ REGE.ow.ne.for<-function(
M<-structure(as.double(M),dim=dM)
dimnames(M)<-dnM
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regeowne",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regeowne,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -403,7 +403,7 @@ REGE.ownm.ne.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regeownmne",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regeownmne,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -451,7 +451,7 @@ REGE.nm.ne.for<-function(
}
E<-matrix(E,ncol=N, nrow=N)
- res<-.Fortran("regenmne",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regenmne,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -481,7 +481,7 @@ REGD.ne.for<-function(
dimnames(M)<-dnM
E<-matrix(as.double(E),ncol=N, nrow=N)
- res<-.Fortran("regdne",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regdne,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
@@ -512,7 +512,7 @@ REGD.ow.ne.for<-function(
dimnames(M)<-dnM
E<-matrix(as.double(E),ncol=N, nrow=N)
- res<-.Fortran("regdowne",M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
+ res<-.Fortran(regdowne,M = M, E = E, N = as.integer(N), NR = as.integer(NR), iter = as.integer(iter))
Eall<-array(NA,dim=c(dim(E),2))
Eall[,,1]<-E
Eall[,,2]<-res$E
diff --git a/R/check.these.par.R b/R/check.these.par.R
index bebd7d6..8113884 100644
--- a/R/check.these.par.R
+++ b/R/check.these.par.R
@@ -1,3 +1,5 @@
+if(getRversion() >= "2.15.1") utils::globalVariables(c('crit.fun.tmp','useM'))
+
"check.these.par" <-
function( #saves the resoult of call a to crit.fun of the best partition and only errors for the rest
M, #matrix (network)
@@ -20,7 +22,6 @@ function( #saves the resoult of call a to crit.fun of the best partition and onl
} else k<-length(unique(partitions[[1]]))
eval(gen.crit.fun(M=M,k=k,approach=approach,changeT=FALSE,...))
-
res<-crit.fun.tmp(M=useM,clu=partitions[[1]])
best<-list(res)
err[1]<-res$err
diff --git a/R/crit.fun.R b/R/crit.fun.R
index 69c1c7e..afefac9 100644
--- a/R/crit.fun.R
+++ b/R/crit.fun.R
@@ -1,3 +1,5 @@
+if(getRversion() >= "2.15.1") utils::globalVariables(c('crit.fun.tmp','useM'))
+
"crit.fun" <-
function(
#function for generting a function for computing criteria function of a blockmodel and preparing data
@@ -40,6 +42,8 @@ function(
}
eval(gen.crit.fun(M=M,k=k,approach=approach,changeT=FALSE,...))
+
+
res<-c(list(M=M),crit.fun.tmp(M=useM,clu=clu),call=match.call())
class(res)<-"crit.fun"
return(res)
diff --git a/R/gen.crit.fun.R b/R/gen.crit.fun.R
index 73f0b78..ec0609e 100644
--- a/R/gen.crit.fun.R
+++ b/R/gen.crit.fun.R
@@ -176,7 +176,7 @@ function(
dn<-dimnames(M)
k<-as.integer(",k[1],")
clu<-as.integer(factor(clu))
- res<- .Fortran('critfunsscom',M=matrix(as.double(M),ncol=n),n=n,clu=clu, k=k,diag=",diag,",err=0,E=diag(k), BM=diag(k))
+ res<- .Fortran(critfunsscom,M=matrix(as.double(M),ncol=n),n=n,clu=clu, k=k,diag=",diag,",err=0,E=diag(k), BM=diag(k))
class(res)<-'crit.fun'
dn->dimnames(res$M)
IM<-res$E
@@ -339,8 +339,8 @@ function(
if(any(max.con.val!="non")){
if(nr==1){
if(max.con.val=="m")max.con.val<-m
- if(max.con.val=="s")max.con.val<-s
- if(!is.numeric(max.con.val))stop('"max.con.val" must me numeric or a strig with a value "m", "s" or "non"!')
+ #if(max.con.val=="s")max.con.val<-s
+ if(!is.numeric(max.con.val))stop('"max.con.val" must me numeric or a strig with a value "m" or "non"!')
M[M>max.con.val]<-max.con.val
M[M<(-max.con.val)]<- (-max.con.val)
@@ -348,9 +348,9 @@ function(
for(i in 1:nr){
tmax.con.val<-max.con.val[i]
if(tmax.con.val=="m")tmax.con.val<-m[i]
- if(tmax.con.val=="s")tmax.con.val<-s[i]
+ #if(tmax.con.val=="s")tmax.con.val<-s[i]
tmax.con.val<-as.numeric(tmax.con.val)
- if(is.na(tmax.con.val))stop('"max.con.val" must me numeric or a strig with a value "m", "s" or "non"!')
+ if(is.na(tmax.con.val))stop('"max.con.val" must me numeric or a strig with a value "m" or "non"!')
Mi<-M[,,i]
Mi[Mi>tmax.con.val]<-tmax.con.val
Mi[Mi<(-tmax.con.val)]<- (-tmax.con.val)
diff --git a/R/gen.opt.par.R b/R/gen.opt.par.R
index 65f10db..bf0e470 100644
--- a/R/gen.opt.par.R
+++ b/R/gen.opt.par.R
@@ -46,12 +46,12 @@ function(
clu<-as.integer(factor(clu))
k<-max(clu)
M[,]<-as.double(M)
- res<-.Fortran('optparsscom',M=M,clu=clu,diag=diag,maxiter=as.integer(maxiter),n=as.integer(dim(M)[1]),k=k,err=as.double(0),E=diag(k)*as.double(0),BM=diag(k)*as.double(0),cluM=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
+ res<-.Fortran(optparsscom,M=M,clu=clu,diag=diag,maxiter=as.integer(maxiter),n=as.integer(dim(M)[1]),k=k,err=as.double(0),E=diag(k)*as.double(0),BM=diag(k)*as.double(0),cluM=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
best1<-res[c(2,7,8,9)]
IM<-best1$E
IM[,] <- 'com'
best1$IM<-IM
- res<-list(M=res$M,best=c(list(best1=best1), if(res$nbest>1) apply(res$cluM[seq(res$nbest),],1,function(x)list(clu=x))[-1]else NULL),nIter=res$iter)
+ res<-list(M=res$M,best=c(list(best1=best1), if(res$nbest>1) apply(res$cluM[seq(min(res$nbest,50)),],1,function(x)list(clu=x))[-1]else NULL),nIter=res$iter)
class(res)<-'opt.par'
return(res)
}")
@@ -69,7 +69,7 @@ function(
k1<-max(clu1)
k2<-max(clu2)
M[,]<-as.double(M)
- res<-.Fortran('optparsscomtm',M=M,clu1=clu1,clu2=clu2,maxiter=as.integer(maxiter),n1=as.integer(dim(M)[1]),n2=as.integer(dim(M)[2]),k1=k1,k2=k2,err=as.double(0),E=matrix(as.double(0),nrow=k1,ncol=k2),BM=matrix(as.double(0),nrow=k1,ncol=k2),cluM1=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),cluM2=matrix(as.integer(0),nrow=50,ncol=dim(M)[2]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
+ res<-.Fortran(optparsscomtm,M=M,clu1=clu1,clu2=clu2,maxiter=as.integer(maxiter),n1=as.integer(dim(M)[1]),n2=as.integer(dim(M)[2]),k1=k1,k2=k2,err=as.double(0),E=matrix(as.double(0),nrow=k1,ncol=k2),BM=matrix(as.double(0),nrow=k1,ncol=k2),cluM1=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),cluM2=matrix(as.integer(0),nrow=50,ncol=dim(M)[2]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
best1<-res[c('err','E','BM')]
best1$clu<-list(res$clu1,res$clu2)
IM<-best1$E
@@ -99,7 +99,7 @@ function(
k1<-max(clu1)
k2<-max(clu2)
M[,,]<-as.double(M)
- res<-.Fortran('optparsscomtmmorerel',M=M,clu1=clu1,clu2=clu2,maxiter=as.integer(maxiter),nr=as.integer(dim(M)[3]),n1=as.integer(dim(M)[1]),n2=as.integer(dim(M)[2]),k1=k1,k2=k2,err=as.double(0),E=matrix(as.double(0),nrow=k1,ncol=k2),BM=array(as.double(0),dim=c(k1,k2,nr)),cluM1=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),cluM2=matrix(as.integer(0),nrow=50,ncol=dim(M)[2]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
+ res<-.Fortran(optparsscomtmmorerel,M=M,clu1=clu1,clu2=clu2,maxiter=as.integer(maxiter),nr=as.integer(dim(M)[3]),n1=as.integer(dim(M)[1]),n2=as.integer(dim(M)[2]),k1=k1,k2=k2,err=as.double(0),E=matrix(as.double(0),nrow=k1,ncol=k2),BM=array(as.double(0),dim=c(k1,k2,nr)),cluM1=matrix(as.integer(0),nrow=50,ncol=dim(M)[1]),cluM2=matrix(as.integer(0),nrow=50,ncol=dim(M)[2]),nbest=as.integer(0),iter=as.integer(0),printIter=",print.iter,")
best1<-res[c('err','E','BM')]
best1$clu<-list(res$clu1,res$clu2)
IM<-best1$E
diff --git a/R/gplot.R b/R/gplot.R
index 7674f8c..2db2467 100644
--- a/R/gplot.R
+++ b/R/gplot.R
@@ -4,8 +4,7 @@
if(is.null(arrowhead.cex)) arrowhead.cex<-do.call(what=arrowheads.fun,list(edge.lwd))
arrowheads<-do.call(what=arrowheads.fun,list(arrowheads))*arrowhead.cex
if(edge.col=="default") edge.col<-gray(1-M/max(M))
- library(sna,pos=max(grep(pat="block",search()))+1)
- gplot(dat=M,diag=diag,displaylabels=displaylabels,boxed.labels=boxed.labels,loop.cex=loop.cex,arrowhead.cex=arrowheads,edge.lwd=edge.lwd,edge.col=edge.col,...)
+ sna::gplot(dat=M,diag=diag,displaylabels=displaylabels,boxed.labels=boxed.labels,loop.cex=loop.cex,arrowhead.cex=arrowheads,edge.lwd=edge.lwd,edge.col=edge.col,...)
}
@@ -13,7 +12,6 @@
function(M,uselen=TRUE,usecurve=TRUE,edge.len=0.001,diag=TRUE,displaylabels=TRUE,boxed.labels=FALSE,loop.cex=4,arrowhead.cex=2.5,edge.lwd=1,edge.col="default",rel.thresh=0.05,...){
M[M<max(M)*rel.thresh]<-0
if(edge.col=="default") edge.col<-gray(1-M/max(M))
- library(sna,pos=max(grep(pat="block",search()))+1)
- gplot(dat=M,uselen=uselen,usecurve=usecurve,edge.len=edge.len,diag=diag,displaylabels=displaylabels,boxed.labels=boxed.labels,loop.cex=loop.cex,arrowhead.cex=arrowhead.cex,edge.lwd=edge.lwd,edge.col=edge.col,...)
+ sna::gplot(dat=M,uselen=uselen,usecurve=usecurve,edge.len=edge.len,diag=diag,displaylabels=displaylabels,boxed.labels=boxed.labels,loop.cex=loop.cex,arrowhead.cex=arrowhead.cex,edge.lwd=edge.lwd,edge.col=edge.col,...)
}
diff --git a/R/loadnetwork.R b/R/loadnetwork.R
index 3d1f4a5..1dd1c5e 100644
--- a/R/loadnetwork.R
+++ b/R/loadnetwork.R
@@ -18,8 +18,8 @@ function(filename,useSparseMatrix=NULL,minN=50){
}
if(useSparseMatrix){
- if(require(Matrix)){
- M<-Matrix(0,nrow=n,ncol=n,sparse=TRUE)
+ if(requireNamespace("Matrix")){
+ M<-Matrix::Matrix(0,nrow=n,ncol=n,sparse=TRUE)
}else{
warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
M<-matrix(0,nrow=n,ncol=n)
@@ -30,8 +30,8 @@ function(filename,useSparseMatrix=NULL,minN=50){
if(useSparseMatrix){
- if(require(Matrix)){
- M<-Matrix(0,nrow=n,ncol=n,sparse=TRUE)
+ if(requireNamespace("Matrix")){
+ M<-Matrix::Matrix(0,nrow=n,ncol=n,sparse=TRUE)
}else{
M<-matrix(0,nrow=n,ncol=n)
warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
@@ -76,8 +76,8 @@ function(filename,useSparseMatrix=NULL,minN=50){
useSparseMatrix<- n12>50
}
if(useSparseMatrix){
- if(require(Matrix)){
- M<-Matrix(0,nrow=n12,ncol=n12,sparse=TRUE)
+ if(requireNamespace("Matrix")){
+ M<-Matrix::Matrix(0,nrow=n12,ncol=n12,sparse=TRUE)
}else{
warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
M<-matrix(0,nrow=n12,ncol=n12)
diff --git a/R/loadnetwork2.R b/R/loadnetwork2.R
index 238f361..95e6ad9 100644
--- a/R/loadnetwork2.R
+++ b/R/loadnetwork2.R
@@ -15,8 +15,8 @@ function(filename,useSparseMatrix=NULL,minN=50){
useSparseMatrix<- n>=50
}
if(useSparseMatrix){
- if(require(Matrix)){
- M<-Matrix(0,nrow=n,ncol=n,sparse=TRUE)
+ if(requireNamespace("Matrix")){
+ M<-Matrix::Matrix(0,nrow=n,ncol=n,sparse=TRUE)
}else{
M<-matrix(0,nrow=n,ncol=n)
warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
@@ -29,7 +29,7 @@ function(filename,useSparseMatrix=NULL,minN=50){
while(TRUE){
line<-scan(file = file, nlines =1,what="char",quiet =TRUE)
- if(length(line)==0||sum(grep(patt="^ *$",x=as.character(line))==1)) break
+ if(length(line)==0||sum(grep(pattern="^ *$",x=as.character(line))==1)) break
if(substr(line[1],start=1,stop=1)=="*"){
type=line[1]
next
@@ -57,8 +57,8 @@ function(filename,useSparseMatrix=NULL,minN=50){
}
if(useSparseMatrix){
- if(require(Matrix)){
- M<-Matrix(0,nrow=n12,ncol=n12,sparse=TRUE)
+ if(requireNamespace("Matrix")){
+ M<-Matrix::Matrix(0,nrow=n12,ncol=n12,sparse=TRUE)
}else{
warning("Matrix package is not installed. Ordanary (dense) matrices will be used instead of sparse onse")
M<-matrix(0,nrow=n12,ncol=n12)
@@ -69,7 +69,7 @@ function(filename,useSparseMatrix=NULL,minN=50){
while(TRUE){
line<-scan(file = file, nlines =1,what="char",quiet =TRUE)
- if(length(line)==0||sum(grep(patt="^ *$",x=as.character(line))==1)) break
+ if(length(line)==0||sum(grep(pattern="^ *$",x=as.character(line))==1)) break
if(substr(line[1],start=1,stop=1)=="*"){
type=line[1]
next
diff --git a/R/loadpajek.R b/R/loadpajek.R
index 1e20b6f..0f03904 100644
--- a/R/loadpajek.R
+++ b/R/loadpajek.R
@@ -11,7 +11,7 @@ loadpajek<-function(filename){
next
}
nblanklines=0
- if(sum(grep(patt="^ *$",x=as.character(line))==1)) next
+ if(sum(grep(pattern="^ *$",x=as.character(line))==1)) next
if(line[1]=="*Matrix" || line[1]=="*Network"){
objName<-paste(line[-1],collapse=" ")
if(line[1]=="*Matrix"){
diff --git a/R/opt.par.R b/R/opt.par.R
index 499187e..d88c5fe 100644
--- a/R/opt.par.R
+++ b/R/opt.par.R
@@ -1,3 +1,5 @@
+if(getRversion() >= "2.15.1") utils::globalVariables(c('opt.par.tmp'))
+
"opt.par" <-
function(
#function for optimizig partition in blockmodeling
@@ -51,6 +53,8 @@ function(
optfun<-gen.opt.par(M=M,k=k,maxiter=maxiter,approach=approach,trace.iter=trace.iter,save.initial.param = save.initial.param,skip.par=skip.par,save.checked.par=save.checked.par,merge.save.skip.par=merge.save.skip.par,check.skip=check.skip,switch.names=switch.names,...)
eval(optfun)
+
+
return(opt.par.tmp(M=M,clu=clu,k=k,approach=approach,...))
}
diff --git a/R/opt.random.par.R b/R/opt.random.par.R
index e00771e..7b26b42 100644
--- a/R/opt.random.par.R
+++ b/R/opt.random.par.R
@@ -1,3 +1,5 @@
+ if(getRversion() >= "2.15.1") utils::globalVariables(c('opt.par.tmp'))
+
"opt.random.par" <-
function(
M,#matrix (network)
@@ -46,7 +48,7 @@ maxTriesToFindNewPar=rep*10 #The maximum number of partition try when trying to
if(save.initial.param)initial.param<-c(tryCatch(lapply(as.list(sys.frame(sys.nframe())),eval),error=function(...)return("error")),dots=list(...))#saves the inital parameters
optfun<-gen.opt.par(M=M,k=k,maxiter=maxiter, approach=approach,switch.names=switch.names,trace.iter=trace.iter,save.initial.param = save.initial.param,skip.par=skip.par,save.checked.par=save.checked.par,merge.save.skip.par=merge.save.skip.par,check.skip=check.skip,print.iter=print.iter,mingr=mingr,maxgr=maxgr,...)
eval(optfun)
-
+
nmode<-length(k)
res<-list(NULL)
diff --git a/R/opt.these.par.R b/R/opt.these.par.R
index eb4f862..e166c5a 100644
--- a/R/opt.these.par.R
+++ b/R/opt.these.par.R
@@ -1,3 +1,5 @@
+if(getRversion() >= "2.15.1") utils::globalVariables(c('opt.par.tmp'))
+
"opt.these.par" <-
function(
M, #matrix (network)
@@ -91,7 +93,7 @@ function(
})
- eval(optfun)
+ eval(optfun)
npar<-length(partitions)
for(i in 1:npar){
cat("\n\nStarting optimization of the partiton",i,"of",npar,"partitions.\n")
@@ -117,7 +119,7 @@ function(
clu=partitions[[i]],
k=k,
approach=approach,
- m=m,
+# m=m,
skip.par=skip.par,
...
)
diff --git a/R/plot.mat.R b/R/plot.mat.R
index cc22dd0..be9da6c 100644
--- a/R/plot.mat.R
+++ b/R/plot.mat.R
@@ -56,7 +56,7 @@ function(
if(class(M)!="matrix"&&class(M)!="mat"){
pack<-attr(class(M),"package")
if(!(is.null(pack))&&pack=="Matrix"){
- if(require(Matrix)){
+ if(requireNamespace("Matrix")){
M<-as.matrix(M)
} else stop("The supplied object needs Matrix packege, but the package is not available (install it!!!).")
} else stop("Cannot convert object of class ",class(M)," to class 'matrix'.")
diff --git a/R/savecluster.R b/R/savecluster.R
index e08f5bf..c5a47df 100644
--- a/R/savecluster.R
+++ b/R/savecluster.R
@@ -1,6 +1,6 @@
"savecluster" <-
structure(function(v,filename,cont=FALSE){
-if(length(grep(patt="w32",x=version["os"]))){
+if(length(grep(pattern="w32",x=version["os"]))){
eol<-"\n"
}else{eol<-"\r\n"}
cat(paste(v,collapse=eol),file = filename,append=cont)
diff --git a/R/savematrix.R b/R/savematrix.R
index ead30e1..7541a5b 100644
--- a/R/savematrix.R
+++ b/R/savematrix.R
@@ -1,6 +1,6 @@
"savematrix" <-
structure(function(n,filename,twomode=1,cont=FALSE){
-if(length(grep(patt="w32",x=version["os"]))){
+if(length(grep(pattern="w32",x=version["os"]))){
eol<-"\n"
}else{eol<-"\r\n"}
if ((dim(n)[1] == dim(n)[2]) & (twomode!=2))
diff --git a/R/savenetwork.R b/R/savenetwork.R
index d1390ff..e36e1d2 100644
--- a/R/savenetwork.R
+++ b/R/savenetwork.R
@@ -1,11 +1,11 @@
"savenetwork" <-
structure(function(n,filename,twomode="default",symetric=NULL,cont=FALSE){
- if(length(grep(patt="w32",x=version["os"]))){
+ if(length(grep(pattern="w32",x=version["os"]))){
eol<-"\n"
}else{eol<-"\r\n"}
rowNames<-rownames(n)
colNames<-colnames(n)
- if(require(Matrix)){
+ if(requireNamespace("Matrix")){
if(class(n)=="mat") n<-unclass(n)
n <- as(n,"dgTMatrix")
useMatrix<-TRUE
diff --git a/R/savepajek.R b/R/savepajek.R
index 4335652..d613bd1 100644
--- a/R/savepajek.R
+++ b/R/savepajek.R
@@ -1,5 +1,5 @@
savepajek<-function(pajekList,filename,twomode="default",asMatrix=FALSE,symetric=NULL){
- if(length(grep(patt="w32",x=version["os"]))){
+ if(length(grep(pattern="w32",x=version["os"]))){
eol<-"\n"
}else{eol<-"\r\n"}
cat("",file = filename,append=FALSE)
diff --git a/R/savevector.R b/R/savevector.R
index 1a16921..7823f70 100644
--- a/R/savevector.R
+++ b/R/savevector.R
@@ -1,6 +1,6 @@
"savevector" <-
structure(function(v,filename,cont=FALSE){
-if(length(grep(patt="w32",x=version["os"]))){
+if(length(grep(pattern="w32",x=version["os"]))){
eol<-"\n"
}else{eol<-"\r\n"}
cat(paste(c(paste("*Vertices",length(v)), v),collapse=eol),file = filename,append=cont)
diff --git a/man/REGE.Rd b/man/REGE.Rd
index 648df6a..26e6ba3 100644
--- a/man/REGE.Rd
+++ b/man/REGE.Rd
@@ -108,10 +108,6 @@ plot.mat(net, clu=cutree(hclust(d=as.dist(1-D),method="ward"),
k=2))
#REGE returns similarities, which have to be converted to
#disimilarities
-
-res<-opt.random.par(M=net,k=2,rep=10,approach="ss",blocks="reg",
- FUN="max")
-plot(res) #Hopefully we get the original partition
}
\keyword{cluster}% at least one, from doc/KEYWORDS
\keyword{graphs}% at least one, from doc/KEYWORDS
diff --git a/man/blockmodeling-package.Rd b/man/blockmodeling-package.Rd
index d456334..cdcd46d 100644
--- a/man/blockmodeling-package.Rd
+++ b/man/blockmodeling-package.Rd
@@ -2,7 +2,7 @@
\alias{blockmodeling-package}
\docType{package}
\title{
-An R package for Generalized and classical blockmodeling of valued networks
+An R Package for Generalized and Classical Blockmodeling of Valued Networks
}
\description{
This package is primarily meant as an implementation of Generalized blockmodeling. In addition, functions for computation of (dis)similarities in terms of structural and regular equivalence, plotting and other "utility" functions are provided.
diff --git a/man/crit.fun.Rd b/man/crit.fun.Rd
index 6ccaa3a..c4287cb 100644
--- a/man/crit.fun.Rd
+++ b/man/crit.fun.Rd
@@ -103,6 +103,33 @@ res$err #the error is relativly small
res$BM #The block means are around 0 or 4
plot(res)
+#computation of criterion function with the correct partition and correct pre-specified blockmodel
+#prespecified blockmodel used
+# null com
+# null null
+B<-array(NA,dim=c(1,2,2))
+B[1,,]<-"null"
+B[1,1,2]<-"com"
+B[1,,]
+res<-crit.fun(M=net,clu=clu,approach="ss",BLOCKS=B)
+res$err #the error is relativly small
+res$IM
+plot(res)
+
+#computation of criterion function with the correct partition and
+# pre-specified blockmodel with some alternatives
+
+#prespecified blockmodel used
+# null null|com
+# null null
+B<-array(NA,dim=c(2,2,2))
+B[1,,]<-"null"
+B[2,1,2]<-"com"
+res<-crit.fun(M=net,clu=clu,approach="ss",BLOCKS=B)
+res$err #the error is relativly small
+res$IM
+plot(res)
+
#computation of criterion function with random partition
clu.rnd<-sample(1:2,size=n,replace=TRUE)
res.rnd<-crit.fun(M=net,clu=clu.rnd,approach="ss",blocks="com")
diff --git a/man/genRandomPar.Rd b/man/genRandomPar.Rd
index f47ccf8..1e7073b 100644
--- a/man/genRandomPar.Rd
+++ b/man/genRandomPar.Rd
@@ -25,7 +25,7 @@ genRandomPar(k, n, seed = NULL, mingr = 1, maxgr = Inf,
A random partition in the format required by \code{\link{opt.random.par}}. If a netowork has several modes, than a list of partitions, one for each mode.
}
\references{
-BATAGELJ, Vladimir, MRVAR, Andrej (2006): Pajek 1.11, \url{http://vlado.fmf.uni lj.si/pub/networks/pajek/} (accessed January 6, 2006).
+BATAGELJ, Vladimir, MRVAR, Andrej (2006): Pajek 1.11, \url{http://mrvar.fdv.uni-lj.si/pajek/} (accessed January 6, 2006).
}
\author{\enc{Aleš Žiberna}{Ales Ziberna}}
\seealso{\code{\link{opt.random.par}}}
diff --git a/man/opt.random.par.Rd b/man/opt.random.par.Rd
index cfda767..ad9c2e5 100644
--- a/man/opt.random.par.Rd
+++ b/man/opt.random.par.Rd
@@ -93,7 +93,7 @@ This function can be extremly slow. The time complexity is incrising with the nu
DOREIAN, Patrick, BATAGELJ, Vladimir, FERLIGOJ, \enc{Anuška}{Anuska} (2005): Generalized blockmodeling, (Structural analysis in the social sciences, 25). Cambridge [etc.]: Cambridge University Press, 2005. XV, 384 p., ISBN 0-521-84085-6.
-BATAGELJ, Vladimir, MRVAR, Andrej (2006): Pajek 1.11, \url{http://vlado.fmf.uni lj.si/pub/networks/pajek/} (accessed January 6, 2006).
+BATAGELJ, Vladimir, MRVAR, Andrej (2006): Pajek 1.11, \url{http://mrvar.fdv.uni-lj.si/pajek/} (accessed January 6, 2006).
}
\author{\enc{Aleš Žiberna}{Ales Ziberna}}
diff --git a/src/REGD_NE_R.f90 b/src/REGD_NE_R.f90
index 7434d6f..20d7af7 100644
--- a/src/REGD_NE_R.f90
+++ b/src/REGD_NE_R.f90
@@ -1,6 +1,6 @@
! REGDI.FOR 3/18/85 - DOUG WHITE'S REGULAR DISTANCES PROGRAM
subroutine regdne(R,B,N,NR,ITER)
- DOUBLE PRECISION R, B, DEG, SUM, CM, Row, Col
+ DOUBLE PRECISION R, B, DEG, SUM, CM, Row, Col, SUMM
INTEGER NR, N, ITER, KR, JJ, II
DIMENSION DEG (N), SUM (N,N), R (N,N, NR), B (N,N), Row(N), Col(N)
diff --git a/src/REGD_R.f90 b/src/REGD_R.f90
index 2b053da..10ed04d 100644
--- a/src/REGD_R.f90
+++ b/src/REGD_R.f90
@@ -1,6 +1,6 @@
! REGDI.FOR 3/18/85 - DOUG WHITE'S REGULAR DISTANCES PROGRAM
subroutine regd(R,B,N,NR,ITER)
- DOUBLE PRECISION R, B, DEG, SUM, CM
+ DOUBLE PRECISION R, B, DEG, SUM, CM, SUMM
INTEGER NR, N, ITER, KR, JJ, II
DIMENSION DEG (N), SUM (N,N), R (N,N, NR), B (N,N)
diff --git a/src/init.c b/src/init.c
new file mode 100644
index 0000000..5204fa5
--- /dev/null
+++ b/src/init.c
@@ -0,0 +1,57 @@
+#include <R_ext/RS.h>
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* FIXME:
+sscom declarations were added that were missed by the skeleton creating functions
+*/
+
+/* .Fortran calls */
+extern void F77_NAME(regd)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regdne)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regdow)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regdowne)(void *, void *, void *, void *, void *);
+extern void F77_NAME(rege)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regene)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regenm)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regenmdiag)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regenmne)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regeow)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regeowne)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regeownm)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regeownmdiag)(void *, void *, void *, void *, void *);
+extern void F77_NAME(regeownmne)(void *, void *, void *, void *, void *);
+extern void F77_NAME(critfunsscom)(void *, void *, void *, void *, void *, void *, void *, void *);
+extern void F77_NAME(optparsscom)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void F77_NAME(optparsscomtm)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+extern void F77_NAME(optparsscomtmmorerel)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *);
+
+
+
+static const R_FortranMethodDef FortranEntries[] = {
+ {"regd", (DL_FUNC) &F77_NAME(regd), 5},
+ {"regdne", (DL_FUNC) &F77_NAME(regdne), 5},
+ {"regdow", (DL_FUNC) &F77_NAME(regdow), 5},
+ {"regdowne", (DL_FUNC) &F77_NAME(regdowne), 5},
+ {"rege", (DL_FUNC) &F77_NAME(rege), 5},
+ {"regene", (DL_FUNC) &F77_NAME(regene), 5},
+ {"regenm", (DL_FUNC) &F77_NAME(regenm), 5},
+ {"regenmdiag", (DL_FUNC) &F77_NAME(regenmdiag), 5},
+ {"regenmne", (DL_FUNC) &F77_NAME(regenmne), 5},
+ {"regeow", (DL_FUNC) &F77_NAME(regeow), 5},
+ {"regeowne", (DL_FUNC) &F77_NAME(regeowne), 5},
+ {"regeownm", (DL_FUNC) &F77_NAME(regeownm), 5},
+ {"regeownmdiag", (DL_FUNC) &F77_NAME(regeownmdiag), 5},
+ {"regeownmne", (DL_FUNC) &F77_NAME(regeownmne), 5},
+ {"critfunsscom", (DL_FUNC) &F77_NAME(critfunsscom), 8},
+ {"optparsscom", (DL_FUNC) &F77_NAME(optparsscom), 13},
+ {"optparsscomtm", (DL_FUNC) &F77_NAME(optparsscomtm), 16},
+ {"optparsscomtmmorerel", (DL_FUNC) &F77_NAME(optparsscomtmmorerel), 17},
+ {NULL, NULL, 0}
+};
+
+void R_init_blockmodeling(DllInfo *dll)
+{
+ R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-blockmodeling.git
More information about the debian-med-commit
mailing list