Nothing
.fowa.stat <-
function(x,phi,um){
folk.ward=data.frame(matrix(ncol=0,nrow=9))
for (b in 1:dim(x)[2])
{y=x[b]
sum.sieve=sum(y)
class.weight=(y*100)/sum.sieve
cum.sum=cumsum(class.weight)[,1]
if (min(cum.sum)>5)
{
fowa=data.frame(rep(0,9))
row.names(fowa)=c("Sediment","Mean.fw.um","Sd.fw.um","Skewness.fw.um","Kurtosis.fw.um","Mean.fw.phi","Sd.fw.phi","Skewness.fw.phi","Kurtosis.fw.phi")
names(fowa)=names(x)[b]
}
if (min(cum.sum)<5)
{
mat.D=.percentile(x[,b],phi,um)
mean.phi=(mat.D[6,1]+mat.D[4,1]+mat.D[2,1])/3
mean.mm=(exp(log(mat.D[6,2])+log(mat.D[4,2])+log(mat.D[2,2])/3))/1000
sd.phi=-(((mat.D[2,1]-mat.D[6,1])/4)+((mat.D[1,1]-mat.D[7,1])/6.6))
sd.mm=exp(((log(mat.D[2,2])-log(mat.D[6,2]))/4)+((log(mat.D[1,2])-log(mat.D[7,2]))/6.6))
skewness.phi=-(((mat.D[6,1]+mat.D[2,1]-(2*mat.D[4,1]))/(2*(mat.D[2,1]-mat.D[6,1])))+ ((mat.D[7,1]+mat.D[1,1]-(2*mat.D[4,1]))/(2*(mat.D[1,1]-mat.D[7,1]))))
skewness.mm=-skewness.phi
kurtosis.phi=(mat.D[1,1]-mat.D[7,1])/(2.44*(mat.D[3,1]-mat.D[5,1]))
kurtosis.mm=kurtosis.phi
if (mean.phi<=-5) mean.descript="Very Coarse Gravel"
if (mean.phi>-5 & mean.phi<=-4) mean.descript="Coarse Gravel"
if (mean.phi>-4 & mean.phi<=-3) mean.descript="Medium Gravel"
if (mean.phi>-3 & mean.phi<=-2) mean.descript="Fine Gravel"
if (mean.phi>-2 & mean.phi<=-1) mean.descript="Very Fine Gravel"
if (mean.phi>-1 & mean.phi<=0) mean.descript="Very Coarse Sand"
if (mean.phi>0 & mean.phi<=1) mean.descript="Coarse Sand"
if (mean.phi>1 & mean.phi<=2) mean.descript="Medium Sand"
if (mean.phi>2 & mean.phi<=3) mean.descript="Fine Sand"
if (mean.phi>3 & mean.phi<=4) mean.descript="Very Fine Sand"
if (mean.phi>4 & mean.phi<=5) mean.descript="Very Coarse Silt"
if (mean.phi>5 & mean.phi<=6) mean.descript="Coarse Silt"
if (mean.phi>6 & mean.phi<=7) mean.descript="Medium Silt"
if (mean.phi>7 & mean.phi<=8) mean.descript="Fine Silt"
if (mean.phi>8 & mean.phi<=9) mean.descript="Very Fine Silt"
if (mean.phi>8) mean.descript="Clay"
if (sd.phi<0.35) sorting="Very Well Sorted"
if (sd.phi>=0.35 & sd.phi<0.5) sorting="Well Sorted"
if (sd.phi>=0.5 & sd.phi<0.7) sorting="Moderately Well Sorted"
if (sd.phi>=0.7 & sd.phi<1) sorting="Moderately Sorted"
if (sd.phi>=1 & sd.phi<2) sorting="Poorly Sorted"
if (sd.phi>=2 & sd.phi<4) sorting="Very Poorly Sorted"
if (sd.phi>=4) sorting="Extremely Poorly Sorted"
if (skewness.phi>=0.3) skewness.descript="Very Fine Skewed"
if (skewness.phi<0.3 & skewness.phi>=0.1) skewness.descript="Fine Skewed"
if (skewness.phi<0.1 & skewness.phi>-0.1) skewness.descript="Symmetrical"
if (skewness.phi<=-0.1 & skewness.phi>-0.3) skewness.descript="Coarse Skewed"
if (skewness.phi<=-0.3) skewness.descript="Very Coarse Skewed"
if (kurtosis.phi<0.67) kurtosis.descript="Very Platykurtic"
if (kurtosis.phi>=0.67 & kurtosis.phi<0.9) kurtosis.descript="Platykurtic"
if (kurtosis.phi>=0.9 & kurtosis.phi<=1.11) kurtosis.descript="Mesokurtic"
if (kurtosis.phi>1.11 & kurtosis.phi<=1.5) kurtosis.descript="Leptokurtic"
if (kurtosis.phi>1.5 & kurtosis.phi<=3) kurtosis.descript="Very Leptokurtic"
if (kurtosis.phi>3) kurtosis.descript="Extremely Leptokurtic"
.sedim.descript=paste(mean.descript,sorting,skewness.descript,kurtosis.descript,sep=",")
result.fw.phi=data.frame(c(round(mean.phi,3),round(sd.phi,3),round(skewness.phi,3),round(kurtosis.phi,3)))
names(result.fw.phi)=names(x)[b]
result.fw.mm=data.frame(c(round(mean.mm,3),round(sd.mm,3),round(skewness.mm,3),round(kurtosis.mm,3)))
names(result.fw.mm)=names(x)[b]
fowa=data.frame(rbind(.sedim.descript,result.fw.mm,result.fw.phi))
row.names(fowa)=c("Sediment","Mean.fw.um","Sd.fw.um","Skewness.fw.um","Kurtosis.fw.um","Mean.fw.phi","Sd.fw.phi","Skewness.fw.phi","Kurtosis.fw.phi")
names(fowa)=names(x)[b]
}
folk.ward=cbind(folk.ward,fowa)
}
folk.ward
}
.G2Sd_web <-
function(){
runApp(appDir=paste0(.libPaths(),"/G2Sd/extdata"))
}
.grancompat <-
function(x)
{
x <- as.data.frame(x)
n.sieve <- nrow(x)
n.sample <- ncol(x)
if (!is.data.frame(x))
stop("dataframe expected.")
if (any(x < 0))
stop("negative entries in dataframe.")
if (any(x > 300))
warning("Some high values are present.", call. = FALSE,immediate.=TRUE)
if (n.sieve!=29)
{
cat("Compatibility progress.... \n \n")
ref_sieve=c(25000,20000,16000,12500,10000,8000,6300,5000,4000,2500,
2000,1600,1250,1000,800,630,500,400,315,250,200,160,125,
100,80,63,50,40,0)
init_df <- as.data.frame(matrix(data=0,ncol=n.sample,nrow=length(ref_sieve)));colnames(init_df) <- colnames(x)
row.names(init_df) <-ref_sieve
if (any(is.na(pmatch(row.names(x),ref_sieve))))
stop("Incorrect sieve values.")
else
{for (sieve in row.names(x))
init_df[sieve,] <- x[sieve,]}
}
else init_df <- x
return(init_df)
}
.index.sedim <-
function(x,phi,um){
x=as.data.frame(x)
INDEX=data.frame(matrix(ncol=0,nrow=9))
for (b in 1:dim(x)[2])
{
mat.D=.percentile(x[,b],phi,um)
index=data.frame(matrix(ncol=1,nrow=9))
row.names(index)=c("D10(um)","D50(um)","D90(um)","D90/D10","D90-D10","D75/D25","D75-D25","Trask(So)","Krumbein(Qd)")
names(index)=names(x)[b]
index[1,1]=round(mat.D[9,2],3)
index[2,1]=round(mat.D[4,2],3)
index[3,1]=round(mat.D[8,2],3)
index[4,1]=round(mat.D[8,2]/mat.D[9,2],3)
index[5,1]=round(mat.D[8,2]-mat.D[9,2],3)
index[6,1]=round(mat.D[3,2]/mat.D[5,2],3)
index[7,1]=round(mat.D[3,2]-mat.D[5,2],3)
index[8,1]=round(sqrt(mat.D[3,2]/mat.D[5,2]),3)
index[9,1]=round((mat.D[5,1]-mat.D[3,1])/2,3)
INDEX=cbind(INDEX,index)
}
return(INDEX)
}
.mgrep <-
function(mpattern,x,FUN="grep")
{
select=NULL
for (i in 1:length(mpattern))
{
if (FUN=="grep")
values=grep(mpattern[i],x)
if (FUN=="which")
values=which(x==mpattern[i])
select=c(select,values)
}
return(sort(select))
}
.mode.sedim <-
function(x,um){
x=as.data.frame(x)
sum.sieve=apply(x,2,sum)
MODE=data.frame(matrix(ncol=0,nrow=5))
for (b in 1:dim(x)[2])
{
class.weight=(x[,b]*100)/sum.sieve[b]
tab.mod=cbind(um,class.weight)
if (pmatch(0,um)!=0) tab.mod=tab.mod[-pmatch(0,um),]
plot(tab.mod[,1],tab.mod[,2],type="b",lwd=3,xlab="Particule size (microns)",ylab="Pourcentage (%)",xaxt="n",log="x")
a=identify(tab.mod,plot=FALSE,n=4)
mod=data.frame(tab.mod[a,1])
names(mod)=names(x)[b]
row.names(mod)=tab.mod[a,1]
if (dim(mod)[1]==1) mod.descript="1 Mode" else mod.descript=paste(dim(mod)[1],"Modes")
MODE.sedim=data.frame(matrix(ncol=1,nrow=4))
for (i in 1:dim(mod)[1])
MODE.sedim[i,]=mod[i,]
MODE.sedim=rbind(mod.descript,MODE.sedim)
names(MODE.sedim)=names(x)[b]
row.names(MODE.sedim)[1]="Nb Mode"
MODE.sedim
MODE=cbind(MODE,MODE.sedim)
}
return(MODE)
}
.moment.arith <-
function(x,um){
x=as.data.frame(x)
sum.sieve=apply(x,2,sum)
arith=data.frame(matrix(ncol=0,nrow=4))
for (b in 1:dim(x)[2])
{
class.weight=(x[b]*100)/sum.sieve[b]
mid.point=rep(0,(length(um)))
for(i in 2:length(um))
{
mid.point[i]=(um[i]+um[i-1])/2
}
fm=class.weight*mid.point
mean.arith=apply(fm,2,sum)/100
fmM2=class.weight*(mid.point-mean.arith)^2
sd.arith=sqrt(apply(fmM2,2,sum)/100)
fmM3=class.weight*(mid.point-mean.arith)^3
skewness.arith=apply(fmM3,2,sum)/(100*sd.arith^3)
fmM4=class.weight*(mid.point-mean.arith)^4
kurtosis.arith=apply(fmM4,2,sum)/(100*sd.arith^4)
moment.arit=data.frame(rbind(round(mean.arith,3),round(sd.arith,3),round(skewness.arith,3),round(kurtosis.arith,3)))
colnames(moment.arit)=colnames(x)[b]
arith=cbind(arith,moment.arit)
rownames(arith)=c("mean.arith.um","sd.arith.um","skewness.arith.um","kurtosis.arith.um")
}
return(arith)
}
.moment.geom <-
function(x,phi){
x=as.data.frame(x)
sum.sieve=apply(x,2,sum)
geom=data.frame(matrix(ncol=0,nrow=4))
for (b in 1:dim(x)[2])
{
class.weight=(x[b]*100)/sum.sieve[b]
mid.point=rep(0,(length(phi)))
for(i in 2:length(phi))
{
mid.point[i]=(phi[i]+phi[i-1])/2
}
logm=log10(2^(-mid.point)*1000)
flogm=class.weight*logm
mean.geom=10^(apply(flogm,2,sum)/100)
fmM2=class.weight*(logm-log10(mean.geom))^2
sd.geom=10^(sqrt(apply(fmM2,2,sum)/100))
fmM3=class.weight*(logm-log10(mean.geom))^3
skewness.geom=(apply(fmM3,2,sum)/(100*log10(sd.geom)^3))
fmM4=class.weight*(logm-log10(mean.geom))^4
kurtosis.geom=(apply(fmM4,2,sum)/(100*log10(sd.geom)^4))
kurtosis3.geom=kurtosis.geom
moment.geo=as.data.frame(rbind(round(mean.geom,3),round(sd.geom,3),round(skewness.geom,3),round(kurtosis.geom,3)))
names(moment.geo)=names(x)[b]
geom=cbind(geom,moment.geo)
rownames(geom)=c("mean.geom.um","sd.geom.um","skewness.geom.um","kurtosis.geom.um")
}
return(geom)
}
.northarrow <-
function(loc,size,bearing=0,cols,letter_dist=1,cex=1,...) {
# checking arguments
if(missing(loc)) stop("loc is missing")
if(missing(size)) stop("size is missing")
# default colors are white and black
if(missing(cols)) cols <- rep(c("white","black"),8)
# calculating coordinates of polygons
radii <- rep(size/c(1,4,2,4),4)
x <- radii[(0:15)+1]*cos((0:15)*pi/8+bearing)+loc[1]
y <- radii[(0:15)+1]*sin((0:15)*pi/8+bearing)+loc[2]
# drawing polygons
for (i in 1:15) {
x1 <- c(x[i],x[i+1],loc[1])
y1 <- c(y[i],y[i+1],loc[2])
polygon(x1,y1,col=cols[i])
}
# drawing the last polygon
polygon(c(x[16],x[1],loc[1]),c(y[16],y[1],loc[2]),col=cols[16])
# drawing letters
b <- c("E","N","W","S")
for (i in 0:3) text((size+letter_dist*par("cxy")[1])*cos(bearing+i*pi/2)+loc[1],
(size+letter_dist*par("cxy")[2])*sin(bearing+i*pi/2)+loc[2],b[i+1],
cex=cex)
}
.percentile <-
function(x,phi,um){
x=as.numeric(x)
sum.sieve=sum(x)
class.weight=(x*100)/sum.sieve
cum.sum=as.numeric(cumsum(class.weight))
D=c(5,16,25,50,75,84,95,10,90)
if (min(cum.sum)>5)
{warning("D5 can't be calculated :
Folk-Ward statistics can't be computed.", call. = FALSE,immediate.=TRUE)
mat.D=data.frame(matrix(ncol=2,nrow=9,0))
row.names(mat.D)=100-D
names(mat.D)=c("Phi","um")}
if (min(cum.sum)<5){
class.weight.PHI=cbind(cum.sum,phi,um)
mat.D=data.frame(matrix(ncol=2,nrow=9))
row.names(mat.D)=100-D
names(mat.D)=c("Phi","um")
for (i in 1:9)
{
greaterpercent=subset(class.weight.PHI,class.weight.PHI[,1]>D[i])
greaterphi=subset(greaterpercent,greaterpercent[,1]==min(greaterpercent[,1]),select=-1)
greaterphi=as.numeric(subset(greaterphi,greaterphi[,2]==max(greaterphi[,2]),select=1))
greaterpercent=min(greaterpercent[,1])
lesspercent=subset(class.weight.PHI,class.weight.PHI[,1]<D[i])
lessphi=subset(lesspercent,lesspercent[,1]==max(lesspercent[,1]),select=-1)
lessphi=as.numeric(subset(lessphi,lessphi[,2]==min(lessphi[,2]),select=1))
lesspercent=max(lesspercent[,1])
ifelse (dim(subset(class.weight.PHI,class.weight.PHI[,1]==D[i]))[1]==0,
{ratio1=(D[i]-lesspercent)/(greaterpercent-lesspercent)
ratio2=(greaterphi-lessphi)*ratio1
phi=lessphi+ratio2
um=1/(2^phi)*1000},
{phi=as.numeric(subset(class.weight.PHI,class.weight.PHI[,1]==D[i],2))
um=as.numeric(subset(class.weight.PHI,class.weight.PHI[,1]==D[i],3))*1000})
result=c(phi,um)
mat.D[i,]=result
}
}
return(mat.D)
}
.Random.seed <-
c(403L, 406L, -1838796285L, -1731966943L, -48438512L, -2083618578L,
1814667417L, 588711211L, 1857371162L, 1686212316L, -12179745L,
-1440198475L, -1329621428L, 1279949474L, 312943101L, -2114606345L,
1306999838L, 622491352L, 1348577851L, -920008743L, 2064158056L,
-939524970L, -838141423L, -248941629L, 2125696978L, -690206108L,
596412839L, 1449797373L, -419519756L, 1499014618L, 1856370981L,
-617291713L, -184688698L, 2036614224L, -655529869L, -1218401135L,
-483570496L, 1670839966L, 1775948393L, -914468197L, 373694378L,
1966975948L, 1914889871L, 54965957L, -980910468L, 1806947026L,
-1159604659L, 1959688967L, -426066194L, -81855544L, -575173429L,
2146727209L, -343337608L, 2104986278L, -1054643007L, 289901907L,
-150599166L, 237146932L, 782237879L, 579709101L, -2010982972L,
-819386902L, 687618645L, -185482257L, 1085170678L, -25963232L,
1998846691L, 1817959297L, 248659440L, 544105614L, 268250105L,
-1308112501L, -1768589894L, 341499068L, 561655807L, 323669333L,
-1487311252L, 870984386L, -1362416355L, -34888809L, -282315010L,
-89332552L, -1876142437L, 1784870137L, 127239752L, 168518006L,
-887404367L, 237341923L, -1867531342L, -876452860L, 1522181959L,
549027357L, -1945234284L, 1724445754L, -1599123835L, 1310830431L,
-1155665946L, 1557185136L, -1740429933L, -440028623L, -352735008L,
702278014L, 572754953L, 91053115L, 1966203402L, -1437734420L,
898608751L, -1134100059L, -17622692L, -345832142L, -1889518547L,
93508327L, -1497573362L, 1005963752L, 1639844843L, 304690313L,
-1514000360L, -451973306L, -132305503L, -1306565581L, 1132538274L,
-393048940L, -1178096873L, -1096686323L, -1144990684L, -2074770422L,
-1918035595L, -620150577L, -443190314L, 1192061824L, 1562763203L,
-860956319L, -881741872L, -1200052434L, 577682137L, -2119329557L,
1536846170L, 436450076L, 580052511L, -1403011467L, -1400857844L,
1156814562L, 81558461L, 848600119L, 692276958L, -2085344744L,
-1718454917L, 1128836377L, -1413910104L, 1641514326L, -1045989935L,
-192344701L, 347296786L, -148103260L, 1599879015L, -604281667L,
96097332L, 1451988890L, -1623342107L, -280739969L, 811196166L,
-1612506992L, -156389069L, 1506780881L, 739783808L, 417609054L,
520915625L, -1463052965L, 451184490L, -1414803956L, 1121797711L,
-822539515L, 1751321532L, 197697170L, 1216118157L, -213602873L,
-702378322L, -2010028280L, -1401326325L, 1511916521L, -212454216L,
1882694502L, 479315969L, 1198823059L, 1141975362L, 139986676L,
-90369289L, -2028764435L, 87727492L, -1331293270L, -1629476587L,
-1084922961L, 831929270L, 1677435360L, 912048419L, 745535041L,
1551218992L, 1546619726L, -1037102663L, 1982532555L, -2109243270L,
-1904287364L, -619220545L, -1351102827L, -974031700L, -1338237310L,
-240863651L, 1776965975L, -1329118146L, -383661960L, -1337879717L,
-518648135L, 375735048L, -1025246794L, 1536984817L, -322039517L,
-2032909454L, -1137743420L, -735506041L, -1595217059L, -649616044L,
475121530L, -837179707L, 1768531999L, 506810278L, 1662366000L,
785984467L, 475197937L, -514287840L, 622550736L, -732032862L,
579785768L, -1455188724L, -405147716L, 1967665458L, -1001950784L,
1062922804L, 1912144840L, -867241798L, 1072351632L, 1360357868L,
-1480263084L, -268093294L, -745089248L, 1688269260L, -1423493664L,
-383080766L, -843178968L, -1016431956L, 1589978300L, -1830243854L,
-594624208L, -255886172L, -2021740872L, 625667418L, 1488428432L,
181484412L, -610684652L, -725019838L, 1254308608L, 1166305212L,
81684304L, -1896504542L, 133780808L, 70414860L, -693397412L,
-181926702L, -964468224L, 797726036L, -2111520280L, 895151098L,
2117144784L, 1151184172L, 122880756L, 1879859602L, 986698848L,
-778990324L, 269562592L, 1257017698L, 508574376L, 445129292L,
873724284L, 2038037810L, 2015055984L, 2030546756L, -17062440L,
668957818L, 1573928496L, -110193988L, -488134828L, -645970878L,
-1508524640L, -1280955716L, -1612721712L, 1692632418L, -1602088984L,
857882572L, -419629316L, -302229006L, 1021055104L, 1830857972L,
-680194424L, 1314357050L, 2065128272L, 1740861036L, 905267348L,
-637593262L, 452859616L, -1349657908L, 1394213024L, 1990069122L,
-1852710168L, 43729644L, 1120316476L, 1783282290L, 1086456944L,
-1123189212L, -2114347976L, 1485768730L, 1755806416L, 390093884L,
995828884L, 407346306L, 1984143296L, 1861120316L, 1607989904L,
-2129267678L, 1738216456L, 2045470860L, -1807195108L, 1404550802L,
-515226496L, -638758892L, -677798616L, -607019462L, 1426869456L,
-417831828L, 1920217780L, 1533452306L, 1497307104L, 1236146124L,
-481686048L, 1733461538L, 838943016L, -1761765108L, 1196385852L,
-486575886L, -474549520L, -1822538940L, 965796440L, -1783215558L,
131890928L, -735873860L, 1049122324L, -946227006L, 1210157152L,
1359697276L, -150842160L, -771351518L, 1981039272L, -293230708L,
-114970180L, -1121070030L, -2115020992L, 546531508L, -1487586488L,
-1536386374L, 992597776L, 715342060L, -1703095212L, 955899666L,
-649634912L, -358645812L, 1081719648L, 19419330L, 551265832L,
738436524L, 556457788L, -661387406L, -629466320L, -442088924L,
-1151805384L, -1195776806L, -2120226416L, 1656030972L, 316141460L,
-144774334L, -674143744L, -2063877572L, 2047737424L, 1958902434L,
-777069752L, 1857675788L, -1570591524L, -1698932142L, -846133120L,
-1642259628L, -96224792L, -668579078L, -1739884720L, 773667884L,
-1721748108L, -221280622L, 2010135136L, -565525876L, 413072224L,
929489634L, 68829352L, 2145910988L, -258553348L, 1036423090L,
-132360720L, 892061124L, 2052661080L, -888050822L, -1308977744L,
-1532126788L, 717105236L, -1738888254L, -174030048L, 2056945596L,
-2058237360L, 10780130L, -977006232L, 248548684L, 882919676L,
375808754L, 784406272L, -1946139020L, 384886792L, -42911302L,
497653712L, -2062951956L, 909332372L, 212890322L, 18902624L,
-468122292L, 793957664L, -1483124094L, -1411700248L, -1960671252L,
-1557989828L, -1411043726L, 1895113584L, -925210332L, 389853752L,
-1773272678L, 210504144L, 1633164732L, 752298132L, 68320386L,
-844118592L, 1037583164L, -443485040L, 2097095458L, 1776922120L,
1117246050L, 372577527L, 285462337L, 1032285638L, -745685244L,
-334136651L, -642697825L, -1570846216L, 90458070L, 2009420387L,
1661766181L, -778784318L, -1316342096L, 57159385L, -1863927733L,
-608901444L, -905804566L, 370430239L, -1347788375L, 137086782L,
2042573356L, 1838768253L, -956677433L, 877657008L, -719639090L,
-1708187909L, 232613213L, -574542198L, -1261343576L, 597276689L,
2068023555L, -1013488636L, 1080822834L, 1783161991L, 1480306897L,
-412523946L, -2113385932L, 124154181L, -2105914481L, -88772856L,
-1877157594L, -458356269L, 722101045L, -453610862L, 2012915296L,
-791896119L, 86494971L, 1481314508L, 27855194L, -1800510385L,
1068099865L, -67169490L, 1300036924L, -2060653907L, 749135191L,
-750054240L, -1280237058L, -816837429L, 1396247245L, 487286266L,
-430373320L, 1546800097L, -2012900205L, 1955925684L, -1899793470L,
-1211004969L, -1090992095L, -966082586L, -1004152092L, 801730069L,
1267185215L, -692902440L, -985183242L, -1306999805L, 2054350661L,
-70093982L, 616570064L, 1372080121L, 1732004651L, 129368220L,
2118065866L, -2009593921L, -218717431L, -2105877474L, 133785036L,
-939004003L, 1745779239L, 1753700432L, -48414482L, -1093268069L,
950399997L, -228274454L, 876616072L, -1186367695L, 2104207267L,
-980160604L, 1453378130L, 179347879L, 148624881L, -2108808906L,
-2144847404L, -653701275L, -366739601L, 1052787112L, -1725016314L,
1782977075L, 259870869L, 2035871986L, 1353312576L, -911829335L,
2113154843L, -784664340L, -128822022L, -163209937L, 2062125369L,
861354830L, 1545011612L, 827972365L, -598069897L, 1574513024L,
2146463710L, 1555683499L, 1394510765L, 1994059802L, 1254287064L,
1157949249L, 733304819L, -1524131308L, -143899742L, 1304771767L,
1639224961L, 490073734L, -310323516L, 839489525L, -58704289L,
-1170794312L, -794714730L, 522506147L, 1681933157L, -350150014L,
-587993104L, -475039335L, -611715189L, 436126332L, 1497649322L,
-545656097L, 466731113L, -1043514754L, 1661862508L, 898563773L,
-216939641L, 216606576L, -1615770098L, 542462779L, -1633054691L,
-941242166L, 49222632L, 816193745L, -269255485L, 1347847108L,
1688250482L, -1719305913L, -1299700463L, -1463000938L, -411638284L,
564754309L, -1574328625L, 18428872L, -1370004890L, 136176420L
)
.sedim.descript <-
function(x,um){
um=as.numeric(um)
x=as.data.frame(x)
sum.sieve=apply(x,2,sum)
sediment=data.frame(matrix(ncol=0,nrow=13))
for (b in 1:dim(x)[2])
{
class.weight=(x[,b])*100/sum.sieve[b]
class.weight.um=cbind(class.weight,um)
seuil.sedim=c(63000,31500,2^c(4:-3)*1000,63,40,NA)
class.sedim=c("boulder","vcgravel","cgravel","mgravel","fgravel","vfgravel","vcsand","csand","msand","fsand","vfsand","vcsilt","silt")
sedim=data.frame(cbind(seuil.sedim,class.sedim),stringsAsFactors = FALSE)
sedim[,1]=as.numeric(sedim[,1])
result=data.frame(matrix(nrow=dim(sedim)[1],ncol=dim(sedim)[1]))
result[,1]=sedim[,1]
names(result)=c("Sedim","Pourcentage")
sedim.result=0
sedim.percent=subset(class.weight.um,class.weight.um[,2]>=sedim[1,1])
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[1,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[1,1] & class.weight.um[,2]>=(sedim[2,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[2,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[2,1] & class.weight.um[,2]>=(sedim[3,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[3,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[3,1] & class.weight.um[,2]>=(sedim[4,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[4,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[4,1] & class.weight.um[,2]>=(sedim[5,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[5,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[5,1] & class.weight.um[,2]>=(sedim[6,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[6,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[6,1] & class.weight.um[,2]>=(sedim[7,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[7,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[7,1] & class.weight.um[,2]>=(sedim[8,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[8,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[8,1] & class.weight.um[,2]>=(sedim[9,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[9,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[9,1] & class.weight.um[,2]>=(sedim[10,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[10,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[10,1] & class.weight.um[,2]>=(sedim[11,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[11,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[11,1] & class.weight.um[,2]>=(sedim[12,1]))
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[12,1]=sedim.result
sedim.percent=subset(class.weight.um,class.weight.um[,2]<sedim[12,1])
sedim.result=sum(as.numeric(sedim.percent[,1]))
result[13,1]=sedim.result
result=data.frame(result[,1])
names(result)=names(x)[b]
row.names(result)=class.sedim
sediment=cbind(sediment,round(result,3))
}
return(sediment)
}
.texture.sedim <-
function(x,um){
um=as.numeric(um)
x=as.data.frame(x)
sum.sieve=apply(x,2,sum)
Texture=data.frame(matrix(ncol=0,nrow=5))
for (b in 1:dim(x)[2])
{
class.weight=(x[,b]*100)/sum.sieve[b]
class.weight.um=cbind(class.weight,um)
class.weight.um[,1] <- as.numeric(as.character(class.weight.um[,1]))
class.weight.um[,2] <- as.numeric(as.character(class.weight.um[,2]))
seuil.texture=c(63000,2000,63,0)
class.texture=c("Boulder","Gravel","Sand","mud")
texture=data.frame(cbind(seuil.texture,class.texture),stringsAsFactors = FALSE)
texture[,1]=as.numeric(texture[,1])
result=data.frame(matrix(nrow=dim(texture)[1],ncol=dim(texture)[2]))
result[,1]=texture[,2]
names(result)=c("Texture","Pourcentage")
texture.result=0
texture.percent=subset(class.weight.um,class.weight.um[,2]>=texture[1,1])
texture.result=sum(texture.percent[,1])
result[1,2]=texture.result
texture.percent=subset(class.weight.um,class.weight.um[,2]<texture[1,1] & class.weight.um[,2]>=(texture[2,1]))
texture.result=sum(texture.percent[,1])
result[2,2]=texture.result
texture.percent=subset(class.weight.um,class.weight.um[,2]<texture[2,1] & class.weight.um[,2]>=(texture[3,1]))
texture.result=sum(texture.percent[,1])
result[3,2]=texture.result
texture.percent=subset(class.weight.um,class.weight.um[,2]<(texture[3,1]))
texture.result=sum(texture.percent[,1])
result[4,2]=texture.result
mud=round(result[4,2],3)
gravel=round(result[2,2],3)
sand=round(result[3,2],3)
{if (mud==0 & sand==0) mudsand=0
if (mud==0 & sand>0) mudsand=10
if (sand==0 & mud>0) mudsand=0.01
else mudsand=sand/mud }
if (mudsand>=9){
if (gravel>80) texture="Gravel"
if (gravel>30 & gravel<=80) texture="Sandy Gravel"
if (gravel>5 & gravel<=30) texture="Gravelly Sand"
if (gravel>0 & gravel<=5) texture="Slightly Gravelly Sand"
if (gravel==0) texture="Sand"}
if (mudsand>=1 & mudsand<9){
if (gravel>80) texture="Gravel"
if (gravel>30 & gravel<=80) texture="Muddy Sandy Gravel"
if (gravel>5 & gravel<=30) texture="Gravelly Muddy Sand"
if (gravel>0 & gravel<=5) texture="Slightly Gravelly Muddy Sand"
if (gravel==0) texture="Muddy Sand"}
if (mudsand>=(1/9) & mudsand<1){
if (gravel>80) texture="Gravel"
if (gravel>30 & gravel<=80) texture="Muddy Gravel"
if (gravel>5 & gravel<=30) texture=" Gravelly Mud"
if (gravel>0 & gravel<=5) texture="Slightly Gravelly Sandy Mud"
if (gravel==0) texture="Sandy Mud"}
if (mudsand<(1/9)){
if (gravel>80) texture="Gravel"
if (gravel>30 & gravel<=80) texture="Muddy Gravel"
if (gravel>5 & gravel<=30) texture=" Gravelly Mud"
if (gravel>0 & gravel<=5) texture="Slightly Gravelly Mud"
if (gravel==0) texture="Mud"}
row.names(result)=result[,1]
name.texture=row.names(result)
result=data.frame(result[,2])
texture.sedim=data.frame(rbind(texture,round(result,3)))
row.names(texture.sedim)=c("Texture",name.texture)
names(texture.sedim)=names(x)[b]
texture.sedim
Texture=cbind(Texture,texture.sedim)
}
return(Texture)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.