Search NKS | Online
171 - 180 of 272 for Length
Implementation [of operators from axioms]
Given an axiom system in the form {f[a, f[a, a]] a, f[a, b] f[b, a]} one can find rule numbers for the operators f[x, y] with k values for each variable that are consistent with the axiom system by using
Module[{c, v}, c = Apply[Function, {v = Union[Level[axioms, {-1}]], Apply[And, axioms]}]; Select[Range[0, k k 2 - 1], With[{u = IntegerDigits[#, k, k 2 ]}, Block[{f}, f[x_, y_] := u 〚 -1 - k x - y 〛 ; Array[c, Table[k, {Length[v]}], 0, And]]] &]]
For k = 4 this involves checking nearly 16 4 or 4 billion cases, though many of these can often be avoided, for example by using analogs of the so-called Davis–Putnam rules.
.} Length[k]]]]
There are a total of 2 m Fibonacci[m+2] black cells in the pattern obtained up to step 2 m , implying fractal dimension Log[2, 1 + Sqrt[5]] .
Given a sequence of length n , an approximation to h can be reconstructed using
Max[MapIndexed[#1/First[#2] &, FoldList[Plus, First[list], Rest[list]]]]
The fractional part of the result obtained is always an element of the Farey sequence
Union[Flatten[Table[a/b, {b, n}, {a, 0, b}]]]
(See also pages 892 , 932 and 1084 .)
Note that each step in the evolution of any additive cellular automaton can be computed as
Mod[ListCorrelate[w, list, Ceiling[Length[w]/2]], k]
(See page 1087 for a discussion of partial additivity.)
Nevertheless, no such deviations have so far been found except when one looks at sequences whose lengths are close to the repetition period.
Successive steps in the iterative procedure used on this page are given by
Move[list_] := (If[Cost[#] < Cost[list], #, list] &)[ MapAt[1 - # &, list, Random[Integer, {1, Length[list]}]]]
while those in the procedure on page 347 have ≤ in place of < .
The probability for a block of n adjacent white cells (corresponding to a row in a white triangle) seems quite accurately to approach 2 -n , with the first length 10 such block occurring at step 67 and the first length 20 one occurring at step 515.
With a rule given in this form, each step in the evolution of the mobile automaton corresponds to the function
MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{ReplacePart[list, #1, n], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]]
The complete evolution for many steps can then be obtained with
MAEvolveList[rule_, init_List, t_Integer] := NestList[MAStep[rule, #]&, init, t]
(The program will run more efficiently if Dispatch is applied to the rule before giving it as input.)
For the mobile automaton on page 73 , the rule can be given as
{{1, 1, 1} {{0, 0, 0}, -1}, {1, 1, 0} {{1, 0, 1}, -1}, {1, 0, 1} {{1, 1, 1}, 1}, {1, 0, 0} {{1, 0, 0}, 1}, {0, 1, 1} {{0, 0, 0}, 1}, {0, 1, 0} {{0, 1, 1}, -1}, {0, 0, 1} {{1, 0, 1}, 1}, {0, 0, 0} {{1, 1, 1}, 1}}
and MAStep must be rewritten as
MAStep[rule_, {list_List, n_Integer}] /; (1 < n < Length[list]) := Apply[{Join[Take[list, {1, n - 2}], #1, Take[list, {n + 2, -1}]], n + #2}&, Replace[Take[list, {n - 1, n + 1}], rule]]
The formulas for local curvature as a function of arc length for each set of pictures are as follows: 1 (circle); s (Cornu spiral or clothoid); s 2 ; 1/Sqrt[s] (involute of circle); 1/s (logarithmic or equiangular spiral); 1/s 2 ; Exp[-s 2 ] ; Sin[s] ; s Sin[s] .
But if one tries to keep all edges the same length the surface will inevitably become curved—like a soccer ball or a geodesic dome.