Quit

Prerequisites

g[x_]=0.5 1/(1+Exp[-100 x])+0.25+0.24Sin[20 x];
Plot[{0.5,g[x]},{x,-1,1}]

points=Table[i,{i,-1,1,0.01}];
ListPlot[Thread[{points,g[#]&/@points}]]

logloss=-#1Log[((#2)/(1-#2))]-Log[1-#2]&;
(* Asymptotes at 0 and 1 cause numerical problems, so put a cap *)
loglosst=-#1Log[((Min[#2,0.999])/(1-Min[#2,0.999]))]-Log[1-Min[#2,.999]]&;
Plot[{logloss[0.6,x],loglosst[0.6,x]},{x,0,1}]

linloss=#2(1-2 #1)&;
Plot[linloss[0.6,x],{x,0,1}]

sqloss=(((#1-#2))^2)&;
Plot[sqloss[0.6,x],{x,0,1}]

Fitters

(* function accepts loss, points, num of params, returns fitted function *)

myfit[loss_,dims_,points_,g_]:=Module[{params,f,realloss,p0,timing,pt,sol},
params=Thread[(Subscript[p, #])&/@Table[i,{i,1,dims}]];
(* function of the form 1/Exp(p1+p2 x+p3 x^2*)
f[x_,params_]:=1/(1+Exp[-Plus@@Thread[Thread[Power[x,Table[i,{i,0,Length[params]-1}]]]*params]]);
realloss=Plus@@(loss[g[#],f[#,params]]&/@points);
(* starting position for minimization*)
p0=Table[0,{i,1,dims}];
(* initialize starting position by minimizing squared loss (faster for some reason)*)
timing=Timing[pt=FindMinimum[realloss,Thread[{params,p0}]]];
sol=pt[[2]];
{timing[[1]],f[x,params]/.sol,params/.sol}
]

Optimized version

myfit2[loss_,dims_,points_,g_]:=Module[{params,f,realloss,p0,p1,timing,pt,sol},
params=Thread[(Subscript[p, #])&/@Table[i,{i,1,dims}]];
(* function of the form 1/Exp(p1+p2 x+p3 x^2*)
f[x_,params_]:=1/(1+Exp[-Plus@@Thread[Thread[Power[x,Table[i,{i,0,Length[params]-1}]]]*params]]);
realloss=Plus@@(loss[g[#],f[#,params]]&/@points);
(* starting position for minimization*)
p0=myfit[(#1-#2)&,dims,points,g][[3]] ;(* initialize using squared loss *)
p1=Table[0,{i,1,dims}];
{p0,p1};
timing=Timing[pt=FindMinimum[realloss,Thread[{params,p0}]]](*
sol=pt[[2]];
{timing[[1]],f[x,params]/.sol}*)
]

myfit[(((#1-#2))^2)&,10,points,g]

Plot[Evaluate[myfit[-#1Log[((#2)/(1-#2))]-Log[1-#2]&,14,Table[i,{i,-1,1,0.01}],g][[2]]],{x,-1,1}]

Plot[Evaluate[myfit[(((#1-#2))^2)&,12,Table[i,{i,-1,1,0.01}],g][[2]]],{x,-1,1}]

Plot[Evaluate[myfit[(((#1-#2))^2)&,#,points,g][[2]]&/@Table[i,{i,1,10}]],{x,-1,1}]

Plot[Evaluate[myfit[-#1Log[((#2)/(1-#2))]-Log[1-#2]&,#,points,g][[2]]&/@{1,12}],{x,-1,1}]

Fitter that uses orthogonal basis

myfito[loss_,dims_,points_,g_]:=Module[{params,polys,f,timing,sol,pt},
params=Thread[(Subscript[p, #])&/@Table[i,{i,0,dims-1}]];
polys=LegendreP[#,x]*(2#+1)&/@Table[i,{i,0,dims-1}]; (* orthonormal polynomials*)
f=1/(1+Exp[-Plus@@Thread[polys*params]]);
realloss=Plus@@(loss[g[#],f/.{x->#}]&/@points) ;
p0=Table[0,{i,0,dims-1}];
p0[[2]]=10; (* set starting point to the optimal classifier *)
timing=Timing[pt=FindMinimum[realloss,Thread[{params,p0}]]];
sol=pt[[2]];
{timing[[1]],f/.sol,params/.sol}
];

myfit[(((#1-#2))^2)&,14,points,g]

temp=myfito[-#1Log[((#2)/(1-#2))]-Log[1-#2]&,35,points,g][[2]];
Plot[temp,{x,-1,1}]

Plot[temp,{x,-1,1}]

Faster version that initializes starting point using squared loss minimizer

myfito2[loss_,dims_,points_,g_]:=Module[{params,polys,f,timing,sol,pt},
params=Thread[(Subscript[p, #])&/@Table[i,{i,0,dims-1}]];
polys=LegendreP[#,x]*(2#+1)&/@Table[i,{i,0,dims-1}]; (* orthonormal polynomials*)
f=1/(1+Exp[-Plus@@Thread[polys*params]]);
realloss=Plus@@(loss[g[#],f/.{x->#}]&/@points) ;
p0=myfito[(((#1-#2))^2)&,dims,points,g][[3]] ;(* initialize using minimum of squared loss *)
p1=Table[0,{i,0,dims-1}];
timing=Timing[pt=FindMinimum[realloss,Thread[{params,p0}]]];
sol=pt[[2]];
{timing[[1]],f/.sol,params/.sol}
];

Faster? version that uses gradients(actually slower)

Constrained fitter

myfitoc[loss_,dims_,points_,g_]:=Module[{params,polys,f,timing,sol,pt},
params=Thread[(Subscript[p, #])&/@Table[i,{i,0,dims-1}]];
polys=LegendreP[#,x]*(2#+1)&/@Table[i,{i,0,dims-1}]; (* orthonormal polynomials*)
f=1/(1+Exp[-Plus@@Thread[polys*params]]);
realloss=Plus@@(loss[g[#],f/.{x->#}]&/@points) ;
p0=Table[0,{i,0,dims-1}];
cons=And@@(LessEqual[-10000,#,10000]&/@params);
timing=Timing[pt=FindMinimum[{realloss,cons},Thread[{params,p0}]]];
sol=pt[[2]];
{timing[[1]],f/.sol,params/.sol}
];