Cafe Version.2.1-patch.1
山田邦博です。
Cafe の patched version です。
複素数を手軽に扱える(RPN)関数電卓です。
電気・電子工学の研究開発に携わる研究者、技術者のためのものです。
詳細は下記 web ペイジにあります。
http://www.tksa.gr.jp/king/Software/Cafe/Cafe.html
全ての完全なファイルの URL は
ftp://ftp.tksa.gr.jp/king/Cafe/Cafe_2.1-patch.1.tgz
です。
-...-
Cafe の bug fixed が中心です。
"| tee" のような STDOUT を pipe した時に、buffer が flush されてい
なかったため、ぎこちない動作になっていました。
STDOUT,STDERR 共に毎回 flush するようにしました。
perl 5.005 対策。
等など。
追加関数：
rabs : 実数の絶対値
sqabs : 絶対値の自乗値
dbp : 複素振幅値の Decibel
追加 script:
minimize_error.cafe : ある評価関数の極小値を求める関数定義
一種の偏微分方程式の数値解析と考えて下さい。
"$ cafe minimize_error" で起動した後、"cafe> pc me" で関数 me
の概要が出て来ます。
doc/example/compensate.small.speaker.cafe に me の使用例があり
ます。 "$ cafe /some/path/compensate.small.speaker.cafe" で周
波数特性補正用のフィルターの RC の数値が出力されます。
ドキュメントは diff で、バイナリーは diff+shar です。 適当に本投稿から
切り出して下さい。
-...-
##### (BEGIN) cut here for documents #####
diff -uN Cafe_2.1/doc/INSTALL.jp.txt Cafe_2.1-patch.1/doc/INSTALL.jp.txt
--- Cafe_2.1/doc/INSTALL.jp.txt 2004-01-03 14:31:28.000000000 +0900
+++ Cafe_2.1-patch.1/doc/INSTALL.jp.txt 2004-01-29 20:47:43.000000000 +0900
@@ -3,6 +3,8 @@
動作に必要な環境：
Perl-5 (5.8.2 および 5.6.1 で動作確認されています)
+ (Cafe version 2.1-patch.1 は 5.005 でも動作確認されてい
+ ます)
Perl module として Term::ReadLine
Perldoc (必須ではないが、ないと cafe -h でヘルプが出ない)
ASCII escape sequence を処理できる端末。
@@ -20,9 +22,13 @@
最近の Linux の distribution であればおそらく問題ないと思います。
他の Unix でも問題は少ないでしょう。(GNU 関連のソフトを少し入れる必
要があるかも知れません。特に ReadLine)
- Windows では分かりません。 Sygwin での動作可能性はあるでしょうが、
- ソースを少し修正する必要があるかも知れません。
+ Windows では分かりません。 Cygwin での動作可能性はあるでしょうが、
+ ソースを少し修正する必要があるかも知れません。
+ 注： cygwin 上の perl を使用した場合、$ cafe diagnosis は正常
+ ですが、端末からのコマンドの補間が効かないようです。
+ ReadLine 関連のトラブルと思います。 私は Windows 使いでは
+ ないのでこれ以上の対応はできませんが、ご参考までに。
インストール方法：
@@ -53,7 +59,7 @@
cafe script を書き貯めておくなら環境変数 CAFE を設定して下さい。
.-.-.
-3 Jan.2004
+29 Jan.2004
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uN Cafe_2.1/doc/README.jp.txt Cafe_2.1-patch.1/doc/README.jp.txt
--- Cafe_2.1/doc/README.jp.txt 2004-01-03 20:48:53.000000000 +0900
+++ Cafe_2.1-patch.1/doc/README.jp.txt 2004-01-31 11:35:16.000000000 +0900
@@ -5,7 +5,7 @@
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
- 3 Jan.2004 (Release 2.1)
+ 31 Jan.2004 (Release 2.1-patch.1)
Copyright policy: GNU GPL Ver.2
@@ -254,6 +254,11 @@
取り込まれるコメントは行単位で、"#" の直後の空白(タブを含まない)一個は
取り除かれます。 また、行末の空白、タブも取り除かれます。
+ただし、先の "#" の直後にさらに "#" がある場合はそのコメントは取り込ま
+れません。 つまり、m/^##.*|\s##.*/ にマッチするコメントは def 宣言で取
+り込まれません。(pc 及び apropos で参照させたくない、def の詳細のコメ
+ントを書くのに使えます。)
+
継続行を使うことで、複数行のコメントを入れられます。 例は define.cafe
を参照してください。
@@ -607,7 +612,8 @@
has_inf Has some INF(infinity)
is_nan Is NAN(Non Arithmetic Number)
is_declared Is declared(引数は対象変数名を表す文字列)
- is_defined Is defined(引数は対象変数名を表す文字列)
+ is_defined Is defined(引数は対象変数名又は配列要素を表す
+ 文字列。配列要素の鈎括弧内は評価される)
split Split string to array(引数は文字列、結果は文字列の配列)
join Join character elements of array into single string
diff -uN Cafe_2.1/doc/TODO.jp.txt Cafe_2.1-patch.1/doc/TODO.jp.txt
--- Cafe_2.1/doc/TODO.jp.txt 2003-07-21 22:16:26.000000000 +0900
+++ Cafe_2.1-patch.1/doc/TODO.jp.txt 2004-01-29 22:01:16.000000000 +0900
@@ -11,8 +11,17 @@
Array への演算子適用。
現在の演算速度では中途半端かな?
+Reference の一般化。
+ ようは現在禁止している referenced value の変数への代入を、許す
+ ようにしたい。
+ しかしながら、MUMBLE.jp.txt にも書いてあるように cafe script
+ の開発上あるいは Cafe そのものの実装上で様々な問題を抱えてしま
+ う。
+ 現在の私の Cafe の使い方からすれば、労多くして功少なしなので、
+ 今しばらくは考えない事にする。
+
.-.-.
-21 Jul.2003
+29 Jan.2004
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uN Cafe_2.1/doc/change.log Cafe_2.1-patch.1/doc/change.log
--- Cafe_2.1/doc/change.log 2004-01-03 17:04:23.000000000 +0900
+++ Cafe_2.1-patch.1/doc/change.log 2004-01-31 11:34:48.000000000 +0900
@@ -1,3 +1,26 @@
+31 Jan.2004
+ Version 2.1-patch.1 : released
+
+23 Jan.2004
+ added compensate.small.speaker.cafe to doc/example/
+
+20 Jan.2004
+ modified for perl 5.005_03. (use/no strict for treating files to
+ be included)
+
+15 Jan.2004
+ cafe: flush buffer any time for STDOUT and STDERR.
+
+13 Jan.2004
+ Bug fixed for def function with referenced-parameter in def
+ function.
+ Changed: comment begining with "##" is ignored for def command.
+ Modified: bracket: checked no term in bracket.
+ is_defined: evaluated array element.
+ skip_command_list: $sv_pnt added for trace_error.
+ define.cafe: added DEBUG variable, rabs,sqabs and dbp function.
+ install.sh: added minimize_error.cafe to LIB.
+
3 Jan.2004
lib_path: changed separator from " " to ":".
inlclude: changed to re-entrant. (New file handle created by string)
##### (END) cut here for documents #####
-...-
##### (BEGIN) cut here for binaries #####
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 2004-01-31 12:55 JST by <king@chiepo>.
# Source directory was `/home/king/tmp'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 13928 -rw-r----- patch_for_cafe.diff
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
if test "$gettext_dir" = FAILED && test -f $dir/gettext \
&& ($dir/gettext --version >/dev/null 2>&1)
then
set `$dir/gettext --version 2>&1`
if test "$3" = GNU
then
gettext_dir=$dir
fi
fi
if test "$locale_dir" = FAILED && test -f $dir/shar \
&& ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
then
locale_dir=`$dir/shar --print-text-domain-dir`
fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
echo=echo
else
TEXTDOMAINDIR=$locale_dir
export TEXTDOMAINDIR
TEXTDOMAIN=sharutils
export TEXTDOMAIN
echo="$gettext_dir/gettext -s"
fi
if touch -am -t 200112312359.59 $$.touch >/dev/null 2>&1 && test ! -f 200112312359.59 -a -f $$.touch; then
shar_touch='touch -am -t $1$2$3$4$5$6.$7 "$8"'
elif touch -am 123123592001.59 $$.touch >/dev/null 2>&1 && test ! -f 123123592001.59 -a ! -f 123123592001.5 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$1$2.$7 "$8"'
elif touch -am 1231235901 $$.touch >/dev/null 2>&1 && test ! -f 1231235901 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$2 "$8"'
else
shar_touch=:
echo
$echo 'WARNING: not restoring timestamps. Consider getting and'
$echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 200112312359.59 123123592001.59 123123592001.5 1231235901 $$.touch
#
if mkdir _sh02177; then
$echo 'x -' 'creating lock directory'
else
$echo 'failed to create lock directory'
exit 1
fi
# ============= patch_for_cafe.diff ==============
if test -f 'patch_for_cafe.diff' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'patch_for_cafe.diff' '(file already exists)'
else
$echo 'x -' extracting 'patch_for_cafe.diff' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'patch_for_cafe.diff' &&
diff -uN Cafe_2.1/bin/cafe Cafe_2.1-patch.1/bin/cafe
--- Cafe_2.1/bin/cafe 2004-01-03 16:39:47.000000000 +0900
+++ Cafe_2.1-patch.1/bin/cafe 2004-01-31 11:45:49.000000000 +0900
@@ -32,6 +32,7 @@
X # 22 May 2003 Ver.2.0-patch.1 (Released)
X # 24 Dec.2003 Ver.2.1-pre.1 (Pre-released)
X # 3 Jan.2004 Ver.2.1 (Released)
+# 31 Jan.2004 Ver.2.1-patch.1 (Released)
X #
X
X no lib qw(:ALL .);
@@ -87,12 +88,14 @@
X
X Cafe::op_set_lib_path($LIB_PATH);
X
+select STDERR; $| = 1; # Flush buffer STDERR
+select STDOUT; $| = 1; # Flush buffer STDOUT
X while(my $f=shift(@ARGV)) {
X Cafe::op_include($f);
X }
X
-exit 0 if not -t STDIN or # the script is fed from STDIN as pipe.
- $opt_t; # terminate before inputting from the console.
+exit 0 if not -t STDIN # the script is fed from STDIN as pipe.
+ or $opt_t; # terminate before inputting from the console.
X
X Cafe::op_print_flush();
X Cafe::op_ps("print_only_new"); # print values if exists on the stack.
@@ -107,12 +110,6 @@
X $attribs->{completion_entry_function} =
X $attribs->{list_completion_function};
X $attribs->{completion_word} = [ Cafe::allIDs() ];
-if (defined $term->OUT and $term->OUT) {
- select($term->OUT);
-} else {
- select STDOUT;
-}
-# $| = 1;
X
X my $string = "";
X my $prompt = "cafe> ";
diff -uN Cafe_2.1/bin/install.sh Cafe_2.1-patch.1/bin/install.sh
--- Cafe_2.1/bin/install.sh 2004-01-03 14:14:08.000000000 +0900
+++ Cafe_2.1-patch.1/bin/install.sh 2004-01-31 11:46:41.000000000 +0900
@@ -31,6 +31,8 @@
X # 5 May 2003 -d: deinstall option
X # 15 May 2003 Ver.2.0 (Released)
X # 22 May 2003 Ver.2.0-patch.1
+# 3 Jan.2004 Ver.2.1 (Released)
+# 31 Jan.2004 Ver.2.1-patch.1 (Released)
X #
X
X set -e
@@ -38,9 +40,9 @@
X
X ### List of files to be installed or deinstalled ###
X BIN="cafe"
-LIB="Cafe.pm define.cafe antenna.cafe music.cafe diagnosis.cafe word.cafe"
+LIB="Cafe.pm define.cafe antenna.cafe music.cafe diagnosis.cafe word.cafe minimize_error.cafe"
X DOC="BNF.txt BUGS.jp.txt DIAGNOSIS.jp.txt GPL-2 INSTALL.jp.txt MUMBLE.jp.txt README.jp.txt TODO.jp.txt VERSION.jp.txt change.log"
-EXM="filts4.cafe"
+EXM="filts4.cafe compensate.small.speaker.cafe"
X
X usage () {
X cat >&2 <<EOF
diff -uN Cafe_2.1/lib/Cafe.pm Cafe_2.1-patch.1/lib/Cafe.pm
--- Cafe_2.1/lib/Cafe.pm 2004-01-03 16:50:29.000000000 +0900
+++ Cafe_2.1-patch.1/lib/Cafe.pm 2004-01-31 11:45:48.000000000 +0900
@@ -28,6 +28,7 @@
X # 22 May 2003 Ver.2.0-patch.1 (Released)
X # 24 Dec 2003 Ver.2.1-pre.1 (Pre-released)
X # 3 Jan.2004 Ver.2.1 (Released)
+# 31 Jan.2004 Ver.2.1-patch.1 (Released)
X #
X
X
@@ -80,7 +81,7 @@
X ### Constants ###
X ###################
X
-my $VERSION = "2.1";
+my $VERSION = "2.1-patch.1";
X
X my $INF = 1e9999999999;
X my $NAN = $INF - $INF;
@@ -1191,11 +1192,34 @@
X
X sub op_is_defined () {
X my $s = check_un_string("is_defined")->{value};
- my $v = getID($s);
- my $bool = 0;
+ push_cmdln($s,'S:is_defined',0,0);
+ s/^\s*($PTN_ID)\s*//o;
+ $cmdpnt += length $&;
+ my $v = getID($1);
+ my $bool;
X if (ref $v) {
- $bool = 1 if defined $v->{value};
+ if (defined $v->{value}) {
+ while(s/^\s*\[//) {
+ $cmdpnt += length($&);
+ unless ($v->{type} eq 'A') {
+ $bool = 0;
+ last;
+ }
+ $v = $v->{value}[bracket()];
+ unless (defined $v) {
+ $bool = 0;
+ last;
+ }
+ }
+ $bool = (/^$/ and defined $v->{value} ? 1 : 0)
+ unless defined $bool;
+ } else {
+ $bool = 0;
+ }
+ } else {
+ $bool = 0;
X }
+ pop_cmdln();
X pushvstack(bool($bool));
X }
X
@@ -1955,10 +1979,11 @@
X no strict;
X use strict qw(vars subs);
X open ($F,$file) || die "include: \"$file\": $!";
- use strict qw(vars subs refs);
+# use strict qw(vars subs refs);
X my $line_number = 1;
X my $string = "";
X while(<$F>) {
+ use strict qw(vars subs refs);
X $string .= $_;
X unless (/$PTN_CONTINUATION/o) { # check continuation mark
X my $src = "f:" . ($file eq '-' ? 'STDIN' : $file);
@@ -1967,6 +1992,7 @@
X if ($on_console) {
X last;
X } else {
+ no strict;
X close($F);
X exit 254;
X }
@@ -1976,6 +2002,7 @@
X }
X }
X close($F);
+ use strict qw(vars subs refs);
X --$Fnumber;
X $_ = "";
X }
@@ -2522,12 +2549,16 @@
X my $skip = shift;
X my $saved_bgn = $cmdbgn;
X $cmdbgn = $cmdpnt - 1;
+ my $saved_nvstack = nvstack();
X expression($skip);
X if (s/^\]\s*//) {
X $cmdpnt += length $&;
X return undef if $skip;
+ die "bracket: No term in bracket.\n"
+ unless nvstack() - $saved_nvstack == 1;
X my $v = check_un_num("bracket");
- DIE("bracket: operand($v->{name}) should be real", $v) unless Im($v) == 0;
+ DIE("bracket: operand($v->{name}) should be real.\n", $v)
+ unless Im($v) == 0;
X my $n = Re($v);
X DIE("bracket: operand($v->{name}) should be non-negative integer.\n", $v)
X unless int($n) == $n and $n >= 0;
@@ -3137,6 +3168,7 @@
X my $saved_bgn = $cmdbgn;
X while ($_ ne '') {
X $cmdpnt += length $& if s/^\s+//;
+ my $sv_pnt = $cmdpnt;
X if (/^\}|^$/) {
X last;
X } elsif (s/^;\s*//) {
@@ -3166,18 +3198,20 @@
X next;
X } elsif (s/^($PTN_ID)\s*\(\s*//o) {
X $cmdpnt += length $&;
- if (s/^\)\s*=\s*\{//o) {
+ if (s/^\)\s*=\s*\{//) {
X $cmdpnt += length $&;
X skip_brace();
X next;
- } elsif (s/^($PTN_ID)\s*(,\s*($PTN_ID)\s*)*\)\s*=\s*\{\s*//o) {
+ } elsif (s/^($PTN_REF)?\s*($PTN_ID)\s*(,\s*($PTN_REF)?\s*($PTN_ID)\s*)*\)\s*=\s*\{\s*//o) {
X $cmdpnt += length $&;
X skip_brace();
X next;
X } else {
+ $cmdbgn = $sv_pnt;
X die "skip_command: Bad function definition format.\n";
X }
X } else {
+ $cmdbgn = $sv_pnt;
X die "skip_command: Bad definition(def) format.\n";
X }
X } else {
@@ -3638,6 +3672,7 @@
X undef $lines; #
X foreach (@lines) {
X $continue = s/$PTN_CONTINUATION//o; # check continuation and remove it
+ s/(^|\s+)\##(.*)//; # Ignore comment begining with ##
X if (s/(^|\s+)\#(.*)//) { # extract comment
X my $cm = $2;
X $cm =~ s/^ //;
diff -uN Cafe_2.1/lib/define.cafe Cafe_2.1-patch.1/lib/define.cafe
--- Cafe_2.1/lib/define.cafe 2004-01-03 15:30:39.000000000 +0900
+++ Cafe_2.1-patch.1/lib/define.cafe 2004-01-31 11:49:16.000000000 +0900
@@ -22,9 +22,10 @@
X # 22 May 2003 Ver.2.0-patch.1 (Released)
X # 24 Dec.2003 Ver.2.1-pre.1 (Pre-released)
X # 3 Jan.2004 Ver.2.1 (Released)
+# 31 Jan.2004 Ver.2.1-patch.1 (Released)
X #
X
-def DEFVER=="2.1"; # Version number of define.cafe
+def DEFVER=="2.1-patch.1"; # Version number of define.cafe
X
X def Version() = { # Print version \
X print "\tCafe system : Version $(sysver)\n"; \
@@ -48,6 +49,7 @@
X set_reps(1e-15); # Set relative epsilon
X no_divide_by_0(1); # Set no error mode while divided by 0
X no_error_stringify(0); # Set no error mode while stringify ("...")
+def DEBUG = 0; # Switch for DEBUG to be used in cafe scripts
X
X #######################################
X ### Basic constants and functions ###
@@ -136,6 +138,9 @@
X def ($a)min($b) 250 = {($a<$b ? $a : $b)} # Minimum
X
X def abs($x) = {sqrt(Re($x)*Re($x) + Im($x)*Im($x))} # "Unary" Absolute value
+def rabs($r) = { ($r>=0 ? $r : -$r) } # "Unary" Absolute real value
+def sqabs($x) = {Re($x)*Re($x) + Im($x)*Im($x)} \
+ # "Unary" Squared absolute value
X def sqrt($x) = {$x^0.5} # "Unary" Square root
X def d2r($x) = {pi($x/180)} # "Unary" Degree to Radian
X def r2d($x) = {180$x/pi} # "Unary" Radian to Degree
@@ -314,6 +319,7 @@
X def db10($x)={10*log10($x)} # "Unary" Decibel(Power)
X def db20($x)={20*log10($x)} # "Unary" Decibel(Amplitude)
X def dBm($power)={db10($power)+30} # "Unary" Decibel of Power (0dBm=1mW)
+def dbp($x)={db10(sqabs($x))} # "Unary" Decibel(Complex amplitude)
X
X def skin_depth($f,$u,$sigma)={sqrt(2/(2pi $f $u Sigma_material($sigma)))} \
X # Skin Depth (m) \
diff -uN Cafe_2.1/lib/minimize_error.cafe Cafe_2.1-patch.1/lib/minimize_error.cafe
--- Cafe_2.1/lib/minimize_error.cafe 1970-01-01 09:00:00.000000000 +0900
+++ Cafe_2.1-patch.1/lib/minimize_error.cafe 2004-01-31 11:48:02.000000000 +0900
@@ -0,0 +1,75 @@
+# minimize_error.cafe : Minimize Error
+
+# Author:
+# YAMADA Kunihiro <king@tksa.gr.jp>
+# (http://www.tksa.gr.jp/king/)
+#
+# Copyright policy:
+# GNU GPL Ver.2
+#
+# History:
+# 13 Jan.2004 Coded and tested.
+# 31 Jan.2004 released with Cafe version 2.1-patch.1
+#
+
+def me(@$ef,@$ap,$ar,$te,$nr,$cn) = { \
+ # Minimize Error \
+ # $ef : Error Function \
+ # $ap : Array of Parameteres \
+ # $ar : Array of Ranges for parameters \
+ # $te : Taget of Error \
+ # $nr : Maximum number of repetition times \
+ # $cn : Array of Control parameter \
+ # (Default: Accel=2, Decel=-0.15, Firststep=0.1) \
+ if (is_defined '$cn') { \
+ if (vtype $cn eq 'ARRAY') { \
+ $ACCEL = $cn[0]; ## Coefficient for Acceleration \
+ $DECEL = $cn[1]; ## Coefficient for Deceleration \
+ $FIRSTSTEP = $cn[2]; ## First step of changing parameters \
+ } \
+ }; \
+ if (!is_defined '$ACCEL') { $ACCEL = 2 }; \
+ if (!is_defined '$DECEL') { $DECEL = -0.15 }; \
+ if (!is_defined '$FIRSTSTEP') { $FIRSTSTEP = 0.1 }; \
+ if ($ACCEL<=0 or $ACCEL>4) \
+ { die "Improper \$cn: should be 0<ACCEL<=4\n" }; \
+ if ($DECEL>=0 or $ACCEL<-0.5) \
+ { die "Improper \$cn: should be -0.5<=ACCEL<0\n" }; \
+ if (not(($FIRSTSTEP>0 and $FIRSTSTEP<=0.2) or \
+ ($FIRSTSTEP<0 and $FIRSTSTEP>=-0.2))) \
+ { die "Improper \$cn: should be 0<abs(FIRSTSTEP)<=0.2\n" }; \
+ $n = narray($ap); \
+ if ($n != narray($ar)) { \
+ die "Mismatched number of array elements for \$ap and \$ar.\n"; \
+ }; \
+ for ($i=0; $i<$n; ++$i) { \
+ $diff[$i] = $FIRSTSTEP($ap[$i]-$ar[$i][0]); \
+ if ($ap[$i]+$diff[$i] >= $ar[$i][1]) { $diff[$i] *= -1 } \
+ }; \
+ $e1 = $ef($ap); ## evaluate error by function $ef with parameter $ap \
+ for ($lp=1; $lp<=$nr and $e1>$te; ++$lp) { \
+ for ($i=0; $i<$n; ++$i) { \
+ $e0 = $e1; \
+ $api = $ap[$i]; ## save current parameter \
+ if($ap[$i]+$diff[$i] < $ar[$i][0]) { ## check lower boundary \
+ if($ap[$i]==$ar[$i][0]){$diff[$i]*=$DECEL}; \
+ $ap[$i]=$ar[$i][0]; \
+ } elsif ($ap[$i]+$diff[$i] > $ar[$i][1]) { ## check higher boundary \
+ if($ap[$i]==$ar[$i][1]){$diff[$i]*=$DECEL}; \
+ $ap[$i]=$ar[$i][1]; \
+ } else { \
+ $ap[$i]+=$diff[$i]; \
+ }; \
+ $e1 = $ef($ap); ## evaluate error by function $ef with parameter $ap \
+ if ($e1 < $e0) { \
+ $diff[$i] *= $ACCEL; \
+ $e0 = $e1; \
+ } else { \
+ $diff[$i] *= $DECEL; \
+ $ap[$i] = $api; ## restore previous parameter \
+ } \
+ } \
+ }; \
+ if(DEBUG){print "\#DEBUG(minimize_error): loop=$($lp-1), error=$e0\n"}; \
+ $e0; \
+}
diff -uN Cafe_2.1/doc/example/compensate.small.speaker.cafe Cafe_2.1-patch.1/doc/example/compensate.small.speaker.cafe
--- Cafe_2.1/doc/example/compensate.small.speaker.cafe 1970-01-01 09:00:00.000000000 +0900
+++ Cafe_2.1-patch.1/doc/example/compensate.small.speaker.cafe 2004-01-31 11:42:16.000000000 +0900
@@ -0,0 +1,138 @@
+#!/usr/local/bin/cafe
+
+# Author:
+# YAMADA Kunihiro <king@tksa.gr.jp>
+# (http://www.tksa.gr.jp/king/)
+#
+# Copyright Policy:
+# GNU GPL Ver.2
+#
+
+# History:
+# 13 Jan.2004 compensater designed for small speaker systems
+# 21 Jan.2004 fixed target response
+# 31 Jan.2004 released with Cafe version 2.1-patch.1
+#
+
+
+# This is an example.
+# Enter command on the shell for test.
+# $ cafe /some/path/compensate.small.speaker.cafe
+#
+
+
+# Compensates frequency response for small speaker sysmtems.
+# (Low boosted and High depressed)
+#
+#
+# | \Ope.Amp.
+# Ein | \
+# ----R0--+------|+ \ Eout
+# | | +--+----
+# R1 +--|- / |
+# | | | / |
+# C1 | | / R3
+# | | |
+# ~~~ +---+--R2--+
+# | | |
+# R4 +--C2--+
+# |
+# ~~~
+#
+
+# Target response(relative):
+# f(Hz) Res(dB)
+# 100 8
+# 200 6
+# 500 2
+# 1k 0
+# 2k -1
+# 5k -3
+# 10k -5
+# 20k -6
+#
+
+
+include 'minimize_error'
+
+DEBUG = 1
+
+GAIN = 6
+R0 = 10kilo
+R4 = 10kilo
+r1 = ({100;10kilo;100kilo;shrink}) # min, initial, max
+c1 = ({100pico;1nano;100nano;shrink})
+r2 = ({100;10kilo;100kilo;shrink})
+c2 = ({1nano;10nano;1micro;shrink})
+r3 = ({100;10kilo;100kilo;shrink})
+
+def setparam($p) = { \
+ apush(@ap,$p[1]); \
+ apush(@ar,({$p[0];$p[2];shrink})); \
+}
+
+# setup for ap(parameters) and ar(ranges)
+#
+setparam(r1) # R1 = ap[0]
+setparam(c1) # C1 = ap[1]
+setparam(r2) # R2 = ap[2]
+setparam(c2) # C2 = ap[3]
+setparam(r3) # R3 = ap[4]
+
+def setresponse($f,$r) = { \
+ apush(@tf,$f); \
+ apush(@tr,$r+GAIN); \
+}
+
+# setup for tf(target frequency) and tr(target response)
+#
+setresponse( 100, 8 ) # Hz and dB
+setresponse( 200, 6 )
+setresponse( 500, 2 )
+setresponse( 1kilo, 0 )
+setresponse( 2kilo, -1 )
+setresponse( 5kilo, -3 )
+setresponse( 10kilo, -5 )
+setresponse( 20kilo, -6 )
+
+N = narray(tf)
+
+def res($f)={ $w=2pi j$f; \
+ $z1=ap[0]+(1/ap[1]$w); $z2=(ap[2]//(1/ap[3]$w))+ap[4]; \
+ dbp($z1/(R0+$z1)*($z2+R4)/R4); \
+}
+
+def ef($ap)={ \
+ $e = 0; \
+ for($i=0; $i<N; ++$i) { \
+ $e += rabs(tr[$i] - res(tf[$i])); \
+ }; \
+ $e; \
+}
+
+def pr($er) = { \
+ print "R0=$(R0) orm\n"; \
+ print "R1=$(ap[0]) ohm \tC1=$(ap[1]) farad\n"; \
+ print "R4=$(R4) orm\n"; \
+ print "R2=$(ap[2]) ohm \tC2=$(ap[3]) farad\n"; \
+ print "R3=$(ap[4]) ohm\n\n"; \
+ for ($i=0; $i<N; ++$i) { \
+ print "f=$(tf[$i])\t$(res(tf[$i])-GAIN) db\t($(tr[$i]-GAIN) db)\n"; \
+ }; \
+ print "\nError_sum = $er (db)\n"; \
+ print "\n---\n"; \
+}
+
+
+print "$(date)\n\n"
+print "INITIAL:\n\n"
+pr(ef(ap))
+
+def $cn
+$cn = ({2;-0.15;0.01;shrink})
+$e = me(@ef,@ap,ar,1,200,$cn)
+
+print "\nFINAL:\n\n"
+pr($e)
+
+quit
SHAR_EOF
(set 20 04 01 31 12 41 21 'patch_for_cafe.diff'; eval "$shar_touch") &&
chmod 0640 'patch_for_cafe.diff' ||
$echo 'restore of' 'patch_for_cafe.diff' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'patch_for_cafe.diff:' 'MD5 check failed'
b71c12c6273875052e02b7e758ef1cf4 patch_for_cafe.diff
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'patch_for_cafe.diff'`"
test 13928 -eq "$shar_count" ||
$echo 'patch_for_cafe.diff:' 'original size' '13928,' 'current size' "$shar_count!"
fi
fi
rm -fr _sh02177
exit 0
Fnews-brouse 1.9(20180406) -- by Mizuno, MWE <mwe@ccsf.jp>
GnuPG Key ID = ECC8A735
GnuPG Key fingerprint = 9BE6 B9E9 55A5 A499 CD51 946E 9BDC 7870 ECC8 A735