>>912

n = 10000
Clear[aa, bb, cc];
aa = IntegerDigits[n, 3];
k = Length[aa] + 1; bb = Table[0, {k}]; cc = bb; Do[
bb[[k - i]] = aa[[i]], {i, Length[aa]}]
Do[Which[bb[[i]] == 2, {bb[[i + 1]] += 1; bb[[i]] = -1},
bb[[i]] == 3, {bb[[i + 1]] += 1; bb[[i]] = 0}], {i, k}]
Do[cc[[k - i + 1]] = bb[[i]], {i, k}]

n=10000 のとき
{1, 1, 1, 2, 0, 1, 1, 0, 1}ーー＞{1, -1, -1, -1, -1, 0, 1, 1, 0, 1}

になりますね。
>>914　さんの方法の初等的なやりかたですが、（頭のいい人はちがうなあああ）

これはＡｎｄｒｅ　Ｗｅｉｌ　の整数論初歩の練習問題（証明せよという形式）に出てきますね。