HSPTV!掲示板

こんにちわ。
AIが流行っているみたいなので、シンプルな機械学習モジュール作ってみました。
「AIを使うより作る方が楽しい」と思う方、改変、組み込みもご自由にどうぞ。
良くない所や、面白い使い方あれば教えていただけると嬉しいです。

※今回からスクリプトの修正があった時に消せるよう（長くならないよう）投稿を分けてます。
※サンプルも載せますので、お手数ですがファイル保存するか頭にコピペして下さいませ。

; 簡易ニューラルネットワークモジュール author: usagi       file: NN.hsp
;------------------------------------------------
#ifndef __Nn__
#define global __Nn__
; Util
#module _NnUtil_
#define global NnUtilEPSILON 0.00001
#define global NnUtilforeach2(%1,%2=i,%3=j)  repeat length(%1)  : %2 = cnt : repeat length2(%1) : %3 = cnt
#define global NnUtilLoop2 loop : loop
#const M_2PI 2f * M_PI
#defcfunc NnUtilRndu ; Uniform Random Number
	return ( double(rnd(32768))+1f ) / 32769f
#defcfunc NnUtilRndn ; Normal Distribution
	return (sqrt(-2.0*logf(NnUtilRndu())) * sin(M_2PI*NnUtilRndu()))
#deffunc NnUtilGuardDim array a_x, array a_y
	if varsize(a_x) != varsize(a_y) { dim  a_x,length(a_y) } return
#deffunc NnUtilGuardDdim array a_x, array a_y
	if varsize(a_x) != varsize(a_y) { ddim a_x,length(a_y) } return
#defcfunc NnUtilMin array a
	m = a : foreach a : m = limitf(a.cnt,, m) : loop : return m
#defcfunc NnUtilMax array a
	m = a : foreach a : m = limitf(a.cnt, m)  : loop : return m
#deffunc NnUtilSoftMax array a_o, array a_i
	max = NnUtilMax(a_i) : sum = NnUtilEPSILON
	foreach a_o : a_o.cnt = expf(a_i.cnt - max) : sum += a_o.cnt : loop
	foreach a_o : a_o.cnt /= sum : loop
	return
#defcfunc NnUtilCrossEntropyError array a_y, array a_t
	foreach a_t : if a_t.cnt >= 1 { loss = -logf(a_y.cnt + NnUtilEPSILON) : break } loop
	return double(loss)
#global
; Affine Layer
#module _NnAffine_ m_w, m_b, m_x, m_dw, m_db
#deffunc NnAffine array a_mod, int a_num_in, int a_num_out
	newmod a_mod, _NnAffine_, a_num_in, a_num_out
	return
#modinit int a_num_in, int a_num_out
	ddim m_x,  a_num_in
	ddim m_w,  a_num_in, a_num_out
	ddim m_b,  a_num_out
	ddim m_dw, a_num_in, a_num_out
	ddim m_db, a_num_out
	sigma = sqrt(2f/a_num_in)	; Randomize(He)
	NnUtilforeach2 m_w : m_w.i.j = NnUtilRndn() * sigma : NnUtilLoop2
	return
#modfunc NnAffineSave str a_filepath, int a_offset
	data_size = varsize(m_w) + varsize(m_b)
	sdim data, data_size
	memcpy data, m_w, varsize(m_w)
	memcpy data, m_b, varsize(m_b), varsize(m_w)
	bsave a_filepath, data, data_size, a_offset
	return data_size + a_offset
#modfunc NnAffineLoad str a_filepath, int a_offset
	data_size = varsize(m_w) + varsize(m_b)
	sdim data, data_size
	bload a_filepath, data, data_size, a_offset
	memcpy m_w, data, varsize(m_w)
	memcpy m_b, data, varsize(m_b),0, varsize(m_w)
	return data_size + a_offset
#modfunc NnAffineForward array a_out, array a_x
	NnUtilGuardDdim a_out, m_b
	memcpy m_x, a_x, varsize(m_x)	; Copy In
	memset a_out, 0, varsize(a_out)	; Weight
	NnUtilforeach2 m_w : a_out.j += a_x.i * m_w.i.j : NnUtilLoop2
	foreach a_out : a_out.cnt += m_b.cnt : loop	; Bias
	return
