(*******************************  microsperma  *)

Needs["Splines`"]

microsperma[1]={{0.2155,7.9741},{1.0776,7.9741},{1.9397,7.7586},{2.8017,7.5431},{3.6638,7.1121},{4.5259,7.1121},{5.3879,7.1121},{6.2500,6.6810},{7.1121,6.2500},{7.9741,5.6034},{8.8362,4.9569},{9.6983,5.6034},{10.5603,6.8966},{11.4224,7.7586},{12.2845,8.1897},{13.1466,9.4828},{14.0086,10.3448},{14.8707,10.7759},{15.7328,10.9914},{16.5948,11.6379},{17.4569,11.8534},{18.3190,12.2845},{19.1810,13.3621},{20.0431,14.0086},{20.9052,14.8707},{21.7672,15.5172},{22.6293,16.3793},{23.4914,16.8103},{24.3534,17.6724},{25.2155,18.7500},{26.0776,19.8276},{26.9397,20.9052},{27.8017,21.7672},{28.6638,21.9828},{29.5259,22.1983},{30.3879,21.9828},{31.2500,21.7672},{32.1121,21.3362},{32.9741,20.2586},{33.8362,18.5345},{34.6983,17.6724},{35.5603,17.0259},{36.4224,16.3793},{37.2845,15.9483},{38.1466,14.6552},{39.0086,14.4397},{39.8707,14.0086},{40.7328,13.5776},{41.5948,12.7155},{42.4569,11.8534},{43.3190,11.2069},{44.1810,10.7759},{45.0431,10.3448},{45.9052,9.9138},{46.7672,9.6983},{47.6293,9.4828},{48.4914,8.6207},{49.3534,7.7586},{50.2155,7.5431},{51.0776,7.9741},{51.9397,8.8362},{52.8017,8.8362},{53.6638,8.8362},{54.5259,8.6207},{55.3879,8.4052},{56.2500,8.4052},{57.1121,8.8362},{57.9741,8.4052},{58.8362,8.4052},{59.6983,7.9741},{60.5603,7.9741},{61.4224,8.1897},{62.2845,8.6207},{63.1466,8.8362},{64.0086,8.8362},{64.8707,8.4052},{65.7328,8.4052},{66.5948,8.4052},{67.4569,8.4052},{68.3190,8.4052},{69.1810,8.4052},{70.0431,8.4052},{70.9052,8.4052},{71.7672,8.4052},{72.6293,8.4052},{73.4914,8.4052},{74.3534,8.1897},{75.2155,7.9741},{76.0776,7.9741},{76.9397,7.9741},{77.8017,7.9741},{78.6638,7.9741},{79.5259,7.9741},{80.3879,7.9741},{81.2500,7.5431},{82.1121,7.5431},{82.9741,7.5431},{83.8362,7.5431},{84.6983,7.5431},{85.5603,7.5431},{86.4224,7.5431},{87.2845,7.1121},{88.1466,6.2500},{89.0086,5.8190},{89.8707,5.3879},{90.7328,5.8190},{91.5948,5.6034},{92.4569,5.3879}}
microsperma[2]={{0.2155,3.6638},{1.0776,3.4483},{1.9397,2.8017},{2.8017,3.0172},{3.6638,3.4483},{4.5259,4.3103},{5.3879,4.7414},{6.2500,5.1724},{7.1121,6.4655},{7.9741,7.7586},{8.8362,8.1897},{9.6983,9.0517},{10.5603,10.3448},{11.4224,10.9914},{12.2845,12.0690},{13.1466,13.3621},{14.0086,14.8707},{14.8707,16.8103},{15.7328,18.9655},{16.5948,21.1207},{17.4569,24.3534},{18.3190,25.8621},{19.1810,26.5086},{20.0431,26.9397},{20.9052,26.9397},{21.7672,26.9397},{22.6293,26.2931},{23.4914,25.4310},{24.3534,24.7845},{25.2155,23.7069},{26.0776,22.4138},{26.9397,21.7672},{27.8017,21.1207},{28.6638,20.2586},{29.5259,19.3966},{30.3879,18.5345},{31.2500,17.6724},{32.1121,17.2414},{32.9741,16.1638},{33.8362,14.8707},{34.6983,14.0086},{35.5603,13.7931},{36.4224,12.7155},{37.2845,10.7759},{38.1466,9.6983},{39.0086,8.8362},{39.8707,8.1897},{40.7328,7.5431},{41.5948,7.5431},{42.4569,7.7586},{43.3190,8.4052},{44.1810,8.4052},{45.0431,7.7586},{45.9052,7.5431},{46.7672,7.7586},{47.6293,8.6207},{48.4914,9.0517},{49.3534,9.4828},{50.2155,10.5603},{51.0776,11.4224},{51.9397,12.5000},{52.8017,12.9310},{53.6638,13.3621},{54.5259,13.7931},{55.3879,14.6552},{56.2500,15.3017},{57.1121,15.7328},{57.9741,16.1638},{58.8362,17.6724},{59.6983,19.1810},{60.5603,19.8276},{61.4224,22.4138},{61.4224,23.9224},{62.2845,24.5690},{63.1466,25.6466},{64.0086,26.0776},{64.8707,26.0776},{65.7328,26.0776},{66.5948,26.0776},{67.4569,25.4310},{68.3190,24.3534},{69.1810,23.7069},{70.0431,22.8448},{70.9052,22.4138},{71.7672,21.5517},{72.6293,20.9052},{73.4914,20.0431},{74.3534,18.9655},{75.2155,17.2414},{76.0776,16.3793},{76.9397,15.0862},{77.8017,13.7931},{78.6638,12.9310},{79.5259,10.7759},{80.3879,10.1293},{81.2500,10.3448},{82.1121,11.2069},{82.9741,12.0690}}
microsperma[3]={{0.2155,10.1293},{1.0776,9.9138},{1.9397,9.6983},{2.8017,9.6983},{3.6638,9.6983},{4.5259,9.4828},{5.3879,9.4828},{6.2500,10.3448},{7.1121,11.4224},{7.9741,12.2845},{8.8362,12.9310},{9.6983,14.4397},{10.5603,15.0862},{11.4224,16.1638},{12.2845,17.6724},{13.1466,18.5345},{14.0086,19.8276},{14.8707,21.1207},{15.7328,22.4138},{16.5948,23.2759},{17.4569,24.1379},{18.3190,25.4310},{19.1810,26.5086},{20.0431,27.1552},{20.9052,27.1552},{21.7672,26.7241},{22.6293,26.5086},{23.4914,25.6466},{24.3534,25.0000},{25.2155,24.3534},{26.0776,23.4914},{26.9397,22.4138},{27.8017,21.5517},{28.6638,20.6897},{29.5259,19.6121},{30.3879,18.5345},{31.2500,18.1034},{32.1121,17.6724},{32.9741,16.8103},{33.8362,16.1638},{34.6983,15.7328},{35.5603,15.5172},{36.4224,15.0862},{37.2845,14.0086},{38.1466,12.9310},{39.0086,12.5000},{39.8707,11.8534},{40.7328,10.5603},{41.5948,10.1293},{42.4569,10.3448},{43.3190,10.7759},{44.1810,11.2069},{45.0431,11.6379},{45.9052,12.0690},{46.7672,12.2845},{47.6293,12.9310},{48.4914,13.7931},{49.3534,15.0862},{50.2155,15.7328},{51.0776,15.7328},{51.9397,16.8103},{52.8017,18.1034},{53.6638,19.1810},{54.5259,20.0431},{55.3879,21.1207},{56.2500,21.7672},{57.1121,22.1983},{57.9741,22.1983},{58.8362,22.1983},{59.6983,22.4138},{60.5603,22.8448},{61.4224,22.8448},{62.2845,22.4138},{63.1466,22.1983},{64.0086,22.1983},{64.8707,21.7672},{65.7328,21.3362},{66.5948,20.9052},{67.4569,20.2586},{68.3190,18.9655},{69.1810,18.1034},{70.0431,17.2414},{70.9052,15.9483},{71.7672,15.0862},{72.6293,14.2241},{73.4914,13.3621},{74.3534,12.7155},{75.2155,12.2845},{76.0776,10.5603},{76.9397,10.1293},{77.8017,10.3448},{78.6638,11.2069}}
microsperma[4]={{0.2155,6.2500},{1.0776,6.2500},{1.9397,5.6034},{2.8017,5.1724},{3.6638,5.3879},{4.5259,5.3879},{5.3879,5.6034},{6.2500,6.8966},{7.1121,7.7586},{7.9741,8.8362},{8.8362,10.3448},{9.6983,11.6379},{10.5603,12.0690},{11.4224,12.5000},{12.2845,13.7931},{13.1466,14.8707},{14.0086,14.8707},{14.8707,15.0862},{15.7328,15.9483},{16.5948,17.2414},{17.4569,18.5345},{18.3190,19.1810},{19.1810,19.6121},{20.0431,19.8276},{20.9052,19.6121},{21.7672,19.6121},{22.6293,18.9655},{23.4914,18.3190},{24.3534,18.1034},{25.2155,18.3190},{26.0776,17.8879},{26.9397,17.4569},{27.8017,17.6724},{28.6638,17.4569},{29.5259,17.2414},{30.3879,17.0259},{31.2500,17.0259},{32.1121,16.8103},{32.9741,16.3793},{33.8362,15.5172},{34.6983,14.8707},{35.5603,14.2241},{36.4224,14.0086},{37.2845,13.7931},{38.1466,13.5776},{39.0086,12.9310},{39.8707,12.5000},{40.7328,11.8534},{41.5948,11.4224},{42.4569,11.6379},{43.3190,12.7155},{44.1810,13.5776},{45.0431,14.4397},{45.9052,14.6552},{46.7672,15.7328},{47.6293,16.5948},{48.4914,17.0259},{49.3534,17.2414},{50.2155,18.1034},{51.0776,18.5345},{51.9397,19.3966},{52.8017,19.8276},{53.6638,20.9052},{54.5259,21.7672},{55.3879,21.7672},{56.2500,21.7672},{57.1121,23.0603},{57.9741,23.4914},{58.8362,24.1379},{59.6983,24.3534},{60.5603,24.7845},{61.4224,24.7845},{62.2845,24.7845},{63.1466,24.7845},{64.0086,24.7845},{64.8707,24.7845},{65.7328,24.3534},{66.5948,24.3534},{67.4569,24.3534},{68.3190,23.2759},{69.1810,21.1207},{70.0431,20.0431},{70.9052,20.0431},{71.7672,19.3966},{72.6293,18.9655},{73.4914,18.1034},{74.3534,17.6724},{75.2155,17.2414},{76.0776,16.8103},{76.9397,17.0259},{77.8017,17.0259},{78.6638,17.0259}}

