Apply a callback to an array: Difference between revisions
Content added Content deleted
(Added uBasic/4tH version) |
|||
| Line 2,549: | Line 2,549: | ||
TXR extends Lisp list processing primitives to work with vectors and strings also, which is why <code>mapdo</code> cheerfully traverses a vector. |
TXR extends Lisp list processing primitives to work with vectors and strings also, which is why <code>mapdo</code> cheerfully traverses a vector. |
||
=={{header|uBasic/4tH}}== |
|||
We cannot transfer the array address, since uBasic/4tH has only got one, but we can transfer the function pointer and size. |
|||
<lang>S = 5 ' Size of the array |
|||
For x = 0 To S - 1 ' Initialize array |
|||
@(x) = x + 1 |
|||
Next |
|||
Proc _MapArray (_SquareRoot, S) ' Call mapping procedure |
|||
For x = 0 To S - 1 ' Print results |
|||
Print "SQRT(";x+1;") = ";Using "#.####";@(x) |
|||
Next |
|||
For x = 0 To S - 1 ' Reinitialize array |
|||
@(x) = x + 1 |
|||
Next |
|||
Proc _MapArray (_Cosine, S) ' Call mapping procedure |
|||
Print : For x = 0 To S - 1 ' Print results |
|||
Print "COS(";x+1;") = ";Using "#.####";@(x) |
|||
Next |
|||
End |
|||
_MapArray Param(2) ' Param(1) = function |
|||
Local (1) ' Param(2) = array size |
|||
For c@ = 0 To b@ - 1 |
|||
@(c@) = FUNC(a@(@(c@))) |
|||
Next |
|||
Return |
|||
_SquareRoot Param (1) ' This is an integer SQR subroutine |
|||
Local (2) |
|||
b@ = (10^(4*2)) * a@ ' Output is scaled by 10^4 |
|||
a@ = b@ |
|||
Do |
|||
c@ = (a@ + (b@ / a@))/2 |
|||
Until (Abs(a@ - c@) < 2) |
|||
a@ = c@ |
|||
Loop |
|||
Return (c@) |
|||
_Cosine Param(1) ' This is an integer COS subroutine |
|||
Push Abs((a@*10000)%62832) ' Output is scaled by 10^4 |
|||
If Tos()>31416 Then Push 62832-Pop() |
|||
Let a@=Tos()>15708 |
|||
If a@ Then Push 31416-Pop() |
|||
Push Tos() |
|||
Push (Pop()*Pop())/10000 |
|||
Push 10000+((10000*-(Tos()/56))/10000) |
|||
Push 10000+((Pop()*-(Tos()/30))/10000) |
|||
Push 10000+((Pop()*-(Tos()/12))/10000) |
|||
Push 10000+((Pop()*-(Pop()/2))/10000) |
|||
If a@ Then Push -Pop() ' Result is directly transferred |
|||
Return ' through the stack</lang> |
|||
{{out}} |
|||
<pre>SQRT(1) = 1.0000 |
|||
SQRT(2) = 1.4142 |
|||
SQRT(3) = 1.7320 |
|||
SQRT(4) = 2.0000 |
|||
SQRT(5) = 2.2360 |
|||
COS(1) = 0.5403 |
|||
COS(2) = -0.4162 |
|||
COS(3) = -0.9901 |
|||
COS(4) = -0.6537 |
|||
COS(5) = 0.2837 |
|||
0 OK, 0:514</pre> |
|||
=={{header|UNIX Shell}}== |
=={{header|UNIX Shell}}== |
||
{{works with|Bourne Shell}} |
{{works with|Bourne Shell}} |
||