#modfunc NnAffineBackward array a_dx, array a_dout
	NnUtilGuardDdim a_dx, m_x
	NnUtilGuardDdim a_dout, m_b
	memset a_dx, 0, varsize(a_dx)	; a_dx
	NnUtilforeach2 m_w : a_dx.i += a_dout.j * m_w.i.j : NnUtilLoop2
	NnUtilforeach2 m_w : m_dw.i.j = m_x.i * a_dout.j : NnUtilLoop2	; m_dw
	foreach a_dout : m_db.cnt = a_dout.cnt : loop	; m_db
	return
#modfunc NnAffineLearn double a_rate
	NnUtilforeach2 m_w : m_w.i.j -= a_rate * m_dw.i.j : NnUtilLoop2
	foreach m_b : m_b.cnt -= a_rate * m_db.cnt : loop
	return
#global
; Relu Layer
#module _NnRelu_ m_mask
#deffunc NnRelu array a_mod, int a_num_inout
	newmod a_mod, _NnRelu_, a_num_inout
	return
#modinit int a_num_inout
	dim m_mask, a_num_inout
	return
#modfunc NnReluForward array a_out, array a_x
	foreach a_x : bool = int(a_x.cnt <= 0f) : a_out.cnt = a_x.cnt * double(1^bool) : m_mask.cnt = bool : loop
	return
#modfunc NnReluBackward array a_dx, array a_dout
	foreach a_dout : bool = (m_mask.cnt != 1) : a_dx.cnt = a_dout.cnt * double(bool) : loop
	return
#global
; Softmax Layer
#module _NnSoftmax_ m_y, m_t
#deffunc NnSoftmax array a_mod, int a_num_inout
	newmod a_mod, _NnSoftmax_, a_num_inout
	return
#modinit int a_num_inout
	ddim m_y,  a_num_inout ; softmax out
	dim  m_t,  a_num_inout ; teach (one-hot)
	return
#modfunc NnSoftmaxForward var a_loss, array a_score, array a_x, array a_t
	NnUtilGuardDim a_t, m_t
	NnUtilGuardDdim a_score, m_y
	memcpy m_t, a_t, varsize(m_t)	; Teach copy
	NnUtilSoftMax m_y, a_x	; Softmax
	a_loss = NnUtilCrossEntropyError(m_y, m_t)	; Loss
	memcpy a_score, m_y, varsize(m_y)	; Score copy
	return
#modfunc NnSoftmaxBackward array a_dx
	foreach m_y : a_dx.cnt = m_y.cnt - m_t.cnt : loop
	return
#global
#endif	; __Nn__
;------------------------------------------------

色認識のサンプルです。 （これくらいなら学習する必要ないですがテストとして。。。）