(*Poner aqui la familia*)
var=microsperma;
(* el número de curvas estudiadas/semillas de la familia*)
m=4;
For[j=1,j≤m,j++,
puntos=var[j];
(* pru es el spline cubico
d es el vector que contiene la información de pru 
n es el número de trozos del spline, es decir, el número de puntos menos 1
*)
pru=SplineFit[puntos,Cubic];
d=InputForm[pru];
n=IntegerPart[d[[1,2,2]]];
spli=ParametricPlot[pru[t],{t,0,n},PlotRange->All, DisplayFunction->Identity];
(* Con los coeficientes se calculan los polinomios cúbicos que dan el spline. Habrá n polinomios para la primera coordenada (X) y otros tantos para la segunda
*)
For[i=0,i<n,i++,
SX[i,t_]=d[[1,4,i+1,1,1]]+d[[1,4,i+1,1,2]]*(t-i)+d[[1,4,i+1,1,3]]*(t-i)^2+d[[1,4,i+1,1,4]]*(t-i)^3];
For[i=0,i<n,i++,SY[i,t_]=d[[1,4,i+1,2,1]]+d[[1,4,i+1,2,2]]*(t-i)+d[[1,4,i+1,2,3]]*(t-i)^2+d[[1,4,i+1,2,4]]*(t-i)^3];
(* Derivada primera y segunda de cada trozo del spline
*)
For[i=0,i<n,i++,DX[i,t_]=d[[1,4,i+1,1,2]]+2*d[[1,4,i+1,1,3]]*(t-i)+3*d[[1,4,i+1,1,4]]*(t-i)^2];
For[i=0,i<n,i++,DY[i,t_]=d[[1,4,i+1,2,2]]+2*d[[1,4,i+1,2,3]]*(t-i)+3*d[[1,4,i+1,2,4]]*(t-i)^2];
For[i=0,i<n,i++,DDX[i,t_]=2*d[[1,4,i+1,1,3]]+6*d[[1,4,i+1,1,4]]*(t-i)];
For[i=0,i<n,i++,DDY[i,t_]=2*d[[1,4,i+1,2,3]]+6*d[[1,4,i+1,2,4]]*(t-i)];
(*Cálculo de la curvatura a trozos
*)
For[i=0,i<n,i++,cur[i,t_]=(DX[i,t]DDY[i,t]-DDX[i,t]DY[i,t])/((DX[i,t])^2+(DY[i,t])^2)^(3/2)];
(* Dibujos de los trozos de curvatura 
*)
For[i=0,i<n,i++,dib[i]=Plot[cur[i,t],{t,i,i+1},DisplayFunction->Identity]];
pp=dib[0];
For[i=1,i<n,i++,pp=Show[pp,dib[i],PlotRange->All]];
(* bez es el spline de Bezier
b es el vector que contiene la información de bez
nb es el número de trozos del spline, es decir, el número de puntos menos 1 (Como nb=n, no se define nuevo)
*)
bez=SplineFit[puntos,Bezier];
b=InputForm[bez];
(*Calculo de las funciones de Bezier para la coordenada X y la Y; la curva es la imagen del intervalo[0,1]*)
For[i=1,i≤n+1,i++,BX[t_]=bez[[4,1,1]]/.#1->t];
For[i=1,i≤n+1,i++,BY[t_]=bez[[4,1,2]]/.#1->t];
dibez[j]=ParametricPlot[{BX[t],BY[t]},{t,0,1},PlotRange->All,DisplayFunction->Identity];
curbe[j,t_]=1000*(BX'[t]BY''[t]-BX''[t]BY'[t])/((BX'[t])^2+(BY'[t])^2)^(3/2);
aa=0.1;
bb=0.9;
cur[j]=Abs[NMinValue[{curbe[j,t],aa<t<bb},t]];
vmed[j]=Abs[NIntegrate[curbe[j,t],{t,aa,bb}]];
vals[j]=Reap[soln=y[x]/. First[NDSolve[{y'[x]==Evaluate[D[curbe[j,x],x]],y[0]==(curbe[j,x]/. x->0)},y[x],{x,aa,bb},Method->{"EventLocator","Event"->y'[x],"EventAction":>Sow[{x,y[x]}]}]]][[2,1]];
Print[ var,"-",j,":"];Print["Máximos y mínimos locales "];
Print[vals[j]];
z=vals[j];
max[j]=Max[Table[z[[k,2]],{k,1,Length[z]}]];
min[j]=Min[Table[z[[k,2]],{k,1,Length[z]}]];dibcurbe[j]=Plot[curbe[j,x],{x,0,1},Epilog->{PointSize[Medium],Red,Point[z]}];
Print[dibez[j]];
Print[dibcurbe[j]];
Print[Plot[{curbe[j,t],vmed[j]},{t,0,1},Axes->True,DisplayFunction->Identity,PlotStyle->{RGBColor[0,1,0],{Dotted,Dashed}}]];
Print[ "Máximo valor de la curvatura",max[j]];
Print[ "Mínimo valor de la curvatura",min[j]];Print[ "Máximo valor de la curvatura (en valor absoluto)con otro cálculo",cur[j]];
Print["______________________________________________________"];];
Print["Curvaturas de cada ", var ,":  ", Table[cur[r],{r,1,4}]];
Print["Valores medios de curvatura de cada ", var ," en [0,1]:  ", Table[vmed[j],{j,1,4}]];

Show[Table[dibcurbe[j],{j,1,6}]]

Table[NMinValue[{curbe[j,t],0.25<t<0.75},t],{j,1,6}]

dibcurbe[j],{j,1,6}

Table[dibcurbe[j],{j,1,6}]

curbe[j,t_]
dibcurbe[j]

Plot[curbe[1,x],{x,0,1},Epilog->{PointSize[Medium],Red,Point[vals[1]]}]

dibcurbe[j]=Plot[curbe[j,x],{x,0,1},Epilog->{PointSize[Medium],Red,Point[z]}]

dibcurbe2[1]

Print[dibez[1]];

f=vals[1]

Max[vals[1]]

Max[Table[f[[k,2]],{k,1,Length[f]}]]
Min[Table[f[[k,2]],{k,1,Length[f]}]]

List