(* $Id: func.m,v 1.14 1997/10/10 21:00:41 tjchol01 Exp $ *) BeginPackage["func`", {"Graphics`Graphics`", "Statistics`DescriptiveStatistics`", "Statistics`DataManipulation`"}]; Spy::usage="" Pri::usage="" TS::usage="" LiListPlot::usage="" MLiListPlot::usage="" ULiListPlot::usage="" SLiListPlot::usage="" ALiListPlot::usage="" CMatr::usage="" conf::usage="" con4::usage="" con8::usage="" con12::usage="" con20::usage="" con24::usage="" calcinp::usage="" posprep::usage="" wprep::usage="" wone::usage="" MPri::usage="" makemat::usage="" rank::usage="" indep::usage="" undep::usage="" done::usage="" matwrite::usage="" prezero::usage="" acfshow::usage="" ReadWeights::usage="" WriteTable::usage="" normalize::usage = "normalize[x_List, a_] returns a list consisting of a list x' being a list x normalized to the range [-a, a] and of a list {a, b} such that x = a x' + b.";\ norm::usage = "norm[x_List, r_] returns a list {a, b} such that x' = a x + b for list x' being a list x normalized to the range [-r, r].";\ norm::zero = "List is constant: max = min";\ prep::usage="Creates weights and normalizes input/output." normvar::usage="" denormvar::usage="" prepvar::usage="" prepnovar::usage="" prepvar::incompat="Incompatible shapes." MatPlot::usage="" SNC::usage = "" vfold::usage = "Returns a list of |v| pairs: |x| without a part and this part" PRun::usage = "Identity dummy definition. Load para.m for full definition." minpos::usage = "" xprepnovar::usage = "" arv::usage = "" stat::usage="" GetData::usage="" Tr::usage="" Begin["`Private`"] SetOptions[$Output, PageWidth->Infinity, TotalWidth->1000, FormatType->OutputForm]; SetOptions[MatrixForm, TableSpacing->{0, 1, 0, 1}]; $PrePrint = NumberForm[#, 3, ExponentFunction->(If[Abs[#] > 10, #, Null]&)]&; Spy = (Print[#]; #)&; Pri[x_] := (Print[$PrePrint[x]]; x) TS[x_] := ToString[NumberForm[x,3, ExponentFunction->(Null&)]] LiListPlot[x_List, opts___] := Show[ ListPlot[#, PlotJoined->True, PlotRange->All, DisplayFunction->Identity, opts]& /@ x, opts, DisplayFunction->$DisplayFunction ]; MLiListPlot[x_List, opts___] := With[ {vert = Table[ i, {i, 0, Length[x] - 1}]}, Show[ ListPlot[#, PlotJoined->True, DisplayFunction->Identity, Axes->False, GridLines->{None, Join[vert, {-1/2}, vert + 1/2]}, opts]& /@ (Reverse[x] + vert), DisplayFunction->$DisplayFunction] ]; ULiListPlot[x_List, opts___] := With[ {vert = Table[ i, {i, 0, Length[x] - 1}]}, Show[ ListPlot[#, PlotJoined->True, DisplayFunction->Identity, Axes->False, GridLines->{None, Join[{0}, 1+vert] }, opts]& /@ (Reverse[x] + vert), DisplayFunction->$DisplayFunction] ]; Correlation[x1_List, x2_List] := With[{x1m = x1 - Mean[x1], x2m = x2 - Mean[x2]}, (Plus @@ (x1m * x2m)) / Sqrt[ Plus @@ (x1m^2) * Plus @@ (x2m^2) ]] CorMat[x_List] := With[ {xm = # - Mean[#]& /@ Transpose[x]}, With[ {xm2 = (Plus@@(#^2))& /@ xm}, Table[ With[{den = xm2[[i]] xm2[[j]]}, If[den != 0, Plus@@(xm[[i]] xm[[j]])/ Sqrt[ den ], 0]], {i, Length[xm]}, {j, Length[xm]}] ]] CMatr[x_List] := With[ {n = Length[x], m = Length[x[[1]]], sums = ((Plus@@#)& /@ Transpose[x]), sumsq = (Transpose[x] . x)}, With[ {d2x = Table[ n sumsq[[i, i]] - sums[[i]]^2, {i, m}]}, Table[ With[{den = d2x[[i]] d2x[[j]]}, If[den > 0, (n sumsq[[i, j]] - sums[[i]] sums[[j]]) / Sqrt[ den ], 0]], {i, m}, {j, m}] ]] conf = {{0}}; con4 = {{-1, 0}, {0, -1}, {1, 0}, {0, 1}}; con8 = Join[con4, {{-1, -1}, {-1, 1}, {1, -1}, {1, 1}}]; con12 = Join[con8, {{-2, 0}, {0, -2}, {2, 0}, {0, 2}}]; con20 = Join[con12, {{-2, -1}, {-2, 1}, {-1, -2}, {1, -2}, {2, -1}, {2, 1}, {-1, 2}, {1, 2}}]; con24 = Join[con20, {{-2, -2}, {-2, 2}, {2, -2}, {2, 2}}]; calcinp[i_, sqr_, pos_] := With[ {rw = Quotient[i - 1, sqr], col = Mod[i - 1, sqr]}, Mod[ col + #[[1]], sqr] + sqr * Mod[ rw + #[[2]], sqr] + 1& /@ pos ] posprep[ n_Integer, con_List, sqr_Integer ] := If[ con === conf, Table[ i, {n}, {i, n} ], Table[ calcinp[i, sqr, con], {i, n} ]]; wprep[ w_List, pos_List ] := MapThread[ #1[[ #2 ]]&, {w, pos}]; wone[w_List, n_Integer, eps_] := eps w + (1 - eps (Plus @@ #)& /@ w) IdentityMatrix[n]; MPri[x_List] := (Pri[MatrixForm[Partition[x, 5]]]; Print[" "];); MPri[n_Integer] := (Pri[MatrixForm[Partition[#, n]]]; Print[" "];)&; makemat[pp_List, pos_List] := Fold[ Function[{l, vp}, MapAt[ vp[[2]]&, l, vp[[1]] ]], Table[0, {Length[pos]}], #]& /@ MapThread[List, {pos, pp}, 2] rank[m_?MatrixQ] := Length[m[[1]]] - Length[NullSpace[m]] indep[m_?MatrixQ] := Take[ RowReduce[m], rank[m] ] undep[m_?MatrixQ] := First @ FixedPoint[ If[ #[[2]] == {}, #, {Append[#[[1]], #[[2,1]]], Delete[ #[[2]], Position[#[[2]], #[[2,1]] | -#[[2,1]]] ]}]&, {{}, m}] done := (Run["echo \"\rDone!!!\" | write ", Environment["USER"]]; 0) matwrite[file_String, mat_?MatrixQ] := Module[ {stmp = OpenWrite[file, FormatType->OutputForm, PageWidth->Infinity]}, Write[ stmp, MatrixForm[ mat ] ]; Close[stmp]; ] prezero[l_List] := MapIndexed[ Flatten[{#2[[1]] - 1, #1}]&, l]; prezero[x_List, n_Integer] := Join[ Table[0, {n}, {Length[x[[1]]]}], x] acfshow[atest_List] := Show[ ErrorListPlot[prezero@Transpose@{atest[[3]], Prepend[atest[[4]],0]}], ListPlot[prezero[atest[[3]]], PlotJoined->True], PlotRange->All]; ReadWeights[f_String] := Module[{s = OpenRead[f], in, hid, outp, kupa, V, W}, {in, hid, outp, kupa} = Read[s, {Number, Number, Number, String}];\ V = Read[s, Table[ Number, {hid}, {in + 1}]]; W = Read[s, Table[ Number, {outp}, {hid + 1}]]; Close[s]; {V, W} ] WriteTable[l_List, name_String] := Module[{s}, s = OpenWrite[name, PageWidth->Infinity, FormatType->OutputForm]; Write[s, TableForm[l, TableSpacing->{0, 1, 0, 1, 0, 1, 0, 1}]]; Close[s]; ] normalize[x_List, a_] := Module[{ma, mi}, ma = Max[x]; mi = Min[x]; {2. a (x - mi)/(ma - mi) - a, {(ma - mi)/(2. a), (ma + mi)/2.}} ] norm[x_List, r_] := Module[{ma, mi}, ma = Max[x]; mi = Min[x]; If[ma == mi, Message[norm::zero]; $Failed, (*$*) N[{2. r/(ma - mi), -r (2. mi/(ma - mi) + 1.)}]] ]; denorm[norm_List, ab_List] := Transpose@MapThread[(#1 - #2[[2]])/#2[[1]]&, {Transpose@norm, ab}] prep[inp_List, dout_List, hid_List, taps_List] := Module[{inpab, inpab1, doutab, nI, nK}, nI = Length[inp[[1]]]; nK = Length[dout[[1]]]; If[ hid[[1]] != nI || hid[[-1]] != nK || Length[hid] - 1 != Length[taps], Return[{}]]; VW = Table[ Table[(Random[] - .5)/1., {hid[[i+1]]}, {hid[[i]] taps[[i]] + 1}], {i, 1, Length[hid] - 1}]; inpab = Transpose[Append[DiagonalMatrix[#1], #2]]& @@ Transpose[norm[#, 0.9]& /@ Transpose[inp]];\ inpab1 = Append[inpab, Append[Array[0.&, nI], 1.]];\ inpnorm = (Append[#, 1.]& /@ inp) . Transpose[inpab];\ doutab = norm[#, 0.9]& /@ Transpose[dout];\ doutnorm = Transpose[MapThread[#2[[1]] #1 + #2[[2]]&, {Transpose[dout], doutab}] ]; {VW, inpnorm, doutnorm} ]; normvar[x_List] := (x - Mean[x]) / Sqrt[Variance[x]] denormvar[xnorm_List, x_List] := xnorm Sqrt[Variance[x]] + Mean[x] prepvarold[inp_List, dout_List, hid_List, taps_List] := Module[{inpab, inpab1, doutab, nI, nK}, nI = Length[inp[[1]]]; nK = Length[dout[[1]]]; If[ hid[[1]] != nI || hid[[-1]] != nK || Length[hid] - 1 != Length[taps], Message[prepvar::incompat]; $Failed]; VW = Table[ Table[ 2.0 (Random[] - .5) / (hid[[i]] taps[[i]] + 1), {hid[[i+1]]}, {hid[[i]] taps[[i]] + 1}], {i, 1, Length[hid] - 1}]; inpnorm = Transpose[normvar /@ Transpose[inp]]; doutnorm = Transpose[normvar /@ Transpose[dout]]; {VW, inpnorm, doutnorm} ]; MatPlot[tt_List, opts___] := Module[{n = Length[First@tt]}, Show @ GraphicsArray @ Table[ Table[ ListPlot[#[[{i, j}]]& /@ tt, DisplayFunction->Identity, opts], {i, 1, j - 1}], {j, 2, n}] ] prepvar[inp_List, dout_List, layers_List, taps_] := Module[{ninp, nout, nW, al}, ninp = Length[inp[[1]]]; nout = Length[dout[[1]]]; nW = Length[layers] - 1; If[ layers[[1]] != ninp || layers[[-1]] != nout || (ListQ[taps] && nW != Length[taps]), Message[prepvar::incompat]; Return[$Failed]]; (*$*) VW = Table[ al = Switch[taps, _List, layers[[i]] taps[[i]], 0, layers[[i]], 3, If[ i < nW, layers[[i]] + layers[[i + 1]], layers[[i]]], 4, layers[[i]] + layers[[i + 1]], 5, If[ i == 1, layers[[i]] + layers[[-1]], layers[[i]]], 6, If[ i == 1, layers[[i]] + layers[[i + 1]] + layers[[-1]], layers[[i]]], _, Message[prepvar::wrongtaps]; Return[$Failed]]; (*$*) Table[ 2.0 (Random[] - .5) / (al + 1), {layers[[i + 1]]}, {al + 1}], {i, 1, nW}]; inpnorm = Transpose[normvar /@ Transpose[inp]]; doutnorm = Transpose[normvar /@ Transpose[dout]]; {VW, inpnorm, doutnorm} ] prepnovar[inp_List, dout_List, layers_List, taps_] := Module[{ninp, nout, nW, al}, ninp = Length[inp[[1]]]; nout = Length[dout[[1]]]; nW = Length[layers] - 1; If[ layers[[1]] != ninp || layers[[-1]] != nout || (ListQ[taps] && nW != Length[taps]), Message[prepvar::incompat]; Return[$Failed]]; VW = Table[ al = Switch[taps, _List, layers[[i]] taps[[i]], 0, layers[[i]], 3, If[ i < nW, layers[[i]] + layers[[i + 1]], layers[[i]]], 4, layers[[i]] + layers[[i + 1]], 5, If[ i == 1, layers[[i]] + layers[[-1]], layers[[i]]], 6, If[ i == 1, layers[[i]] + layers[[i + 1]] + layers[[-1]], layers[[i]]], _, Message[prepvar::wrongtaps]; Return[$Failed]]; Table[ 2.0 (Random[] - .5) / (al + 1), {layers[[i + 1]]}, {al + 1}], {i, 1, nW}]; inpnorm = Transpose[normvar /@ Transpose[inp]]; doutnorm = Transpose[normvar /@ Transpose[dout]]; {VW, inp, dout} ] SNC[VW8_List, inp_List, dout_List, hidinc_Integer] := Module[{inpnorm, doutnorm, VW, VWa}, {VW, inpnorm, doutnorm} = prepvar[inp, dout, {1, hidinc + Length[VW8[[1]]], 1}, taps]; VWa = {prezero[VW8[[1]], Length[VW[[1]]] - Length[VW8[[1]]]], Transpose@prezero[Transpose@VW8[[2]], Length[VW[[2,1]]] - Length[VW8[[2,1]]]]}; Wmask = Map[If[#1 == 0, 1, 0]&, VWa, {-1}]; VW = MapIndexed[If[#1 == 0, VW[[##]]& @@ #2, #1]&, VWa, {-1}]; {VW, inpnorm, doutnorm, Wmask} ]; vfold[x_List, v_Integer] := Module[{n = Length[x], len, vf, m}, vf = Min[n, v]; len = Floor[n / vf]; m = Mod[n, vf]; Table[ {Delete[x, {#}& /@ (Range @@ #)], Take[x, #]}& @ If[i < m, {i len + i + 1, i len + i + len + 1}, {i len + m + 1, i len + m + len}], {i, 0, vf - 1} ] ] (* dummy definitions for functions from para.m *) If[ !ListQ[LinkResults], PRun := Identity; ] (* some fun *) Format[ LinkObject[s_String, n_Integer, i_Integer] ] := s <> ":" <> ToString[i] SLiListPlot[x_List, opts___] := Show[ ListPlot[#[[1]], PlotStyle -> #[[2]], PlotJoined->True, PlotRange->All, DisplayFunction->Identity, opts]& /@ x, opts, DisplayFunction->$DisplayFunction ]; ALiListPlot[x_List, opts___] := Show[ (ListPlot[#1, ##2, PlotJoined->True, PlotRange->All, DisplayFunction->Identity, opts]& @@#&)/@ x, opts, DisplayFunction->$DisplayFunction ]; minpos[x_List] := (Position[#, Min[#]]& [x])[[1,1]] xprepnovar[arch_Integer, layers_List, taps_List:{}] := Module[{nW, al, alactive, ti, mask, Wl}, nW = Length[layers] - 1; If[(arch == 1 || arch == 2) && nW != Length[taps], Message[xprepnovar::incompataps]; Return[$Failed]]; mask = {}; VW = Table[ If[ (arch == 1 || arch == 2), ti = taps[[i]]; If[ NumberQ[ti], al = layers[[i]] ti; Wl = Table[2.0 (Random[] - .5) / (al + 1), {layers[[i + 1]]}, {al + 1}]; AppendTo[mask, Map[If[# == 0, 0, 1]&, Wl, {-1}]]; Wl, al = layers[[i]] (Max[ti] + 1); (* List form of ti *) alactive = layers[[i]] Length[ti]; Wl = Table[If[ t == al || MemberQ[ ti, Mod[t, 1 + Max[ti]] ], 2.0 (Random[] - .5) / (alactive + 1), 0], {layers[[i + 1]]}, {t, 0, al}]; AppendTo[mask, Map[If[# == 0, 0, 1]&, Wl, {-1}]]; Wl ], al = Switch[arch, 0, layers[[i]], 3, If[ i < nW, layers[[i]] + layers[[i + 1]], layers[[i]]], 4, layers[[i]] + layers[[i + 1]], 5, If[ i == 1, layers[[i]] + layers[[-1]], layers[[i]]], 6, If[ i == 1, layers[[i]] + layers[[i + 1]] + layers[[-1]], layers[[i]]], _, Message[prepvar::wrongtaps]; Return[$Failed]]; (*$*) Table[ 2.0 (Random[] - .5) / (al + 1), {layers[[i + 1]]}, {al + 1}] ], {i, 1, nW}]; {VW, mask} ] arv[out_List, test_List] := Plus@@((test-out)^2) / Plus@@((test - Mean[test])^2) stat[x_List] := #[x]& /@ {Min, Max, Mean, Median, Sqrt[Variance[#]]&} GetData[x_String] := ReadList[HomeDirectory[] <> "/nn1/data/" <> x] Tr[x_] := Transpose[x] End[] EndPackage[] (* $Log: func.m,v $ Revision 1.14 1997/10/10 21:00:41 tjchol01 Added TS and ALiListPlot. Revision 1.13 1996/10/14 02:06:38 tjchol01 Moved opts in front of DisplayFunction. Added minpos and xprepnovar. Revision 1.12 1996/10/12 20:22:41 tjchol01 SLiListPlot added. Revision 1.11 1996/10/04 19:51:10 tjchol01 Added |SNC| and |vfold|. Revision 1.10 1996/07/09 16:06:32 tjchol01 MatPlot added. Revision 1.9 1996/05/30 03:11:23 tjchol01 Added |normvar| and |prepvar|. Revision 1.8 1996/05/24 05:03:24 tjchol01 Recovered |acfshow| and |prezero|. Revision 1.7 1996/05/24 05:00:01 tjchol01 Added |opts| to LiListPlot. Revision 1.6 1996/05/09 03:27:09 tjchol01 Added functions from |scg.mma|. Revision 1.5 1996/04/29 02:12:54 tjchol01 Lost last changes. Revision 1.4 1996/02/26 23:29:13 tjchol01 Cosmetics. Revision 1.3 1996/02/22 07:46:36 tjchol01 MLiListPlot with grid, added undep. Revision 1.2 1996/02/15 08:05:36 tjchol01 Local working. Got rid of con's with {0, 0}. Revision 1.1 1996/02/15 08:00:53 tjchol01 Initial revision *)