#include "NN.hsp"
; サンプル　色を学習して、何色系か推測する。
screen 0, 640, 480 : title "Nnテスト　※左クリックでマウス下の色名を推測：右クリックでデータから学習開始"
randomize : font msgothic, 25 : onclick goto *L_ON_CLICK
; iro-color.com を参考に学習データを用意
hue_names  = "赤色","橙色","黄色","黄緑","緑色","青緑","青色","水色","紺色","紫色","桃色","赤桃","無色"	; 13
tone_names = "Vd","Bt","Sg","Dp","Lt","St","Dl","Dk","Pe","Lg","Gh","Dg","Vp","Pg","Mg","Vg","Vk"	; 17
dim col_codes, length(hue_names), length(tone_names)
col_codes.0.0  = $E60012,$F39800,$FFF100,$8FC31F,$009944,$009E96,$00A0E9,$0068B7,$1D2088,$920783,$E4007F,$E5004F, $000000
col_codes.0.1  = $EA5532,$F6AD3C,$FFF33F,$AACF52,$00A95F,$00ADA9,$00AFEC,$187FC4,$4D4398,$A64A97,$E85298,$E9546B, $0f0f0f
col_codes.0.2  = $D7000F,$E48E00,$F3E100,$86B81B,$009140,$00958D,$0097DB,$0062AC,$1B1C80,$8A017C,$D60077,$D7004A, $1f1f1f
col_codes.0.3  = $C7000B,$D28300,$DFD000,$7BAA17,$00873C,$008A83,$008DCB,$005AA0,$181878,$800073,$C6006F,$C70044, $2f2f2f
col_codes.0.4  = $EF845C,$F9C270,$FFF67F,$C1DB81,$69BD83,$61C1BE,$54C3F1,$6C9BD2,$796BAF,$BA79B1,$EE87B4,$EF858C, $3f3f3f
col_codes.0.5  = $DE6641,$E8AC51,$F2E55C,$AAC863,$39A869,$27ACA9,$00AEE0,$4784BF,$5D5099,$A55B9A,$DC669B,$DD6673, $4f4f4f
col_codes.0.6  = $CB4829,$D59533,$DFD238,$93B447,$009453,$009794,$0099CE,$136EAB,$423885,$903E84,$CA4684,$CA475C, $5f5f5f
col_codes.0.7  = $A40000,$AC6A00,$B7AA00,$638C0B,$007130,$00736D,$0075A9,$004986,$100964,$6A005F,$A4005B,$A40035, $6f6f6f
col_codes.0.8  = $F5B090,$FCD7A1,$FFF9B1,$D7E7AF,$A5D4AD,$A2D7D4,$9FD9F6,$A3BCE2,$A59ACA,$CFA7CD,$F4B4D0,$F5B2B2, $7f7f7f
col_codes.0.9  = $CF7250,$D7A861,$DED46E,$A7BE70,$5AA572,$53A8A6,$49AAD2,$5D87B7,$695C98,$A1689A,$CE749C,$CF737A, $8f8f8f
col_codes.0.10 = $A7381D,$AE7A26,$B6AC2B,$779438,$007B43,$007D7A,$007FAB,$055A8E,$352A6F,$772F6D,$A7366D,$A7374A, $9f9f9f
col_codes.0.11 = $7D0000,$834E00,$8A8000,$486A00,$00561F,$005752,$005982,$003567,$02004C,$500047,$7E0043,$7D0022, $afafaf
col_codes.0.12 = $FBDAC8,$FEECD2,$FFFCDB,$ECF4D9,$D5EAD8,$D4ECEA,$D3EDFB,$D3DEF1,$D2CCE6,$E7D5E8,$FADCE9,$FADBDA, $bfbfbf
col_codes.0.13 = $D4987E,$D9BA8C,$DED799,$B9C998,$8FB896,$8CBBB8,$89BCD6,$8DA3C4,$8F85AF,$B491B2,$D39CB5,$D49A9C, $cfcfcf
col_codes.0.14 = $BD6748,$C49958,$CAC264,$98AE66,$519768,$4A9A98,$419CC0,$547BA8,$60538C,$945E8D,$BC698F,$BD6970, $dfdfdf
col_codes.0.15 = $7F2509,$845A12,$8A8219,$587026,$005D30,$005F5D,$006083,$00426D,$241754,$5A1B52,$802151,$7F2334, $efefef
col_codes.0.16 = $530000,$562E00,$5B5300,$2A4400,$003705,$003833,$003856,$001A43,$000030,$33002B,$550025,$540005, $ffffff
ddim in, 3 : dim  score, length(hue_names)
ddim losses, 640 : losses_cnt = 0 : counter = 0

; ★学習率の設定　(色々調整すると収束のしかたが変わって面白いかも）
learning_rate = 0.01
; ★In:3-24-13:Outのネットワークを作成　(中間層の数やレイヤー数を増やすと面白いかも)
NnAffine  layer1, 3, 24
NnRelu    layer2
NnAffine  layer3, 24, 13
NnSoftmax layer4, 13
goto *L_LEARN_LOOP

; ★推測
*L_PREDICT
	; 順伝搬
	NnAffineForward  layer1, layer1_out, in
	NnReluForward    layer2, layer2_out, layer1_out
	NnAffineForward  layer3, layer3_out, layer2_out
	NnSoftmaxForward layer4, loss, score, layer3_out, teach
	return

;　★学習
*L_LEARN
	gosub *L_PREDICT
	; 逆伝搬
	NnSoftmaxBackward layer4, layer3_out
	NnAffineBackward  layer3, layer2_out, layer3_out
	NnReluBackward    layer2, layer1_out, layer2_out
	NnAffineBackward  layer1, dummy, layer1_out
	; 更新 (たまにドロップしてもいいかも？）
	NnAffineLearn layer3, learning_rate
	NnAffineLearn layer1, learning_rate
	; 損失率
	losses(losses_cnt) = loss : losses_cnt++ : losses_cnt\=length(losses) : counter++
	return

; 学習ループ
*L_LEARN_LOOP
	gosub *L_GEN_COLOR
	gosub *L_LEARN
	if losses_cnt == 0 : gosub *L_DRAW : await 0
	goto *L_LEARN_LOOP

; マウスクリック
*L_ON_CLICK
	if wparam == 1 { ; 右クリックで画面の色を推測
		pget mousex, mousey : in = double(ginfo_r)/255f, double(ginfo_g)/255f, double(ginfo_b)/255f
		gosub *L_PREDICT
	}
	if wparam == 2 { ; 右クリックで学習開始
		goto *L_LEARN_LOOP
	}
	if wparam == 16 { ; 中クリックでカラーダイアログで選択した色を推測
		dialog "", 33 : in = double(ginfo_r)/255f, double(ginfo_g)/255f, double(ginfo_b)/255f
		gosub *L_PREDICT
	}
	gosub *L_DRAW
	stop

; ランダムに色を選択
*L_GEN_COLOR
	c_hue  = rnd(length(hue_names))
	c_tone = rnd(length(tone_names))
	rgbcolor col_codes(c_hue, c_tone)
	in = double(ginfo_r)/255f, double(ginfo_g)/255f, double(ginfo_b)/255f
	memset teach, 0, varsize(teach) : teach.c_hue = 1
	return

; 情報描画
*L_DRAW
	redraw 0 : rgbcolor $FFFFFF : boxf
	
	rgbcolor $8888cc : foreach losses : line cnt, ginfo_sy, cnt, ginfo_sy-(losses.cnt*100) : loop

	color 255.*in.0,255.*in.1,255.*in.2 : boxf 295,10,345,60

	repeat length(tone_names) : j = cnt : repeat length(hue_names) : i = cnt
			x1 = j*25 : y1 = i*25 : x2 = x1+25 : y2 = y1+25 : x0 = 150: y0 = 85
			rgbcolor col_codes(i,j) : boxf x1+x0,y1+y0,x2+x0,y2+y0
	loop : loop 
	
	rgbcolor $FFFFFF : pos 10, 10
	mes strf("学習回数: %d", counter), 4

	max = score.0 : res = 0 : s = ""
	repeat length(hue_names) : if max<score.cnt { max=score.cnt : res = cnt } loop
	mes strf("推測結果：%s\nスコア", hue_names.res), 4
	foreach score : if cnt==res {rgbcolor $FFFF00}else{rgbcolor $FFFFFF} : mes strf("%s: %.2f", hue_names.cnt, score.cnt), 4 : loop

	redraw 1
	return

音声認識のサンプルです。
学習は「あーーー↑」と低->高い声を出しながら対応する母音のキーボード押してみてください。
何回かやると学習してくると思います。
Vtuberのようなキャラクタの口パクとかに使えるかも。

#include "NN.hsp"
// 簡易FFTモジュール author: usagi
#module _FFT_
#const double M_2PI 2.0*M_PI
// 初期化(4の倍数)
#deffunc FFTInit int q
deg = logf(q)/logf(4) : Ndeg = powf(4, deg) : Pdeg = 0
ddim CR, Ndeg : ddim CI, Ndeg : ddim FR, Ndeg : ddim FI, Ndeg : ddim amp, Ndeg  : ddim phase, Ndeg
return
// セット
#deffunc FFTSet array _arr, int _type
memcpy CR, _arr, varsize(_arr) : memset CI, 0, varsize(_arr)
on _type goto *A0,*A1,*A2 : return
*A0 : return
*A1 : d0 = 1.0/Ndeg : repeat Ndeg : CR.cnt *= 0.50-0.50*cos(M_2PI*d0*cnt) : loop : return	// ハニング窓関数
*A2 : d0 = 1.0/Ndeg : repeat Ndeg : CR.cnt *= 0.54-0.46*cos(M_2PI*d0*cnt) : loop : return	// ハミング窓関数
// ゲット
#deffunc FFTGet array _arr, int _type
on _type goto *B0,*B1,*B2,*B3,*B4,*B5 : return
*B0 : memcpy _arr, amp, varsize(amp) : return		// 振幅
*B1 : memcpy _arr, phase, varsize(phase) : return	// 位相
*B2 : memcpy _arr, CR, varsize(CR) : return			// 入力実数部
*B3 : memcpy _arr, CI, varsize(CI) : return			// 入力虚数部
*B4 : memcpy _arr, FR, varsize(FR) : return			// 出力実数部
*B5 : memcpy _arr, FI, varsize(FI) : return			// 出力虚数部
// FFT(wiki参考)
#deffunc FFTCalc int _mode
	for i, 1, deg+1 : Pdeg = powf(4,deg-i) : for j0, 0, powf(4,i-1) : for j1, 0, Pdeg
	t0 = j1+j0*Pdeg*4 : t1 = t0+Pdeg : t2 = t0+2*Pdeg : t3 = t0+3*Pdeg
	w1 = CR.t0+CR.t1+CR.t2+CR.t3 : w2 = CI.t0+CI.t1+CI.t2+CI.t3 : w3 = CR.t0+CI.t1-CR.t2-CI.t3 : w4 = CI.t0-CR.t1-CI.t2+CR.t3
	w5 = CR.t0-CR.t1+CR.t2-CR.t3 : w6 = CI.t0-CI.t1+CI.t2-CI.t3 : w7 = CR.t0-CI.t1-CR.t2+CI.t3 : w8 = CI.t0+CR.t1-CI.t2-CR.t3
	CR.t0 = w1 : CI.t0 = w2 : CR.t1 = w3 : CI.t1 = w4 : CR.t2 = w5 : CI.t2 = w6 : CR.t3 = w7 : CI.t3 = w8
	for k, 0, 4 : t4 = M_2PI*t0*k/Pdeg/4.0 : t5 = t0+k*Pdeg
	w1 = cos(t4) : w2 = -sin(t4) : w3 = CR.t5*w1-CI.t5*w2 : w4 = CR.t5*w2+CI.t5*w1 : CR.t5 = w3 : CI.t5 = w4
	next : next : next : next
	for i, 0, Ndeg : k = i : k1 = 0
		for j, 1, deg+1 : k1 = k1+(k-Int(k/4)*4)*powf(4,deg-j) : k = Int(k/4) : next
		FR(i) = CR(k1) : FI(i) = CI(k1)
	next
	if _mode { repeat Ndeg : FR.cnt /= Ndeg : FI.cnt /= Ndeg : loop }
	return
#deffunc FFTSpec
	repeat Ndeg : amp.cnt = sqrt(FR.cnt*FR.cnt+FI.cnt*FI.cnt) : phase.cnt = atan(FI.cnt, FR.cnt) : loop : return
#deffunc FFT2Log
	repeat Ndeg : amp.cnt = 20.0*logf(amp.cnt)/logf(10.0) : loop : return
#global
// 簡易マイク入力モジュール author: usagi
#module _WaveIn_
#uselib "WINMM.DLL"
#func waveInOpen "waveInOpen" var,int,var,int,int,int
#func waveInClose "waveInClose" int
#func waveInStart "waveInStart" int
#func waveInReset "waveInReset" int
#func waveInPrepareHeader "waveInPrepareHeader" int,var,int
#func waveInUnprepareHeader "waveInUnprepareHeader" int,var,int
#func waveInAddBuffer "waveInAddBuffer" int,var,int
#deffunc mic_open array _buff, int _rate
	dup m_buff, _buff
	hwi = 0 : wfx = 1 | (1 << 16), _rate, _rate * 2, 2 | (16 << 16), 0 // 既定マイク, PCM: ? KHz 16bit mono
	waveInOpen hwi, /*WAVE_MAPPER*/ 0xFFFFFFFF, wfx, hwnd, 0, /*CALLBACK_WINDOW*/ 0x10000
	bufferLength = length(_buff) * 2
	sdim buff1, bufferLength
	sdim buff2, bufferLength
	wh1 = varptr(buff1), varsize(buff1), 0,0,0,0,0,0
	wh2 = varptr(buff2), varsize(buff2), 0,0,0,0,0,0
	waveInPrepareHeader hwi, wh1, 32 : waveInAddBuffer hwi, wh1, 32
	waveInPrepareHeader hwi, wh2, 32 : waveInAddBuffer hwi, wh2, 32
	waveInStart hwi : if stat { dialog "マイク入力出来ませんでした" : end }
	oncmd gosub *ON_MM_WIM_DATA, /*MM_WIM_DATA*/0x03C0
	return
*ON_MM_WIM_DATA
	dupptr wh, lparam, 32 : dupptr buff, wh.0, wh.1, 2
	foreach m_buff : m_buff.cnt = double(wpeek(buff, cnt * 2) << 16 >> 16) / 32768.0 : loop
	waveInAddBuffer wparam, wh, 32
	return
#deffunc local exit onexit
	waveInReset hwi : waveInUnprepareHeader hwi, wh, 32 : waveInClose hwi : return
#global

; 定義
#define SAMPLE_RATE 8000
#define BUFFER_SIZE 256
; 画面初期化
screen 0, 600, 600
; マイク
ddim buff, BUFFER_SIZE
ddim amp,  BUFFER_SIZE
ddim ceps, BUFFER_SIZE
mic_open buff, SAMPLE_RATE
FFTInit	BUFFER_SIZE
; 学習 ★ここを色々変えると認識制度がかわるかも（レイヤー増やした方が良さそう）
learning_rate = 0.01
NnAffine  layer1, 12, 32
NnRelu    layer2
NnAffine  layer3, 32, 6
NnSoftmax layer4, 6
dim teach, 12
keyname = "A", "I", "U", "E", "O", "N"
keycode = 65, 73, 85, 69, 79, 78
*MAIN

	; 高周波強調
	foreach buff : d0 = buff(cnt) : buff(cnt) = buff(cnt) - 0.97 * d1 : d1 = d0 : loop
	; スペクトラム
	FFTSet buff, 1 : FFTCalc 0 : FFTSpec : FFT2Log : FFTGet amp, 0
	foreach amp : amp(cnt) = limitf( amp(cnt), -96.0, 0.0) : loop	; 丸め
	; ケプストラム
	FFTSet amp, 0 : FFTCalc 1 : FFTGet ceps, 4
	repeat 12 : in.cnt = ceps(cnt+1) : loop ; 学習の入力はケプストラムの1次の平行成分は除去
	vol = double(ceps.0+96)/96 ; ケプストラムの1次は音量として使う

	; キー入力
	idx = -1 : memset teach, 0, varsize(teach)
	foreach keycode
		getkey key, keycode.cnt : if key { idx = cnt : teach.cnt = 1 : break}
	loop

	; 推測
	NnAffineForward  layer1, layer1_out, in
	NnReluForward    layer2, layer2_out, layer1_out
	NnAffineForward  layer3, layer3_out, layer2_out
	NnSoftmaxForward layer4, loss, score, layer3_out, teach

	if idx != -1 {
		; 学習
		NnSoftmaxBackward layer4, layer3_out
		NnAffineBackward  layer3, layer2_out, layer3_out
		NnReluBackward    layer2, layer1_out, layer2_out
		NnAffineBackward  layer1, dummy, layer1_out
		; 更新
		NnAffineLearn layer3, learning_rate
		NnAffineLearn layer1, learning_rate
	}

	redraw 0
	color : boxf : pos 0,0 : rgbcolor $FFFFFF
	mes "マイクに「あいうえお」を入力しながら、キーボード[aiueo]を押すと学習します。"
	; マイク入力描画
	rgbcolor $888888 : pos 0, 300 : foreach buff : line cnt*600/BUFFER_SIZE, buff(cnt)*150+300 : loop
	; 音素表描画
	foreach keyname
		col = limit(score(cnt)*255, 128, 255)
		ang = (360f / length(keyname)) * cnt - 90f
		x = cos( deg2rad( ang )) * 200 + 300
		y = sin( deg2rad( ang )) * 200 + 300
		color col, col, 128 : line x, y, 300, 300
		mes strf(" %s:%1.4f", keyname(cnt), score(cnt)),4
	loop
	rgbcolor $ff0000
	repeat length(keyname)+1 : i = cnt\length(keyname)
		ang = (360f / length(keyname)) * cnt - 90f
		x = cos( deg2rad( ang )) * 200  * score(i) * vol + 300
		y = sin( deg2rad( ang )) * 200  * score(i) * vol + 300
		if cnt = 0 : pos x, y : else : line x, y
	loop
	
	redraw 1 : await 32
	goto *MAIN